dxftpservercore.pas

Well known and usefull component for delphi 7

unit DXFTPServerCore;

interface

///////////////////////////////////////////////////////////////////////////////
//    Component: TDXFTPServerCore
//       Author: G.E. Ozz Nixon Jr. ([e-mail])
// ========================================================================
// Source Owner: DX, Inc. 1995-2003
//    Copyright: All code is the property of DX, Inc. Licensed for
//               resell by Brain Patchwork DX (tm) and part of the
//               DX (r) product lines, which are (c) 1999-2003
//               DX, Inc. Source may not be distributed without
//               written permission from both Brain Patchwork DX,
//               and DX, Inc.
//      License: (Reminder), None of this code can be added to other
//               developer products without permission. This includes
//               but not limited to DCU's, DCP's, DLL's, OCX's, or
//               any other form of merging our technologies. All of
//               your products released to a public consumer be it
//               shareware, freeware, commercial, etc. must contain a
//               license notification somewhere visible in the
//               application.
//               Example is Internet Explorer - Help->About screen
//               shows the licensed code contained in the application.
// Code Version: (4th Generation Code)
// ========================================================================
//  Description: implements FTP (File Transfer Protocol)
// ========================================================================
///////////////////////////////////////////////////////////////////////////////

uses
  Classes,
  DXServerCore;

{$I DXSock.def}

const
   MaxStatusCodes=38;
   StatusCodes:array[0..MaxStatusCodes] of record
      Code:Integer;
      Msg:string
   end=
   ((Code:110;Msg:'Restart marker reply') ,
    (Code:120;Msg:'System ready in nnn minutes') ,
    (Code:125;Msg:'Data connection already open; transfer starting') ,
    (Code:150;Msg:'File status okay; about to open data connection') ,
    (Code:200;Msg:'Command okay') ,
    (Code:202;Msg:'Command not implemented, superfluous at this site') ,
    (Code:211;Msg:'System status, or system help reply') ,
    (Code:212;Msg:'Directory status') ,
    (Code:213;Msg:'File status') ,
    (Code:214;Msg:'Help Message') ,
    (Code:215;Msg:'Windows operating system type') ,
    (Code:220;Msg:'System ready for new user') ,
    (Code:221;Msg:'Service closing control connection') ,
    (Code:225;Msg:'Data connection open, no transfer in progress') ,
    (Code:226;Msg:'Closing data connection') ,
    (Code:227;Msg:'Entering Passive Mode '),
    (Code:230;Msg:'User logged in, proceed'),
    (Code:250;Msg:'Requested file action okay, completed'),
    (Code:257;Msg:'"PATHNAME" created'),
    (Code:331;Msg:'Anonymous access allowed, send identity (e-mail name) as password'),
//    (Code:331;Msg:'User name okay, need password'),
    (Code:332;Msg:'Need account for login'),
    (Code:350;Msg:'Requested file action pending further information'),
    (Code:421;Msg:'Service not available, closing control connection') ,
    (Code:425;Msg:'Cannot open data connection') ,
    (Code:426;Msg:'Connection closed, transfer aborted') ,
    (Code:450;Msg:'Requested file action not taken') ,
    (Code:451;Msg:'Requested action aborted. Local error in processing') ,
    (Code:452;Msg:'Requested action not taken') ,
    (Code:500;Msg:'Syntax error, command unrecognized') ,
    (Code:501;Msg:'Syntax error in parameters or arguments') ,
    (Code:502;Msg:'Command not implemented') ,
    (Code:503;Msg:'Bad sequence of commands') ,
    (Code:504;Msg:'Command not implemented for that parameter') ,
    (Code:530;Msg:'Not logged in'),
    (Code:532;Msg:'Need account for storing files'),
    (Code:550;Msg:'Requested action not taken'),
    (Code:551;Msg:'Requested action aborted. Page type unknown'),
    (Code:552;Msg:'Requested file action aborted'),
    (Code:553;Msg:'Requested action not taken'));

type
  FTPTSimpleEvent  = procedure(ClientThread:TDXClientThread) of object;
  FTPTBasicEvent   = procedure(ClientThread:TDXClientThread;Parm:string) of object;
  FTPTComplexEvent = procedure(ClientThread:TDXClientThread;Parm1,Parm2:string) of object;
  FTPTPassEvent    = procedure(ClientThread:TDXClientThread;Parm:string;Var SuccessfulLogin:Boolean) of object;
  FTPTOtherEvent   = procedure(ClientThread: TDXClientThread; Command: string; Parm: string; var Handled: Boolean) of object;

  TDXFTPServerCore = class(TDXServerCore)
  private
    fGetLocalHostName:String;
    fOnCommandUSER: FTPTBasicEvent;
    fOnCommandPASS: FTPTPassEvent;
    fOnCommandACCT: FTPTBasicEvent;
    fOnCommandCWD:  FTPTBasicEvent;
    fOnCommandCDUP: FTPTSimpleEvent;
    fOnCommandSMNT: FTPTBasicEvent;
    fOnCommandQUIT: FTPTSimpleEvent;
    fOnCommandREIN: FTPTSimpleEvent;
    fOnCommandPORT: FTPTBasicEvent;
    fOnCommandPASV: FTPTSimpleEvent;
    fOnCommandTYPE: FTPTBasicEvent;
    fOnCommandSTRU: FTPTBasicEvent;
    fOnCommandMODE: FTPTBasicEvent;
    fOnCommandRETR: FTPTBasicEvent;
    fOnCommandSTOR: FTPTBasicEvent;
    fOnCommandSTOU: FTPTSimpleEvent;
    fOnCommandAPPE: FTPTBasicEvent;
    fOnCommandALLO: FTPTComplexEvent;
    fOnCommandREST: FTPTBasicEvent;
    fOnCommandRNFR: FTPTBasicEvent;
    fOnCommandRNTO: FTPTBasicEvent;
    fOnCommandABOR: FTPTSimpleEvent;
    fOnCommandDELE: FTPTBasicEvent;
    fOnCommandRMD:  FTPTBasicEvent;
    fOnCommandMKD:  FTPTBasicEvent;
    fOnCommandPWD:  FTPTSimpleEvent;
    fOnCommandLIST: FTPTBasicEvent;
    fOnCommandNLST: FTPTBasicEvent;
    fOnCommandSITE: FTPTBasicEvent;
    fOnCommandSIZE: FTPTBasicEvent; // 2.0
    fOnCommandSYST: FTPTSimpleEvent;
    fOnCommandSTAT: FTPTBasicEvent;
    fOnCommandHELP: FTPTBasicEvent;
    fOnCommandNOOP: FTPTSimpleEvent;
    fOnCommandOther:FTPTOtherEvent;
    fOnCommandTimeout: FTPTSimpleEvent; // Dec 20
  protected
    Procedure SetOnCommandUSER(value:FTPTBasicEvent);
    Procedure SetOnCommandPASS(value:FTPTPassEvent);
    Procedure SetOnCommandACCT(value:FTPTBasicEvent);
    Procedure SetOnCommandCWD(value:FTPTBasicEvent);
    Procedure SetOnCommandCDUP(value:FTPTSimpleEvent);
    Procedure SetOnCommandSMNT(value:FTPTBasicEvent);
    Procedure SetOnCommandQUIT(value:FTPTSimpleEvent);
    Procedure SetOnCommandREIN(value:FTPTSimpleEvent);
    Procedure SetOnCommandPORT(value:FTPTBasicEvent);
    Procedure SetOnCommandPASV(value:FTPTSimpleEvent);
    Procedure SetOnCommandTYPE(value:FTPTBasicEvent);
    Procedure SetOnCommandSTRU(value:FTPTBasicEvent);
    Procedure SetOnCommandMODE(value:FTPTBasicEvent);
    Procedure SetOnCommandRETR(value:FTPTBasicEvent);
    Procedure SetOnCommandSTOR(value:FTPTBasicEvent);
    Procedure SetOnCommandSTOU(value:FTPTSimpleEvent);
    Procedure SetOnCommandAPPE(value:FTPTBasicEvent);
    Procedure SetOnCommandALLO(value:FTPTComplexEvent);
    Procedure SetOnCommandREST(value:FTPTBasicEvent);
    Procedure SetOnCommandRNFR(value:FTPTBasicEvent);
    Procedure SetOnCommandRNTO(value:FTPTBasicEvent);
    Procedure SetOnCommandABOR(value:FTPTSimpleEvent);
    Procedure SetOnCommandDELE(value:FTPTBasicEvent);
    Procedure SetOnCommandRMD(value:FTPTBasicEvent);
    Procedure SetOnCommandMKD(value:FTPTBasicEvent);
    Procedure SetOnCommandPWD(value:FTPTSimpleEvent);
    Procedure SetOnCommandLIST(value:FTPTBasicEvent);
    Procedure SetOnCommandNLST(value:FTPTBasicEvent);
    Procedure SetOnCommandSITE(value:FTPTBasicEvent);
    Procedure SetOnCommandSIZE(value:FTPTBasicEvent);
    Procedure SetOnCommandSYST(value:FTPTSimpleEvent);
    Procedure SetOnCommandSTAT(value:FTPTBasicEvent);
    Procedure SetOnCommandHELP(value:FTPTBasicEvent);
    Procedure SetOnCommandNOOP(value:FTPTSimpleEvent);
  public
    constructor Create(AOwner:TComponent); {$IFNDEF OBJECTS_ONLY} override; {$ENDIF}
    destructor Destroy; override;
    procedure SayHello(ClientThread:TDXClientThread;Header:TStrings);
    procedure SayGoodbye(ClientThread:TDXClientThread;Footer:TStrings);
    procedure ProcessSession(ClientThread:TDXClientThread;MOTD:TStrings);
    Procedure AddBasicEvent(Command:String;EventProc:FTPTBasicEvent);
    Procedure AddSimpleEvent(Command:String;EventProc:FTPTSimpleEvent);
    Procedure AddComplexEvent(Command:String;EventProc:FTPTComplexEvent);
    Procedure AddPassEvent(Command:String;EventProc:FTPTPassEvent);
    function ErrorText (StatusCode:Integer) :string;
  published
    property OnCommandUSER: FTPTBasicEvent read fOnCommandUSER
                                           write SetOnCommandUSER;
    property OnCommandPASS: FTPTPassEvent read fOnCommandPASS
                                          write SetOnCommandPASS;
    property OnCommandACCT: FTPTBasicEvent read fOnCommandACCT
                                           write SetOnCommandACCT;
    property OnCommandCWD: FTPTBasicEvent read fOnCommandCWD
                                          write SetOnCommandCWD;
    property OnCommandCDUP: FTPTSimpleEvent read fOnCommandCDUP
                                            write SetOnCommandCDUP;
    property OnCommandSMNT: FTPTBasicEvent read fOnCommandSMNT
                                           write SetOnCommandSMNT;
    property OnCommandQUIT: FTPTSimpleEvent read fOnCommandQUIT
                                            write SetOnCommandQUIT;
    property OnCommandREIN: FTPTSimpleEvent read fOnCommandREIN
                                            write SetOnCommandREIN;
    property OnCommandPORT: FTPTBasicEvent read fOnCommandPORT
                                           write SetOnCommandPORT;
    property OnCommandPASV: FTPTSimpleEvent read fOnCommandPASV
                                            write SetOnCommandPASV;
    property OnCommandTYPE: FTPTBasicEvent read fOnCommandTYPE
                                           write SetOnCommandTYPE;
    property OnCommandSTRU: FTPTBasicEvent read fOnCommandSTRU
                                           write SetOnCommandSTRU;
    property OnCommandMODE: FTPTBasicEvent read fOnCommandMODE
                                           write SetOnCommandMODE;
    property OnCommandRETR: FTPTBasicEvent read fOnCommandRETR
                                           write SetOnCommandRETR;
    property OnCommandSTOR: FTPTBasicEvent read fOnCommandSTOR
                                           write SetOnCommandSTOR;
    property OnCommandSTOU: FTPTSimpleEvent read fOnCommandSTOU
                                            write SetOnCommandSTOU;
    property OnCommandAPPE: FTPTBasicEvent read fOnCommandAPPE
                                           write SetOnCommandAPPE;
    property OnCommandALLO: FTPTComplexEvent read fOnCommandALLO
                                             write SetOnCommandALLO;
    property OnCommandREST: FTPTBasicEvent read fOnCommandREST
                                           write SetOnCommandREST;
    property OnCommandRNFR: FTPTBasicEvent read fOnCommandRNFR
                                           write SetOnCommandRNFR;
    property OnCommandRNTO: FTPTBasicEvent read fOnCommandRNTO
                                           write SetOnCommandRNTO;
    property OnCommandABOR: FTPTSimpleEvent read fOnCommandABOR
                                            write SetOnCommandABOR;
    property OnCommandDELE: FTPTBasicEvent read fOnCommandDELE
                                           write SetOnCommandDELE;
    property OnCommandRMD: FTPTBasicEvent read fOnCommandRMD
                                          write SetOnCommandRMD;
    property OnCommandMKD: FTPTBasicEvent read fOnCommandMKD
                                          write SetOnCommandMKD;
    property OnCommandPWD: FTPTSimpleEvent read fOnCommandPWD
                                           write SetOnCommandPWD;
    property OnCommandLIST: FTPTBasicEvent read fOnCommandLIST
                                           write SetOnCommandLIST;
    property OnCommandNLST: FTPTBasicEvent read fOnCommandNLST
                                           write SetOnCommandNLST;
    property OnCommandSITE: FTPTBasicEvent read fOnCommandSITE
                                           write SetOnCommandSITE;
    property OnCommandSIZE: FTPTBasicEvent read fOnCommandSIZE
                                           write SetOnCommandSIZE; // 2.0
    property OnCommandSYST: FTPTSimpleEvent read fOnCommandSYST
                                            write SetOnCommandSYST;
    property OnCommandSTAT: FTPTBasicEvent read fOnCommandSTAT
                                           write SetOnCommandSTAT;
    property OnCommandHELP: FTPTBasicEvent read fOnCommandHELP
                                           write SetOnCommandHELP;
    property OnCommandNOOP: FTPTSimpleEvent read fOnCommandNOOP
                                            write SetOnCommandNOOP;
    property OnCommandOther: FTPTOtherEvent read fOnCommandOther
                                            write fOnCommandOther;
    property OnTimeout: FTPTSimpleEvent read fOnCommandTimeout
                                            write fOnCommandTimeout;
  end;

implementation

Uses
   DXSocket,
   DXSock,
   DXString;

Type
  PFTPBasicEvent=^TFTPBasicEvent;
  TFTPBasicEvent=record
     Tag:Integer;
     Command:String;
     EventProcedure:FTPTBasicEvent;
  End;
  PFTPSimpleEvent=^TFTPSimpleEvent;
  TFTPSimpleEvent=record
     Tag:Integer;
     Command:String;
     EventProcedure:FTPTSimpleEvent;
  End;
  PFTPComplexEvent=^TFTPComplexEvent;
  TFTPComplexEvent=record
     Tag:Integer;
     Command:String;
     EventProcedure:FTPTComplexEvent;
  End;
  PFTPPassEvent=^TFTPPassEvent;
  TFTPPassEvent=record
     Tag:Integer;
     Command:String;
     EventProcedure:FTPTPassEvent;
  End;

///////////////////////////////////////////////////////////////////////////////
// from RFC959...
//   'USER', {USER<SP><username><CRLF>}
//   'PASS', {PASS<SP><password><CRLF>}
//   'ACCT', {ACCT<SP><account-information><CRLF>}
//   'CWD',  {CWD<SP><pathname><CRLF>}
//   'CDUP', {CDUP<CRLF>}
//   'SMNT', {SMNT<SP><pathname><CRLF>}
//   'QUIT', {QUIT<CRLF>}
//   'REIN', {REIN<CRLF>}
//   'PORT', {PORT<SP><host-port><CRLF>}
//   'PASV', {PASV<CRLF>}