如何实现进度条,显示%比,并显示下载速度,下载剩余时间.....delphi中
如何实现进度条,显示%比,并显示下载速度,下载剩余时间.....delphi
在memo中如何能在列出下载文件列表,再分别在一行的后面列出其文件大小.怎样才能让文件大小对其显示呢??
[解决办法]
我给你个我用的方法吧：
unit1.pas
unit Unit1;interfaceuses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, UrlMon, ActiveX, StdCtrls, ComCtrls; //引用了UrlMon, ActiveX；type TForm1 = class(TForm, IBindStatusCallback) //注意这里的接口继承； pb: TProgressBar; Button1: TButton; procedure Button1Click(Sender: TObject); private { Private declarations } //以下是接口的声明，复制即可； 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 { Public declarations } DownloadProgress: Integer; end;var Form1: TForm1;implementation{$R *.dfm}{ TForm1 }uses Unit2; //Unit2是个线程；在file->new->Other->Thread Object中创建，名称是TUrlDownload；function TForm1.GetBindInfo(out grfBINDF: DWORD; var bindinfo: TBindInfo): HResult;begin result := E_NOTIMPL;end;function TForm1.GetPriority(out nPriority): HResult;begin result := E_NOTIMPL;end;function TForm1.OnDataAvailable(grfBSCF, dwSize: DWORD; formatetc: PFormatEtc; stgmed: PStgMedium): HResult;begin result := E_NOTIMPL;end;function TForm1.OnLowResource(reserved: DWORD): HResult;begin result := E_NOTIMPL;end;function TForm1.OnObjectAvailable(const iid: TGUID; punk: IInterface): HResult;begin result := E_NOTIMPL;end;//这里是关键，ulProgress是当前下载量，ulProgressMax是文件大小；function TForm1.OnProgress(ulProgress, ulProgressMax, ulStatusCode: ULONG; szStatusText: LPCWSTR): HResult;begin if ulStatusCode = 1 then DownloadProgress := 0; if ulProgressMax > 0 then DownloadProgress := Round(100 * ulProgress / ulProgressMax) ; pb.Position := DownloadProgress; result := E_NOTIMPL;end;function TForm1.OnStartBinding(dwReserved: DWORD; pib: IBinding): HResult;begin result := E_NOTIMPL;end;function TForm1.OnStopBinding(hresult: HResult; szError: LPCWSTR): HResult;begin result := E_NOTIMPL;end;procedure TForm1.Button1Click(Sender: TObject);var td: TUrlDownload; //定义线程；begin td := TUrlDownload.Create(false) ; //创建线程，开始下载，没有善后，自己处理；end;end.
[解决办法]
//加一个Unit
{ Delphi File Download Thread Class , Copyright (c) Zhou Zuoji }unit FileDownLoadThread;interfaceuses 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;implementationconstructor 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.