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(AURLdelphi 多线程下载文件, 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(FHandledelphi 多线程下载文件, 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;

本文来自电脑杂谈，转载请注明本文网址：
http://www.pc-fly.com/a/jisuanjixue/article-137862-1.html