Download via Http usando UrlMon

Download com Barra de Progresso via UrlMon (Http)

            Depois de procurar na net, e não encontra um exemplo completo, resolvi implementar um aplicativo de download direto via url.

            Estava querendo algo para substituir a minha atualização de versão que era via ftp, para algo mais rápido e não dando muito erro de ficar travando o usuário, entre outras coisas, então comecei a procura na Net algo que pudesse me ajudar. Achei um exemplo que tem em todos os fóruns, e todos eles são idênticos, até os pingos nos “i”.

            Então vamos lá:

Primeiro vamos fazer um formulário parecido com a figura abaixo:

            Nele vamos utilizar os seguintes componentes:

. 2 TEdits

. 2 TLabel

. 2 TStaticText

. 2 TButton

. 1 Gauge

No Uses da interface declares as seguintes units: UrlMon, ShellApi, Activex.

Criaremos agora uma interface herdando de TInterfacedObject e IBindStatusCallback, sendo que esta classe deve vir logo após o uses da Interface.

Conforme o exemplo abaixo:

unit Uprincipal;

interface

uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, UrlMon, ShellApi, Activex, ComCtrls, StdCtrls, Gauges;

Type

  TMeuObjetoInterface = class(TInterfacedObject, IBindStatusCallback)

  public

    function OnStartBinding(dwReserved: DWORD; pib: IBinding): HResult; stdcall;

    function GetPriority(out nPriority): HResult; stdcall;

    function OnLowResource(reserved: DWORD): HResult; stdcall;

    function OnProgress(ulProgress, ulProgressMax, ulStatusCode: ULONG;

      szStatusText: LPCWSTR): HResult; stdcall;

    function OnStopBinding(hresult: HResult; szError: LPCWSTR): HResult;

      stdcall;

    function GetBindInfo(out grfBINDF: DWORD; var bindinfo: TBindInfo): HResult;

      stdcall;

    function OnDataAvailable(grfBSCF: DWORD; dwSize: DWORD; formatetc:

      PFormatEtc;

      stgmed: PStgMedium): HResult; stdcall;

    function OnObjectAvailable(const iid: TGUID; punk: IUnknown): HResult;

      stdcall;

  end;

Logo após criarmos a interface TMeuObjetoInterface, pressionaremos as teclas CRTL+SHIF+C para o Delphi implementar as funções declaradas na sessão public.

Na “function OnProgress(ulProgress, ulProgressMax, ulStatusCode: ULONG;

      szStatusText: LPCWSTR): HResult; stdcall;” colocaremos o seguinte código:

function TMeuObjetoInterface.OnProgress(ulProgress, ulProgressMax,

  ulStatusCode: ULONG; szStatusText: LPCWSTR): HResult;

begin

  if Assigned(FrPrincipal) then

  begin

    Application.ProcessMessages;

    case ulStatusCode of

      1: FrPrincipal.StaticText1.Caption := 'Conectando em: '+ szStatusText;

      2: FrPrincipal.StaticText1.Caption := 'Conectado em: '+ szStatusText;

      3: FrPrincipal.StaticText1.Caption := 'Redirecionando para: '+ szStatusText;

      4: begin

           FrPrincipal.StaticText1.Caption := 'Fazendo Download: '+ szStatusText;

           FrPrincipal.barra.MaxValue := ulProgressMax;

           FrPrincipal.barra.Progress := ulProgressMax - ulProgress;

         end;

      5: begin

          FrPrincipal.StaticText2.Caption := 'Baixando: ' + FormatFloat('#.#,',

          ulProgress div 1024)

          + ' de ' +

          FormatFloat('#.#,', ulProgressMax div 1024) + 'Kb';

          FrPrincipal.barra.MaxValue := ulProgressMax;

          // FrPrincipal.barra.Progress := ulProgressMax - ulProgress; // descomente este para fazer decrecente

          FrPrincipal.barra.Progress := ulProgress;

         end;

      6: begin

           FrPrincipal.StaticText1.Caption := 'Final de Download: '+ szStatusText;

           FrPrincipal.StaticText2.Caption := 'Baixando: ' + FormatFloat('#.#,',

           ulProgressMax div 1024)

           + ' de ' +

           FormatFloat('#.#,', ulProgressMax div 1024) + 'Kb';

         end;

    end;

  end;

end;

No Botão de “Download” colocaremos o seguinte código:

procedure TFrPrincipal.Button1Click(Sender: TObject);

var

  MeuEstatus: TMeuObjetoInterface;

begin

  MeuEstatus := TMeuObjetoInterface.Create;

  URLDownloadToFile(nil, PChar(Edit1.Text), PChar(Edit2.Text), 0,MeuEstatus);

  StatusBar1.Panels[0].Text := 'Download concluído';

end;

No Botão de “Fechar”

procedure TFrPrincipal.Button2Click(Sender: TObject);

begin

  Application.Terminate;

end;

Simples assim.

Marco Banaggia

Analista de Sistemas

Delphi 2007