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

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

Pascal

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.

调用方法为：

Pascal

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.