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.

使用DeleteUrlCacheEntry清理缓存后再使用URLDownloadToFile下载文件。

/********************************************************/
CString szUrl = "http://www.dtapp.cn";

DeleteUrlCacheEntry (szUrl); // 清理缓存
CString szFileName = "C:\\dtapp.txt";

 if (S_OK == URLDownloadToFile(NULL, szUrl, szFileName, NULL,NULL)) 
 {
  // 下载成功
 }
 else
 {
  // 下载失败
 }