3 respuestas en este tema

[Khronos]

Hola, investigando un poco sobre el protocolo HTTP se me ocurrió hacer una función para descargar archivos de un servidor web mediante HTTP y WinSock. Este es el resultado:

delphi

uses SysUtils, Classes, Windows, Forms, WinSock;
 
{Función: GetDomainName
Ejemplo: Si le pasas "http://www.delphiaccess.com/forum/index.php?action=post;board=16.0"
como parámetro te devuelve "www.delphiaccess.com"}
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://www.delphiaccess.com/forum/index.php?action=post;board=16.0"
como parámetro te devuelve "/forum/index.php?action=post;board=16.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:= &#39;GET &#39; + GetFileWeb(URL) + &#39;   HTTP/1.0&#39;#13#10 +
                  &#39;Host: &#39; + 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 result:= true;
                  Stream.SaveToFile(FileName);
                  finally
                    Stream.Free;
                  end;
 
                  ShutDown(Sock, SD_BOTH);
                  CloseSocket(Sock);
                end;
            end;
    end;
  WSACleanUp;
end;

Ejemplo de uso:

delphi

DownLoadFile('[url]http://www.google.es[/url]', 'C:\google.html');

Se puede hacer una clase TThread para descargar archivos de forma sencilla usando estas funciones.

Saludos.

[egostar]

Ah que interesante amigo Khronos.

Salud OS

[off-topic]
En México quien estrena algo invita los tragos y tú has estrenado los prefijos
[/off-topic]

[seoane]

Da gusto ver que todavía hay gente a la que no le asusta bajar hasta el mismísimo winsock para experimentar un rato 

[escafandra]

Aunque existen formas de descarga mas sencillas de codificar, a veces merece la pena  romperse un rato la cabeza experimentando a bajo nivel.

Saludos.