有点线程池的意思

最新推荐文章于 2024-01-19 11:53:25 发布

pipilang3220119

最新推荐文章于 2024-01-19 11:53:25 发布

阅读量232

点赞数

CC 4.0 BY-SA版权

分类专栏： delphi

本文链接：https://blog.youkuaiyun.com/pipilang3220119/article/details/50264441

delphi 专栏收录该内容

6 篇文章

订阅专栏

本文介绍了一个使用Delphi实现的多线程FTP下载器。该下载器通过创建多个工作线程从指定的FTP服务器上下载文件，并采用TIdFTP组件进行连接和文件传输操作。文章展示了如何创建和管理线程，以及如何使用TIdFTP组件进行FTP操作。

摘要生成于 C知道，由 DeepSeek-R1 满血版支持，前往体验 >

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, RzEdit, Vcl.ExtCtrls,
  RzPanel, RzButton, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
  IdExplicitTLSClientServerBase, IdFTP, activex;

type
  TThreadwork = class(TThread)
  private
  protected
    procedure Execute; override;
  public
    hEvent: Cardinal;
    constructor Create; overload;
    procedure run;
  end;

  TForm1 = class(TForm)
    RzBitBtn1: TRzBitBtn;
    RzPanel1: TRzPanel;
    RzMemo1: TRzMemo;
    RzBitBtn2: TRzBitBtn;
    IdFTP1: TIdFTP;
    procedure RzBitBtn1Click(Sender: TObject);
    procedure RzBitBtn2Click(Sender: TObject);
  private
    { Private declarations }
    aworkthread: TThreadwork;
    bworkthread: TThreadwork;
    cworkthread: TThreadwork;
    dworkthread: TThreadwork;
    eworkthread: TThreadwork;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  worklist: TStringList;

implementation

{$R *.dfm}

procedure TForm1.RzBitBtn1Click(Sender: TObject);
var
  i: Integer;
begin
  aworkthread := TThreadwork.Create;
  bworkthread := TThreadwork.Create;
  cworkthread := TThreadwork.Create;
  dworkthread := TThreadwork.Create;
  eworkthread := TThreadwork.Create;
  worklist := TStringList.Create;

  worklist.Add('111.tar.gz');


end;

procedure TForm1.RzBitBtn2Click(Sender: TObject);
begin
  aworkthread.run;
  bworkthread.run;
  cworkthread.run;
  dworkthread.run;
  eworkthread.run;

end;

{ TThreadwork }

constructor TThreadwork.Create;
begin
  inherited;
  hEvent := CreateEvent(nil, True, False, nil);
  FreeOnTerminate := True;
end;

procedure TThreadwork.Execute;
var
  str: string;
  idftp: TIdFTP;
begin
  inherited;
  CoInitialize(nil);
  idftp := TIdFTP.Create;
  IdFTP.Host := 'X.X.X.X';
  IdFTP.Port := 21;
  IdFTP.Username := 'fXXXt';
  IdFTP.Password := 'XXXXX';
  IdFTP.Connect;
  IdFTP.ChangeDir('./rpt');
  while not Self.Terminated do
  begin
    WaitForSingleObject(hEvent, INFINITE);
    while worklist.Count > 0 do
    begin
      str := worklist[0];
      worklist.Delete(0);
      IdFTP.Get(str, 'c:\' + str, True, False);
    end;
    ResetEvent(hEvent);
  end;
  IdFTP.Disconnect;
  idftp.Free;
  CoUninitialize;
end;

procedure TThreadwork.run;
begin
  SetEvent(hEvent);
end;

end.