Progresso em Download

Delphi

08/02/2004

Gostaria de saber com fazer para exibir uma barra de progresso ao se fazer download com a função DownloadFile.

function DownloadFile(Source, Dest: string): Boolean;
begin
try
Result:= UrlDownloadToFile(nil, PChar(source),PChar(Dest), 0, nil) = 0;
except
Result:= False;
end;
end;

Valew, espero que algúem possa me ajudar!


Pauloricardofs

Pauloricardofs

Curtidas 0

Respostas

Adilsond

Adilsond

08/02/2004

Voce deve passar em sua unit um parametro do tipo TBindStatusCallback, mas voce deve conhecer o tamanho do arquivo

Exemplo:

Em uma unit chamada uAtualizaSistema foi criado um ProgressBar e defini o seguinte:

  private
    { Private declarations }
    fProgresso: LongInt;
    BSC: TBindStatusCallback;
    function DownloadFile(Source, Dest: String): Boolean;
    procedure SetProgresso(Value: LongInt);
  public
    { Public declarations }
    property Progresso: LongInt read fProgresso write SetProgresso;
  end;

procedure TfrmAtualizaSistema.FormCreate(Sender: TObject);
begin
  BSC := TBindStatusCallback.Create;
end;

procedure TfrmAtualizaSistema.SetProgresso(Value: LongInt);
begin
  fProgresso := Value;
  ProgressBar1.Position := Value;
end;

function TfrmAtualizaSistema.DownloadFile(Source, Dest: String): Boolean;
begin
  try
    Result := UrlDownloadToFile(nil, PChar(source), PChar(Dest), 0, BSC) = 0;
  except
    Result := False;
  end;
end;

procedure TfrmAtualizaSistema.btnAtualizaClick(Sender: TObject);
begin
    ProgressBar1.Position := 0;
    ProgressBar1.Max := // aqui irá o tamnho do arquivo;
    if DownloadFile(URL de origem, Nome arquivo destino) then
       MessageDlg(´Mensagem OK.´,mtInformation,[mbOK],0)
    else
       MessageDlg(´Mensagem Erro.´,mtInformation,[mbOK],0);
end;

procedure TfrmAtualizaSistema.FormDestroy(Sender: TObject);
begin
  FreeAndNil(BSC);
end;



Crie esta unit em seu projeto ( veja a clausula uses uAtualizaSistema )

unit uBindStatusCallback;

// Implementation of TBindStatusCallback

interface

uses
  SysUtils, Windows, UrlMon, ActiveX;

type
  TBindStatusCallback = class(TObject, IBindStatusCallback)
  protected
    FRefCount: Integer;
    // IUnknown
    function QueryInterface(const IID: TGUID; out Obj): Integer; stdcall;
    function _AddRef: Integer; stdcall;
    function _Release: Integer; stdcall;
  public
    // IBindStatusCallback
    function OnStartBinding(dwReserved: DWORD; pib: IBinding): HResult; stdcall;
    function GetPriority(out nPriority: Longint): 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: Longint; dwSize: Longint;
      var pformatetc: TFormatEtc; var pstgmed: TSTGMEDIUM): HResult; stdcall;
    function OnObjectAvailable(const iid: TGUID; const punk: IUnknown): HResult;
      stdcall;
  end;

implementation

{ TBindStatusCallback }

uses uAtualizaSistema;

function TBindStatusCallback.QueryInterface(const IID: TGUID; out Obj): Integer;
begin
  if GetInterface(IID, Obj) then
     Result := S_OK
  else
     Result := E_NOINTERFACE;
end;

function TBindStatusCallback._AddRef: Integer;
begin
  Inc(FRefCount);
  Result := FRefCount;
end;

function TBindStatusCallback._Release: Integer;
begin
  Dec(FRefCount);
  Result := FRefCount;
end;

function TBindStatusCallback.GetBindInfo(out grfBINDF: DWORD;
  var bindinfo: TBindInfo): HResult;
begin
  Result := E_NOTIMPL;
end;

function TBindStatusCallback.GetPriority(out nPriority: Longint): HResult;
begin
  Result := E_NOTIMPL;
end;

function TBindStatusCallback.OnDataAvailable(grfBSCF: Longint; dwSize: Longint;
  var pformatetc: TFormatEtc; var pstgmed: TSTGMEDIUM): HResult; stdcall;
begin
  Result := E_NOTIMPL;
end;

function TBindStatusCallback.OnLowResource(reserved: DWORD): HResult;
begin
  Result := E_NOTIMPL;
end;

function TBindStatusCallback.OnObjectAvailable(const iid: TGUID;
  const punk: IUnknown): HResult;
begin
  Result := E_NOTIMPL;
end;

function TBindStatusCallback.OnStartBinding(dwReserved: DWORD;
  pib: IBinding): HResult;
begin
  Result := E_NOTIMPL;
end;

function TBindStatusCallback.OnStopBinding(hresult: HResult;
  szError: LPCWSTR): HResult;
begin
  Result := E_NOTIMPL;
end;

function TBindStatusCallback.OnProgress(ulProgress, ulProgressMax,
  ulStatusCode: ULONG; szStatusText: LPCWSTR): HResult;
begin
  frmAtualizaSistema.Progresso := ulProgress;
  Result := S_OK;
end;

end.


2 -


GOSTEI 0
POSTAR