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;

转载于:https://www.cnblogs.com/11wf/archive/2012/12/02/2798292.html