本文整理自网络,侵删。
开发的过程中遇到文件下载的过程,我们都是想到要放在线程里处理,那么线程里进行文件下载,进度怎么展示呢?这对于很多不经常使用线程的人来说是个疑问,尤其是把进度通知到界面上这一步,所以这里分享一个简单的例子。使用indy里的TIdHttp控件来下载文件,然后通过windows自定义消息将进度反馈到界面上。具体下载线程代码如下:
Pascalunit uDownThread;
interface
uses Classes, Windows, SysUtils, IdHTTP, IdComponent, Math, Messages;
const WM_DownProgres = WM_USER + 1001;
type TDownThread = class(TThread) private FIDHttp: TIdHTTP; FWorkSize: Int64; FURL: string; FSavePath: string; FHandle: THandle; { Private declarations } procedure DoExecute; procedure DoWorkBegin(ASender: TObject; AWorkMode: TWorkMode; AWorkCountMax: Int64); procedure DoWork(ASender: TObject; AWorkMode: TWorkMode; AWorkCount: Int64); protected procedure Execute; override; public constructor Create(const AURL, ASavePath: string; const AHandle: THandle); destructor Destroy; override; end;
implementation
{ TDownThread }
constructor TDownThread.Create(const AURL, ASavePath: string; const AHandle: THandle);begin FURL := AURL; FSavePath := ASavePath; FHandle := AHandle; FIDHttp := TIdHTTP.Create(nil); FIDHttp.OnWorkBegin := DoWorkBegin; FIDHttp.OnWork := DoWork; inherited Create(True);end;
destructor TDownThread.Destroy;begin FIDHttp.Free; inherited;end;
procedure TDownThread.DoExecute;var FMs: TMemoryStream;begin FMs := TMemoryStream.Create; try try FIDHttp.Get(FURL, FMs); FMs.SaveToFile(FSavePath); except // 记录日志 // 处理重试 end; finally FMs.Free; end;end;
procedure TDownThread.DoWork(ASender: TObject; AWorkMode: TWorkMode; AWorkCount: Int64);var ANowProgres: Integer;begin if FWorkSize <> 0 then begin ANowProgres := Ceil(AWorkCount / FWorkSize * 100); PostMessage(FHandle, WM_DownProgres, 0, ANowProgres); end;end;
procedure TDownThread.DoWorkBegin(ASender: TObject; AWorkMode: TWorkMode; AWorkCountMax: Int64);begin FWorkSize := AWorkCountMax;end;
procedure TDownThread.Execute;begin DoExecute;end;
end.调用方法为:Pascalunit Unit8;
interface
uses Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ComCtrls, uDownThread;
type TForm8 = class(TForm) Button1: TButton; ProgressBar1: TProgressBar; Edit1: TEdit; procedure Button1Click(Sender: TObject); procedure FormCreate(Sender: TObject); private FDownThread: TDownThread; procedure DoWM_DownProgres(var Msg: TMessage); message WM_DownProgres; { Private declarations } public { Public declarations } end;
var Form8: TForm8;
implementation
{$R *.dfm}
procedure TForm8.Button1Click(Sender: TObject);begin if not Assigned(FDownThread) then begin FDownThread := TDownThread.Create(Edit1.Text, 'd:\Tim.exe', Handle); FDownThread.Start; end;end;
procedure TForm8.DoWM_DownProgres(var Msg: TMessage);begin ProgressBar1.Position := Msg.LParam;end;
procedure TForm8.FormCreate(Sender: TObject);begin if Assigned(FDownThread) then begin FDownThread.Terminate; FDownThread.WaitFor; FDownThread.Free; FDownThread := nil; end;end;
end.
相关阅读 >>
Delphi sysutils.comparestr、sysutils.comparetext - 字符串比较
更多相关阅读请进入《Delphi》频道 >>