En esta sección de Código Fuente en Delphi vamos a mostrar cómo podemos realizar la descarga de un archivo de internet utilizando la Api de WinInet.
Para ello, he escrito esta pequeña app de ejemplo. Lo más interesante de la "UnitDescargar.pas" son dos cualidades que posee la función pública "Descargar2File":
En la siguiente imagen puedes ver un ejemplo de uso de esta app.
A continuación, puedes ver el código completo de la app, y si lo deseas puedes descargarlo todo (código y app) en un archivo "zip".
unit Unit1; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ComCtrls; type TForm1 = class(TForm) Label1: TLabel; EditURL: TEdit; Label2: TLabel; EditRuta: TEdit; Label3: TLabel; LabelProgreso: TLabel; Button1: TButton; ProgressBar1: TProgressBar; Label4: TLabel; procedure Button1Click(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation {$R *.DFM} uses UnitDescargar; function ConvertBytes(i: real): string; begin if i < 1024 then Result := FloatToStr(i) + ' Bytes'; if (i >= 1024) and (i < 1024*1024) then Result := Format('%7.2f', [i / 1024]) + ' KB'; if (i >= 1024*1024) and (i < 1024*1024*1024) then Result := Format('%7.2f', [i / 1024*1024]) + ' MB'; if (i >= 1024*1024*1024) then Result := Format('%7.2f', [i / 1024*1024*1024]) + ' GB'; Result := Trim(Result); end; procedure GetProgresoDescarga(total, descargado: real); var progreso: real; msg: ansiString; begin if total>0 then begin progreso:= descargado*100 / total; msg:= inttostr(round(progreso))+'%'; form1.ProgressBar1.Position:= round(progreso); end else begin progreso:= descargado; msg:= ConvertBytes(descargado); end; form1.LabelProgreso.Caption:= msg; Application.ProcessMessages; end; procedure TForm1.Button1Click(Sender: TObject); var ruta: AnsiString; f: tProgresoDescarga; begin f:= GetProgresoDescarga; ruta:= EditRuta.Text; if ExtractFileName(ruta)= ruta then ruta:= ExtractFilePath(ParamStr(0))+ruta; if Descargar2File(EditURL.Text, ruta, f) then Label4.caption:='Descarga Finalizada con éxito' else Label4.caption:='Error al descargar el archivo'; end; end.
unit UnitDescargar; interface uses windows, forms, //application.processmessages, application.title sysutils,//FileCreate, FileWrite, FileClose,... classes,//TThread wininet;//InternetOpen, InternetOpenURL, HttpQueryInfo, InternetReadFile, InternetCloseHandle type tProgresoDescarga = procedure(total, descargado: real); function Descargar2File(const aUrl: Ansistring; ruta: AnsiString; f: tProgresoDescarga): Boolean; implementation function GetBytesTotal(URLHandle: HINTERNET): real; var SBuffer: Array[0..512] of char; SBufferSize: DWORD; reserved: DWORD; begin reserved := 0; SBufferSize := Length(SBuffer); if HttpQueryInfo(URLHandle, HTTP_QUERY_CONTENT_LENGTH, @SBuffer, SBufferSize, reserved) then Result := StrToFloat(SBuffer) else Result := 0; end; function DownloadURL2File(const aUrl: ansiString; ruta: ansiString; f: tProgresoDescarga ): Boolean; var hSession: HINTERNET; hService: HINTERNET; lpBuffer: array[0..1024 + 1] of AnsiChar; dwBytesRead: DWORD; BytesTotal, BytesDescargados: real; FileHandle: THandle; begin Result := False; FileHandle := FileCreate(ruta); if FileHandle = INVALID_HANDLE_VALUE then exit; hSession := InternetOpen(pchar(Application.Title), INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0); try if Assigned(hSession) then begin hService := InternetOpenUrl(hSession, PChar(aUrl), nil, 0, INTERNET_FLAG_RELOAD, 0); if Assigned(hService) then try BytesTotal:= GetBytesTotal(hService); BytesDescargados:=0; while True do begin InternetReadFile(hService, @lpBuffer, 1024, dwBytesRead); if dwBytesRead = 0 then break; BytesDescargados:= BytesDescargados + dwBytesRead; FileWrite(FileHandle, lpBuffer, dwBytesRead); f(BytesTotal, BytesDescargados); end; Result := True; finally InternetCloseHandle(hService); FileClose(FileHandle); end; end; finally InternetCloseHandle(hSession); end; end; type THiloDownloadURL2File = class(TThread) private _aUrl: ansistring; _ruta: AnsiString; _f: tProgresoDescarga; protected procedure Execute; override; public resultado: Boolean; terminado: Boolean; constructor Create(CreateSuspended : boolean; aUrl: ansistring; ruta: AnsiString; f: tProgresoDescarga); end; constructor THiloDownloadURL2File.Create(CreateSuspended : boolean; aUrl: ansistring; ruta: AnsiString; f: tProgresoDescarga); begin FreeOnTerminate := false; _aUrl:= aUrl; _ruta:= ruta; _f:= f; resultado:= false; terminado:=false; inherited Create(CreateSuspended); end; procedure THiloDownloadURL2File.Execute; begin resultado:= DownloadURL2File(_aUrl, _ruta, _f); terminado:=true; end; function Descargar2File(const aUrl: Ansistring; ruta: AnsiString; f: tProgresoDescarga): Boolean; var MyThread : THiloDownloadURL2File; begin MyThread:=THiloDownloadURL2File.Create(false, aUrl, ruta,f); while not MyThread.Terminado do Application.ProcessMessages; result:= MyThread.Resultado; MyThread.free; end; end.