Delphi实现Ftp客户端下载（支持断点续传，多线程传输）

{ ******************************************************* }
{ }
{ 得闲工作室 Ftp客户端下载控件单元 }
{ FtpClient }
{ 作者: 不得闲 2009年2月25日, 9:09:04 }
{ }
{ ******************************************************* }

unit FtpClient;

interface
uses Windows,Classes,SysUtils,StrUtils,ScktComp,WinInet, Messages,Forms,IniFiles;

type
TDxFtpClient = class ;

TDxSockState = (Ds_DataOk,Ds_UserTerminate,Ds_DataErr);

TReadWriteThread = class (TThread)
private
FDataSocket: TClientSocket;
Owner: TDxFtpClient;
SocketDataStream: TWinSocketStream;
procedure DownLoad;
procedure UpLoad;
protected
procedure Execute; override ;
procedure UpdateProgress;
public
constructor Create(bSuspend:Boolean;AOwnerFtp: TDxFtpClient;Host: string ;Port: Word);
destructor Destroy; override ;
end ;

TDxFtp = class ;


{ FTP的双线连接,数据连接与命令连接 }
TDxFtpClient = class (TComponent)
private
FCmdSocket: TClientSocket; // 数据连接与命令连接
DataStream: TMemoryStream;
protected
DataSize,ReadySize: Int64;
OwnerFtp: TDxFtp;
SocketIndex: Integer;
ReadWriteThread: TReadWriteThread;
User,PassWord,DirName,FileName,Host: string ;
ConPort: Word;
procedure DoCmdSocketRead(Sender: TObject; Socket: TCustomWinSocket);
procedure DoCmdSocketError(Sender: TObject; Socket: TCustomWinSocket;ErrorEvent: TErrorEvent; var ErrorCode: Integer);
procedure DoReadWriteEnd(Sender: TObject);
public
constructor Create(AOwner: TComponent); override ;
destructor Destroy; override ;
procedure Open;
end ;


// 下载开始事件,Conindex指定下载的线程号,startPos和TotalSize分别指定下载开始位置和总数据量
TOnDownStartEvent = procedure (sender:TObject;conindex: integer;startPos,totalSize:Int64) of object ;
// 进度事件，分别指定为当前进度，以及下载速度
TOnProgressEvent = procedure (Sender: TObject;Const FileReadySize,FileTotalSize: int64; const Progress: Single; const ReadWriteRate: Single) of object ;
// 上传下载完成时候触发的事件,ReadyState指定完成的状态
TOnUpDownReadyEvent = procedure (Sender: TObject; const FileReadySize,FileTotalSize: Int64; const ReadyState: TDxSockState) of object ;
// 在下载和上传时，SockStream在读取和写入数据失败的时候触发的事件！WaitAgain表示是否继续等待下一次读取和写入，默认是不等待，
// 如果不等待，则直接中止数据传输，否则一直等待直到有数据读取和写入
// 如果不指定该事件，自动检测10次，如果超过10没有读取或写入数据，代表异常，传输数据中止

TSocketError = procedure (Sender: TObject;ErrorEvent: TErrorEvent; var ErrorCode: Integer) of object ;

TReadWritDataErrEvent = procedure (Sender: TObject; var WaitAgain: Boolean { 继续等待 } ) of object ;
TDxFtp = class (TComponent)
private
FThreadCount: Integer;
FtpSocketArr: array of TDxFtpClient;
Ini: TMemIniFile;
FileTotalSize: Int64;
FOnDownStart: TOnDownStartEvent;
FOnProgress: TOnProgressEvent;
ReadyCount: Integer; // 执行完成的数量
DownStartTick: DWORD;
BeginSize: Int64;
SaveFileName: string ;
UserTerminated: Boolean; // 用户终止
CriticalSection: TRTLCriticalSection; // 创建一个临界区
FileStream: TFileStream;
SaveFileIntime: Boolean; // 实时保存数据文件
IsUpLoad: Boolean;
FOnUpDownReady: TOnUpDownReadyEvent;
SockState: TDxSockState;
FOnReadWriteDataError: TReadWritDataErrEvent;
FOnSocketError: TSocketError;
procedure SetThreadCount( const Value: Integer);
function GetActive: Boolean;
procedure DownReady; // 全部完成，文件合并
procedure Ready;
public
constructor Create(AOwner: TComponent); override ;
destructor Destroy; override ;
property ThreadCount: Integer read FThreadCount write SetThreadCount default 2 ; // 线程数量
procedure Suspend; // 暂停
procedure Resume; // 继续
procedure Terminate; // 终止数据传输
property Active: Boolean read GetActive; // 是否活动
procedure DownLoad( const FptUrl: string ;SaveToFile: string ; const SaveInTime: Boolean = False); // 下载
procedure UpLoad( const FileName,FtpUrl: string );
procedure SaveCfg(CfgFile: string ); // 生成配置文件
property OnDownStart: TOnDownStartEvent read FOnDownStart write FOnDownStart;
property OnProgress: TOnProgressEvent read FOnProgress write FOnProgress;
property OnUpDownReady: TOnUpDownReadyEvent read FOnUpDownReady write FOnUpDownReady;
property OnReadWriteDataError: TReadWritDataErrEvent read FOnReadWriteDataError write FOnReadWriteDataError;
property OnSocketError: TSocketError read FOnSocketError write FOnSocketError;
end ;

function CheckFileName( const FileName: string ): string ;
function RightPos(Const SubStr,Str: string ; const index: integer =- 1 ): integer;
implementation
const
RecvTmpBufSize = 64 * 1024 ;
end .