Delphi編寫下載程序：UrlDownloadToFile的進度提示

urlmon.dll中有一個用於下載的API，MSDN中的定義以下：

HRESULT URLDownloadToFile(      
       LPUNKNOWN pCaller,
       LPCTSTR szURL,
      LPCTSTR szFileName,
       DWORD dwReserved,
       LPBINDSTATUSCALLBACK lpfnCB
);

Delphi的UrlMon.pas中有它的Pascal聲明：

   function URLDownloadToFile(      
       pCaller: IUnKnown,
      szURL: PAnsiChar,
       szFileName: PAnsiChar,
       dwReserved: DWORD,
       lpfnCB: IBindStatusCallBack;
    );HRESULT;stdcall;

szURL是要下載的文件的URL地址，szFileName是另存文件名，dwReserved是保留參數，傳遞0。若是不須要進度提示的話，調用這個函數很簡單。好比要下載http://218.95.47.224/page/jxzy/XSZB/web/fourteens/Music/qili.mp3 這首歌，並保存爲D:\ Music\七里香.mp3，就能夠這樣調用：

    URLDownloadToFile(nil,'http://218.95.47.224/page/jxzy/XSZB/web/fourteens/Music/qili.mp3 ','D:\ Music\七里香.mp3',0,nil);

不過這樣作的缺點是沒有進度提示，並且會阻塞調用線程。若是要得到進度提示就要用到最後一個參數lpfnCB了，它是一個接口類型IBindStatusCallBack，定義以下：

IBindStatusCallback = interface
     ['{79eac9c1-baf9-11ce-8c82-00aa004ba90b}']
    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;

進度提示就靠這個接口的OnProgress方法了。咱們能夠定義一個實現 IBindStatusCallback 接口的類，只處理一下OnProgress方法就能夠了，其它方法咱啥都不作，就返回S_OK。下面簡要說一下OnProgress：

ulProgress ：當前進度值
ulProgressMax ：總進度
ulStatusCode: 狀態值，是tagBINDSTATUS枚舉。代表正在尋找資源啊，正在鏈接啊這些狀態。具體請查看MSDN，咱們這裏不須要關心它
szStatusText：狀態字符串，咱也不關心它

因此咱們用百分比來表示進度的話就是FloatToStr(ulProgress*100/ulProgressMax)+'/%'，簡單吧。若是要在下載完成前取消任務，能夠在OnProgress中返回E_ABORT。
我把UrlDownloadToFile及其進度提示功能都封裝進了一個線程類中，這個類的源碼以下： 

{ Delphi File Download Thread Class , Copyright (c) Zhou Zuoji }

unit FileDownLoadThread;

interface

uses
     Classes,
     SysUtils,
     Windows,
     ActiveX,
     UrlMon;

const
     S_ABORT = HRESULT($80004004);
    
type
     TFileDownLoadThread = class;
    
     TDownLoadProcessEvent = procedure(Sender:TFileDownLoadThread;Progress, ProgressMax:Cardinal) of object;
     TDownLoadCompleteEvent = procedure(Sender:TFileDownLoadThread) of object ;
     TDownLoadFailEvent = procedure(Sender:TFileDownLoadThread;Reason:LongInt) of object ;

     TDownLoadMonitor = class( TInterfacedObject, IBindStatusCallback )
     private
         FShouldAbort: Boolean;
         FThread:TFileDownLoadThread;
     protected
        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;
     public
         constructor Create(AThread:TFileDownLoadThread);
         property ShouldAbort: Boolean read FShouldAbort write FShouldAbort;
    end;

     TFileDownLoadThread = class( TThread )
     private
         FSourceURL: string;
         FSaveFileName: string;
         FProgress,FProgressMax:Cardinal;
         FOnProcess: TDownLoadProcessEvent;
         FOnComplete: TDownLoadCompleteEvent;
         FOnFail: TDownLoadFailEvent;
         FMonitor: TDownLoadMonitor;
     protected
        procedure Execute; override;
        procedure UpdateProgress(Progress, ProgressMax, StatusCode: Cardinal; StatusText:string);
        procedure DoUpdateUI;
     public
         constructor Create( ASrcURL, ASaveFileName: string; AProgressEvent:TDownLoadProcessEvent = nil;
           ACompleteEvent:TDownLoadCompleteEvent = nil;AFailEvent:TDownLoadFailEvent=nil;CreateSuspended: Boolean=False );
         property SourceURL: string read FSourceURL;
         property SaveFileName: string read FSaveFileName;
         property OnProcess: TDownLoadProcessEvent read FOnProcess write FOnProcess;
         property OnComplete: TDownLoadCompleteEvent read FOnComplete write FOnComplete;
         property OnFail: TDownLoadFailEvent read FOnFail write FOnFail;
    end;

implementation

constructor TDownLoadMonitor.Create(AThread: TFileDownLoadThread);
begin
     inherited Create;
     FThread:=AThread;
     FShouldAbort:=False;
end;

function TDownLoadMonitor.GetBindInfo( out grfBINDF: DWORD; var bindinfo: TBindInfo ): HResult;
begin
     result := S_OK;
end;

function TDownLoadMonitor.GetPriority( out nPriority ): HResult;
begin
     Result := S_OK;
end;

function TDownLoadMonitor.OnDataAvailable( grfBSCF, dwSize: DWORD; formatetc: PFormatEtc; stgmed: PStgMedium ): HResult;
begin
     Result := S_OK;
end;

function TDownLoadMonitor.OnLowResource( reserved: DWORD ): HResult;
begin
     Result := S_OK;
end;

function TDownLoadMonitor.OnObjectAvailable( const iid: TGUID; punk: IInterface ): HResult;
begin
     Result := S_OK;
end;

function TDownLoadMonitor.OnProgress( ulProgress, ulProgressMax, ulStatusCode: ULONG; szStatusText: LPCWSTR ): HResult;
begin
    if FThread<>nil then
         FThread.UpdateProgress(ulProgress,ulProgressMax,ulStatusCode,'');
    if FShouldAbort then
         Result := E_ABORT
    else
         Result := S_OK;
end;

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

function TDownLoadMonitor.OnStopBinding( hresult: HResult; szError: LPCWSTR ): HResult;
begin
     Result := S_OK;
end;
{ TFileDownLoadThread }

constructor TFileDownLoadThread.Create( ASrcURL, ASaveFileName: string;AProgressEvent:TDownLoadProcessEvent ;
           ACompleteEvent:TDownLoadCompleteEvent;AFailEvent:TDownLoadFailEvent; CreateSuspended: Boolean );
begin
    if (@AProgressEvent=nil) or (@ACompleteEvent=nil) or (@AFailEvent=nil) then
         CreateSuspended:=True;
     inherited Create( CreateSuspended );
     FSourceURL:=ASrcURL;
     FSaveFileName:=ASaveFileName;
     FOnProcess:=AProgressEvent;
     FOnComplete:=ACompleteEvent;
     FOnFail:=AFailEvent;
end;

procedure TFileDownLoadThread.DoUpdateUI;
begin
     if Assigned(FOnProcess) then
         FOnProcess(Self,FProgress,FProgressMax);
end;

procedure TFileDownLoadThread.Execute;
var
     DownRet:HRESULT;
begin
     inherited;
     FMonitor:=TDownLoadMonitor.Create(Self);
     DownRet:= URLDownloadToFile( nil, PAnsiChar( FSourceURL ), PAnsiChar( FSaveFileName ), 0,FMonitor as IBindStatusCallback);
    if DownRet=S_OK then
    begin
        if Assigned(FOnComplete) then
             FOnComplete(Self);
    end
    else
    begin
        if Assigned(FOnFail) then
             FOnFail(Self,DownRet);
    end;
     FMonitor:=nil;
end;

procedure TFileDownLoadThread.UpdateProgress(Progress, ProgressMax, StatusCode: Cardinal; StatusText: string);
begin
     FProgress:=Progress;
     FProgressMax:=ProgressMax;
     Synchronize(DoUpdateUI);
    if Terminated then
         FMonitor.ShouldAbort:=True;
end;

end.