delphi 发送下载进度到前台的多线程下载
unit uTestThread;
interface
uses
Classes, Windows, SysUtils, IdHTTP, IdComponent, Math, Messages;
const
WM_DownProgres = WM_USER + 1001;
type
TTestThread = class(TThread)
private
FIDHttp: TIdHTTP; //封装的idhttp实例
FMaxProgres: 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(AURL, ASavePath: string; AHandle: THandle);
destructor Destroy; override;
end;
implementation
{ TestThread }
constructor TTestThread.Create(AURL, ASavePath: string; AHandle: THandle);
begin
FURL := AURL;
FSavePath := ASavePath;
FHandle := AHandle;
FIDHttp := TIdHTTP.Create(nil);
FIDHttp.OnWorkBegin := DoWorkBegin;
FIDHttp.OnWork := DoWork;
inherited Create(False); // 参数为False指线程创建后自动运行,为True则不自动运行
FreeOnTerminate := True; // 执行完毕后自动释放
end;
destructor TTestThread.Destroy;
begin
FIDHttp.Free;
inherited;
end;
procedure TTestThread.DoExecute;
var
FMs: TMemoryStream;
begin
FMs := TMemoryStream.Create;
try
FIDHttp.Get(FURL, FMs);
FMs.SaveToFile(FSavePath);
finally
FMs.Free;
end;
end;
procedure TTestThread.DoWork(ASender: TObject; AWorkMode: TWorkMode;
AWorkCount: Int64);
var
ANowProgres: Integer;
begin
if FMaxProgres <> 0 then
begin
ANowProgres := Ceil(AWorkCount / FMaxProgres * 100);
PostMessage(FHandle, WM_DownProgres, 0, ANowProgres);
end;
end;
procedure TTestThread.DoWorkBegin(ASender: TObject; AWorkMode: TWorkMode;
AWorkCountMax: Int64);
begin
FMaxProgres := AWorkCountMax;
end;
procedure TTestThread.Execute;
begin
DoExecute;
end;
end.
----------------------------------------------------------------------------------------------------------------------------------------------------------------
procedure TForm1.Button1Click(Sender: TObject);
var
FDownThread: TTestThread;
begin
FDownThread := TTestThread.Create(Edit1.Text, 'c:\testdown..zip',
Self.Handle);
end;
procedure TForm1.DoWM_DownProgres(var Msg: TMessage);
begin
Gauge1.Progress := Msg.LParam;
end;