Delphi里实现多线程下载文件并且显示进度到界面

开发的过程中遇到文件下载的过程，我们都是想到要放在线程里处理，那么线程里进行文件下载，进度怎么展示呢？这对于很多不经常使用线程的人来说是个疑问，尤其是把进度通知到界面上这一步，所以这里分享一个简单的例子。使用indy里的TIdHttp控件来下载文件，然后通过windows自定义消息将进度反馈到界面上。具体下载线程代码如下：

unit 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.

调用方法为：

unit 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.