RSS订阅 | 匿名投稿
您的位置:网站首页 > 网络 > 正文

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

作者:admin 来源: 日期:2018/1/30 9:32:50 人气: 标签:

 开发的过程中遇到文件下载的过程,我们都是想到要放在线程里处理,那么线程里进行文件下载,进度怎么展示呢?这对于很多不经常使用线程的人来说是个疑问,尤其是把进度通知到界面上这一步,所以这里分享一个简单的例子。使用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.

读完这篇文章后,您心情如何?
0
0
0
0
0
0
0
0
本文网址:
上一篇:delphi BytesToFile
下一篇:没有资料