Delphi利用线程池实现基于TIdFTP的FTP分段下载

最新推荐文章于 2025-03-27 22:55:59 发布
rslxy
最新推荐文章于 2025-03-27 22:55:59 发布
阅读量846
点赞数 1
文章标签： Delphi 线程池 FTP 断点续传
本文链接：https://blog.csdn.net/rslxy/article/details/102620052
版权
该博客介绍了如何在Delphi中利用线程池和TIdFTP组件进行FTP文件的分段下载。通过SIZE命令获取文件大小，并使用REST命令实现断点续传功能。
摘要生成于 C知道，由 DeepSeek-R1 满血版支持，前往体验 >
FTP下载单元，使用TIdFtp实现，利用SIZE命令获取文件大小，使用REST命令分段下载：
unit rsrFtpDown;

interface
uses SysUtils, Classes, Windows, Messages, Forms, Controls, ComObj, ActiveX,
    IdResourceStrings, IDTCPClient, IdIOHandlerSocket, IdFTP, IdComponent, IdSimpleServer,
    rsrThreadPoolSimple, MATH, StrUtils;

{
自动下载组件
by    renshouren
mail  root@renshou.net
QQ    114032666
2019.10.05

使用的组件
1、TIdFTP  Indy FTP客户端
2、TThreadsPool 线程池

工作原理及流程
调用本单元，将自动在程序初始化时生成线程池TThreadPoolDown实例 Share_ThreadPool_FTPDown
一、外部调用方法
    外部只需要一次性调用  FtpDown() 函数向线程池加入下载任务，下载任务执行中的事件会通过调用时注册的
回调函数 AFtpDownEvent 进行通知。
二、内部工作流程
1、FtpDown()函数将调用TThreadPoolDown.AddFtpDown() ，然后调用TADownFileObj.MakeGetFileSizeObj()分配线程任务
本过程中，将向回调函数 AFtpDownEvent 触发 HEM_ADDURL 事件通知
2、工作线程调用任务对象TFTPHeadObj.DoThreadExecute 过程获取远程文件大小
备注：该功能实际使用到FTP命令SIZE，该命令一些老版本FTP服务器有可能不支持
本过程中，若获取文件大小成功，将向回调函数 AFtpDownEvent 触发 HEM_GETSIZE 事件通知，
若失败，则触发 HEM_ERROR 事件通知
3、得到远程文件大小后，调用TADownFileObj.MakeGetObjs()，分配获取远程文件线程任务
本过程中，开始时，将向回调函数 AFtpDownEvent 触发 HEM_WORKBEGIN 事件通知
在接收数据时，向回调函数  AFtpDownEvent 触发 HEM_WORK 事件通知
4、工作线程调用任务对象 TFTPGetObj.DoThreadExecute 实际下载远程文件数据块
每一个数据块下载任务完成后，触发 HEM_BLOCKOK 事件通知
5、所有数据块完成后，将调用 DoDownloadOK 函数，触发 HEM_DOWNOK 事件通知

}

Const
  //一个下载块，目标文件大于此，则进行分块下载（可以通过设置TADownFileObj.ADefBlockSize 重新指定）
  DefBlockSize = 1024*1024*1;

  ErrMsg_BlockDownloaded  ='块下载完成。';
  ErrMsg_OtherBlockHasError ='因发生错误而取消：';
  ErrMsg_FileNotExists  ='远程文件不存在。';

type
  TADownFileObj = class;
  TFTPGetObj = class;
  TDownThread = class;

  TFTPEventMode  =(
    HEM_ADDURL, HEM_GETSIZE, HEM_WORK, HEM_DOWNOK,  HEM_BLOCKOK,
    HEM_SPEED, HEM_WORKBEGIN, HEM_ERROR);

  TFTPDownEvent  = procedure (Sender: TObject; ADownFileObj: TADownFileObj; EventMode: TFTPEventMode; ErrorMsg:string) of object;


  TDownServerInfo = record
     FHost  :string;
     FPort  :Integer;
     FUserName  :string;
     FPassWord  :string;
     FRemoteFile  :string;//文件相对URL
  end;

  TRSRIdFTP = class (TIdFTP)
  protected
    procedure ResumeGet(const ASourceFile: string; ADest: TStream; APosition: Integer);
  public
  end;


  //一个需要下载的 文件
  TADownFileObj  = class
  private
    FStream :TMemoryStream;

    //----------用于计算下载速度，临时变量，每隔3秒做一次计算
    FTmpRefreshTick :LongWord;
    FTmpRefreshSize :LongWord;

    //生成下载任务
    procedure MakeGetObjs;
    //采取 Head 方式获取文件信息
    procedure MakeGetFileSizeObj;

    procedure FtpGetWork(AFtpGetObj: TFTPGetObj; const AWorkCount: Integer);

  protected
    AUrl  :String;
    ASavePath :String;

    FHasError  :Boolean;//是否已发生错误
    FLastErrMsg :String;

    FileTestOK  :Boolean;//是否已正确获得文件大小

    //需要下载文件的大小
    AFileSize :Int64;
    //已下载大小
    ADownSize :Int64;

    //开始下载时间
    BeginTime :TDateTime;
    BeginTick :LongWord;

    //是否下载已全部完成
    FDownloaded  :Boolean;
    EndTime :TDateTime;
    EndTick :LongWord;

    //分割任务列表
    DownWorkItems :TList;

    //下载任务完成，做一些操作
    procedure DoDownloadOK;virtual;
  public
    //下载过程中的事件通知
    FtpDownEvent :TFTPDownEvent;

    Host  :String;
    Port  :Integer;
    UserName  :String;
    PassWord  :String;


    //用于自定义附加数据
    Data  :Pointer;
    //FTP服务器是否支持断点续传 REST 命令    True=支持 False=不支持
    CanSupportRest  :Boolean;
    ADefBlockSize :Integer;
    Constructor Create; overload;
    Destructor  Destroy; override;

    //从Url中分离出文件名
    function  GetFileNameFromUrl (AUrl:String):String;
    //从Url中分离出完整文件名（包括路径）
    function  GetFullFileNameFromUrl (AUrl:String):String;

    property  Url :String read AUrl write AUrl;
    property  SavePath  :String read ASavePath write ASavePath;
    property  FileSize  :Int64 read AFileSize;
    property  DownSize  :Int64 read ADownSize;
    property  Stream  :TMemoryStream read FStream;
    property  HasError  :Boolean read FHasError;
    property  LastErrMsg  :String read FLastErrMsg;
    property  Downloaded  :Boolean read FDownloaded;
  end;

  //一个获得文件大小任务
  TFTPHeadObj  = class(TWorkItem)
  private
    FErrMsg :String;
    procedure DoThreadError;
  protected
    procedure DoThreadExecute (Sender: TThreadsPool; AThread: TProcessorThread);override;
    procedure DoSync (ThreadsPool:TThreadsPool; AThread: TProcessorThread);override;
  public
    ADownFileObj  :TADownFileObj;
  end;

  //一个下载任务数据块
  TFTPGetObj = class(TWorkItem)
  private
    FStream :TMemoryStream;
    FAWorkCount,
    FCurCount :Integer;
    FDownThread :TDownThread;

    FErrMsg :String;

    procedure OnWork(Sender: TObject; AWorkMode: TWorkMode; const AWorkCount: Integer);
    procedure DoThreadError;
  protected
    procedure DoThreadExecute (Sender: TThreadsPool; AThread: TProcessorThread);override;
    procedure DoSync (ThreadsPool:TThreadsPool; AThread: TProcessorThread);override;
    procedure DoFtpGetWork;

  public
    ADownFileObj  :TADownFileObj;
    //开始位置、结束位置
    AStart, AEnd  :LongWord;
    //已下载数据量
    RecvCount :LongWord;
    BlockNo :Integer;
    BlockOK  :Boolean;

    Constructor Create; overload;
    Destructor  Destroy; override;
  end;


  //工作线程（下载）
  TDownThread = class (TProcessorThread)
  private
    FFtp :TRsrIdFTP;
    FMakeTick :LongWord;
    FLastRunOKTick  :LongWord;
    FErrorMsg: String;

    procedure DoThreadError;
    procedure DoSyncExec;
  protected

    procedure DoInit; override;
    procedure DoFInit; override;
    procedure DoWork;virtual;
  public
    constructor Create(APool: TThreadsPool);override;
  end;

  {
  FTP 下载线程池管理类
  }
  TThreadPoolDown = class (TThreadsPool)
  private
    FCallBackEvent  :TFTPDownEvent;

    //下载任务列表
    FDownFileObjs :TList;
    procedure   ClearDownFileObjs;
  protected
    //线程执行代码-》执行任务
    procedure   DoProcessRequest(aDataObj: TWorkItem; aThread: TProcessorThread);override;
  public
    constructor Create(AOwner: TComponent); override;
    Destructor  Destroy; override;

    //增加下载任务
    procedure    AddFtpDown (
      ASavePath  :String;
      AUrl  :String;
      AHost:String; AUserName:String='Anonymous'; APassWord:String='114032666@qq.com'; APort:Integer=21;
      AFtpDownEvent :TFTPDownEvent=nil;AMaxBlockSize: Integer=DefBlockSize);overload;
    procedure   AddFtpDown (ADownFileObj  :TADownFileObj);overload;
  end;



  {
  函数名：FtpDown
  作用：下载FTP服务器上的文件
  参数：
  ASavePath ->本地保存路径，本参数不为空，则在下载完成后，自动保存到该路径下。
     如：
     ASavePath='C:\Download'
     AUrl='/soft/MyFile.rar'
     则表示在下载完成后，保存为本地文件 C:\Download\My
最低0.47元/天解锁文章