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