UrlDownloadFile, 线程下载文件, 带进度条
2013-10-29 21:06
417 查看
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. //使用unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ComCtrls, UrlMon, FileDownLoadThread; type TfrmDownloadFile = class(TForm) btn1: TButton; pb1: TProgressBar; lbl1: TLabel; lbl2: TLabel; procedure FormCreate(Sender: TObject); procedure btn1Click(Sender: TObject); private aRunThread: TFileDownLoadThread; public SourceFile, DestFile: string; procedure DownLoadProcessEvent(Sender: TFileDownLoadThread; Progress, ProgressMax: Cardinal); procedure DownLoadCompleteEvent(Sender: TFileDownLoadThread); procedure DownLoadFailEvent(Sender: TFileDownLoadThread; Reason: LongInt); end; var frmDownloadFile: TfrmDownloadFile; implementation {$R *.dfm} procedure TfrmDownloadFile.FormCreate(Sender: TObject); begin AppendMenu(GetSystemMenu(Handle, false), 0, 0, '程序: 花太香, QQ号: 2111971'); end; procedure TfrmDownloadFile.btn1Click(Sender: TObject); begin SourceFile := 'http://toolbar.soso.com/T4/download/QQToolbarInstaller.exe'; DestFile := '.\QQToolbarInstaller.exe'; lbl1.Caption := '0/0'; lbl2.Caption := ''; pb1.Position := 0; lbl2.Caption := '正在下载:' + ExtractFileName(DestFile); aRunThread := TFileDownLoadThread.Create(SourceFile, DestFile, DownLoadProcessEvent, DownLoadCompleteEvent, DownLoadFailEvent, False); end; procedure TfrmDownloadFile.DownLoadProcessEvent( Sender: TFileDownLoadThread; Progress, ProgressMax: Cardinal); var z, z1: Single; s, s1: string; begin pb1.Position := Progress; pb1.Max := ProgressMax; if (pb1.Max > 0) then begin if pb1.Max > 1024 * 1024 then begin z := pb1.Max / (1024 * 1024); s := 'MB'; end else begin z := pb1.Max / (1024); s := 'KB'; end; if Progress > 1024 * 1024 then begin z1 := Progress / (1024 * 1024); s1 := 'MB'; end else begin z1 := Progress / (1024); s1 := 'KB'; end; lbl1.Caption := Format('%.2n' + s1 + ' / %.2n' + s, [z1, z]); end; end; procedure TfrmDownloadFile.DownLoadCompleteEvent( Sender: TFileDownLoadThread); begin lbl2.Caption := '下载完成.'; lbl1.Caption := ''; end; procedure TfrmDownloadFile.DownLoadFailEvent(Sender: TFileDownLoadThread; Reason: Integer); begin lbl2.Caption := '下载文件失败,请重试!'; end; end.
相关文章推荐
- 转:delphi用URLDownloadToFile下载文件,用进度条跟踪下载进度
- UrlDownloadFile, 线程下载文件, 带进度条
- UrlDownloadFile, 线程下载文件, 带进度条
- WebClient.DownloadFile(线程机制,异步下载文件)
- VC URLDownloadToFile 不能下载中文路径文件的解决办法
- 一个使用URLDownloadToFile实现文件下载的类
- (转)关于URLDownloadToFile下载文件
- bool DownloadFile(string sURL, ProgressBar pProgress, string Filename)(文件下载,进度条)
- 用URLDownloadToFile下载文件
- UrlDownloadtoFile文件下载,进度条,下载暂停,停止的简单实现
- URLDownloadToFile 直接下载文件
- WebClient.DownloadFile(线程机制,异步下载文件)
- Windows客户端开发--URLDownloadToFile下载文件进度条
- Windows客户端开发--URLDownloadToFile下载文件进度条
- URLDownloadToFile下载文件文章两篇
- C++Builder利用URLDownloadToFile下载文件并显示进度
- URLDownloadToCacheFile,下载文件到缓存中
- 一个使用URLDownloadToFile实现文件下载的类
- 使用URLDownloadToFile下载文件,有进度
- nsis使用URLDownloadToFile下载文件