adftp.pas

测试用例

(***** BEGIN LICENSE BLOCK *****
 * Version: MPL 1.1
 *
 * The contents of this file are subject to the Mozilla Public License Version
 * 1.1 (the "License"); you may not use this file except in compliance with
 * the License. You may obtain a copy of the License at
 * http://www.mozilla.org/MPL/
 *
 * Software distributed under the License is distributed on an "AS IS" basis,
 * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
 * for the specific language governing rights and limitations under the
 * License.
 *
 * The Original Code is TurboPower Async Professional
 *
 * The Initial Developer of the Original Code is
 * TurboPower Software
 *
 * Portions created by the Initial Developer are Copyright (C) 1991-2002
 * the Initial Developer. All Rights Reserved.
 *
 * Contributor(s):
 *
 * ***** END LICENSE BLOCK ***** *)

{*********************************************************}
{*                    ADFTP.PAS 4.06                     *}
{*********************************************************}
{* TApdFTPClient component                               *}
{*********************************************************}

{
  We descend from a TApdWinsockPort for the control connection,
  and create a TApdSocket for the data connection. We currently
  do not support proxy/firewall, mainly because that is in the
  TApdWinsockPort but not available at the TApdSocket.
}

{Global defines potentially affecting this unit}
{$I AWDEFINE.INC}

{Options required for this unit}
{$G+,X+,F+,B-,J+}
{$C MOVEABLE,DEMANDLOAD,DISCARDABLE}

unit AdFtp;
  {-Delphi internet file transfer protocol (FTP) client component}

interface

uses
  WinTypes,
  WinProcs,
  Classes,
  Messages,
  SysUtils,
  Forms,
  OoMisc,
  AwUser,
  AdSocket,
  AdwUtil,
  AdWnPort,
  AdPort,
  AdPacket,
  AdExcept;                                                          

const {miscellaneous constants}
  MaxBuffer = 32768;
  MaxCmdStack = 32;

type {Ftp mode and status definitions}
  TFtpRetrieveMode  = (rmAppend, rmReplace, rmRestart);
  TFtpStoreMode     = (smAppend, smReplace, smUnique, smRestart);
  TFtpFileType      = (ftAscii, ftBinary);
  TFtpProcessState  = (psClosed, psLogin, psIdle, psDir, psGet, psPut, psRen,
                       psCmd, psMkDir);                                
  TFtpStatusCode    = (scClose, scOpen, scLogout, scLogin, scComplete,
                       scCurrentDir, scDataAvail, scProgress, scTransferOK,
                       scTimeout);
  TFtpLogCode       = (lcClose, lcOpen, lcLogout, lcLogin, lcDelete,
                       lcRename, lcReceive, lcStore, lcComplete,
                       lcRestart, lcTimeout, lcUserAbort);

type {Ftp event definitions}
  TFtpErrorEvent  = procedure(Sender : TObject;
                              ErrorCode : Integer;
                              ErrorText : PChar) of object;
  TFtpLogEvent    = procedure(Sender : TObject;
                              LogCode : TFtpLogCode) of object;
  TFtpReplyEvent  = procedure(Sender : TObject;
                              ReplyCode : Integer;
                              ReplyText : PChar) of object;
  TFtpStatusEvent = procedure(Sender : TObject;
                              StatusCode : TFtpStatusCode;
                              InfoText : PChar) of object;

type {forwards}
  TApdFtpLog = class;

  {custom ftp component}
  TApdCustomFtpClient = class(TApdCustomWinsockPort)
  protected {private}
    AbortXfer       : Boolean;
    CmdStack        : array[0..MaxCmdStack-1] of string;
    CmdsStacked     : Byte;
    DataName        : TSockAddrIn;
    DataSocket      : TSocket;
    hwndFtpEvent    : HWND;
    ReplyPacket     : TApdDataPacket;
    DataBuffer      : array[0..MaxBuffer] of Byte;
    ReplyBuffer     : array[0..MaxBuffer] of Char;
    ListenSocket    : TSocket;
    ListenName      : TSockAddrIn;
    LocalStream     : TFileStream;
    MultiLine       : Boolean;
    MultiLineTerm   : string;
    NoEvents        : Boolean;
    ProcessState    : TFtpProcessState;
    Sock            : TApdSocket;
    Timer           : Integer;

  protected {property variables}
    FAccount          : string;
    FBytesTransferred : Longint;
    FConnectTimeout   : Integer;
    FFileLength       : Longint;
    FFileType         : TFtpFileType;
    FFtpLog           : TApdFtpLog;
    FLocalFile        : string;
    FPassword         : string;
    FPassiveMode      : Boolean;
    FTransferTimeout  : Integer;
    FRemoteFile       : string;
    FRestartAt        : Longint;
    FReplyCode        : Integer;
    FUserLoggedIn     : Boolean;
    FUserName         : string;

  protected {event variables}
    FOnFtpError        : TFtpErrorEvent;
    FOnFtpStatus       : TFtpStatusEvent;
    FOnFtpConnected    : TNotifyEvent;
    FOnFtpDisconnected : TNotifyEvent;
    FOnFtpLog          : TFtpLogEvent;
    FOnFtpReply        : TFtpReplyEvent;

  protected {methods}
    procedure ChangeState(NewState : TFtpProcessState);
    function  DataConnect : Boolean;
    procedure DataConnectPASV(IP : string);
    procedure DataDisconnect(FlushBuffer : Boolean);
    procedure DataShutDown;
    procedure DoConnect; override;
    procedure DoDisconnect; override;
    procedure FtpEventHandler(var Msg : TMessage);
    procedure FtpReplyHandler(ReplyCode : Integer; PData : PChar);
    function  GetConnected : Boolean;
    function  GetData : Integer;
    function  GetInProgress : Boolean;
    procedure Notification(AComponent : TComponent;
                           Operation : TOperation); override;
    function  PopCommand : string;
    procedure PostError(Code : Integer; Info : PChar);
    procedure PostLog(Code : TFtpLogCode);
    procedure PostStatus(Code : TFtpStatusCode; Info : PChar);
    procedure PushCommand(const Cmd : string);
    function  PutData : Integer;
    procedure ReplyPacketHandler(Sender : TObject; Data : string);
    procedure ResetTimer;
    procedure SendCommand(const Cmd : string);
    procedure SetFtpLog(const NewLog : TApdFtpLog);
    procedure StartTimer;
    procedure StopTimer;
    procedure TimerTrigger(Msg, wParam : Cardinal; lParam : Longint);
    procedure WsDataAccept(Sender : TObject; Socket : TSocket);
    procedure WsDataDisconnect(Sender : TObject; Socket : TSocket);
    procedure WsDataError(Sender : TObject; Socket : TSocket; ErrorCode : Integer);
    procedure WsDataRead(Sender : TObject; Socket : TSocket);
    procedure WsDataWrite(Sender : TObject; Socket : TSocket);

  protected {properties}
    property Account  : string
      read FAccount write FAccount;
    property ConnectTimeout : Integer
      read FConnectTimeout write FConnectTimeout;
    property FileType : TFtpFileType
      read FFileType write FFileType;
    property FtpLog : TApdFtpLog
      read FFtpLog write SetFtpLog;
    property Password : string
      read FPassword write FPassword;
    property PassiveMode : Boolean
      read FPassiveMode write FPassiveMode;
    property ServerAddress : string
      read FWsAddress write SetWsAddress;
    property TransferTimeout : Integer
      read FTransferTimeout write FTransferTimeout;
    property UserName : string
      read FUserName write FUserName;
  protected {events}
    property OnFtpError : TFtpErrorEvent
      read FOnFtpError write FOnFtpError;
    property OnFtpLog : TFtpLogEvent
      read FOnFtpLog write FOnFtpLog;
    property OnFtpReply : TFtpReplyEvent
      read FOnFtpReply write FOnFtpReply;
    property OnFtpStatus : TFtpStatusEvent
      read FOnFtpStatus write FOnFtpStatus;

  public {run-time properties}
    property BytesTransferred : Longint
      read FBytesTransferred;
    property Connected : Boolean
      read GetConnected;
    property InProgress : Boolean
      read GetInProgress;
    property FileLength : Longint
      read FFileLength;
    property ReplyCode : Integer
      read FReplyCode;
    property RestartAt : Longint
      read FRestartAt write FRestartAt;
    property UserLoggedIn : Boolean
      read FUserLoggedIn;

  public {methods}
    constructor Create(AOwner: TComponent); override;
    destructor  Destroy; override;
    function  Abort : Boolean;
    function  ChangeDir(const RemotePathName : string) : Boolean;
    function  CurrentDir : Boolean;
    function  Delete(const RemotePathName : string) : Boolean;
    function  ListDir(const RemotePathName : string;
                      FullList : Boolean) : Boolean;
    function  Help(const Command : string) : Boolean;
    function  Login : Boolean;
    function  Logout : Boolean;
    function  MakeDir(const RemotePathName : string) : Boolean;
    function  RemoveDir (const RemotePathName : string) : Boolean;     
    function  Rename(const RemotePathName, NewPathName : string) : Boolean;
    function  Retrieve(const RemotePathName, LocalPathName : string;
                       RetrieveMode : TFtpRetrieveMode) : Boolean;
    function  SendFtpCommand(const FtpCmd : string) : Boolean;
    function  Status(const RemotePathName : string) : Boolean;
    function  Store(const RemotePathName, LocalPathName : string;
                    StoreMode : TFtpStoreMode) : Boolean;
  end;


  {FtpLog component}
  TApdFtpLog = class(TApdBaseComponent)
  protected {properties}
    FEnabled        : Boolean;
    FFtpHistoryName : string;
    FFtpClient      : TApdCustomFtpClient;

  protected {methods}
    procedure Notification(AComponent : TComponent;
                           Operation: TOperation); override;

  public {methods}
    constructor Create(AOwner : TComponent); override;
    destructor Destroy; override;
    procedure UpdateLog(const LogCode : TFtpLogCode); virtual;

  published {properties}
    property Enabled : Boolean
      read FEnabled write FEnabled;
    property FtpHistoryName : string
      read FFtpHistoryName write FFtpHistoryName;
    property FtpClient : TApdCustomFtpClient
      read FFtpClient write FFtpClient;
  end;


  {Ftp component}
  TApdFtpClient = class(TApdCustomFtpClient)
  published {properties}
    property Account;
    property ConnectTimeout;
    property FileType;
    property FtpLog;
    property Password;
    property PassiveMode;                                            
    property ServerAddress;
    property TransferTimeout;
    property UserName;
             {events}
    property OnFtpError;
    property OnFtpLog;
    property OnFtpReply;
    property OnFtpStatus;
             {inherited properties}
    property Logging;
    property LogSize;
    property LogName;
    property LogHex;
    property Tracing;
    property TraceSize;
    property TraceName;
    property TraceHex;
    property WsPort;
             {inherited events}
    property OnWsError;                                             
  end;


implementation

const {file data type constants}
  TypeChar  : array[TFtpFileType] of Char = ('A', 'I');

const {FTP commands}
  fcABOR = 'ABOR';
  fcACCT = 'ACCT';
  fcALLO = 'ALLO';
  fcAPPE = 'APPE';
  fcCDUP = 'CDUP';
  fcCWD  = 'CWD';
  fcDELE = 'DELE';
  fcHELP = 'HELP';
  fcLIST = 'LIST';
  fcMKD  = 'MKD';
  fcMODE = 'MODE';
  fcNLST = 'NLST';
  fcNOOP = 'NOOP';
  fcPASS = 'PASS';
  fcPASV = 'PASV';
  fcPORT = 'PORT';
  fcPWD  = 'PWD';
  fcQUIT = 'QUIT';
  fcREIN = 'REIN';
  fcREST = 'REST';
  fcRETR = 'RETR';
  fcRMD  = 'RMD';
  fcRNFR = 'RNFR';
  fcRNTO = 'RNTO';
  fcSITE = 'SITE';
  fcSIZE = 'SIZE';
  fcSMNT = 'SMNT';
  fcSTAT = 'STAT';
  fcSTOR = 'STOR';
  fcSTOU = 'STOU';
  fcSTRU = 'STRU';
  fcSYST = 'SYST';
  fcTYPE = 'TYPE';
  fcUSER = 'USER';

type {miscellaneous types}
  wParam = Longint;
  lParam = Longint;

const {miscellaneous constants}
  SockNameSize : Integer = SizeOf(TSockAddrIn);
  CRLF = #13 + #10;
  DefFtpHistoryName = 'APROFTP.HIS';
  DefServicePort = 'ftp';
  tmConnectTimer = 1;                                                
  ecFtpConnectTimeout = -1;                                          
  DefTransferTimeout = 1092;