ftp.pas

Monster FTP Client 强大的ftp客户控件,支持Proxy等

unit Ftp;

{
  Monster FTP Client VCL 0.3.3
  written by Chen Yu (monster)

  E-Mail: [e-mail]   ICQ UIN: 6740755

  Suggestions and bug reports are warm welcomed.

  Notes:

    * You can use it free because it is terms of the GNU Library
      General Public License.
    * If you modified the code, please send me a copy via email so that
      I can improve the component.
    * Some methods like FileSetAttr are not supported by all ftp servers.
    * This code is based on TStarFTP and TStarSock from Tony BenBrahim's
      freenet 2.0.
    * Many thanks to Brad Stowers (http://www.pobox.com/~bstowers/delphi/),
      Hector Vega Arvide ([e-mail]), Chris Godwin,
      Kaufman Alex (http://pages.infinit.net/kaufman/Index.htm) and other people
      who give me a lot of good advise.
    * You can modify mftp.inc to make a special version of Monster FTP Client
      other than the default one.
    * Please read problem.htm under doc folder carefully
}

interface

uses Classes, WinTypes, WinProcs, Messages, SysUtils, Forms, Extctrls,
     WinSock, FtpSock, FtpData, FtpCache, FtpMisc, FtpParse, FtpIndex;

{$I mftp.inc}

const
   FTP_AVAILABLE = WM_USER + 2;
// FTP_ERROR = WM_USER + 3;
   FTP_READY = WM_USER + 4;

type
   FtpInfo = (ftpServerConnected, ftpServerDisconnected, ftpResolvingAddress,
              ftpTraceIn, ftpTraceOut, ftpAlreadyBusy, ftpSupportResume,
              ftpResumeFailed, ftpDataTrace, ftpReady, ftpTransferDone,
              ftpDirectoryRefresh, ftpBadURL, ftpLoggedIn, ftpFileSize,
              ftpPermissionDenied, ftpListing, ftpNotSupportResume, ftpRetrying,
              ftpAddressResolved, ftpSizeDifferent, ftpNothing);

   FtpError = (ftpNone, ftpNetworkDown, ftpInvalidAddress, ftpInternalError,
               ftpGeneralWinsockError, ftpConnAborted, ftpConnReset, ftpConnectTimeOut,
               ftpOutofSockets, ftpNetworkUnreachable, ftpAddressNotAvailable,
               ftpConnectionRefused, ftpProtocolError, ftpCanceled, ftpUnknown,
               ftpAddressResolutionError, ftpPrematureDisconnect,
               ftpHostUnreachable, ftpNoServer, ftpNoProxyServer,
               ftpFileOpen, ftpFileWrite, ftpFileRead, ftpFileNotFound,
               ftpTimeOut, ftpServerDown, ftpAccessDenied, ftpDataError);

   TMFtpInfoNeeded = (niAccount, niHost, niIndexFile, niLocalFile, niOverwrite,
                      niPassword, niUser);

   TTransferType = (AsciiTransfer, BinaryTransfer);

   TMFtpLastAction = (ftplaNone, ftplaLOGIN, ftplaCWD, ftplaMKD, ftplaRMD,
                      ftplaRM, ftplaGETIndexFile, ftplaGET, ftplaPUT, ftplaLIST,
                      ftplaREN, ftplaCDUP);

   TMFtpProxyType = (proxyNone, proxyHost, proxyHostUser, proxyOpen, proxySite,
                     proxyUserSite);

   TMFtpServerType = (ftpstAutoDetect, ftpstDefault,
                      ftpstUNIX, ftpstULTRIX, ftpstClix, ftpstChameleon,
                      ftpstNCSA, ftpstQVT, ftpstBSD, ftpstSunOS,
                      ftpstVmsMultinet, ftpstVmsUcx, ftpstMVS, ftpstVM, ftpstVMVPS,
                      ftpstMSFTP, ftpstNetTerm, ftpstServU, ftpstWFTPD, ftpWarFTPD,
                      ftpstNetware, ftpstNetPresenz);

   TMFtpInfoEvent = procedure (Sender: TObject; info: FtpInfo; addinfo: String) of object;
   TMFtpErrorEvent = procedure (Sender: TObject; error: FtpError; addinfo: String) of object;
   TMFtpInfoNeededEvent = procedure (Sender: TObject; need: TMFtpInfoNeeded; var value: String) of object;
   TNewLineProc = procedure(line: String) of object;

   TMFtp = class(TMSocket)
   private
      NTimer:                    TTimer;
      FBusy:                     Boolean;
      FDBusy:                    Boolean;

      URLMode:                   Integer;
      FUrl:                      String;

      FtpServer:                 String;
      FtpPort:                   Integer;
      FProxyServer:              String;
      FProxyPort:                Integer;
      FPassive:                  Boolean;
      FProxyType:                TMFtpProxyType;

      FSupportResume:            Boolean;
      {Supports[x]: the value is true if server support the command

         1: NOOP    2: SIZE    3: RMD -r
      }
      Supports:                  Array [1..3] of Boolean;

      FUser, FPass, FAcct:       String;
      FPUser, FPPass:            String;

      FRetries:                  Integer;
      FRetryI:                   Word;
      FRemain:                   Integer;

      FList:                     TStrings;

      FFList:                    TStrings;    {can be also used as 'source list'}
      FDList:                    TStrings;    {can be also used as 'target list'}

      FFiles:                    TStrings;
      FFilesInfo:                TMFtpFileInfoList;
      FDirectories:              TStrings;
      FDirectoriesInfo:          TMFtpFileInfoList;

      FFile:                     String;
      FIFile:                    String;
      FSelection:                String;
      FDirectory:                String;
      FIDirectory:               String;

      FFileMask:                 String;

      FCache:                    Boolean;
      FCacheE:                   Integer;
      FFromCache:                Boolean;

      FType:                     TMFtpServerType;

      FMode:                     TTransferType;

      Bytes, TrTime, StartTime:  LongWord;

      {$ifdef BDS}
      TotalBytesToSend:          LongInt;
      {$endif}

      FtpInfoEvt:                TMFtpInfoEvent;
      FOnError:                  TMFtpErrorEvent;
      FOnReady:                  TNotifyEvent;
      NeedInfo:                  TMFtpInfoNeededEvent;

      FtpProc:                   TNewLineProc;
      Intermediate:              Boolean;
      Response:                  String;
      PartialLine:               String;
      DataPartialLine:           String;
      Step:                      Integer;
      pStep:                     Integer;

      ControlLoggedIn:           Boolean;
      ControlConnected:          Boolean;
      FDoingListing:             Boolean;
      FSuccess:                  Boolean;
      DataConnected:             Boolean;
      FileOpened:                Boolean;
      OnHold, TransferAborted:   Boolean;
      Aborted, SRetry:           Boolean;

      rnto:                      String;
      datafile:                  file;

      FVersion, DummyS:          String;

      OprDir:                    String;

      FLoggedIn, FDirectoryChanged,
      FDirectoryCreated, FFileRenamed,
      FDirectoryDeleted, FFileDeleted,
      FIndexFileReceived, FFileReceived,
      FFtpQuit, FFtpBusy, FAborted,
      FFileStored, FListingDone: TNotifyEvent;

      FtpLastAction:             TMFtpLastAction;
      ReadyPort, ReadyMain:      Boolean;

      InBuffer:  Array [0..IN_BUFFER_SIZE] of Char;
      OutBuffer: Array [0..OUT_BUFFER_SIZE] of Char;

      ListeningSocket,
      DataSocket:                TMSocket;

      FError:                    FtpError;
      errs:                      String;

      CurrentMode:               String;

      DownloadSize:              Integer;
      UploadSize:                Integer;

      NOnFtpError:         Array [1..MAX_HANDLERS] of TMFtpErrorEvent;
      NOnFtpInfo:          Array [1..MAX_HANDLERS] of TMFtpInfoEvent;
      NEvents:             Array [1..14, 1..MAX_HANDLERS] of TNotifyEvent;

      procedure CallNEvents(EventType: Integer);

      function CheckError: Boolean;
      function CheckStatus: Boolean;

      procedure DataDoListing(sender: TObject);
      procedure DataListConnected(sender: TObject);
      procedure DataListDisconnected(sender: TObject);
      procedure DataRetrFile(sender: TObject);
      {$ifdef BDS}
      procedure DataStorFile(sender: TObject);
      {$endif}
      procedure DataFileDisconnected(sender: TObject);
      procedure DataStorConnected(sender: TObject);

      procedure Proceed(line: String; n: Integer);
      procedure FtpLogin(line: String);
      procedure LoginMain;

      procedure UpdateCache;

      procedure NTimerTimer(Sender: TObject);
      procedure SetInterval(I: Word);
      function GetInterval: Word;

      procedure SetRetries(I: Integer);
      procedure SetTransferMode(M: String; S: Integer);

      procedure UserMessageHandler(var Message: TMessage);

      procedure DoFtpInfo(info: FtpInfo; add: String);
      procedure DoFtpError(e: FtpError);
      procedure Ready;

      function SetupDataPort: String;
      procedure SetupDataPortPassive(S: String);

      function DummyP: String;
      function DummyPP: String;
      function DummyPS(S: String): String;

      procedure DidConnect(Sender: TObject);
      procedure DoDisconnect(Sender: TObject);
      procedure DoRead(Sender: TObject);
      function RecvText: String;

      function GetUrl: String;
      procedure SetUrl(S: String);

      procedure FatalError(e: FtpError);
      procedure TimedOut(Sender: TObject);
   protected
      procedure LookupNameDone; override;
   public
      constructor Create(AOwner: TComponent); override;
      destructor Destroy; override;

      {$ifdef HAVE_OVERLOAD}
      procedure CreateDirectory(dir: String); overload;
      procedure CreateDirectory(dirlist: TStrings); overload;
      procedure DeleteDirectory(dir: String); overload;
      procedure DeleteDirectory(dirlist: TStrings); overload;
      procedure DeleteFile(filename: String); overload;
      procedure DeleteFile(filelist: TStrings); overload;
      procedure GetFile(RemoteFile, LocalFile: String); overload;
//    procedure GetFile(RemoteFiles, LocalFiles: TStrings); overload;
      procedure MoveFile(filename, newdir: String); overload;
      procedure MoveFile(filelist, dirlist: TStrings); overload;
      procedure PutFile(LocalFile, RemoteFile: String); overload;
//    procedure PutFile(LocalFiles, RemoteFiles: TStrings); overload;
      procedure RenameFile(oldname, newname: String); overload;
      procedure RenameFile(oldlist, newlist: TStrings); overload;
      {$else}
      procedure CreateDirectory(dir: String);
      procedure CreateDirectories(dirlist: TStrings);
      procedure DeleteDirectory(dir: String);
      procedure DeleteDirectories(dirlist: TStrings);
      procedure DeleteFile(filename: String);
      procedure DeleteFiles(filelist: TStrings);
      procedure GetFile(RemoteFile, LocalFile: String);
//    procedure GetFiles(RemoteFiles, LocalFiles: TStrings);
      procedure MoveFile(filename, newdir: String);
      procedure MoveFiles(filelist, dirlist: TStrings);
      procedure PutFile(LocalFile, RemoteFile: String);
//    procedure PutFiles(LocalFiles, RemoteFiles: TStrings);
      procedure RenameFile(oldname, newname: String);
      procedure RenameFiles(oldlist, newlist: TStrings);
      {$endif}

      procedure IssueCommand(command: String);
      procedure ChangeDirectory(name: String);
      procedure ChangeToParentDirectory;

      procedure LoadIndexFile(Filename: String);

      procedure Login;
      procedure Quit;
      procedure Refresh;

      procedure Abort;

      procedure FileSetAttr(filename: String;
      OwnerRead, OwnerWrite, OwnerExecute,
      GroupRead, GroupWrite, GroupExecute,
      PublicRead, PublicWrite, PublicExecute: Boolean);

      function RegisterNotifyEvent(EventType: Integer; P: TNotifyEvent): Integer;
      function RegisterErrorEvent(P: TMFtpErrorEvent): Integer;
      function RegisterInfoEvent(P: TMFtpInfoEvent): Integer;

      procedure UnRegisterNotifyEvent(EventType: Integer; i: Integer);
      procedure UnRegisterErrorEvent(i: Integer);
      procedure UnRegisterInfoEvent(i: Integer);

      function FileExists(filename: String): Integer;
      function DirectoryExists(dir: String): Integer;

      property Listing: TStrings read FList;
      property Files: TStrings read FFiles;
      property Directories: TStrings read FDirectories;
      property DirectoriesInfo: TMFtpFileInfoList read FDirectoriesInfo;
      property FilesInfo: TMFtpFileInfoList read FFilesInfo;

      property URL: String read GetUrl write SetUrl;

      property BytesTransferred: LongWord read Bytes write Bytes;
      property TransferTime: LongWord read TrTime;

      property Busy: Boolean read FBusy;
      {$warnings off} {avoiding warning here}
      property Connected: Boolean read ControlConnected;
      {$warnings on}
      property DoingListing: Boolean read FDoingListing;
      property FromCache: Boolean read FFromCache;
      property Success: Boolean read FSuccess;
      property SupportResume: Boolean read FSupportResume;

      property Error: FtpError read FError;
   published
      property NoopInterval: Word read GetInterval write SetInterval;

      property Username: String read FUser write FUser;
      property Password: String read DummyP write FPass;
      property Account: String read FAcct write FAcct;
      property ProxyUsername: String read FPUser write FPUser;
      property ProxyPassword: String read DummyPP write FPPass;

      property Retries: Integer read FRetries write SetRetries;
      property RetryInterval: Word read FRetryI write FRetryI;

      property ServerType: TMFtpServerType read FType write FType;
      property CurrentDirectory: String read FDirectory;
      property InitialDirectory: String read FIDirectory write FIDirectory;

      property FileMask: String read FFileMask write FFileMask;

      property Cache: Boolean read FCache write FCache;
      property CacheExpire: Integer read FCacheE write FCacheE;

      property TransferMode: TTransferType read FMode write FMode;

      property ProxyType: TMFtpProxyType read FProxyType write FProxyType;
      property ProxyServer: String read FProxyServer write FProxyServer;
      property ProxyPort: Integer read FProxyPort write FProxyPort;
      property Passive: Boolean read FPassive write FPassive;

      property OnFtpInfo: TMFtpInfoEvent read FtpInfoEvt write FtpInfoEvt;
      property OnFtpNeedInfo: TMFtpInfoNeededEvent read NeedInfo write NeedInfo;
      property OnFtpReady: TNotifyEvent read FOnReady write FOnReady;
      property OnFtpError: TMFtpErrorEvent read FOnError write FOnError;
      property OnLoggedIn: TNotifyEvent read FLoggedIn write FLoggedIn;
      property OnDirectoryChanged: TNotifyEvent read FDirectoryChanged write FDirectoryChanged;
      property OnDirectoryCreated: TNotifyEvent read FDirectoryCreated write FDirectoryCreated;
      property OnDirectoryDeleted: TNotifyEvent read FDirectoryDeleted write FDirectoryDeleted;
      property OnFileDeleted: TNotifyEvent read FFileDeleted write FFileDeleted;
      property OnIndexFileReceived: TNotifyEvent read FIndexFileReceived write FIndexFileReceived;
      property OnFileReceived: TNotifyEvent read FFileReceived write FFileReceived;
      property OnFileStored: TNotifyEvent read FFileStored write FFileStored;
      property OnListingDone: TNotifyEvent read FListingDone write FListingDone;
      property OnFileRenamed: TNotifyEvent read FFileRenamed write FFIleRenamed;
      property OnFtpQuit: TNotifyEvent read FFtpQuit write FFtpQuit;
      property OnFtpBusy: TNotifyEvent read FFtpBusy write FFtpBusy;
      property OnAborted: TNotifyEvent read FAborted write FAborted;

      property Version: String read FVersion write DummyS;

      {provided by TMSock}
      property Port;
      property Server;
      property TimeOutConnect;
      property TimeOutArp;
   end;

const
   WM_Proceed = WM_USER + 1;

implementation

{$R *.res}

constructor TMFtp.Create;
begin
   inherited Create(AOwner);

   NTimer := TTimer.Create(Self);
   SetInterval(30);

   FList := TStringList.Create;
   FFList := TStringList.Create;
   FDList := TStringList.Create;
   FFiles := TStringList.Create;
   FDirectories := TStringList.Create;

   FDirectoriesInfo := TMFtpFileInfoList.Create;
   FFilesInfo := TMFtpFileInfoList.Create;

   ListeningSocket := TMSocket.Create(Self);
   DataSocket := TMSocket.Create(Self);

   NTimer.OnTimer := NTimerTimer;
   CustomMessage := UserMessageHandler;

   FVersion := 'Monster FTP Client 0.3.3';
   Port := 21;

   FProxyPort := 21;
   FProxyType := proxyNone;

   CurrentMode := '';
   URLMode := 0;

   FRetries := 3;
   FRetryI := 15;

   FCache := True;
   FCacheE := 7;
   FFromCache := False;

   FtpProc := FtpLogin;
   OnConnected := DidConnect;
   OnDisconnected := DoDisconnect;
   OnReadReady := DoRead;
   OnTimeOut := TimedOut;
end;

destructor TMFtp.Destroy;
begin
   DataSocket.Destroy;
   ListeningSocket.Destroy;
   CloseSocket(Socket);