使用系统的UrlDownload下载文件

提供进度反馈等信息！

原创 - fftou

unit BindStatusCallback;

// Implementation of TBindStatusCallback

interface

uses SysUtils, Windows, UrlMon, ActiveX,Forms;

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): 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;

implementation

{ TBindStatusCallback }

uses UDP;

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): HResult;

begin

Result := E_NOTIMPL;

end;

function TBindStatusCallback.OnDataAvailable(grfBSCF, dwSize: DWORD;

formatetc: PFormatEtc; stgmed: PStgMedium): HResult;

begin

Result := E_NOTIMPL;

end;

function TBindStatusCallback.OnLowResource(reserved: DWORD): HResult;

begin

Result := E_NOTIMPL;

end;

function TBindStatusCallback.OnObjectAvailable(const iid: TGUID;

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

with AutoFrm do

begin

  PBar.MinValue := 0;

  PBar.MaxValue := UlProgressMax;

  PBar.Progress := UlProgress;

  Label1.Caption := Format('当前文件已下载 %d 个字节...',[ulProgress]);

end;

Result := S_OK;

end;

end.

使用方法:

声明全局变量

Bsc: TBindStatusCallback;

function DownloadFiles(Des,Loca: String):Boolean;

begin

  if UrlDownloadToFile(nil,Pchar(Des),Pchar(Loca),0,Bsc) = 1 then

  begin

     Result := False;

     Exit;

  end;

  Result := True;

end;

希望对大能有所启发