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":

• Es una función que al realizar su trabajo utilizando la clase TThread "NO CONGELA" la aplicación, es decir, que mientras que la descarga se está realizando, la aplicación sigue respondiendo con normalidad a los mensajes de ventana.
• A la función Descargar2File le pasamos un puntero a una función del tipo "tProgresoDescarga" (definido en la parte pública de UnitDescargar.pas) que nos informará continuamente del progreso de la descarga, por lo que podremos mostrar esa información al usuario mediante una barra de progreso o de la forma que queramos.

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.

La guía de Delphi. Francisco Charte

La guía de Delphi. Marco Cantú

Curso de Pascal por Nacho Cabanes

Introducción a la programación Pascal

Algoritmos y programación en Pascal

Manual de Pascal