Ir al contenido


Foto

[DELPHI] DownLoadFile con WinSock 2.0


  • Por favor identifícate para responder
3 respuestas en este tema

#1 Khronos

Khronos

    Advanced Member

  • Miembro Platino
  • PipPipPip
  • 56 mensajes

Escrito 23 enero 2011 - 05:02

Hace algún tiempo cree una función para descargar un archivo de una página web en Delphi. Hoy decidí mejorarla un poco y tiene algunas novedades:

- La función se ejecuta dentro de un Thread, por lo que no afecta al rendimiento de la aplicación ni hace que se congele.
- Para descargar el archivo me conecto al servidor trabajando directamente con sockets y consultas HTTP.
- Incluye 3 eventos: OnStartDownload, OnProgress y OnFinishDownload.



delphi
  1. procedure DownloadFile(URL: AnsiString; FileName: String; StartDownload: TOnStartDownload;          Progress: TOnProgress; FinishDownload: TOnFinishDownload);

URL: Es la dirección del archivo web a descargar.
FileName: Es la ruta donde vas a guardar el archivo descargado.
StartDownload: Es un puntero a una función, este se ejecutará al comenzar la descarga. Devuelve como parámetro el tamaño del archivo, si se conoce.
Progress: Es un puntero a una función, este se ejecuta a medida que se va descargando el archivo. Este evento, puede ser útil si quieres mostrar el progreso de la descarga en un TProgressBar, por ejemplo.
FinishDownload: Es un puntero a una función, este se ejecuta si se produce algún error en la descarga o al terminar la descarga. Tiene como parámetro ErrorCode, de tipo byte, si ErrorCode es 0 significa que la descarga se completó con éxito.

A continuación el código de la unidad:


delphi
  1. unit URLDown;
  2.  
  3. (*
  4.  * *****************************************************************************
  5.  * ***************************  Unidad URLDown  *******************************
  6.  *    Esta unidad contiene la función DownloadFile, una función que
  7.  * descarga un archivo desde una dirección URL. Esta función se ejecuta en
  8.  * otro thread, por lo que no "congela" la aplicación ni causa inastabilidad.
  9.  * Además, cuenta con 3 eventos: OnStartDownload, OnProgress y OnFinishDownload.
  10.  *
  11.  * Autor: Khronos
  12.  * Email: khronos14@hotmail.com
  13.  * Blog: khronos14.blogspot.com
  14.  *******************************************************************************
  15. *)
  16.  
  17. interface
  18.  
  19. uses SysUtils, Classes, Windows, WinSock;
  20.  
  21. {$DEFINE OBJECT_FUNCTIONS}
  22. (*
  23.   Si borras la definición OBJECT_FUNCTIONS, los eventos
  24.   de la función DownloadFile no serán de tipo objetos.
  25.   Para emplear esta función en modo consola o sin clases,
  26.   comenta esta definición.
  27. *)
  28.  
  29. const
  30.   SZBUFFER_SIZE  = 2048; //Este es el tamaño del buffer de descarga
  31.  
  32.   URLDOWN_OK                    = 0;
  33.   URLDOWN_INVALID_HOST          = 1;
  34.   URLDOWN_CONNECT_ERROR        = 2;
  35.   URLDOWN_DOWNLOAD_ERROR        = 3;
  36.   URLDOWN_UNKNOWN_ERROR        = $FD;
  37.  
  38. type
  39.   TOnStartDownload = procedure(FileSize: int64) {$IFDEF OBJECT_FUNCTIONS}of object{$ENDIF};
  40.   TOnProgress = procedure(Progress: int64) {$IFDEF OBJECT_FUNCTIONS}of object{$ENDIF};
  41.   TOnFinishDownload = procedure(ErrorCode: byte) {$IFDEF OBJECT_FUNCTIONS}of object{$ENDIF};
  42.  
  43.   TDownloadVars = record
  44.     URL: AnsiString;
  45.     FileName: String;
  46.     OnStartDownload: TOnStartDownload;
  47.     OnProgress: TOnProgress;
  48.     OnFinishDownload: TOnFinishDownload;
  49.   end;
  50.   PDownloadVars = ^TDownloadVars;
  51.  
  52. procedure DownloadFile(URL: AnsiString; FileName: String; StartDownload: TOnStartDownload;
  53.           Progress: TOnProgress; FinishDownload: TOnFinishDownload); stdcall;
  54.  
  55. implementation
  56.  
  57.  
  58. function GetDomainName(const URL: AnsiString): AnsiString;
  59. var
  60. P1: integer;
  61. begin
  62.   P1:= Pos('http://', URL);
  63.   if P1 > 0 then
  64.   begin
  65.     result:= Copy(URL, P1 + 7, Length(URL) - P1 - 6);
  66.     P1:= Pos('/', result);
  67.     if P1 > 0 then
  68.       result:= Copy(result, 0, P1 - 1);
  69.   end else
  70.     begin
  71.       P1:= Pos('/', URL);
  72.       if P1 > 0 then
  73.         result:= Copy(URL, 0, P1 - 1)
  74.       else result:= URL;
  75.     end;
  76. end;
  77.  
  78. function GetFileWeb(const URL: AnsiString): AnsiString;
  79. var
  80. P1: integer;
  81. begin
  82.   P1:= Pos('http://', URL);
  83.   if P1 > 0 then
  84.   begin
  85.     result:= Copy(URL, P1 + 7, Length(URL) - P1 - 6);
  86.     P1:= Pos('/', result);
  87.     if P1 > 0 then
  88.       result:= Copy(result, P1, Length(result) - P1 + 1);
  89.   end else
  90.     begin
  91.       P1:= Pos('/', URL);
  92.       if P1 > 0 then
  93.         result:= Copy(URL, P1, Length(URL) - P1 + 1)
  94.       else result:= URL;
  95.     end;
  96.   if result = GetDomainName(URL) then
  97.     result:= '/';
  98. end;
  99.  
  100. procedure CleanHttp(var Mem: TMemoryStream);
  101. var
  102. i: integer;
  103. Separator: array [0..3] of AnsiChar;
  104. Mem2: TMemoryStream;
  105. begin
  106. if Assigned(Mem) then
  107.   begin
  108.     for i := 0 to Mem.Size - 1 do
  109.       begin
  110.         Mem.Seek(i, 0);
  111.         Mem.Read(Separator, 4);
  112.         if (Separator[0] = #13) and (Separator[1] = #10) and (Separator[2] = #13)
  113.             and (Separator[3] = #10) then
  114.               begin
  115.                 Mem2:= TMemoryStream.Create;
  116.                 Mem.Seek(i + 4, 0);
  117.                 Mem2.CopyFrom(Mem, Mem.Size - I - 4);
  118.                 Mem:= Mem2;
  119.                 break;
  120.               end;
  121.       end;
  122.   end;
  123. end;
  124.  
  125. function SendQuery(Socket: TSocket; RHost: sockaddr_in; Query: AnsiString): boolean;
  126. begin
  127. if Connect(Socket, PSockAddrIn(@RHost)^, Sizeof(RHost)) = 0 then
  128.   begin
  129.     send(Socket, Pointer(Query)^, Length(Query), 0);
  130.     result:= true;
  131.   end else
  132.     result:= false;
  133. end;
  134.  
  135. function CreateQuery(URL: AnsiString): AnsiString;
  136. begin
  137.   result:= 'GET ' + GetFileWeb(URL) + ' HTTP/1.0' + #13#10 +
  138.     'Host: ' + GetDomainName(URL) +  #13#10 +
  139.     'User-Agent: Khronos' + #13#10#13#10;
  140. end;
  141.  
  142. function GetContentLength(szBuff: AnsiString; Size: Cardinal): int64;
  143. var
  144. dwStart, dwEnd: integer;
  145. ContentLength: AnsiString;
  146. begin
  147. Result:= 0;
  148.   dwStart:= Pos('Content-Length: ', szBuff);
  149.   if dwStart <> 0 then
  150.     begin
  151.       dwStart:= dwStart + StrLen(&#39;Content-Length: &#39;);
  152.       dwEnd:= dwStart;
  153.       repeat
  154.         Inc(dwEnd);
  155.       until (szBuff[dwEnd] = #0) or (szBuff[dwEnd] = #13) or (dwEnd = Size);
  156.       ContentLength:= Copy(szBuff, dwStart, dwEnd - dwStart);
  157.       if TryStrToInt64(ContentLength, Result) = false then
  158.         result:= -1;
  159.     end;
  160.   dwStart:= Pos(#13#10#13#10, szBuff);
  161. end;
  162.  
  163. function InitializeWinSock(Host: AnsiString; var Socket: TSocket; var RHost: sockaddr_in): boolean;
  164. var
  165. WSA: TWSAData;
  166. Addr: u_long;
  167. Hostent: PHostent;
  168. Ip: ^Integer;
  169. begin
  170. If WSAStartup(MakeWord(2,2), WSA) = 0 then
  171.   begin
  172.     Socket:= WinSock.SOCKET(AF_INET, SOCK_STREAM, 0);
  173.     if Socket <> INVALID_SOCKET then
  174.         begin
  175.           Hostent:= GetHostByName(PAnsiChar(GetDomainName(Host)));
  176.           if Hostent <> nil then
  177.             begin
  178.               Ip:= @Hostent.h_addr_list^[0];
  179.               RHost.sin_family:= AF_INET;
  180.               RHost.sin_port:= htons(80);
  181.               RHost.sin_addr.S_addr:= ip^;
  182.               result:= true;
  183.           end;
  184.         end;
  185.   end else
  186.     result:= false;
  187. end;
  188.  
  189. function ProcessDownload(Socket: TSocket; FileName: WideString; StartDownload: TOnStartDownload;
  190.           Progress: TOnProgress; FinishDownload: TOnFinishDownload): boolean;
  191. var
  192. szBuffer: array [0..SZBUFFER_SIZE] of AnsiChar;
  193. Stream: TMemoryStream;
  194. ContentLength, ReturnCode: integer;
  195. begin
  196. result:= false;
  197.     try
  198.       Stream:= TMemoryStream.Create;
  199.       ContentLength:= 0;
  200.       repeat
  201.         FillChar(szBuffer, SZBUFFER_SIZE, 0);
  202.         ReturnCode:= recv(Socket, szBuffer, SZBUFFER_SIZE, 0);
  203.         if (ContentLength = 0) and (ReturnCode > 0) then
  204.           begin
  205.             ContentLength:= GetContentLength(szBuffer, ReturnCode);
  206.             if Assigned(StartDownload) then
  207.               StartDownload(ContentLength);
  208.           end;
  209.         if ReturnCode > 0 then
  210.           begin
  211.             Stream.Write(szBuffer, ReturnCode);
  212.             if Assigned(Progress) then
  213.                 Progress(Stream.Position);
  214.           end;
  215.       until ReturnCode <= 0;
  216.       if Stream.Size > 0 then
  217.         begin
  218.           CleanHttp(Stream);
  219.           Stream.SaveToFile(FileName);
  220.           if Assigned(FinishDownload) then
  221.             FinishDownload(URLDOWN_OK);
  222.           result:= true;
  223.         end;
  224.     finally
  225.       Stream.Free;
  226.     end;
  227. end;
  228.  
  229. procedure Download(P: Pointer);
  230. var
  231. Query: AnsiString;
  232. Socket: TSocket;
  233. RHost: sockaddr_in;
  234. begin
  235.   try
  236.     if InitializeWinSock(TDownloadVars(P^).URL, Socket, RHost) then
  237.       begin
  238.         Query:= CreateQuery(TDownloadVars(P^).URL);
  239.         if SendQuery(Socket, RHost, Query) then
  240.           begin
  241.             If ProcessDownload(Socket, TDownloadVars(P^).FileName, TDownloadVars(P^).OnStartDownload,
  242.                 TDownloadVars(P^).OnProgress, TDownloadVars(P^).OnFinishDownload) = false then
  243.                 if Assigned(TDownloadVars(P^).OnFinishDownload) then
  244.                   TDownloadVars(P^).OnFinishDownload(URLDOWN_DOWNLOAD_ERROR);
  245.             ShutDown(Socket, SD_BOTH);
  246.             CloseSocket(Socket);
  247.           end else
  248.             if Assigned(TDownloadVars(P^).OnFinishDownload) then
  249.               TDownloadVars(P^).OnFinishDownload(URLDOWN_CONNECT_ERROR);
  250.       end else
  251.         if Assigned(TDownloadVars(P^).OnFinishDownload) then
  252.           TDownloadVars(P^).OnFinishDownload(URLDOWN_INVALID_HOST);
  253.  
  254.     WSACleanUp();
  255.     Dispose(PDownloadVars(P));
  256.   Except on Exception do
  257.     begin
  258.       if Assigned(TDownloadVars(P^).OnFinishDownload) then
  259.           TDownloadVars(P^).OnFinishDownload(URLDOWN_UNKNOWN_ERROR);
  260.     end;
  261.   end;
  262. end;
  263.  
  264. procedure DownloadFile(URL: AnsiString; FileName: String; StartDownload: TOnStartDownload;
  265.           Progress: TOnProgress; FinishDownload: TOnFinishDownload);
  266. var
  267. DownloadVars: ^TDownloadVars;
  268. begin
  269.   New(DownloadVars);
  270.   DownloadVars^.URL:= URL;
  271.   DownloadVars^.FileName:= FileName;
  272.   DownloadVars^.OnStartDownload:= StartDownload;
  273.   DownloadVars^.OnProgress:= Progress;
  274.   DownloadVars^.OnFinishDownload:= FinishDownload;
  275.  
  276.   BeginThread(nil, 0, @Download, DownloadVars, 0, PDWORD(0)^);
  277. end;
  278.  
  279. end.



Subí a MegaUpload un programa de prueba que usa la función, además incluye todo el código fuente.


http://www.megaupload.com/?d=GU5P5QDW

Saludos.

Me tomé la libertad de editar tu mensaje para mejorar la visualización del código (escafandra).
  • 0

#2 escafandra

escafandra

    Advanced Member

  • Administrador
  • 4.107 mensajes
  • LocationMadrid - España

Escrito 23 enero 2011 - 05:28

Buen ejemplo, Khronos(y)

Saludos.
  • 0

#3 Wilson

Wilson

    Advanced Member

  • Moderadores
  • PipPipPip
  • 2.137 mensajes

Escrito 23 enero 2011 - 08:10

Gracias por tu muy buen aporte.

Saludos
  • 0

#4 ELKurgan

ELKurgan

    Advanced Member

  • Miembro Platino
  • PipPipPip
  • 566 mensajes
  • LocationEspaña

Escrito 24 enero 2011 - 01:26

Muchas gracias por el detalle y un saludo (y)
  • 0




IP.Board spam blocked by CleanTalk.