En una tarde de aburrimiento, se me ocurrió hacer una función para descargar archivos de un servidor web utilizando Sockets.
Es una función alternativa a la API URLDownLoadToFile o a la API de WinInet.
uses SysUtils, Classes, Windows, Forms, WinSock;
{Función: GetDomainName
Ejemplo: Si le pasas "http://foro.elhacker.net/post.html;board=18.0"
como parámetro te devuelve "foro.elhacker.net"}
function GetDomainName(const URL: AnsiString): AnsiString;
var
P1: integer;
begin
P1:= Pos('http://', LowerCase(URL));
if P1 > 0 then
begin
result:= Copy(lowercase(URL), P1 + 7, Length(URL) - P1 - 6);
P1:= Pos('/', result);
if P1 > 0 then
result:= Copy(result, 0, P1 - 1);
end else
begin
P1:= Pos('/', URL);
if P1 > 0 then
result:= Copy(Lowercase(URL), 0, P1 - 1)
else result:= LowerCase(URL);
end;
end;
{Función: GetFileWeb
Ejemplo: Si le pasas "http://foro.elhacker.net/post.html;board=18.0"
como parámetro te devuelve "post.html;board=18.0"}
function GetFileWeb(const URL: AnsiString): AnsiString;
var
P1: integer;
begin
P1:= Pos('http://', LowerCase(URL));
if P1 > 0 then
begin
result:= Copy(lowercase(URL), P1 + 7, Length(URL) - P1 - 6);
P1:= Pos('/', result);
if P1 > 0 then
result:= Copy(result, P1, Length(result) - P1 + 1);
end else
begin
P1:= Pos('/', URL);
if P1 > 0 then
result:= Copy(LowerCase(URL), P1, Length(URL) - P1 + 1)
else result:= LowerCase(URL);
end;
end;
{Función: CleanHTTP
Esta función se encarga de eliminiar las líneas de control
que emplea el protocolo HTTP. El archivo comienza despues de #13#10#13#10.
Un ejemplo de las líneas que vamos a quitar con esta función:
HTTP/1.0 200 OK
Date: Sat, 07 Aug 2010 23:25:05 GMT
Expires: -1
Cache-Control: private, max-age=0
Content-Type: text/html; charset=ISO-8859-1
Set-Cookie: PREF=ID=45985543825451c0:TM=1281223505:LM=1281223505:S=kPYwkz3GOI3idLv6; expires=Mon, 06-Aug-2012 23:25:05 GMT; path=/; domain=.google.es
Set-Cookie: NID=37=rPl51eNebbKvxz3Abvlpje8AT-qMszIbpmDR-zJJjYlwRie55cmev5KE45t4kBPVmhsHPpWUqBwzwqI4rsndihEbd0OtrMJfMohVYI0lfxJ3U1uchrbJMA4SUVh2-uNz; expires=Sun, 06-Feb-2011 23:25:05 GMT; path=/; domain=.google.es; HttpOnly
Server: gws
X-XSS-Protection: 1; mode=block
}
procedure CleanHttp(var Mem: TMemoryStream);
var
i: integer;
Separator: array [0..3] of AnsiChar;
Mem2: TMemoryStream;
begin
if Assigned(Mem) then
begin
for i := 0 to Mem.Size - 1 do
begin
Mem.Seek(i, 0);
Mem.Read(Separator, 4);
if (Separator[0] = #13) and (Separator[1] = #10) and (Separator[2] = #13)
and (Separator[3] = #10) then
begin
Mem2:= TMemoryStream.Create;
Mem.Seek(i + 4, 0);
Mem2.CopyFrom(Mem, Mem.Size - I - 4);
Mem:= Mem2;
break;
end;
end;
end;
end;
{Función DownLoadFile
URL: La dirección del archivo que vas a descargar.
FileName: La ruta donde vas a guardar el archivo
ProcessMessages: Por defecto está a True, hace que no se bloquee
la aplicación con el bucle. Puedes cambiar su valor a False o eliminar la línea
"if ProcessMessages then Application.ProcessMessages;" y los uses "Forms" si vas a
trabajar en modo consola
Devuelve True si tiene éxito}
function DownLoadFile(const URL: AnsiString; FileName: String; ProcessMessages: boolean = true): boolean;
var
WSA: TWSAData;
Sock: TSocket;
Hostent: PHostent;
Ip: ^Integer;
ReturnCode, i: integer;
RHost: sockaddr_in;
Http: AnsiString;
szBuffer: array [0..1023] of AnsiChar;
Stream: TMemoryStream;
begin
result:= false;
If WSAStartup(MakeWord(2,2), WSA) = 0 then
begin
Sock:= SOCKET(AF_INET, SOCK_STREAM, 0);
if Sock <> INVALID_SOCKET then
Hostent:= GetHostByName(PAnsiChar(GetDomainName(URL)));
if Hostent <> nil then
begin
Ip:= @Hostent.h_addr_list^[0];
RHost.sin_family:= AF_INET;
RHost.sin_port:= htons(80);
RHost.sin_addr.S_addr:= ip^;
if Connect(Sock, RHost, Sizeof(RHost)) = 0 then
begin
Http:= 'GET ' + GetFileWeb(URL) + ' HTTP/1.0'#13#10 +
'Host: ' + GetDomainName(URL) + #13#10#13#10;
send(Sock, Pointer(Http)^, Length(Http), 0);
try
Stream:= TMemoryStream.Create;
repeat
if ProcessMessages then Application.ProcessMessages;
FillChar(szBuffer, SizeOf(szBuffer), 0);
ReturnCode:= recv(Sock, szBuffer, sizeof(szBuffer), 0);
if ReturnCode > 0 then
Stream.Write(szBuffer, ReturnCode);
until ReturnCode <= 0;
CleanHttp(Stream);
if Stream.Size > 0 then
begin
result:= true;
Stream.SaveToFile(FileName);
end;
finally
Stream.Free;
end;
ShutDown(Sock, SD_BOTH);
CloseSocket(Sock);
end;
end;
end;
WSACleanUp;
end;
Un ejemplo de uso:
DownLoadFile('http://www.google.es', 'C:\google.html');
Saludos.
Mostrar Mensajes
