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

hb120973135

　　以前写的一个ftp客户端下载的玩意！支持了断点续传，多线程传输等（实际上并非是一个真正多线程的传输与下载模式，是一个伪多线程方式，仅仅是多开ftp端口，连接上之后从指定的数据段位置开始下载，所以要想真正意义上实现一个多线程的模式还是需要在服务器端做相应的处理才能实现！）代码写的很简陋，仅仅提供了一个DownLoad方法，传递一个Ftp格式的URL然后解析出实际地址与文件名等开始实现下载！大致代码：
　　



{*******************************************************}
{                                                       }
{       得闲工作室  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.

　　这个默认地址是从看雪上下载的一个例子，具体代码下载（2007下测试）