ftpcli.pas

互联网套件

  FTP_RCV_BUF_SIZE = 4096;
{$ENDIF}

type
  TFtpOption      = (ftpAcceptLF);
  TFtpOptions     = set of TFtpOption;
  TFtpState       = (ftpNotConnected,  ftpReady,         ftpInternalReady,
                     ftpDnsLookup,     ftpConnected,     ftpAbort,
                     ftpInternalAbort, ftpWaitingBanner, ftpWaitingResponse);
  TFtpRequest     = (ftpNone,          ftpOpenAsync,     ftpUserAsync,
                     ftpPassAsync,     ftpCwdAsync,      ftpConnectAsync,
                     ftpReceiveAsync,  ftpDirAsync,      ftpLsAsync,
                     ftpPortAsync,     ftpGetAsync,      ftpDirectoryAsync,
                     ftpListAsync,     ftpSystemAsync,   ftpSystAsync,
                     ftpQuitAsync,
                     ftpSizeAsync,     ftpPutAsync,      ftpAppendAsync,
                     ftpFileSizeAsync, ftpRqAbort,       ftpMkdAsync,
                     ftpRmdAsync,      ftpRenameAsync,   ftpDeleAsync,
                     ftpRenAsync,      ftpRenToAsync,    ftpRenFromAsync,
                     ftpDeleteAsync,   ftpMkdirAsync,    ftpRmdirAsync,
                     ftpPwdAsync,      ftpQuoteAsync,    ftpCDupAsync,
                     ftpDoQuoteAsync,  ftpTransmitAsync, ftpTypeSetAsync,
                     ftpRestAsync,     ftpRestGetAsync,  ftpRestartGetAsync);
  TFtpFct         = (ftpFctNone,       ftpFctOpen,       ftpFctUser,
                     ftpFctPass,       ftpFctCwd,        ftpFctSize,
                     ftpFctMkd,        ftpFctRmd,        ftpFctRenFrom,
                     ftpFctRenTo,      ftpFctGet,        ftpFctDir,
                     ftpFctQuit,       ftpFctSyst,       ftpFctDele,
                     ftpFctPwd,        ftpFctQuote,      ftpFctPut,
                     ftpFctTypeSet,    ftpFctRest,       ftpFctCDup,
                     ftpFctLs,         ftpFctAppend,     ftpFctPort);
  TFtpFctSet      = set of TFtpFct;
  TFtpShareMode   = (ftpShareCompat,    ftpShareExclusive,
                     ftpShareDenyWrite, ftpShareDenyRead,
                     ftpShareDenyNone);
  TFtpDisplayFileMode = (ftpLineByLine, ftpBinary);

  TFtpDisplay     = procedure(Sender    : TObject;
                              var Msg   : String) of object;
  TFtpProgress    = procedure(Sender    : TObject;
                              Count     : LongInt;
                              var Abort : Boolean) of object;
  TFtpCommand     = procedure(Sender    : TObject;
                              var Cmd   : String) of object;
  TFtpRequestDone = procedure(Sender    : TObject;
                              RqType    : TFtpRequest;
                              Error     : Word) of object;
  TFtpReadyToTransmit = procedure(Sender      : TObject;
                                  var bCancel : Boolean) of object;
  TFtpNextProc    = procedure of object;

  FtpException = class(Exception);

  TCustomFtpCli = class(TComponent)
  protected
    FWindowHandle       : HWND;
    FHostName           : String;
    FPort               : String;
    FUserName           : String;
    FPassWord           : String;
    FLocalFileName      : String;
    FHostFileName       : String;
    FHostDirName        : String;
    FDnsResult          : String;
    FType               : Char;
    FShareMode          : Word;
    FDisplayFileMode    : TFtpDisplayFileMode;
    FAppendFlag         : Boolean;
    FDisplayFileFlag    : Boolean;
    FControlSocket      : TWSocket;
    FDataSocket         : TWSocket;
    FStartTime          : LongInt;
    FStopTime           : LongInt;
    FState              : TFtpState;
    FStatusCode         : LongInt;
    FRequestResult      : Integer;
    FFctSet             : TFtpFctSet;
    FFctPrv             : TFtpFct;
    FHighLevelResult    : Integer;
    FHighLevelFlag      : Boolean;
    FRestartFlag        : Boolean;
    FOptions            : TFtpOptions;
    FOnDisplay          : TFtpDisplay;
    FOnDisplayFile      : TFtpDisplay;
    FOnError            : TFTPDisplay;
    FOnCommand          : TFtpCommand;
    FOnResponse         : TNotifyEvent;
    FOnSessionConnected : TSessionConnected;
    FOnSessionClosed    : TSessionClosed;
    FOnStateChange      : TNotifyEvent;
    FOnRequestDone      : TFtpRequestDone;
    FOnProgress         : TFtpProgress;
    FOnReadyToTransmit  : TFtpReadyToTransmit;
    FOnBgException      : TBgExceptionEvent;
    FLocalStream        : TStream;
    FRequestType        : TFtpRequest;
    FRequestDoneFlag    : Boolean;
    FReceiveBuffer      : array [0..FTP_RCV_BUF_SIZE - 1] of char;
    FReceiveLen         : Integer;
    FLastResponse       : String;
    FLastResponseSave   : String;  { To save FLastResponse when quitting }
    FPasvResponse       : String;  { To fix REST + PASV transfers }
    FStatusCodeSave     : LongInt; { To save FStatusCode when quitting }
    FErrorMessage       : String;
    FError              : Word;    { To save Error when data connection closed }
    FGetCommand         : String;
    FConnected          : Boolean;
    FSendBuffer         : array [0..BLOCK_SIZE - 1] of char;
    FByteCount          : LongInt;
    FSizeResult         : LongInt;
    FDirResult          : String;
    FResumeAt           : LongInt;
    FNext               : TFtpNextProc;
    FWhenConnected      : TFtpNextProc;
    FDoneAsync          : TFtpNextProc;
    FOkResponses        : array [0..15] of Integer;
    FNextRequest        : TFtpNextProc;
    FServerSaidDone     : Boolean;
    FFileReceived       : Boolean;
    FFileSent           : Boolean;
    FPassive            : Boolean;
    FEofFlag            : Boolean;
    FStorAnswerRcvd     : Boolean;
    FPutSessionOpened   : Boolean;
    procedure   SetErrorMessage;
    procedure   DataSocketGetDataAvailable(Sender: TObject; Error : word);
    procedure   DataSocketGetSessionConnected(Sender: TObject; Error : word);
    procedure   DataSocketPutSessionConnected(Sender: TObject; Error : word);
    procedure   DataSocketGetSessionAvailable(Sender: TObject; Error : word);
    procedure   DataSocketGetSessionClosed(Sender: TObject; Error : word);
    procedure   DataSocketPutDataAvailable(Sender: TObject; Error : word);
    procedure   DataSocketPutDataSent(Sender: TObject; Error : word);
    procedure   DataSocketPutSessionAvailable(Sender: TObject; Error : word);
    procedure   DataSocketPutSessionClosed(Sender: TObject; Error : word);
    procedure   SendCommand(Cmd : String); virtual;
    procedure   TriggerDisplay(Msg : String); virtual;
    procedure   TriggerReadyToTransmit(var bCancel : Boolean); virtual;
    procedure   TriggerDisplayFile(Msg : String); virtual;
    procedure   TriggerError(Msg: string); virtual;
    procedure   DisplayLastResponse;
    procedure   Notification(AComponent: TComponent; Operation: TOperation); override;
    function    Progress : Boolean; virtual;
    procedure   ControlSocketDnsLookupDone(Sender: TObject; Error: Word);
    procedure   ControlSocketSessionConnected(Sender: TObject; Error: Word);
    procedure   ControlSocketDataAvailable(Sender: TObject; Error: Word);
    procedure   ControlSocketSessionClosed(Sender: TObject; Error: Word);
    procedure   TriggerRequestDone(Error: Word);
    procedure   TriggerStateChange;
    procedure   StateChange(NewState : TFtpState);
    procedure   PortAsync; virtual;
    procedure   DoneQuitAsync;
    procedure   ExecAsync(RqType      : TFtpRequest;
                          Cmd         : String;
                          OkResponses : array of Word;
                          DoneAsync   : TFtpNextProc);
    procedure   NextExecAsync;
    procedure   DoGetAsync(RqType : TFtpRequest);
    procedure   Next1GetAsync;
    procedure   Next2GetAsync;
    procedure   Next3GetAsync;
    procedure   Next1PutAsync;
    procedure   Next2PutAsync;
    procedure   Next3PutAsync;
    procedure   DoHighLevelAsync;
    procedure   DoPutAppendAsync;
    procedure   HighLevelAsync(RqType : TFtpRequest; Fcts : TFtpFctSet);
    procedure   HandleError(const Msg : String);
    function    CheckReady : Boolean;
    procedure   TransfertStats; virtual;
    procedure   ExtractMoreResults;
    procedure   SetBinary(Value : Boolean);
    function    GetBinary : Boolean;
    function    GetConnected : Boolean;
    procedure   SetShareMode(newValue : TFtpShareMode);
    function    GetShareMode : TFtpShareMode;
    procedure   SetDisplayFileMode(NewValue: TFtpDisplayFileMode);
    function    GetDisplayFileMode: TFtpDisplayFileMode;
    procedure   WndProc(var MsgRec: TMessage); virtual;
    procedure   HandleBackGroundException(E: Exception); virtual;
    procedure   WMFtpRequestDone(var msg: TMessage);
                message WM_FTP_REQUEST_DONE;
    procedure   WMFtpSendData(var msg: TMessage);
                message WM_FTP_SENDDATA;
  public
    constructor Create(AOwner: TComponent); override;
    destructor  Destroy; override;

    procedure   OpenAsync;       virtual;
    procedure   UserAsync;       virtual;
    procedure   PassAsync;       virtual;
    procedure   ConnectAsync;    virtual;
    procedure   QuitAsync;       virtual;
    procedure   AbortAsync;      virtual;
    procedure   GetAsync;        virtual;
    procedure   ExecGetAsync;    virtual;
    procedure   ReceiveAsync;    virtual;
    procedure   PutAsync;        virtual;
    procedure   ExecPutAsync;    virtual;
    procedure   TransmitAsync;   virtual;
    procedure   AppendAsync;     virtual;
    procedure   ExecAppendAsync; virtual;
    procedure   AppendFileAsync; virtual;
    procedure   ExecDirAsync;    virtual;
    procedure   DirAsync;        virtual;
    procedure   ExecLsAsync;     virtual;
    procedure   LsAsync;         virtual;
    procedure   TypeSetAsync;    virtual;
    procedure   TypeBinaryAsync; virtual;
    procedure   TypeAsciiAsync;  virtual;
    procedure   PwdAsync;        virtual;
    procedure   CwdAsync;        virtual;
    procedure   CDupAsync;       virtual;
    procedure   DirectoryAsync;  virtual;
    procedure   ListAsync;       virtual;
    procedure   SystAsync;       virtual;
    procedure   SystemAsync;     virtual;
    procedure   SizeAsync;       virtual;
    procedure   FileSizeAsync;   virtual;
    procedure   MkdAsync;        virtual;
    procedure   MkdirAsync;      virtual;
    procedure   RmdAsync;        virtual;
    procedure   RmdirAsync;      virtual;
    procedure   DeleAsync;       virtual;
    procedure   DeleteAsync;     virtual;
    procedure   RenFromAsync;    virtual;
    procedure   RenToAsync;      virtual;
    procedure   RenAsync;        virtual;
    procedure   RenameAsync;     virtual;
    procedure   QuoteAsync;      virtual;
    procedure   DoQuoteAsync;    virtual;
    procedure   RestAsync;       virtual;
    procedure   RestGetAsync;    virtual;
    procedure   RestartGetAsync; virtual;

    property    Handle        : HWND        read FWindowHandle;
    property    LastResponse  : String      read FLastResponse;
    property    ErrorMessage  : String      read FErrorMessage;
    property    DnsResult     : String      read FDnsResult;
    property    SizeResult    : LongInt     read FSizeResult;
    property    DirResult     : String      read FDirResult;
    property    ControlSocket : TWSocket    read FControlSocket;
    property    DataSocket    : TWSocket    read FDataSocket;
    property    Connected     : Boolean     read GetConnected;
    property    StatusCode    : LongInt     read FStatusCode;
    property    ByteCount     : LongInt     read FByteCount;
    property    State         : TFtpState   read FState;
    property    RequestType   : TFtpRequest read FRequestType;
    property    Options       : TFtpOptions read  FOptions
                                            write FOptions;
    property ResumeAt       : LongInt  read FResumeAt      write FResumeAt;
    property HostName       : String   read FHostName      write FHostName;
    property Port           : String   read FPort          write FPort;
    property UserName       : String   read FUserName      write FUserName;
    property PassWord       : String   read FPassWord      write FPassWord;
    property HostDirName    : String   read FHostDirName   write FHostDirName;
    property HostFileName   : String   read FHostFileName  write FHostFileName;
    property LocalFileName  : String   read FLocalFileName write FLocalFileName;
    property DisplayFileFlag: Boolean  read FDisplayFileFlag write FDisplayFileFlag;
    property Binary         : Boolean  read GetBinary      write SetBinary;
    property Passive        : Boolean  read FPassive       write FPassive;
    property ShareMode      : TFtpShareMode          read  GetShareMode
                                                     write SetShareMode;
    property DisplayFileMode: TFtpDisplayFileMode    read  GetDisplayFileMode
                                                     write SetDisplayFileMode;
    property OnDisplay      : TFtpDisplay            read  FOnDisplay
                                                     write FOnDisplay;
    property OnDisplayFile  : TFtpDisplay            read  FOnDisplayFile
                                                     write FOnDisplayFile;
    property OnError        : TFTPDisplay            read  FOnError
                                                     write FOnError;
    property OnCommand  : TFtpCommand                read  FOnCommand
                                                     write FOnCommand;
    property OnResponse : TNotifyEvent               read  FOnResponse
                                                     write FOnResponse;
    property OnProgress : TFtpProgress               read  FOnProgress
                                                     write FOnProgress;
    property OnSessionConnected : TSessionConnected  read  FOnSessionConnected
                                                     write FOnSessionConnected;
    property OnSessionClosed : TSessionClosed        read  FOnSessionClosed
                                                     write FOnSessionClosed;
    property OnRequestDone : TFtpRequestDone         read  FOnRequestDone
                                                     write FOnRequestDone;
    property OnStateChange : TNotifyEvent            read  FOnStateChange
                                                     write FOnStateChange;
    property OnReadyToTransmit : TFtpReadyToTransmit read  FOnReadyToTransmit
                                                     write FOnReadyToTransmit;
    property OnBgException : TBgExceptionEvent       read  FOnBgException
                                                     write FOnBgException;
  end;

  TFtpClient = class(TCustomFtpCli)
  protected
    FTimeout       : Integer;                 { Given in seconds }
    FTimeStop      : LongInt;                 { Milli-seconds    }
    FMultiThreaded : Boolean;
    function    Progress : Boolean; override;
    function    Synchronize(Proc : TFtpNextProc) : Boolean; virtual;
    function    WaitUntilReady : Boolean; virtual;
  public
    constructor Create(AOwner: TComponent); override;
    function    Open       : Boolean;
    function    User       : Boolean;
    function    Pass       : Boolean;
    function    Connect    : Boolean;
    function    Cwd        : Boolean;
    function    Pwd        : Boolean;
    function    CDup       : Boolean;
    function    TypeSet    : Boolean;
    function    TypeBinary : Boolean;
    function    TypeAscii  : Boolean;
    function    Get        : Boolean;
    function    Put        : Boolean;
    function    Quit       : Boolean;
    function    Abort      : Boolean;
    function    Receive    : Boolean;
    function    Transmit   : Boolean;
    function    Append     : Boolean;
    function    AppendFile : Boolean;
    function    Dir        : Boolean;
    function    Directory  : Boolean;
    function    Ls         : Boolean;
    function    List       : Boolean;
    function    Mkd        : Boolean;
    function    Mkdir      : Boolean;
    function    Ren        : Boolean;
    function    Rename     : Boolean;
    function    Dele       : Boolean;
    function    Delete     : Boolean;
    function    Rmd        : Boolean;
    function    Rmdir      : Boolean;
    function    Syst       : Boolean;
    function    System     : Boolean;
    function    Size       : Boolean;
    function    FileSize   : Boolean;
    function    Quote      : Boolean;
    function    DoQuote    : Boolean;
    function    RestGet    : Boolean;
    function    RestartGet : Boolean;
  published
    property Timeout       : Integer read FTimeout       write FTimeout;
    property MultiThreaded : Boolean read FMultiThreaded write FMultiThreaded;
    property HostName;
    property Port;
    property UserName;
    property PassWord;
    property HostDirName;
    property HostFileName;
    property LocalFileName;
    property DisplayFileFlag;
    property Binary;
    property ErrorMessage;
    property ShareMode;
    property Options;
    property OnDisplay;
    property OnDisplayFile;
    property OnCommand;