home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 September / Chip_2001-09_cd1.bin / zkuste / delphi / nastroje / d5 / MFTP.ZIP / src / Ftp.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2001-06-09  |  97.0 KB  |  3,770 lines
  1. unit Ftp;
  2.  
  3. {
  4.   Monster FTP VCL 0.4.7
  5.   written by Chen Yu (monster)
  6.  
  7.   E-Mail: mftp@21cn.com   ICQ UIN: 6740755
  8.   Homepage: http://homepages.msn.com/RedmondAve/mftp/
  9.  
  10.   Suggestions and bug reports are warm welcomed.
  11.  
  12.   Notes:
  13.  
  14.     * You can use it free because it is terms of the GNU Library
  15.       General Public License.
  16.  
  17.     * Original code was based on TStarFTP and TStarSock from Tony BenBrahim's
  18.       freenet 2.0.
  19.  
  20.     * Many thanks to Brad Stowers (http://www.delphifreestuff.com/),
  21.       Hector Vega Arvide (hvega@cabonet.net.mx), Chris Godwin,
  22.       Kaufman Alex (http://pages.infinit.net/kaufman/Index.htm) and other people
  23.       who give me a lot of good advise.
  24.  
  25.     * If you modified the code, please send me a copy via email so that
  26.       I can improve the component.
  27.  
  28.     * You can modify mftp.inc to make a special version of Monster FTP
  29.       other than the default one.
  30.  
  31.     * Some methods like FileSetAttr are not supported by all ftp servers.
  32. }
  33.  
  34. interface
  35.  
  36. uses Classes, Windows, Messages, SysUtils, Forms, ExtCtrls,
  37.      WinSock, FtpSock, FtpData, FtpCache, FtpMisc, FtpParse, FtpIndex;
  38.  
  39. {$I mftp.inc}
  40.  
  41. const
  42.    FTP_AVAILABLE = WM_USER + 2;
  43. // FTP_ERROR = WM_USER + 3;
  44.    FTP_READY = WM_USER + 4;
  45.  
  46. type
  47.    FtpInfo = (ftpServerConnected, ftpServerDisconnected, ftpResolvingAddress,
  48.               ftpTraceIn, ftpTraceOut, ftpAlreadyBusy, ftpSupportResume,
  49.               {$ifndef NODEBUG}ftpDebug,{$endif} ftpDataTrace, ftpReady, ftpTransferDone,
  50.               ftpDirectoryRefresh, ftpLoggedIn, ftpFileSize,
  51.               ftpStartListing, ftpListingParsed, ftpBannerAvailable,
  52.               ftpNotSupportResume, ftpRetrying, ftpAddressResolved,
  53.               ftpNothing, ftpRetryFinished, ftpSearchStopped,
  54.               ftpTransferPutStart, ftpTransferPutFinish,
  55.               ftpTransferResume, ftpTransferGetStart, ftpTransferGetFinish);
  56.  
  57.    FtpError = (ftpNone, ftpNetworkDown, ftpInvalidAddress, ftpInternalError,
  58.                ftpGeneralWinsockError, ftpConnAborted, ftpConnReset, ftpConnectTimeOut,
  59.                ftpOutofSockets, ftpNetworkUnreachable, ftpAddressNotAvailable,
  60.                ftpConnectionRefused, ftpProtocolError, ftpCanceled, ftpUnknown,
  61.                ftpAddressResolutionError, ftpPrematureDisconnect,
  62.                ftpHostUnreachable, ftpNoServer, ftpNoProxyServer,
  63.                ftpFileOpen, ftpFileWrite, ftpFileRead, ftpFileNotFound,
  64.                ftpTimeOut, ftpServerDown, ftpAccessDenied, ftpDataError,
  65.                ftpResumeFailed, ftpPermissionDenied, ftpBadURL,
  66.                ftpTransferType, ftpTransferPort, ftpTransferFatalPort, ftpTransferGet, ftpTransferPut,
  67.                ftpTransferFatalError, ftpTransferResumeFailed);
  68.  
  69.    TMFtpInfoNeeded = (niAccount, niHost, niLocalFile, niOverwrite,
  70.                       niPassword, niUser);
  71.  
  72.    TMFtpTransferType = (AsciiTransfer, BinaryTransfer);
  73.  
  74.    TMFtpLastAction = (ftplaNone, ftplaLOGIN, ftplaCWD, ftplaMKD, ftplaMKDS,
  75.                       ftplaRMD, ftplaRMDS, ftplaRM, ftplaRMS, ftplaGETIndexFile,
  76.                       ftplaGET, ftplaGETS, ftplaPUT, ftplaPUTS,
  77.                       ftplaLIST, ftplaREN, ftplaRENS,
  78.                       ftplaCDUP, ftplaResolveLinks,
  79.                       ftplaNOOP, ftplaSearch, ftplaTransfer, ftplaTransfers);
  80.  
  81.    TMFtpProxyType = (proxyNone, proxyHost, proxyHostUser, proxyOpen, proxySite,
  82.                      proxyUserSite);
  83.  
  84.    TMFtpServerType = (ftpstAutoDetect, ftpstDefault,
  85.                       ftpstUNIX, ftpstULTRIX, ftpstClix, ftpstChameleon,
  86.                       ftpstNCSA, ftpstQVT, ftpstBSD, ftpstSunOS,
  87.                       ftpstVmsMultinet, ftpstVmsUcx, ftpstMVS, ftpstVM, ftpstVMVPS,
  88.                       ftpstMSFTP, ftpstNetTerm, ftpstServU, ftpstWFTPD, ftpWarFTPD,
  89.                       ftpstNetware, ftpstNetPresenz);
  90.  
  91.    TMFtpInfoEvent = procedure (Sender: TObject; info: FtpInfo; addinfo: String) of object;
  92.    TMFtpErrorEvent = procedure (Sender: TObject; error: FtpError; addinfo: String) of object;
  93.    TMFtpFileFoundEvent = procedure (Sender: TObject; FileFound: MFtpFileInfo; Location: String; Directory: Boolean) of object;
  94.    TMFtpInfoNeededEvent = procedure (Sender: TObject; need: TMFtpInfoNeeded; var Value: String) of object;
  95.  
  96.    TFtpProc = procedure(Line: String) of object;
  97.  
  98.    TMFtpBFParm = record
  99.       Depth:                     Integer;
  100.       ScanSymLink:               Boolean;
  101.       StartDir:                  String;
  102.       WildCard:                  String;
  103.    end;
  104.  
  105.    TMFtp = class(TMSocket)
  106.    private
  107.       pcount:                    Integer;
  108.       NTimer:                    TTimer;
  109.  
  110.       {$ifdef USE_RETRYING_TIMER}
  111.       RTimer:                    TTimer;
  112.       {$endif}
  113.  
  114.       FBusy:                     Boolean;
  115.       FDBusy:                    Boolean;
  116.       FMBusy:                    Boolean;
  117.       FMFinished:                Boolean;
  118.       FMAborted:                 Boolean;
  119.       FMultiThreaded:            Boolean;
  120.  
  121.       URLMode:                   Integer;
  122.       FUrl:                      String;
  123.  
  124.       FtpServer:                 String;
  125.       FtpPort:                   Integer;
  126.       FProxyServer:              String;
  127.       FProxyPort:                Integer;
  128.       FPassive:                  Boolean;
  129.       FProxyType:                TMFtpProxyType;
  130.  
  131.       FSupportResume:            Boolean;
  132.       FSupportNOOP:              Boolean;
  133.       FSupportSize:              Boolean;
  134.  
  135.       FUser, FPass, FAcct:       String;
  136.       FPUser, FPPass:            String;
  137.  
  138.       FRetries:                  Integer;
  139.       FRetryI:                   Word;
  140.       FRemain:                   Integer;
  141.  
  142.       FList, TempList, Visited:  TStrings;
  143.       FBFParm:                   TMFtpBFParm;
  144.  
  145.       FSP:                       Integer;
  146.  
  147.       FFiles:                    TMFtpFileInfoList;
  148.       FDirectories:              TMFtpFileInfoList;
  149.       TFiles:                    TMFtpFileInfoList;
  150.       TDirectories:              TMFtpFileInfoList;
  151.  
  152.       FFile:                     String;
  153.       FIFile:                    String;
  154.       FSelection:                String;
  155.       FDirectory:                String;
  156.       FCDirectory:               String;
  157.       FIDirectory:               String;
  158.       FSDirectory:               String;
  159.  
  160.       FFileMask:                 String;
  161.  
  162.       FCache:                    Boolean;
  163.       FCacheE:                   Integer;
  164.       FFromCache:                Boolean;
  165.  
  166.       FType:                     TMFtpServerType;
  167.  
  168.       FMode:                     TMFtpTransferType;
  169.  
  170.       Bytes, TrTime, StartTime:  Longword;
  171.  
  172.       TotalBytesToSend:          Longint;
  173.       FStartPoint:               Integer;
  174.  
  175.       FtpInfoEvt:                TMFtpInfoEvent;
  176.       FOnError:                  TMFtpErrorEvent;
  177.       FOnFileFound:              TMFtpFileFoundEvent;
  178.       FOnReady:                  TNotifyEvent;
  179.       NeedInfo:                  TMFtpInfoNeededEvent;
  180.  
  181.       NextP, PassiveP:           TFtpProc;
  182.  
  183.       Intermediate:              Boolean;
  184.       Response:                  String;
  185.       PartialLine:               String;
  186.       DataPartialLine:           String;
  187.       FLastLine:                 String;
  188.  
  189.       FBanner:                   TStrings;
  190.       FBannerStore:              String;
  191.  
  192.       ControlLoggedIn:           Boolean;
  193.       ControlConnected:          Boolean;
  194.       FDoingListing:             Boolean;
  195.       FSuccess:                  Boolean;
  196.       FTransferSuccess:          Boolean;
  197.       FAsync:                    Boolean;
  198.       FileOpened:                Boolean;
  199.       DataConnected:             Boolean;
  200.       OnHold, TransferAborted:   Boolean;
  201.       Aborted, BAborted,
  202.       {$ifndef USE_RETRYING_TIMER}
  203.       SRetry:                    Boolean;
  204.       {$endif}
  205.  
  206.       Rnto:                      String;
  207.       DataFile:                  TFileStream;
  208.  
  209.       FVersion, DummyS:          String;
  210.  
  211.       TransMode:                 String;
  212.       FTransferToFtp:            TMFtp;
  213.       FTransferFromFtp:          TMFtp;
  214.       FTransferResume:           Boolean;
  215.       FSourceName, FTargetName:  String;
  216.       FTransferCounter, TempInt: Integer;
  217.  
  218.       OprDir:                    String;
  219.  
  220.       FLoggedIn, FDirectoryChanged,
  221.       FDirectoryCreated, FFileRenamed,
  222.       FDirectoryDeleted, FFileDeleted,
  223.       FIndexFileReceived, FFileReceived,
  224.       FFtpQuit, FFtpBusy, FAborted,
  225.       FFileStored, FListingDone, FResolved,
  226.       FFileTransferred:          TNotifyEvent;
  227.       FtpLastAction:             TMFtpLastAction;
  228.       ReadyPort, ReadyMain,
  229.       ReadyCWD, ReadyList:       Boolean;
  230.  
  231.       InBuffer:  Array [0..IN_BUFFER_SIZE] of Char;
  232.       OutBuffer: Array [0..OUT_BUFFER_SIZE] of Char;
  233.  
  234.       ListeningSocket,
  235.       DataSocket:                TMSocket;
  236.  
  237.       FError:                    FtpError;
  238.       errs:                      String;
  239.  
  240.       CurrentMode:               String;
  241.  
  242.       DownloadSize:              Integer;
  243.       UploadSize:                Integer;
  244.  
  245.       NOnFtpError:         Array [1..MAX_HANDLERS] of TMFtpErrorEvent;
  246.       NOnFtpInfo:          Array [1..MAX_HANDLERS] of TMFtpInfoEvent;
  247.       NEvents:             Array [1..EVENT_COUNT, 1..MAX_HANDLERS] of TNotifyEvent;
  248.  
  249.       function CheckError: Boolean;
  250.       function CheckStatus: Boolean;
  251.  
  252.       procedure DataDoListing(sender: TObject);
  253.       procedure DataListConnected(sender: TObject);
  254.       procedure DataListDisconnected(sender: TObject);
  255.       procedure DataRetrFile(sender: TObject);
  256.       procedure DataStorFile(sender: TObject); {BDS}
  257.       procedure DataFileDisconnected(sender: TObject);
  258.       procedure DataStorConnected(sender: TObject);
  259.  
  260.       procedure Proceed(Line: String; P: TFtpProc);
  261.       procedure FtpProcess(Line: String);
  262.       procedure LoginMain;
  263.  
  264.       procedure UpdateCache;
  265.  
  266.       procedure MyCloseFile;
  267.       function MyEOF: Boolean;
  268.  
  269.       procedure NTimerTimer(Sender: TObject);
  270.  
  271.       {$ifdef USE_RETRYING_TIMER}
  272.       procedure RTimerTimer(Sender: TObject);
  273.       {$endif}
  274.  
  275.       procedure SetInterval(I: Word);
  276.       function GetInterval: Word;
  277.  
  278.       function GetStartPoint: Longword;
  279.  
  280.       procedure SetAsync(B: Boolean);
  281.       procedure SetRetries(I: Integer);
  282.       procedure SetTransferMode(M: String; P: TFtpProc);
  283.  
  284.       procedure UserMessageHandler(var Message: TMessage);
  285.  
  286.       procedure DoFtpInfo(info: FtpInfo; add: String = '');
  287.       procedure DoFtpError(e: FtpError);
  288.       procedure Ready;
  289.  
  290.       function SetupDataPort: String;
  291.       procedure SetupDataPortPassive(S: String);
  292.  
  293.       procedure DoRetry;
  294.       procedure DidConnect(Sender: TObject);
  295.       procedure DoDisconnect(Sender: TObject);
  296.       procedure DoRead(Sender: TObject);
  297.       function RecvText: String;
  298.  
  299.       function GetUrl: String;
  300.       procedure SetUrl(S: String);
  301.  
  302.       procedure RefreshB;
  303.  
  304.       procedure FatalError(e: FtpError);
  305.       procedure TimedOut(Sender: TObject);
  306.  
  307.       procedure fpChmod(Line: String);
  308.  
  309.       procedure fpBuildFileList(Flag: Boolean);
  310.  
  311.       procedure fpCWD(Line: String);
  312.       procedure fpCWD2(Line: String);
  313.  
  314.       procedure fpDeleteDirectory(Line: String);
  315.  
  316.       procedure fpDownload(Line: String);
  317.       procedure fpDownload2(Line: String);
  318.       procedure fpDownload3(Line: String);
  319.       procedure fpDownload4a(Line: String);
  320.       procedure fpDownload4b(Line: String);
  321.       procedure fpDownload5a(Line: String);
  322.       procedure fpDownload5b(Line: String);
  323.  
  324.       procedure fpList(Line: String);
  325.       procedure fpList2(Line: String);
  326.       procedure fpList3(Line: String);
  327.  
  328.       procedure fpLogin(Line: String);
  329.       procedure fpLogin2(Line: String);
  330.       procedure fpLogin3(Line: String);
  331.       procedure fpLogin4(Line: String);
  332.       procedure fpLogin5(Line: String);
  333.  
  334.       procedure fpLoginProxyHost(Line: String);
  335.       procedure fpLoginProxyOpen(Line: String);
  336.       procedure fpLoginProxySite(Line: String);
  337.       procedure fpLoginProxySite2(Line: String);
  338.       procedure fpLoginProxySite3(Line: String);
  339.  
  340.       procedure fpNOOP(Line: String);
  341.  
  342.       procedure fpPreparePassive(Line: String);
  343.  
  344.       procedure fpProcessGeneral(Line: String);
  345.  
  346.       procedure fpProcessURL(Line: String);
  347.       procedure fpProcessURL2(Line: String);
  348.       procedure fpProcessURL3(Line: String);
  349.  
  350.       procedure fpQuit(Line: String);
  351.  
  352.       procedure fpRename(Line: String);
  353.       procedure fpRename2(Line: String);
  354.  
  355.       procedure fpResolveLinks(Line: String);
  356.  
  357.       procedure fpSetinitialDirectory(Line: String);
  358.       procedure fpSetinitialDirectory2(Line: String);
  359.  
  360.       procedure fpTestREST(Line: String);
  361.       procedure fpTestSystemType(Line: String);
  362.  
  363.       procedure fpTransfer(Line: String);
  364.       procedure fpTransfer2(Line: String);
  365.       procedure fpTransfer3(Line: String);
  366.       procedure fpTransfer3b(Line: String);
  367.       procedure fpTransfer4b(Line: String);
  368.       procedure fpTransfer5(Line: String);
  369.       procedure fpTransfer6(Line: String);
  370.       procedure fpTransfer6b(Line: String);
  371.       procedure fpTransfer7b(Line: String);
  372.       procedure fpTransfer8(Line: String);
  373.       procedure fpTransferFinished;
  374.  
  375.       procedure fpUpload(Line: String);
  376.       procedure fpUpload2(Line: String);
  377.       procedure fpUpload3(Line: String);
  378.       procedure fpUpload4a(Line: String);
  379.       procedure fpUpload4b(Line: String);
  380.       procedure fpUpload5a(Line: String);
  381.       procedure fpUpload5b(Line: String);
  382.    protected
  383.       procedure LookupNameDone; override;
  384.  
  385.       function ProcessMessage: Boolean;
  386.       procedure ProcessMessages;
  387.    public
  388.       constructor Create(AOwner: TComponent); override;
  389.       destructor Destroy; override;
  390.  
  391.       procedure BuildFileList(Parameter: TMFtpBFParm);
  392.  
  393.       procedure CreateDirectory(dir: String); overload;
  394.       procedure CreateDirectory(dirs: TStrings); overload;
  395.  
  396.       procedure DeleteDirectory(dir: String); overload;
  397.       procedure DeleteDirectory(dirs: TStrings); overload;
  398.  
  399.       procedure DeleteFile(filename: String); overload;
  400.       procedure DeleteFile(files: TStrings); overload;
  401.  
  402.       procedure GetFile(RemoteFile, LocalFile: String); overload;
  403.       procedure GetFile(RemoteFiles, LocalFiles: TStrings); overload;
  404.  
  405.       procedure MoveFile(filename, newdir: String); overload;
  406.       procedure MoveFile(files: TStrings; newdir: String); overload;
  407.  
  408.       procedure PutFile(LocalFile, RemoteFile: String); overload;
  409.       procedure PutFile(LocalFiles, RemoteFiles: TStrings); overload;
  410.  
  411.       procedure RenameFile(oldname, newname: String); overload;
  412.       procedure RenameFile(oldnames, newnames: TStrings); overload;
  413.  
  414.       procedure TransferFile(SourceFile, TargetFile: String; TargetFTP: TMFtp); overload;
  415.       procedure TransferFile(SourceFiles, TargetFiles: TStrings; TargetFTP: TMFtp); overload;
  416.  
  417.       procedure IssueCommand(Command: String; OnDone: TFtpProc = nil);
  418.       procedure ChangeDirectory(name: String);
  419.       procedure ChangeToParentDirectory;
  420.  
  421.       procedure LoadIndexFile(Filename: String);
  422.       procedure ResolveLinks;
  423.  
  424.       procedure Login;
  425.       procedure Quit;
  426.       procedure Refresh;
  427.  
  428.       procedure Abort;
  429.       procedure StopTransfer; { internal use, do not call it directly }
  430.  
  431.       procedure CallNEvents(EventType: Integer);
  432.  
  433.       procedure FileSetAttr(filename: String;
  434.                             OwnerRead, OwnerWrite, OwnerExecute,
  435.                             GroupRead, GroupWrite, GroupExecute,
  436.                             PublicRead, PublicWrite, PublicExecute: Boolean);
  437.  
  438.       function RegisterNotifyEvent(EventType: Integer; P: TNotifyEvent): Integer;
  439.       function RegisterErrorEvent(P: TMFtpErrorEvent): Integer;
  440.       function RegisterInfoEvent(P: TMFtpInfoEvent): Integer;
  441.  
  442.       procedure UnRegisterNotifyEvent(EventType: Integer; i: Integer);
  443.       procedure UnRegisterErrorEvent(i: Integer);
  444.       procedure UnRegisterInfoEvent(i: Integer);
  445.  
  446.       function FileExists(filename: String): Integer;
  447.       function DirectoryExists(dir: String): Integer;
  448.  
  449.       property Listing: TStrings read FList;
  450.       property Files: TMFtpFileInfoList read FFiles;
  451.       property Directories: TMFtpFileInfoList read FDirectories;
  452.  
  453.       property URL: String read GetUrl write SetUrl;
  454.  
  455.       property BytesTransferred: Longword read Bytes write Bytes;
  456.       property StartPoint: Longword read GetStartPoint;
  457.       property TransferTime: Longword read TrTime;
  458.  
  459.       property Busy: Boolean read FBusy;
  460.       {$warnings off} {avoiding warning here}
  461.       property Connected: Boolean read ControlConnected;
  462.       {$warnings on}
  463.       property DoingListing: Boolean read FDoingListing;
  464.       property FromCache: Boolean read FFromCache;
  465.       property Success: Boolean read FSuccess;
  466.       property SupportResume: Boolean read FSupportResume;
  467.  
  468.       property Error: FtpError read FError;
  469.  
  470.       property CurrentDirectory: String read FDirectory;
  471.       property LastReply: String read FLastLine;
  472.       property Selection: String read FSelection;
  473.       property Banner: TStrings read FBanner;
  474.    published
  475.       property Asynchronous: Boolean read FAsync write SetAsync;
  476.       property MultiThreaded: Boolean read FMultiThreaded write FMultiThreaded;
  477.  
  478.       property NoopInterval: Word read GetInterval write SetInterval;
  479.  
  480.       property Username: String read FUser write FUser;
  481.       property Password: String read FPass write FPass;
  482.       property Account: String read FAcct write FAcct;
  483.       property ProxyUsername: String read FPUser write FPUser;
  484.       property ProxyPassword: String read FPPass write FPPass;
  485.  
  486.       property Retries: Integer read FRetries write SetRetries;
  487.       property RetryInterval: Word read FRetryI write FRetryI;
  488.  
  489.       property ServerType: TMFtpServerType read FType write FType;
  490.       property InitialDirectory: String read FIDirectory write FIDirectory;
  491.  
  492.       property FileMask: String read FFileMask write FFileMask;
  493.  
  494.       property Cache: Boolean read FCache write FCache;
  495.       property CacheExpire: Integer read FCacheE write FCacheE;
  496.  
  497.       property TransferMode: TMFtpTransferType read FMode write FMode;
  498.  
  499.       property ProxyType: TMFtpProxyType read FProxyType write FProxyType;
  500.       property ProxyServer: String read FProxyServer write FProxyServer;
  501.       property ProxyPort: Integer read FProxyPort write FProxyPort;
  502.       property Passive: Boolean read FPassive write FPassive;
  503.  
  504.       property OnFtpInfo: TMFtpInfoEvent read FtpInfoEvt write FtpInfoEvt;
  505.       property OnFtpNeedInfo: TMFtpInfoNeededEvent read NeedInfo write NeedInfo;
  506.       property OnFtpReady: TNotifyEvent read FOnReady write FOnReady;
  507.       property OnFtpError: TMFtpErrorEvent read FOnError write FOnError;
  508.       property OnLoggedIn: TNotifyEvent read FLoggedIn write FLoggedIn;
  509.       property OnDirectoryChanged: TNotifyEvent read FDirectoryChanged write FDirectoryChanged;
  510.       property OnDirectoryCreated: TNotifyEvent read FDirectoryCreated write FDirectoryCreated;
  511.       property OnDirectoryDeleted: TNotifyEvent read FDirectoryDeleted write FDirectoryDeleted;
  512.       property OnFileDeleted: TNotifyEvent read FFileDeleted write FFileDeleted;
  513.       property OnFileFound: TMFtpFileFoundEvent read FOnFileFound write FOnFileFound;
  514.       property OnIndexFileReceived: TNotifyEvent read FIndexFileReceived write FIndexFileReceived;
  515.       property OnFileReceived: TNotifyEvent read FFileReceived write FFileReceived;
  516.       property OnFileStored: TNotifyEvent read FFileStored write FFileStored;
  517.       property OnListingDone: TNotifyEvent read FListingDone write FListingDone;
  518.       property OnFileRenamed: TNotifyEvent read FFileRenamed write FFIleRenamed;
  519.       property OnFtpQuit: TNotifyEvent read FFtpQuit write FFtpQuit;
  520.       property OnFileTransferred: TNotifyEvent read FFileTransferred write FFileTransferred;
  521.       property OnFtpBusy: TNotifyEvent read FFtpBusy write FFtpBusy;
  522.       property OnAborted: TNotifyEvent read FAborted write FAborted;
  523.       property OnResolvedLinks: TNotifyEvent read FResolved write FResolved;
  524.  
  525.       property Version: String read FVersion write DummyS;
  526.  
  527.       {provided by TMSock}
  528.       property Port;
  529.       property Server;
  530.       property TimeOut;
  531.    end;
  532.  
  533. const
  534.    WM_Proceed = WM_USER + 1;
  535.  
  536. implementation
  537.  
  538. {$R *.res}
  539.  
  540. constructor TMFtp.Create;
  541. begin
  542.    inherited Create(AOwner);
  543.  
  544.    NTimer := TTimer.Create(Self);
  545.    SetInterval(30);
  546.  
  547.    {$ifdef USE_RETRYING_TIMER}
  548.    RTimer := TTimer.Create(Self);
  549.    {$endif}
  550.  
  551.    FList := TStringList.Create;
  552.    FBanner := TStringList.Create;
  553.  
  554.    FDirectories := TMFtpFileInfoList.Create;
  555.    FFiles := TMFtpFileInfoList.Create;
  556.    TDirectories := TMFtpFileInfoList.Create;
  557.    TFiles := TMFtpFileInfoList.Create;
  558.  
  559.    ListeningSocket := TMSocket.Create(Self);
  560.    DataSocket := TMSocket.Create(Self);
  561.  
  562.    NTimer.OnTimer := NTimerTimer;
  563.  
  564.    {$ifdef USE_RETRYING_TIMER}
  565.    RTimer.OnTimer := RTimerTimer;
  566.    {$endif}
  567.  
  568.    CustomMessage := UserMessageHandler;
  569.  
  570.    FVersion := 'Monster FTP 0.4.7';
  571.  
  572.    CurrentMode := '';
  573.    URLMode := 0;
  574.  
  575.    FFromCache := False;
  576.  
  577.    FMFinished := True;
  578.    FMAborted := False;
  579.  
  580.    BAborted := False;
  581.  
  582.    OnConnected := DidConnect;
  583.    OnDisconnected := DoDisconnect;
  584.    OnReadReady := DoRead;
  585.    OnTimeOut := TimedOut;
  586.  
  587.    {fill in default values}
  588.    FUser := 'anonymous';
  589.    FPass := 'guest@mftp.org';
  590.    Port := 21;
  591.    FProxyPort := 21;
  592.    FProxyType := proxyNone;
  593.    FMode := BinaryTransfer;
  594.    FCache := True;
  595.    FCacheE := 7;
  596.    FAsync := True;
  597.    FRetries := 3;
  598.    FRetryI := 15;
  599.    FMultiThreaded := False;
  600. end;
  601.  
  602. destructor TMFtp.Destroy;
  603. begin
  604.    DataSocket.Destroy;
  605.    ListeningSocket.Destroy;
  606.    CloseSocket(Socket);
  607.  
  608.    FreeAndNil(FList);
  609.    FreeAndNil(FBanner);
  610.  
  611.    FFiles.MyFree;
  612.    FDirectories.MyFree;
  613.    TFiles.MyFree;
  614.    TDirectories.MyFree;
  615.  
  616.    FreeAndNil(NTimer);
  617.  
  618.    {$ifdef USE_RETRYING_TIMER}
  619.    FreeAndNil(RTimer);
  620.    {$endif}
  621.  
  622.    inherited Destroy;
  623. end;
  624.  
  625. procedure TMFtp.UserMessageHandler;
  626. begin
  627.    case Message.Msg of
  628.       FTP_AVAILABLE:
  629.       begin
  630.          FBusy := False;
  631.          NTimer.Enabled := False;
  632.          ControlLoggedIn := False;
  633.  
  634.          if Assigned(FFtpQuit) then FFtpQuit(Self);
  635.          CallNEvents(8);
  636.  
  637.          if UrlMode = 1 then Login;
  638.       end;
  639. //    FTP_ERROR: if Assigned(FOnError) then FOnError(Self, FtpError(Message.WParam), 'Error');
  640.       FTP_READY:
  641.       begin
  642.          if FMFinished then
  643.          begin
  644.             FBusy := False;
  645.             NTimer.Enabled := True;
  646.  
  647.             if FMAborted then
  648.             begin
  649.                FMAborted := False;
  650.                if Assigned(FAborted) then FAborted(Self);
  651.                CallNEvents(13);
  652.             end;
  653.  
  654.             if Assigned(FOnReady) then FOnReady(Self);
  655.             CallNEvents(9);
  656.          end
  657.          else
  658.             FMBusy := False;
  659.  
  660.          if TransferAborted then
  661.          begin
  662.             DataSocket.Disconnect;
  663.             ListeningSocket.Disconnect;
  664.             TransferAborted := False;
  665.          end;
  666.          case FtpLastAction of
  667.             ftplaLogin:
  668.             begin
  669.                FtpLastAction := ftplaNone;
  670.                ControlLoggedIn := True;
  671.                SRetry := True;
  672.                if Assigned(FLoggedIn) then FloggedIn(Self);
  673.                CallNEvents(11);
  674.             end;
  675.             ftplaCDUP, ftplaCWD:
  676.             begin
  677.                FtpLastAction := ftplaNone;
  678.                if Assigned(FDirectoryChanged) then FDirectoryChanged(Self);
  679.                CallNEvents(1);
  680.             end;
  681.             ftplaMKD, ftplaMKDS:
  682.             begin
  683.                if FMFinished then
  684.                begin
  685.                   FtpLastAction := ftplaNone;
  686.                   if Assigned(FDirectoryCreated) then FDirectoryCreated(Self);
  687.                   CallNEvents(2);
  688.                end;
  689.             end;
  690.             ftplaRMD, ftplaRMDS:
  691.             begin
  692.                if FMFinished then
  693.                begin
  694.                   FtpLastAction := ftplaNone;
  695.                   if Assigned(FDirectoryDeleted) then FDirectoryDeleted(Self);
  696.                   CallNEvents(3);
  697.                end;
  698.             end;
  699.             ftplaRM, ftplaRMS:
  700.             begin
  701.                if FMFinished then
  702.                begin
  703.                   FtpLastAction := ftplaNone;
  704.                   if Assigned(FFileDeleted) then FFileDeleted(Self);
  705.                   CallNEvents(4);
  706.                end;
  707.             end;
  708.             ftplaGETIndexFile:
  709.             begin
  710.                FtpLastAction := ftplaNone;
  711.                if ParseIndexFile(FIFile, FDirectories, FFiles) then
  712.                begin
  713.                   UpdateCache;
  714.  
  715.                   if Assigned(FIndexFileReceived) then FIndexFileReceived(Self);
  716.                   CallNEvents(14);
  717.                end;
  718.             end;
  719.             ftplaGET, ftplaGETS:
  720.             begin
  721.                if FMFinished then
  722.                begin
  723.                   FtpLastAction := ftplaNone;
  724.                   if Assigned(FFileReceived) then FFileReceived(Self);
  725.                   CallNEvents(5);
  726.                end;
  727.             end;
  728.             ftplaPUT, ftplaPUTS:
  729.             begin
  730.                if FMFinished then
  731.                begin
  732.                   FtpLastAction := ftplaNone;
  733.                   if Assigned(FFileStored) then FFileStored(Self);
  734.                   CallNEvents(7);
  735.                end;
  736.             end;
  737.             ftplaLIST:
  738.             begin
  739.                FtpLastAction := ftplaNone;
  740.  
  741.                if not FFromCache then
  742.                begin
  743.                   FFiles.Assign(TFiles);
  744.                   FDirectories.Assign(TDirectories);
  745.                   UpdateCache;
  746.                end;
  747.  
  748.                if Assigned(FListingDone) then FListingDone(Self);
  749.                CallNEvents(10);
  750.             end;
  751.             ftplaREN, ftplaRENS:
  752.             begin
  753.                if FMFinished then
  754.                begin
  755.                   if Assigned(TempList) then FreeAndNil(TempList); // Clear tempoary file list that used by method MoveFile
  756.  
  757.                   FtpLastAction := ftplaNone;
  758.                   if Assigned(FFileRenamed) then FFileRenamed(Self);
  759.                   CallNEvents(6);
  760.                end;
  761.             end;
  762.             ftplaResolveLinks:
  763.             begin
  764.                FtpLastAction := ftplaNone;
  765.                UpdateCache;
  766.                Proceed('CWD '+ FCDirectory, fpCWD);
  767.  
  768.                if Assigned(FResolved) then FResolved(Self);
  769.                CallNEvents(15);
  770.             end;
  771.             ftplaSearch:
  772.             begin
  773.                ReadyCWD := False;
  774.                Proceed('CWD ' + FSDirectory, fpCWD);
  775.                while not ReadyCWD do ProcessMessages;
  776.  
  777.                FtpLastAction := ftplaNone;
  778.                FreeAndNil(Visited);
  779.  
  780.                if BAborted then
  781.                begin
  782.                  BAborted := False;
  783.                  if Assigned(FAborted) then FAborted(Self);
  784.                  CallNEvents(13);
  785.                end;
  786.  
  787.                if not FSuccess then DoFtpInfo(ftpSearchStopped);
  788.             end;
  789.             ftplaTransfer, ftplaTransfers:
  790.             begin
  791.                if FMFinished then
  792.                begin
  793.                   FtpLastAction := ftplaNone;
  794.                   if Assigned(FFileTransferred) then FFileTransferred(Self);
  795.                   CallNEvents(16);
  796.                end;
  797.             end;
  798.          end;
  799.       end;
  800.    end;
  801. end;
  802.  
  803. procedure TMFtp.DoFtpInfo;
  804. var hs: Integer;
  805.     S: String;
  806. begin
  807.    if add = '' then
  808.    begin
  809.       case info of
  810.          ftpAlreadyBusy:
  811.             S := msgBusy;
  812.          ftpLoggedIn:
  813.             S := msgLogin;
  814.          ftpNotSupportResume:
  815.             S := msgNResume;
  816.          ftpSearchStopped:
  817.             S := msgSearchStopped;
  818.          ftpServerDisconnected:
  819.             S := msgEDisconnected;
  820.       end;
  821.    end
  822.    else
  823.    begin
  824.       if (info = ftpTraceOut) and (Copy(add, 1, 5) = 'PASS ') then
  825.       begin
  826.          S := msgIDontTellYou;
  827.       end
  828.       else
  829.       begin
  830.          S := add;
  831.       end;
  832.    end;
  833.  
  834.    if Assigned(FtpInfoEvt) then FtpInfoEvt(Self, info, S);
  835.    for hs := 1 to MAX_HANDLERS do
  836.       if Assigned(NOnFtpInfo[hs]) then NOnFtpInfo[hs](Self, info, S);
  837. end;
  838.  
  839. procedure TMFtp.DoFtpError;
  840. var hs: Integer;
  841. begin
  842.    FSuccess := False;
  843.    FError := e;
  844. // PostMessage(Handle,FTP_ERROR,Ord(e), 0);
  845.    if Assigned(FOnError) then FOnError(Self, e, errs);
  846.    for hs := 1 to MAX_HANDLERS do
  847.       if Assigned(NOnFtpError[hs]) then NOnFtpError[hs](Self, e, errs);
  848.    errs := '';
  849. end;
  850.  
  851. procedure TMFtp.Ready;
  852. begin
  853.    NextP := nil;
  854.    PostMessage(Handle, FTP_READY, 0, 0);
  855. end;
  856.  
  857. procedure TMFtp.Login;
  858. begin
  859.    FRemain := FRetries;
  860.    FBusy := False;
  861.    ControlLoggedIn := False;
  862.  
  863.    LoginMain;
  864. end;
  865.  
  866. procedure TMFtp.LoginMain;
  867. var S: String;
  868. begin
  869.    FDBusy := False;
  870.    if FBusy then
  871.    begin
  872.       DoFtpInfo(ftpAlreadyBusy);
  873.       Exit;
  874.    end;
  875.  
  876.    LastError := 0;
  877.    FDirectory := '';
  878.    Response := '';
  879.    FError := FtpNone;
  880.    FSuccess := True;
  881.    Intermediate := False;
  882.    FSupportSIZE := True;
  883.    FSupportNOOP := True;
  884.  
  885.    Dec(FRemain);
  886.    ReCreateTCPSocket;
  887.  
  888.    if Trim(FProxyServer) = '' then FProxyType := proxyNone else
  889.    if FProxyType <> proxyNone then
  890.    begin
  891.       FtpServer := Server;
  892.       FtpPort := Port;
  893.       Server := FProxyServer;
  894.       Port := FProxyPort;
  895.    end;
  896.  
  897.    if Trim(Server) = '' then
  898.    begin
  899.       if Assigned(NeedInfo) then NeedInfo(Self, niHost, s);
  900.       s := Trim(s);
  901.       if s = '' then
  902.       begin
  903.          DoFtpError(ftpNoServer);
  904.          Ready;
  905.          Exit;
  906.       end;
  907.       SetServer(s);
  908.    end;
  909.  
  910.    if Port = 0 then Port := 21;
  911.  
  912.    if Address <> '' then FillAddress(Address)
  913.    else
  914.    begin
  915.       DoFtpInfo(ftpResolvingAddress, Host);
  916.       LookupName(Host);
  917.       CheckError;
  918.       Exit;
  919.    end;
  920.    FillPort(Port);
  921.    Connect;
  922.    CheckError;
  923. end;
  924.  
  925. procedure TMFtp.LookupNameDone;
  926. begin
  927.    if CheckError then Exit;
  928.    FillName;
  929.    FillPort(Port);
  930.    Address := GetAddressString;
  931.    DoFtpInfo(ftpAddressResolved, Address);
  932.    Connect;
  933.    CheckError;
  934. end;
  935.  
  936. procedure TMFtp.UpdateCache;
  937. begin
  938.    if {(FFileMask = '') and }(FSuccess) then
  939.    begin
  940.       SaveToCache(GetCacheFilename(Server, FUser, FDirectory, Port, True), FDirectories);
  941.       SaveToCache(GetCacheFilename(Server, FUser, FDirectory, Port, False), FFiles);
  942.    end;
  943. end;
  944.  
  945. procedure TMFtp.MyCloseFile;
  946. begin
  947.    if FileOpened then
  948.    begin
  949.       FileOpened := False;
  950.       FreeAndNil(DataFile);
  951.    end;
  952. end;
  953.  
  954. function TMFtp.MyEOF;
  955. begin
  956.    if (FileOpened) and (Assigned(DataFile)) then
  957.       Result := (DataFile.Position = DataFile.Size)
  958.    else
  959.       Result := True;
  960. end;
  961.  
  962. {===== Directory/File  managemenet routines =====}
  963. procedure TMFtp.BuildFileList;
  964. begin
  965.    if CheckStatus then
  966.    begin
  967.       FtpLastAction := ftplaSearch;
  968.       Visited := TStringList.Create;
  969.  
  970.       FBFParm := Parameter;
  971.       if FBFParm.Depth <= 0 then FBFParm.Depth := MaxInt;      
  972.  
  973.       if (FDirectory <> FBFParm.StartDir) and (FBFParm.StartDir <> '') then
  974.       begin
  975.          ReadyCWD := False;
  976.          Proceed('CWD ' + FBFParm.StartDir, fpCWD);
  977.          while not ReadyCWD do ProcessMessages;
  978.          if not FSuccess then
  979.          begin
  980.             Ready;
  981.             Exit;
  982.          end;
  983.       end;
  984.  
  985.       Visited.Add(FDirectory);
  986.       if (FDirectory[1] <> '/') and (FDirectory[1] <> '\') then
  987.          FSDirectory := '/' + FDirectory
  988.       else
  989.          FSDirectory := FDirectory;
  990.  
  991.       Dec(FBFParm.Depth);
  992.       fpBuildFileList(True);
  993.       Inc(FBFParm.Depth);
  994.    end;
  995. end;
  996.  
  997. procedure TMFtp.ChangeDirectory;
  998. begin
  999.    if CheckStatus then
  1000.    begin
  1001.       FtpLastAction := ftplaCWD;
  1002.       Proceed('CWD ' + name, fpCWD);
  1003.       while (FBusy) and (not FAsync) do ProcessMessages;
  1004.    end;
  1005. end;
  1006.  
  1007. procedure TMFtp.ChangeToParentDirectory;
  1008. begin
  1009.    if CheckStatus then
  1010.    begin
  1011.       FtpLastAction := ftplaCDUP;
  1012.       Proceed('CDUP', fpCWD);
  1013.       while (not FBusy) and (FAsync) do ProcessMessages;
  1014.    end;
  1015. end;
  1016.  
  1017. procedure TMFtp.CreateDirectory(dir: String);
  1018. begin
  1019.    if CheckStatus then
  1020.    begin
  1021.       FTPLastAction := ftplaMKD;
  1022.       Proceed('MKD ' + dir, fpProcessGeneral);
  1023.       while (FBusy) and (not FAsync) do ProcessMessages;
  1024.    end;
  1025. end;
  1026.  
  1027. procedure TMFtp.CreateDirectory(dirs: TStrings);
  1028. var i: Integer;
  1029. begin
  1030.    if Assigned(dirs) and (CheckStatus) then
  1031.    begin
  1032.       FTPLastAction := ftplaMKDS;
  1033.       FMFinished := False;
  1034.       
  1035.       for i := 0 to dirs.Count - 1 do
  1036.       begin
  1037.          FMBusy := True;
  1038.          Proceed('MKD ' + dirs[i], fpProcessGeneral);
  1039.          while FMBusy do ProcessMessages;         
  1040.       end;
  1041.  
  1042.       FMFinished := True;
  1043.       Ready;
  1044.    end;
  1045. end;
  1046.  
  1047. procedure TMFtp.DeleteDirectory(dir: String);
  1048. begin
  1049.    if (dir <> '') and (CheckStatus) then
  1050.    begin
  1051.       FTPLastAction := ftplaRMD;
  1052.       OprDir := Trim(dir);
  1053.       Proceed('RMD ' + dir, fpDeleteDirectory);
  1054.       while (FBusy) and (not FAsync) do ProcessMessages;
  1055.    end;
  1056. end;
  1057.  
  1058. procedure TMFtp.DeleteDirectory(dirs: TStrings);
  1059. var i: Integer;
  1060. begin
  1061.    if Assigned(dirs) and (CheckStatus) then
  1062.    begin
  1063.       FTPLastAction := ftplaRMDS;
  1064.       FMFinished := False;
  1065.  
  1066.       for i := 0 to dirs.Count - 1 do
  1067.       begin
  1068.          FMBusy := True;
  1069.          OprDir := Trim(dirs[i]);
  1070.          Proceed('RMD ' + dirs[i], fpDeleteDirectory);
  1071.          while FMBusy do ProcessMessages;
  1072.       end;
  1073.  
  1074.       FMFinished := True;
  1075.       Ready;
  1076.    end;
  1077. end;
  1078.  
  1079. procedure TMFtp.DeleteFile(filename: String);
  1080. begin
  1081.    if (filename <> '') and (CheckStatus) then
  1082.    begin
  1083.       FTPLastAction := ftplaRM;
  1084.       Proceed('DELE ' + filename, fpProcessGeneral);
  1085.       while (FBusy) and (not FAsync) do ProcessMessages;
  1086.    end;
  1087. end;
  1088.  
  1089. procedure TMFtp.DeleteFile(files: TStrings);
  1090. var i: Integer;
  1091. begin
  1092.    if Assigned(files) and (CheckStatus) then
  1093.    begin
  1094.       FTPLastAction := ftplaRMS;
  1095.       FMFinished := False;
  1096.       
  1097.       for i := 0 to files.Count - 1 do
  1098.       begin
  1099.          FMBusy := True;
  1100.          Proceed('DELE ' + files[i], fpProcessGeneral);
  1101.          while FMBusy do ProcessMessages;         
  1102.       end;
  1103.  
  1104.       FMFinished := True;
  1105.       Ready;
  1106.    end;
  1107. end;
  1108.  
  1109. procedure TMFtp.MoveFile(filename, newdir: String);
  1110. begin
  1111.    NewDir := Trim(NewDir);
  1112.    if NewDir[Length(NewDir)] <> '/' then NewDir := NewDir + '/';
  1113.    RenameFile(FileName, NewDir + ExtractFileName(FileName));
  1114. end;
  1115.  
  1116. procedure TMFtp.MoveFile(files: TStrings; newdir: String);
  1117. var i: Integer;
  1118. begin
  1119.    if not Assigned(files) then Exit;
  1120.    if files.Count < 1 then Exit;
  1121.    if not CheckStatus then Exit;
  1122.  
  1123.    FBusy := False;
  1124.    if Assigned(TempList) then TempList.Clear else TempList := TStringList.Create;
  1125.  
  1126.    NewDir := Trim(NewDir);
  1127.    if NewDir[Length(NewDir)] <> '/' then NewDir := NewDir + '/';
  1128.  
  1129.    for i := 0 to files.Count - 1 do
  1130.       TempList.Add(NewDir + ExtractFileName(Files[i]));
  1131.  
  1132.    RenameFile(files, TempList);
  1133. end;
  1134.  
  1135. procedure TMFtp.RenameFile(oldname, newname: String);
  1136. begin
  1137.    if (CheckStatus) and (oldname <> '') and (oldname <> newname) then
  1138.    begin
  1139.       FTPLastAction := ftplaREN;
  1140.       Rnto := newname;
  1141.       Proceed('RNFR ' + oldname, fpRename);
  1142.       while (FBusy) and (not FAsync) do ProcessMessages;
  1143.    end;
  1144. end;
  1145.  
  1146. procedure TMFtp.RenameFile(oldnames, newnames: TStrings);
  1147. var i: Integer;
  1148. begin
  1149.    if Assigned(oldnames) and Assigned(newnames) then
  1150.    begin
  1151.       if oldnames.Count = newnames.Count then
  1152.       begin
  1153.          if not CheckStatus then Exit;
  1154.          FTPLastAction := ftplaRENS;
  1155.          FMFinished := False;
  1156.  
  1157.          for i := 0 to oldnames.Count - 1 do
  1158.          begin
  1159.             FMBusy := True;
  1160.             Rnto := newnames[i];
  1161.             Proceed('RNFR ' + oldnames[i], fpRename);
  1162.             while FMBusy do ProcessMessages;         
  1163.          end;
  1164.  
  1165.          FMFinished := True;
  1166.          Ready;
  1167.       end;
  1168.    end;
  1169. end;
  1170.  
  1171. procedure TMFtp.ResolveLinks;
  1172. begin
  1173.    if FDirectories.Count = 0 then Exit;
  1174.    if not CheckStatus then Exit;
  1175.  
  1176.    FSP := 0;
  1177.    FCDirectory := FDirectory;
  1178.    if FCDirectory[1] <> '/' then FCDirectory := '/' + FCDirectory;
  1179.    if FCDirectory[Length(FCDirectory)] <> '/' then FCDirectory := FCDirectory + '/';
  1180.  
  1181.    while FSP < FDirectories.Count do
  1182.    begin
  1183.       if (FDirectories[FSP].Filename <> '.') and (FDirectories[FSP].Filename <> '..') and
  1184.          (FDirectories[FSP].SymbolLink <> '.') and
  1185.          (FDirectories[FSP].SymbolLink <> '..') and
  1186.          (FDirectories[FSP].SymbolLink <> '') then Break;
  1187.       Inc(FSP);
  1188.    end;
  1189.  
  1190.    if FSP < FDirectories.Count then
  1191.    begin
  1192.       FtpLastAction := ftplaResolveLinks;
  1193.       Proceed('CWD '+ FCDirectory + Directories[0].Filename, fpResolveLinks);
  1194.    end
  1195.    else
  1196.    begin
  1197.       Ready;
  1198.    end;
  1199. end;
  1200.  
  1201. procedure TMFtp.LoadIndexFile;
  1202. begin
  1203.    if (not CheckStatus) or (Trim(Filename) = '') then Exit;
  1204.  
  1205.    FIFile := GetTempFilename;
  1206.    FTPLastAction := ftplaGETIndexFile;
  1207.  
  1208.    GetFile(Filename, FIFile);
  1209. end;
  1210.  
  1211. procedure TMFtp.GetFile(RemoteFile, LocalFile: String);
  1212. var p: TFtpProc;
  1213. begin
  1214.    if (FTPLastAction <> ftplaGETIndexFile) and (FTPLastAction <> ftplaGETS) then
  1215.    begin
  1216.       if not CheckStatus then Exit;
  1217.       FTPLastAction := ftplaGET;
  1218.    end;
  1219.  
  1220.    FSelection := RemoteFile;
  1221.    FFile := LocalFile;
  1222.    FStartPoint := 0;
  1223.  
  1224.    if FSelection = '' then
  1225.    begin
  1226.       FMBusy := False;
  1227.       DoFtpError(ftpFileNotFound);
  1228.       Ready;      
  1229.       Exit;
  1230.    end;
  1231.  
  1232.    if FFile <> '' then
  1233.    begin
  1234.       try
  1235.          if SysUtils.FileExists(FFile) then
  1236.          begin
  1237.             DataFile := TFileStream.Create(FFile, fmOpenReadWrite + fmShareDenyWrite);
  1238.             p := fpDownload;
  1239.          end
  1240.          else
  1241.          begin
  1242.             DataFile := TFileStream.Create(FFile, fmCreate);
  1243.             PassiveP := fpDownload4b;
  1244.             p := fpDownload3;
  1245.          end;
  1246.  
  1247.          FileOpened := True;
  1248.          ReadyPort := False;
  1249.          ReadyMain := False;         
  1250.  
  1251.          if FMode = BinaryTransfer then
  1252.             SetTransferMode('I', p)
  1253.          else
  1254.             SetTransferMode('A', p);
  1255.  
  1256.          while (FBusy) and (not FAsync) do ProcessMessages;
  1257.       except
  1258.          DoFtpError(ftpFileOpen);
  1259.          Ready;
  1260.       end;
  1261.    end
  1262.    else
  1263.    begin
  1264.       FMBusy := False;
  1265.       DoFtpError(ftpFileOpen);
  1266.       Ready;
  1267.       Exit;
  1268.    end;
  1269. end;
  1270.  
  1271. procedure TMFtp.GetFile(RemoteFiles, LocalFiles: TStrings);
  1272. var i: Integer;
  1273. begin
  1274.    if not (Assigned(RemoteFiles) and Assigned(LocalFiles)) then Exit;
  1275.    if RemoteFiles.Count <> LocalFiles.Count then Exit;
  1276.    if not CheckStatus then Exit;
  1277.  
  1278.    FTPLastAction := ftplaGETS;
  1279.    FMFinished := False;
  1280.  
  1281.    for i := 0 to RemoteFiles.Count - 1 do
  1282.    begin
  1283.       FMBusy := True;
  1284.       GetFile(RemoteFiles[i], LocalFiles[i]);
  1285.       while FMBusy do ProcessMessages;              
  1286.    end;
  1287.  
  1288.    FMFinished := True;
  1289.    Ready;
  1290. end;
  1291.  
  1292. procedure TMFtp.PutFile(LocalFile, RemoteFile: String);
  1293. begin
  1294.    if FTPLastAction <> ftplaPUTS then
  1295.    begin
  1296.       if not CheckStatus then Exit;
  1297.       FTPLastAction := ftplaPUT;
  1298.    end;
  1299.  
  1300.    FSelection := RemoteFile;
  1301.    FFile := LocalFile;
  1302.    FStartPoint := 0;
  1303.  
  1304.    if FSelection = '' then
  1305.    begin
  1306.       FMBusy := False;
  1307.       DoFtpError(ftpFileNotFound);
  1308.       Ready;
  1309.       Exit;
  1310.    end;
  1311.  
  1312.    if FFile <> '' then
  1313.    begin
  1314.       try
  1315.          DataFile := TFileStream.Create(FFile, fmOpenRead);
  1316.          FileOpened := True;
  1317.       except
  1318.          FMBusy := False;
  1319.          DoFtpError(ftpFileOpen);
  1320.          Ready;
  1321.       end;
  1322.    end
  1323.    else
  1324.    begin
  1325.       FMBusy := False;
  1326.       DoFtpError(ftpFileOpen);
  1327.       Ready;
  1328.       Exit;
  1329.    end;
  1330.  
  1331.    if FMode = BinaryTransfer then
  1332.       SetTransferMode('I', fpUpload)
  1333.    else
  1334.       SetTransferMode('A', fpUpload);
  1335.  
  1336.    while (FBusy) and (not FAsync) do ProcessMessages;
  1337. end;
  1338.  
  1339. procedure TMFtp.PutFile(LocalFiles, RemoteFiles: TStrings);
  1340. var i: Integer;
  1341. begin
  1342.    if not (Assigned(RemoteFiles) and Assigned(LocalFiles)) then Exit;
  1343.    if RemoteFiles.Count <> LocalFiles.Count then Exit;
  1344.    if not CheckStatus then Exit;
  1345.  
  1346.    FTPLastAction := ftplaPUTS;
  1347.    FMFinished := False;
  1348.  
  1349.    for i := 0 to RemoteFiles.Count - 1 do
  1350.    begin
  1351.       FMBusy := True;
  1352.       PutFile(LocalFiles[i], RemoteFiles[i]);
  1353.       while FMBusy do ProcessMessages;              
  1354.    end;
  1355.  
  1356.    FMFinished := True;
  1357.    Ready;
  1358. end;
  1359.  
  1360. procedure TMFtp.TransferFile(SourceFile, TargetFile: String; TargetFTP: TMFtp);
  1361. begin
  1362.    FTransferSuccess := False;
  1363.  
  1364.    FTransferFromFtp := Self;
  1365.    FTransferToFtp := TargetFtp;
  1366.  
  1367.    FSourceName := SourceFile;
  1368.    FTargetName := TargetFile;
  1369.    FTransferCounter := 0;
  1370.  
  1371.    if Assigned(FTransferToFtp) then
  1372.    begin
  1373.       if ((FTransferFromFtp.CheckStatus) and (FTransferToFtp.CheckStatus)) or (FTPLastAction = ftplaTransfers) then
  1374.       begin
  1375.          if FTPLastAction <> ftplaTransfers then FTPLastAction := ftplaTransfer;
  1376.  
  1377.        {if CheckSymLink(FSourceName) then
  1378.             TransMode := 'A'
  1379.          else
  1380.             TransMode := 'I';}
  1381.  
  1382.          TransMode := 'I';  
  1383.          FTransferFromFtp.SetTransferMode(TransMode, fpTransfer);
  1384.       end
  1385.       else
  1386.          DoFtpError(ftpTransferFatalError);
  1387.    end;
  1388. end;
  1389.  
  1390. procedure TMFtp.TransferFile(SourceFiles, TargetFiles: TStrings; TargetFTP: TMFtp);
  1391. var i: Integer;
  1392. begin
  1393.    if not (Assigned(SourceFiles) and Assigned(TargetFiles)) then Exit;
  1394.    if SourceFiles.Count <> TargetFiles.Count then Exit;
  1395.    if not ((TargetFTP.CheckStatus) and (CheckStatus)) then Exit;
  1396.  
  1397.    FTPLastAction := ftplaTransfers;
  1398.    FMFinished := False;
  1399.  
  1400.    for i := 0 to SourceFiles.Count - 1 do
  1401.    begin
  1402.       FMBusy := True;
  1403.       TransferFile(SourceFiles[i], TargetFiles[i], TargetFTP);
  1404.       while FMBusy do ProcessMessages;              
  1405.    end;
  1406.  
  1407.    FMFinished := True;
  1408.    Ready;
  1409. end;
  1410.  
  1411. procedure TMFtp.IssueCommand;
  1412. begin
  1413.    if Command = '' then
  1414.    begin
  1415.       NextP := nil;
  1416.       Ready;
  1417.       Exit;
  1418.    end;
  1419.  
  1420.    if CheckStatus then
  1421.    begin
  1422.       CurrentMode := '';
  1423.  
  1424.       if Assigned(OnDone) then
  1425.          Proceed(Command, OnDone)
  1426.       else
  1427.          Proceed(Command, fpProcessGeneral);
  1428.    end;
  1429. end;
  1430.  
  1431. procedure TMFtp.Refresh;
  1432. var R1, R2: Boolean;
  1433. begin
  1434.    FTPLastAction := ftplaLIST;
  1435.  
  1436.    if FCache then
  1437.    begin
  1438.       R1 := LoadFromCache(GetCacheFilename(Server, FUser, FDirectory, Port, True), FDirectories, FCacheE);
  1439.       R2 := LoadFromCache(GetCacheFilename(Server, FUser, FDirectory, Port, False), FFiles, FCacheE);
  1440.  
  1441.       if (R1 = True) and (R2 = True) then
  1442.       begin
  1443.          FFromCache := True;
  1444.          Ready;
  1445.          Exit;
  1446.       end;
  1447.    end;
  1448.  
  1449.    if CheckStatus then
  1450.    begin
  1451.       FFromCache := False;
  1452.       SetTransferMode('A', fpList);
  1453.  
  1454.       while (FBusy) and (not FAsync) do ProcessMessages;
  1455.    end;
  1456. end;
  1457.  
  1458. procedure TMFtp.RefreshB;
  1459. begin
  1460.    ReadyList := False;
  1461.    SetTransferMode('A', fpList);
  1462.  
  1463.    while (not ReadyList) and (not BAborted) do ProcessMessages;
  1464.  
  1465.    FFiles.Assign(TFiles);
  1466.    FDirectories.Assign(TDirectories);
  1467.    UpdateCache;
  1468. end;
  1469.  
  1470. procedure TMFtp.Quit;
  1471. begin
  1472.    if CheckStatus then Proceed('QUIT', fpQuit);
  1473. end;
  1474.  
  1475. procedure TMFtp.fpRename;
  1476. begin
  1477.    if Line[1] = '3' then
  1478.    begin
  1479.       Proceed('Rnto ' + Rnto, fpRename2)
  1480.    end
  1481.    else
  1482.    begin
  1483.       errs := msgDenied;
  1484.       DoFtpError(ftpPermissionDenied);
  1485.       Ready;
  1486.    end;
  1487. end;
  1488.  
  1489. procedure TMFtp.fpRename2;
  1490. begin
  1491.    if Line[1] <> '2' then
  1492.    begin
  1493.       errs := msgDenied;
  1494.       DoFtpError(ftpPermissionDenied);
  1495.    end;
  1496.  
  1497.    Ready;
  1498. end;
  1499.  
  1500. procedure TMFtp.fpResolveLinks;
  1501. begin
  1502.    if line[1] <> '2' then
  1503.    begin
  1504.       FFiles.Add(FDirectories[FSP].Filename,
  1505.                  FDirectories[FSP].Attrib,
  1506.                  FDirectories[FSP].DateTime,
  1507.                  FDirectories[FSP].Size,
  1508.                  FDirectories[FSP].SymbolLink,
  1509.                  FDirectories[FSP].Owner,
  1510.                  FDirectories[FSP].Group,
  1511.                  FDirectories[FSP].Description);
  1512.       FDirectories.Delete(FSP);
  1513.    end
  1514.    else
  1515.    begin
  1516.       Inc(FSP);
  1517.    end;
  1518.  
  1519.    while FSP < FDirectories.Count do
  1520.    begin
  1521.       if (FDirectories[FSP].Filename <> '.') and (FDirectories[FSP].Filename <> '..') and
  1522.          (FDirectories[FSP].SymbolLink <> '.') and
  1523.          (FDirectories[FSP].SymbolLink <> '..') and
  1524.          (FDirectories[FSP].SymbolLink <> '') then Break;
  1525.       Inc(FSP);
  1526.    end;
  1527.  
  1528.    if FSP < FDirectories.Count then
  1529.       Proceed('CWD ' + FCDirectory + FDirectories[FSP].Filename, fpResolveLinks)
  1530.    else
  1531.       Ready;
  1532. end;
  1533.  
  1534. procedure TMFtp.SetUrl;
  1535. var S1, S2, RT, TUser, TPass, TServer: String;
  1536.     p, TPort: Integer;
  1537. begin
  1538.    try
  1539.       if FBusy then
  1540.       begin
  1541.          DoFtpInfo(ftpAlreadyBusy);
  1542.          Exit;
  1543.       end;
  1544.  
  1545.       S := PrepareURL(Trim(S)); {preprocessing the url Line}
  1546.  
  1547.       RT := LowerCase(Copy(S, 1, 6));
  1548.       if RT <> 'ftp://' then
  1549.       begin
  1550.          errs := msgNSProtocol;
  1551.          DoFtpError(ftpBadURL);
  1552.          Exit;
  1553.       end
  1554.       else
  1555.       begin
  1556.          S1 := '';
  1557.          Delete(S, 1, 6);
  1558.          p := Pos('@', S);
  1559.          if p > 0 then
  1560.          begin
  1561.             S1 := Copy(S, 1, p - 1);
  1562.             Delete(S, 1, p);
  1563.          end;
  1564.          p := Pos('/', S);
  1565.          if p = 0 then
  1566.             S2 := ''
  1567.          else
  1568.          begin
  1569.             S2 := Copy(S, p, 999);
  1570.             Delete(S, p, 999);
  1571.          end;
  1572.          if S1 = '' then
  1573.          begin
  1574.             if FUser = '' then FUser := 'anonymous';
  1575.             if FPass = '' then FPass := 'guest@somewhere.on.earth';
  1576.             TUser := FUser;
  1577.             TPass := FPass;
  1578.          end
  1579.          else
  1580.          begin
  1581.             p := Pos(':', S1);
  1582.             if p = 0 then
  1583.             begin
  1584.                errs := msgISytax;
  1585.                DoFtpError(ftpBadURL);
  1586.                FBusy := False;
  1587.                Exit;
  1588.             end;
  1589.             TUser := Copy(S1, 1, p - 1);
  1590.             TPass := Copy(S1, p + 1, 999);
  1591.          end;
  1592.          p := Pos(':', S);
  1593.          if p = 0 then
  1594.          begin
  1595.             TServer := S;
  1596.             TPort := FPort; { useless, just make compiler happy }
  1597.          end
  1598.          else
  1599.          begin
  1600.             TServer := Copy(S, 1, p - 1);
  1601.             TPort := StrToInt(Copy(S, p + 1, 999));
  1602.          end;
  1603.       end;
  1604.  
  1605.       FUrl := S2;
  1606.  
  1607.       FBusy := True;
  1608.       if Assigned(FFtpBusy) then FFtpBusy(Self);
  1609.       CallNEvents(12);
  1610.  
  1611.       if (FUser = TUser) and (FPass = TPass) and (FServer = TServer)
  1612.           and (FPort = TPort) and (ControlLoggedIn) then
  1613.       begin
  1614.          fpProcessURL('299');
  1615.          Exit;
  1616.       end;
  1617.  
  1618.       FUser := TUser;
  1619.       FPass := TPass;
  1620.       Server := TServer;
  1621.       FPort := TPort;
  1622.  
  1623.       if not ControlConnected then
  1624.       begin
  1625.          URLMode := 2;
  1626.          Login;
  1627.       end
  1628.       else
  1629.       begin
  1630.          URLMode := 1;
  1631.          Proceed('QUIT', fpQuit);
  1632.       end;
  1633.    except
  1634.       errs := msgUEParse;
  1635.       DoFtpError(ftpBadURL);
  1636.    end;
  1637. end;
  1638.  
  1639. function TMFtp.GetUrl;
  1640. var i: Integer;
  1641. begin
  1642.    {reformats the url, extra information(username, password etc.) is excluded}
  1643.    if FPort = 21 then
  1644.       Result := 'ftp://' + Server + '/'
  1645.    else
  1646.       Result := 'ftp://' + Server + ':' + IntToStr(Port) + '/';
  1647.  
  1648.    if FDirectory = '' then Exit;
  1649.    if FDirectory = '/' then Exit;
  1650.    if FDirectory[1] = '/' then Delete(FDirectory, 1, 1);
  1651.  
  1652.    Result := Result + FDirectory;
  1653.  
  1654.    i := Length(Result);
  1655.    if Result[i] <> '/' then Result := Result + '/';
  1656. end;
  1657.  
  1658. procedure TMFtp.Proceed;
  1659. var data: String;
  1660. begin
  1661.    data := Line + #13#10;
  1662.  
  1663.    DoFtpInfo(ftpTraceOut, data);
  1664.    while data <> '' do
  1665.    begin
  1666.       ProcessMessages;
  1667.       Delete(data, 1, SendBuf(PChar(@data[1]), Length(data)));
  1668.       if (CheckError) or (Aborted) or (not Connected) then
  1669.       begin
  1670.          ReadyCWD := True;
  1671.          Exit;
  1672.       end;
  1673.    end;
  1674.  
  1675.    NextP := P;
  1676. end;
  1677.  
  1678. procedure TMFtp.DidConnect;
  1679. begin
  1680.    if CheckError then Exit;
  1681.    
  1682.    DoFtpInfo(ftpServerConnected, Address);
  1683.  
  1684.    ControlConnected := True;
  1685.    OnHold := False;
  1686.  
  1687.    PartialLine := '';
  1688.    NextP := fpLogin;
  1689. end;
  1690.  
  1691. procedure TMFtp.TimedOut;
  1692. begin
  1693.    errs := 'Connection timed out';
  1694.    FatalError(ftpConnectTimeOut);
  1695. end;
  1696.  
  1697. procedure TMFtp.DoRetry;
  1698. {$ifndef USE_RETRYING_TIMER}
  1699. var ST: Longword;
  1700. {$endif}
  1701. begin
  1702.    if FRemain < 0 then
  1703.    begin
  1704.       DoFTPInfo(ftpRetryFinished, 'Retry Finished');
  1705.       SRetry := True;
  1706.       Exit;
  1707.    end;
  1708.  
  1709.    {$ifdef USE_RETRYING_TIMER}
  1710.    if (not ControlLoggedIn) and (FRemain >= 0) and (FError <> ftpNone) then
  1711.    begin
  1712. //    DoFTPInfo(ftpRetrying, msgRetry + IntToStr(FRetryI) + ' Seconds..'); {mEga}
  1713.       DoFTPInfo(ftpRetrying, msgRetry);
  1714.  
  1715.       FDBusy := True;
  1716.  
  1717.       if FRetryI > 0 then
  1718.       begin
  1719.          RTimer.Interval := FRetryI * 1000;
  1720.          RTimer.Enabled := True;
  1721.       end;
  1722.    end;
  1723.    {$else}
  1724.    if (not ControlLoggedIn) and (FRemain >= 0) and (FError <> ftpNone) then
  1725.    begin
  1726. //    DoFTPInfo(ftpRetrying, msgRetry + IntToStr(FRetryI) + ' Seconds..'); {mEga}
  1727.       DoFTPInfo(ftpRetrying, msgRetry);
  1728.  
  1729.       FDBusy := True;
  1730.       SRetry := False;
  1731.  
  1732.       if FRetryI > 0 then
  1733.       begin
  1734.          ST := GetTickCount;
  1735.          while GetTickCount - ST < FRetryI * 1000 do
  1736.          begin
  1737.             if SRetry then
  1738.                Break
  1739.             else
  1740.                ProcessMessages;
  1741.          end;
  1742.       end;
  1743.       if not SRetry then
  1744.       begin
  1745.          LoginMain;
  1746.          Exit;
  1747.       end;
  1748.    end;
  1749.    {$endif}
  1750. end;
  1751.  
  1752. procedure TMFtp.DoDisconnect;
  1753. procedure RealDoDisconnect;
  1754. begin
  1755.    ControlConnected := False;
  1756.    DoFTPInfo(ftpServerDisconnected, msgDisconnected);
  1757.    PostMessage(Handle, FTP_AVAILABLE, 0, 0);
  1758.    FtpLastAction := ftplaNone;
  1759.    ReadyList := True;
  1760.    Ready;
  1761. end;
  1762. begin
  1763.    if FDBusy then Exit;
  1764.    DoRetry;
  1765.    if SRetry then RealDoDisconnect;
  1766. end;
  1767.  
  1768. procedure TMFtp.DoRead;
  1769. var
  1770.    Linein, newLine: String;
  1771.    el: Integer;
  1772. begin
  1773.    if OnHold then Exit;
  1774.    if Aborted then Exit;
  1775.    while True do
  1776.    begin
  1777.       if Aborted then Exit;
  1778.       Linein := RecvText;
  1779.       if CheckError then Exit;
  1780.       DoFtpInfo(ftpTraceIn, Linein);
  1781.       if Length(Linein) = 0 then Exit;
  1782.       Linein := PartialLine + Linein;
  1783.       repeat
  1784.          // fix for ftp.es.tripod.de, reported by Alfonso Martinez de Lizarrondo
  1785.          {$ifndef NOPATCH}
  1786.          el := Pos(#10, Linein);
  1787.          if el <> 0 then
  1788.          begin
  1789.             if ((el>1) and (Linein[el-1] = #13)) then
  1790.                 newLine := Copy(Linein, 1, el - 2)
  1791.             else
  1792.                 newLine := Copy(Linein, 1, el - 1);
  1793.  
  1794.             Delete(Linein, 1, el);
  1795.          {$else}
  1796.          el := Pos(#13 + #10, Linein);
  1797.          if el <> 0 then
  1798.          begin
  1799.             newLine := Copy(Linein, 1, el - 1);
  1800.             Delete(Linein, 1, el + 1);
  1801.          {$endif}
  1802.             OnHold := True;
  1803.             FtpProcess(newLine);
  1804.             OnHold := False;
  1805.             if Aborted then Exit;
  1806.          end;
  1807.       until el = 0;
  1808.       PartialLine := Linein;
  1809.    end;
  1810. end;
  1811.  
  1812. procedure TMFtp.FatalError;
  1813. begin
  1814.    if Aborted then Exit;
  1815.  
  1816.    FError := e;
  1817.    DoFtpError(e);
  1818.    if DataSocket.IsConnected then DataSocket.Disconnect;
  1819.    if ListeningSocket.IsConnected then ListeningSocket.Disconnect;
  1820.    if IsConnected then Disconnect;
  1821. end;
  1822.  
  1823. procedure TMFtp.fpBuildFileList;
  1824. var D: TStringList;
  1825.     L, CurrDir: String;
  1826.     i: Integer;
  1827. begin
  1828.    D := TStringList.Create;
  1829.  
  1830.    try
  1831.       RefreshB;
  1832.       if not FSuccess then Ready;
  1833.  
  1834.       if Flag or (Visited.IndexOf(FDirectory) < 0) then
  1835.       begin
  1836.          if not Flag then Visited.Add(FDirectory);
  1837.          L := GetURL;
  1838.  
  1839.          if FDirectory <> '' then
  1840.          begin
  1841.             if (FDirectory[1] <> '/') and (FDirectory[1] <> '\') then
  1842.                CurrDir := '/' + FDirectory
  1843.             else
  1844.                CurrDir := FDirectory;
  1845.          end;
  1846.  
  1847.          for i := 0 to Directories.Count - 1 do
  1848.          begin
  1849.             if (FBFParm.ScanSymLink) or ((not FBFParm.ScanSymLink) and (Directories[i].SymbolLink = '')) then
  1850.                D.Add(Directories[i].Filename);
  1851.             if Assigned(FOnFileFound) then FOnFileFound(Self, Directories[i], L, True);
  1852.          end;
  1853.  
  1854.          for i := 0 to Files.Count - 1 do
  1855.             if Assigned(FOnFileFound) then FOnFileFound(Self, Files[i], L, False);
  1856.  
  1857.          if FBFParm.Depth > 0 then
  1858.          begin
  1859.             for i := 0 to D.Count - 1 do
  1860.             begin
  1861.                ReadyCWD := False;
  1862.                Proceed('CWD ' + CurrDir + '/' + D[i], fpCWD);
  1863.                while not ReadyCWD do ProcessMessages;
  1864.                if FDirectory <> '' then
  1865.                begin
  1866.                   Dec(FBFParm.Depth);
  1867.                   fpBuildFileList(False);
  1868.                   Inc(FBFParm.Depth);
  1869.                end;
  1870.             end;
  1871.          end;
  1872.       end;
  1873.  
  1874.       if Flag then Ready;
  1875.    finally
  1876.       FreeAndNil(D);
  1877.    end;
  1878. end;
  1879.  
  1880. procedure TMFtp.fpChmod;
  1881. begin
  1882.    if Line[1] = '5' then
  1883.    begin
  1884.       if Line[1] = '0' then
  1885.          DoFtpError(ftpProtocolError)
  1886.       else
  1887.          DoFtpError(ftpAccessDenied);
  1888.       Ready;
  1889.    end;
  1890. end;
  1891.  
  1892. procedure TMFtp.fpCWD;
  1893. var i: Integer;
  1894. begin
  1895.    if Line[1] <> '2' then
  1896.    begin
  1897.       FDirectory := '';
  1898.       errs := msgDenied;
  1899.       DoFtpError(ftpPermissionDenied);
  1900.       ReadyCWD := True;
  1901.       Ready;
  1902.    end
  1903.    else
  1904.    begin
  1905.       {setting new CurrentDirectory property}
  1906.       i := Pos('"', Line);
  1907.       if i > 0 then
  1908.       begin
  1909.          FDirectory := Copy(Line, i + 1, 999);
  1910.          FDirectory := Copy(FDirectory, 1, Pos('"', FDirectory) - 1);
  1911.          ReadyCWD := True;
  1912.          Ready;
  1913.       end
  1914.       else
  1915.          Proceed('PWD', fpCWD2);
  1916.    end;
  1917. end;
  1918.  
  1919. procedure TMFtp.fpCWD2;
  1920. begin
  1921.    if Line[1] <> '2' then
  1922.    begin
  1923.       DoFtpError(ftpProtocolError)
  1924.    end
  1925.    else
  1926.    begin
  1927.       {setting new CurrentDirectory property}
  1928.       FDirectory := Copy(Line, Pos('"', Line) + 1, 999);
  1929.       FDirectory := Copy(FDirectory, 1, Pos('"', FDirectory) - 1);
  1930.  
  1931.       if (FType = ftpstNetTerm) or (FType = ftpstServU) then
  1932.          FDirectory := DOSName2UnixName(FDirectory);
  1933.    end;
  1934.  
  1935.    ReadyCWD := True;
  1936.    Ready;
  1937. end;
  1938.  
  1939. procedure TMFtp.fpDeleteDirectory;
  1940. var S: String;
  1941. begin
  1942.    if Line[1] <> '2' then
  1943.    begin
  1944.       errs := msgDenied;
  1945.       DoFtpError(ftpPermissionDenied);
  1946.    end
  1947.    else
  1948.    begin
  1949.       // find out the name of deleted directory
  1950.       if Oprdir[1] = '/' then
  1951.          S := Oprdir
  1952.       else
  1953.          if FDirectory[Length(FDirectory)] = '/' then
  1954.             S := FDirectory + Oprdir
  1955.          else
  1956.             S := FDirectory + '/' + Oprdir;
  1957.  
  1958.       // delete cache files
  1959.       Sysutils.DeleteFile(GetCacheFilename(Server, FUser, S, Port, True));
  1960.       Sysutils.DeleteFile(GetCacheFilename(Server, FUser, S, Port, False));
  1961.    end;
  1962.  
  1963.    Ready;
  1964. end;
  1965.  
  1966. procedure TMFtp.fpDownload;
  1967. var s: String;
  1968. begin
  1969.    DownloadSize := 0;
  1970.  
  1971.    if Assigned(NeedInfo) then NeedInfo(self, niOverwrite, s);
  1972.    if s = 'Resume' then
  1973.    begin
  1974.       if FSupportResume then
  1975.       begin
  1976.          if FSupportSIZE then
  1977.          begin
  1978.             Proceed('SIZE ' + FSelection, fpDownload2);
  1979.          end
  1980.          else
  1981.          begin
  1982.             fpDownload2('500');
  1983.          end;
  1984.       end
  1985.       else
  1986.       begin
  1987.          DoFtpInfo(ftpNotSupportResume);
  1988.          MyCloseFile;
  1989.          FTPLastAction := ftplaNone;
  1990.          Ready;
  1991.       end;
  1992.    end
  1993.    else
  1994.    begin
  1995.       if (s = 'Overwrite') or (s = '') then
  1996.       begin
  1997.          PassiveP := fpDownload4b;
  1998.          fpDownload3('299')
  1999.       end
  2000.       else
  2001.       begin
  2002.          MyCloseFile;
  2003.          FTPLastAction := ftplaNone;
  2004.          Ready;
  2005.       end;
  2006.    end;
  2007. end;
  2008.  
  2009. procedure TMFtp.fpDownload2;
  2010. begin
  2011.    if Line[1] <> '2' then
  2012.    begin
  2013.       if (Line[1] = '5') and (Line[2] = '0') then
  2014.       begin
  2015.          FSupportSIZE := False;
  2016.          Line := '213 '+ IntToStr(DataFile.Size);
  2017.          fpDownload2(Line);
  2018.       end
  2019.       else
  2020.       begin
  2021.          PassiveP := fpDownload4b;
  2022.          fpDownload3('299');
  2023.       end;
  2024.    end
  2025.    else
  2026.    begin
  2027.       DownloadSize := StrToIntDef(Copy(Line, 5, 999), 0);
  2028.       if (DownloadSize < DataFile.Size) or (DataFile.Size = 0) then
  2029.       begin
  2030.          DoFtpInfo(ftpNotSupportResume, msgAOverwrite);
  2031.          PassiveP := fpDownload4b;
  2032.          fpDownload3('299');
  2033.       end
  2034.       else
  2035.       begin
  2036.          if DownloadSize = DataFile.Size then
  2037.          begin
  2038.             DoFtpInfo(ftpNothing, msgNothing);
  2039.             MyCloseFile;
  2040.             FTPLastAction := ftplaNone;
  2041.             Ready;
  2042.          end
  2043.          else
  2044.          begin
  2045.             DataFile.Seek(0, soFromEnd);
  2046.             PassiveP := fpDownload4a;
  2047.             fpDownload3('299');
  2048.          end;
  2049.       end;
  2050.    end;
  2051. end;
  2052.  
  2053. procedure TMFtp.fpDownload3;
  2054. begin
  2055.    if Line[1] = '2' then
  2056.    begin
  2057.       if FPassive then
  2058.          Proceed('PASV', fpPreparePassive)
  2059.       else
  2060.          Proceed('PORT ' + SetupDataPort, PassiveP);
  2061.    end
  2062.    else
  2063.    begin
  2064.       DoFtpError(ftpProtocolError);
  2065.       Ready;
  2066.    end;
  2067. end;
  2068.  
  2069. procedure TMFtp.fpDownload4a;
  2070. begin
  2071.    if Line[1] <> '2' then
  2072.    begin
  2073.       DoFtpError(ftpProtocolError);
  2074.       Ready;
  2075.    end
  2076.    else
  2077.    begin
  2078.       with DataSocket do
  2079.       begin
  2080.          OnReadReady := DataRetrFile;
  2081.          OnDisconnected := DataFileDisconnected;
  2082.          OnWriteReady := nil;
  2083.          if FPassive then
  2084.             OnConnected := DataListConnected
  2085.          else
  2086.             ListeningSocket.OnAccept := DataListConnected;
  2087.       end;
  2088.  
  2089.       FStartPoint := DataFile.Size;
  2090.       Proceed('REST ' + IntToStr(FStartPoint), fpDownload5a);
  2091.    end;
  2092. end;
  2093.  
  2094. procedure TMFtp.fpDownload4b;
  2095. begin
  2096.    if Line[1] <> '2' then
  2097.    begin
  2098.       DoFtpError(ftpProtocolError);
  2099.       Ready;
  2100.    end
  2101.    else
  2102.    begin
  2103.       with DataSocket do
  2104.       begin
  2105.          OnReadReady := DataRetrFile;
  2106.          OnDisconnected := DataFileDisconnected;
  2107.          OnWriteReady := nil;
  2108.          if FPassive then
  2109.             OnConnected := DataListConnected
  2110.          else
  2111.             ListeningSocket.OnAccept := DataListConnected;
  2112.       end;
  2113.       Proceed('RETR ' + FSelection, fpDownload5b);
  2114.    end;
  2115. end;
  2116.  
  2117. procedure TMFtp.fpDownload5a;
  2118. begin
  2119.    if Line[1] = '3' then
  2120.       Proceed('RETR ' + FSelection, fpDownload5b)
  2121.    else
  2122.    begin
  2123.       DataSocket.Disconnect;
  2124.       ListeningSocket.Disconnect;
  2125.       errs := msgFResumeD;
  2126.       DoFtpError(ftpResumeFailed);
  2127.       Ready;
  2128.    end;
  2129. end;
  2130.  
  2131. procedure TMFtp.fpDownload5b;
  2132. var i, j: Integer;
  2133. begin
  2134.    case Line[1] of
  2135.       '1':
  2136.       begin
  2137.          i := Pos('(', Line);
  2138.          if i > 0 then
  2139.          begin
  2140.             while i > 0 do
  2141.             begin
  2142.                Delete(Line, 1, i);
  2143.                i := Pos('(', Line);
  2144.             end;
  2145.  
  2146.             for j := 1 to Length(Line) do
  2147.             begin
  2148.                if Line[j] = ' ' then
  2149.                begin
  2150.                   DoFtpInfo(ftpFileSize, Copy(Line, i + 1, j - i - 1));
  2151.                   Exit;
  2152.                end;
  2153.             end;
  2154.          end;
  2155.          Exit;
  2156.       end;
  2157.       '2':
  2158.       begin
  2159.          ReadyMain := True;
  2160.          if ReadyPort then Ready;
  2161. //       NextP := nil;
  2162.       end
  2163.       else
  2164.       begin
  2165.          DataSocket.Disconnect; {close data connection}
  2166.          ListeningSocket.Disconnect;
  2167.          if (Aborted) and (Copy(Line, 1, 3) = '426') then
  2168.          begin
  2169.             if Assigned(FAborted) then FAborted(Self);
  2170.             CallNEvents(13);
  2171.          end
  2172.          else
  2173.          begin
  2174.             errs := msgDenied;
  2175.             DoFtpError(ftpPermissionDenied);
  2176.          end;
  2177.          Ready;
  2178.       end;
  2179.    end;
  2180. end;
  2181.  
  2182. procedure TMFtp.fpList;
  2183. begin
  2184.    ReadyMain := False;
  2185.    ReadyPort := False;
  2186.  
  2187.    if Line[1] = '2' then
  2188.    begin
  2189.       if FPassive then
  2190.       begin
  2191.          PassiveP := fpList2;
  2192.          Proceed('PASV', fpPreparePassive)
  2193.       end
  2194.       else
  2195.          Proceed('PORT ' + SetupDataPort, fpList2)
  2196.    end
  2197.    else
  2198.    begin
  2199.       DoFtpError(ftpProtocolError);
  2200.       if ftpLastAction = ftplaSearch then ReadyList := True else Ready;
  2201.    end;
  2202. end;
  2203.  
  2204. procedure TMFtp.fpList2;
  2205. begin
  2206.    if Line[1] <> '2' then
  2207.    begin
  2208.       DoFtpError(ftpProtocolError);
  2209.       if ftpLastAction = ftplaSearch then ReadyList := True else Ready;
  2210.    end
  2211.    else
  2212.    begin
  2213.       with DataSocket do
  2214.       begin
  2215.          OnReadReady := DataDoListing;
  2216.          OnDisconnected := DataListDisconnected;
  2217.          OnWriteReady := nil;
  2218.          if FPassive then
  2219.             OnConnected := DataListConnected
  2220.          else
  2221.             ListeningSocket.OnAccept := DataListConnected;
  2222.       end;
  2223.  
  2224.       FList.Clear;
  2225.       TFiles.Clear;
  2226.       TDirectories.Clear;
  2227.  
  2228.       pcount := 0;
  2229.       if FFileMask <> '' then
  2230.          Proceed('LIST ' + FFileMask, fpList3)
  2231.       else
  2232.          Proceed('LIST', fpList3);
  2233.  
  2234.       DoFtpInfo(ftpStartListing);
  2235.    end;
  2236. end;
  2237.  
  2238. procedure TMFtp.fpList3;
  2239. begin
  2240.    case Line[1] of
  2241.       '1': Exit;
  2242.       '2':
  2243.       begin
  2244.          ReadyMain := True;
  2245.          if ReadyPort then
  2246.             if ftpLastAction = ftplaSearch then ReadyList := True else Ready;
  2247.       end
  2248.       else
  2249.       begin
  2250.          DataSocket.Disconnect; {close data connection}
  2251.          ListeningSocket.Disconnect;
  2252.          if (Aborted) and (Copy(Line, 1, 3) = '426') then
  2253.          begin
  2254.             if Assigned(FAborted) then FAborted(Self);
  2255.             CallNEvents(13);
  2256.          end
  2257.          else
  2258.          begin
  2259.             errs := msgDenied;
  2260.             DoFtpError(ftpPermissionDenied);
  2261.          end;
  2262.          if ftpLastAction = ftplaSearch then ReadyList := True else Ready;
  2263.       end;
  2264.    end;
  2265. end;
  2266.  
  2267. procedure TMFtp.fpLogin;
  2268. begin
  2269.    if URLMode = 0 then FtpLastAction := ftplaLOGIN else UrlMode := 2;
  2270.  
  2271.    if Line[1] <> '2' then
  2272.       FatalError(ftpServerDown)
  2273.    else
  2274.    begin
  2275.       if (FUser = '') and Assigned(NeedInfo) then NeedInfo(Self, niUser, FUser);
  2276.  
  2277.       if FProxyType <> proxyNone then
  2278.       begin
  2279.          Server := FtpServer;
  2280.          Port := FtpPort;
  2281.       end
  2282.       else
  2283.       begin
  2284.          if FType = ftpstAutoDetect then
  2285.          begin
  2286.             if Pos('NetTerm FTP server', Line) <> 0 then FType := ftpstNetTerm;
  2287.          end;
  2288.       end;
  2289.  
  2290.       case FProxyType of
  2291.          proxyHost: Proceed('HOST ' + Server, fpLoginProxyHost);
  2292.          proxyNone: Proceed('USER ' + FUser, fpLogin2);
  2293.          proxyOpen: Proceed('OPEN ' + Server, fpLoginProxyOpen);
  2294.          proxySite: Proceed('USER ' + FPUser, fpLoginProxySite);
  2295.          proxyHostUser:
  2296.          begin
  2297.             if Port = 21 then
  2298.                Proceed('USER ' + Server + '!' + FUser, fpLogin2)
  2299.             else
  2300.                Proceed('USER ' + Server + ':' + IntToStr(Port) + '!' + FUser, fpLogin2);
  2301.          end;
  2302.          proxyUserSite:
  2303.          begin
  2304.             if Port = 21 then
  2305.                Proceed('USER ' + FUser + '@' + Server, fpLogin2)
  2306.             else
  2307.                Proceed('USER ' + FUser + '@' + Server + ':' + IntToStr(Port), fpLogin2);
  2308.          end;
  2309.       end;
  2310.    end;
  2311. end;
  2312.  
  2313. procedure TMFtp.fpLogin2;
  2314. begin
  2315.    if Line[1] = '2' then
  2316.    begin
  2317.       if FType = ftpstAutoDetect then
  2318.          Proceed('SYST', fpTestSystemType)
  2319.       else
  2320.          Proceed('REST 100', fpTestREST);
  2321.    end
  2322.    else
  2323.    begin
  2324.       if Line[1] <> '3' then
  2325.       begin
  2326.          FatalError(ftpAccessDenied);
  2327.       end
  2328.       else
  2329.       begin
  2330.          if (FPass = '') and Assigned(NeedInfo) then NeedInfo(Self, niPassword, FPass);
  2331.          Proceed('PASS ' + FPass, fpLogin3);
  2332.       end;
  2333.    end;
  2334. end;
  2335.  
  2336. procedure TMFtp.fpLogin3;
  2337. begin
  2338.    if Line[1] = '2' then
  2339.    begin
  2340.       if FType = ftpstAutoDetect then
  2341.          Proceed('SYST', fpTestSystemType)
  2342.       else
  2343.          Proceed('REST 100', fpTestREST);
  2344.    end
  2345.    else
  2346.    begin
  2347.       if Line[1] <> '3' then
  2348.       begin
  2349.          FatalError(ftpAccessDenied);
  2350.       end
  2351.       else
  2352.       begin
  2353.          if (FAcct = '') and Assigned(NeedInfo) then NeedInfo(Self, niAccount, FAcct);
  2354.          Proceed('ACCT ' + FAcct, fpLogin4);
  2355.       end;
  2356.    end;
  2357. end;
  2358.  
  2359. procedure TMFtp.fpLogin4;
  2360. begin
  2361.    if Line[1] = '2' then
  2362.    begin
  2363.       if FType = ftpstAutoDetect then
  2364.          Proceed('SYST', fpTestSystemType)
  2365.       else
  2366.          Proceed('REST 100', fpTestREST);
  2367.    end
  2368.    else
  2369.    begin
  2370.       FatalError(ftpAccessDenied);
  2371.    end;
  2372. end;
  2373.  
  2374. procedure TMFtp.fpLogin5;
  2375. begin
  2376.    if FDirectory = '' then
  2377.    begin
  2378.       if Line[1] = '2' then
  2379.       begin
  2380.          FDirectory := Copy(Line, Pos('"', Line) + 1, 999);
  2381.          FDirectory := Copy(FDirectory, 1, Pos('"', FDirectory) - 1);
  2382.  
  2383.          if (FType = ftpstNetTerm) or (FType = ftpstServU) then
  2384.             FDirectory := DOSName2UnixName(FDirectory);
  2385.       end
  2386.       else
  2387.          FatalError(ftpProtocolError);
  2388.    end
  2389.    else
  2390.    begin
  2391.       if Line[1] <> '2' then
  2392.       begin
  2393.          errs := msgDenied;
  2394.          DoFtpError(ftpPermissionDenied);
  2395.       end;
  2396.    end;
  2397.  
  2398.    DoFtpInfo(ftpLoggedIn);
  2399.    Ready;
  2400. end;
  2401.  
  2402. procedure TMFtp.fpLoginProxyHost(Line: String);
  2403. begin
  2404.    if Line[1] <> '3' then FatalError(ftpServerDown) else Proceed('USER ' + FUser, fpLogin2);
  2405. end;
  2406.  
  2407. procedure TMFtp.fpLoginProxyOpen(Line: String);
  2408. begin
  2409.    if Line[1] <> '2' then FatalError(ftpServerDown) else Proceed('USER ' + FUser, fpLogin2);
  2410. end;
  2411.  
  2412. procedure TMFtp.fpLoginProxySite(Line: String);
  2413. begin
  2414.    if (FPUser = '') and Assigned(NeedInfo) then NeedInfo(Self, niUser, FPUser);
  2415.    case Line[1] of
  2416.       '2': Proceed('SITE ' + FServer, fpLoginProxySite3);
  2417.       '3':
  2418.       begin
  2419.          if (FPPass = '') and Assigned(NeedInfo) then NeedInfo(Self, niPassword, FPPass);
  2420.          Proceed('PASS ' + FPPass, fpLoginProxySite2);
  2421.       end;
  2422.       else FatalError(ftpAccessDenied);
  2423.    end;
  2424. end;
  2425.  
  2426. procedure TMFtp.fpLoginProxySite2(Line: String);
  2427. begin
  2428.    if Line[1] = '2' then Proceed('SITE ' + FServer, fpLoginProxySite3) else FatalError(ftpAccessDenied);
  2429. end;
  2430.  
  2431. procedure TMFtp.fpLoginProxySite3(Line: String);
  2432. begin
  2433.    if Line[1] <> '2' then FatalError(ftpProtocolError) else Proceed('USER ' + FUser, fpLogin2);
  2434. end;
  2435.  
  2436. procedure TMFtp.fpNOOP;
  2437. begin
  2438.    if (Line[1] = '5') and (Line[2] = '0') then FSupportNOOP := False;
  2439.    FBusy := False;
  2440. end;
  2441.  
  2442. procedure TMFtp.fpPreparePassive;
  2443. begin
  2444.    if (Line[1] = '2') and Assigned(PassiveP) then
  2445.    begin
  2446.       SetupDataPortPassive(Line);
  2447.       PassiveP('299');
  2448.    end
  2449.    else
  2450.    begin
  2451.       DoFtpError(ftpProtocolError);
  2452.       Ready;
  2453.    end;
  2454. end;
  2455.  
  2456. procedure TMFtp.fpProcessGeneral;
  2457. begin
  2458.    if Line[1] <> '2' then
  2459.    begin
  2460.       errs := msgDenied;
  2461.       DoFtpError(ftpPermissionDenied);
  2462.    end;
  2463.  
  2464.    Ready;
  2465. end;
  2466.  
  2467. procedure TMFtp.fpProcessURL;
  2468. begin
  2469.    UrlMode := 0;
  2470.  
  2471.    if FUrl = '' then
  2472.       Proceed('PWD', fpProcessURL2)
  2473.    else
  2474.       Proceed('CWD ' + FUrl, fpProcessURL2);
  2475. end;
  2476.  
  2477. procedure TMFtp.fpProcessURL2;
  2478. var i, j: Integer;
  2479. begin
  2480.    if Line[1] = '2' then
  2481.    begin
  2482.       FtpLastAction := ftplaCWD;
  2483.       FDirectory := Copy(Line, Pos('"', Line) + 1, 999);
  2484.       FDirectory := Copy(FDirectory, 1, Pos('"', FDirectory) - 1);
  2485.  
  2486.       if not ControlLoggedIn then
  2487.       begin
  2488.          ControlLoggedIn := True;
  2489.          SRetry := True;
  2490.          DoFtpInfo(ftpLoggedIn);
  2491.       end;
  2492.  
  2493.       fpCWD(Line);
  2494.    end
  2495.    else
  2496.    begin
  2497.       i := Length(FUrl);
  2498.  
  2499.       if FUrl[i] = '/' then
  2500.       begin
  2501.          FtpLastAction := ftplaCWD;
  2502.          errs := msgDenied;
  2503.          DoFtpError(ftpPermissionDenied);
  2504.          Ready;
  2505.       end
  2506.       else
  2507.       begin
  2508.          for j := i downto 1 do
  2509.          begin
  2510.             if FUrl[j] = '/' then
  2511.             begin
  2512.                FSelection := Copy(FUrl, j + 1, 999);
  2513.                Delete(FUrl, j + 1, 999);
  2514.                Break;
  2515.             end;
  2516.          end;
  2517.  
  2518.          Proceed('CWD ' + FUrl, fpProcessURL3);
  2519.       end;
  2520.    end;
  2521. end;
  2522.  
  2523. procedure TMFtp.fpProcessURL3;
  2524. begin
  2525.    if Line[1] = '2' then
  2526.    begin
  2527.       if not ControlLoggedIn then
  2528.       begin
  2529.          ControlLoggedIn := True;
  2530.          SRetry := True;
  2531.          DoFtpInfo(ftpLoggedIn);
  2532.       end;
  2533.  
  2534.       if FSelection <> '' then
  2535.       begin
  2536.          if Assigned(NeedInfo) then
  2537.          begin
  2538.             FFile := FSelection;
  2539.             NeedInfo(Self, niLocalFile, FFile);
  2540.             if FFile = '' then
  2541.             begin
  2542.                Disconnect;
  2543.                Exit;
  2544.             end;
  2545.          end
  2546.          else
  2547.          begin
  2548.             Disconnect;
  2549.             Exit;
  2550.          end;
  2551.  
  2552.          FBusy := False;
  2553.          GetFile(FSelection, FFile);
  2554.       end;
  2555.    end
  2556.    else
  2557.    begin
  2558. //    FRemain := -1;
  2559.       FatalError(ftpFileNotFound);
  2560.    end;
  2561. end;
  2562.  
  2563. procedure TMFtp.fpQuit;
  2564. begin
  2565.    ControlLoggedIn := False;
  2566.    if Line[1] <> '2' then FatalError(ftpNone);
  2567. // NextP := nil;
  2568. end;
  2569.  
  2570. procedure TMFtp.fpSetinitialDirectory;
  2571. begin
  2572.    if URLMode > 0 then
  2573.    begin
  2574.       fpProcessURL('299');
  2575.       Exit;
  2576.    end;
  2577.  
  2578.    if FIDirectory = '' then
  2579.       Proceed('PWD', fpLogin5)
  2580.    else
  2581.       Proceed('CWD ' + FIDirectory, fpSetinitialDirectory2);
  2582. end;
  2583.  
  2584. procedure TMFtp.fpSetinitialDirectory2;
  2585. begin
  2586.    if Line[1] = '2' then
  2587.    begin
  2588.       FDirectory := Copy(Line, Pos('"', Line) + 1, 999);
  2589.       FDirectory := Copy(FDirectory, 1, Pos('"', FDirectory) - 1);
  2590.    end;
  2591.  
  2592.    if FDirectory <> '' then
  2593.    begin
  2594.       DoFtpInfo(ftpLoggedIn);
  2595.       Ready;
  2596.    end
  2597.    else
  2598.       Proceed('PWD', fpLogin5);
  2599. end;
  2600.  
  2601. procedure TMFtp.fpTestREST;
  2602. begin
  2603.    if Line[1] = '3' then
  2604.    begin
  2605.       FSupportResume := True;
  2606.       DoFtpInfo(ftpSupportResume, msgSResume);
  2607.       Proceed('REST 0', fpSetinitialDirectory);
  2608.    end
  2609.    else
  2610.    begin
  2611.       FSupportResume := False;
  2612.       DoFtpInfo(ftpNotSupportResume);
  2613.       fpSetinitialDirectory('299');
  2614.    end;   
  2615. end;
  2616.  
  2617. procedure TMFtp.fpTestSystemType;
  2618. var FSyst: String;
  2619. begin
  2620.    if Line[1] <> '5' then
  2621.    begin
  2622.       if FType = ftpstAutoDetect then
  2623.       begin
  2624.          FSyst := UpperCase(Copy(Line, 5, 99));
  2625.          FType := ftpstDefault;
  2626.  
  2627.          if Pos('UNIX', FSyst) <> 0 then FType := ftpstUnix else
  2628.          if Pos('BSD', FSyst) <> 0 then FType := ftpstBSD else
  2629.          if Pos('SUNOS', FSyst) <> 0 then FType := ftpstSunOS else
  2630.          if Pos('CLIX', FSyst) <> 0 then FType := ftpstClix else
  2631.          if Pos('ULTRIX', FSyst) <> 0 then FType := ftpstUltrix else
  2632.          if Pos('MVS', FSyst) <> 0 then FType := ftpstMVS else
  2633.          if Pos('QVT', FSyst) <> 0 then FType := ftpstQVT else
  2634.          if Pos('NCSA', FSyst) <> 0 then FType := ftpstNCSA else
  2635.          if Pos('WFTPD', FSyst) <> 0 then FType := ftpstWFTPD else
  2636.          if Pos('WINDWOS_NT', FSyst) <> 0 then FType := ftpstMSFTP else
  2637.          if Pos('CHAMELEON', FSyst) <> 0 then FType := ftpstChameleon else
  2638.          if Pos('VMS', FSyst) <> 0 then
  2639.          if Pos('MULTINET', FSyst) <> 0 then FType := ftpstVmsMultinet else FType := ftpstVmsUcx
  2640.          else
  2641.          begin
  2642.             if Pos('VM', Fsyst) <> 0 then
  2643.             begin
  2644.                if Pos('VPS', FSyst) = 0 then
  2645.                   FType := ftpstVM
  2646.                else
  2647.                   FType := ftpstVMVPS;
  2648.             end;
  2649.          end;
  2650.       end;
  2651.    end
  2652.    else
  2653.    begin
  2654.       FType := ftpstDefault;
  2655.    end;
  2656.  
  2657.    Proceed('REST 100', fpTestREST);
  2658. end;
  2659.  
  2660. function InitPort(Line: String): String;
  2661. begin
  2662.    Result := Copy(Line, Pos('(', Line) + 1, Length(Line));
  2663.    Result := Copy(Result, 1, Pos(')', Result) - 1);
  2664. end;
  2665.  
  2666. procedure TMFtp.fpTransfer;
  2667. begin
  2668.    if Line[1] <> '2' then
  2669.    begin
  2670.       FTransferSuccess := False;
  2671.       FTransferFromFtp.DoFtpError(ftpTransferType);
  2672.    end;
  2673.    FTransferToFtp.SetTransferMode(TransMode, fpTransfer2);
  2674. end;
  2675.  
  2676. procedure TMFtp.fpTransfer2;
  2677. begin
  2678.    if Line[1] <> '2' then
  2679.    begin
  2680.       FTransferSuccess := False;
  2681.       FTransferToFtp.DoFtpError(ftpTransferType);
  2682.    end;
  2683.    FTransferFromFtp.Proceed('PASV', fpTransfer3);
  2684. end;
  2685.  
  2686. procedure TMFtp.fpTransfer3;
  2687. begin
  2688.    if Line[1] <> '2' then
  2689.    begin
  2690.       FTransferFromFtp.DoFtpError(ftpTransferPort);
  2691.       FTransferToFtp.Proceed('PASV', fpTransfer3b);
  2692.    end
  2693.    else
  2694.       FTransferToFtp.Proceed('PORT ' + InitPort(Line), fpTransfer5);
  2695. end;
  2696.  
  2697. procedure TMFtp.fpTransfer3b;
  2698. begin
  2699.    if Line[1] <> '2' then
  2700.    begin
  2701.       FTransferSuccess := False;
  2702.       FTransferToFtp.DoFtpError(ftpTransferFatalPort);
  2703.    end
  2704.    else
  2705.       FTransferFromFtp.Proceed('PORT ' + InitPort(Line), fpTransfer4b);
  2706. end;
  2707.  
  2708. procedure TMFtp.fpTransfer4b;
  2709. begin
  2710.    if Line[1] <> '2' then
  2711.    begin
  2712.       FTransferSuccess := False;
  2713.       FTransferToFtp.DoFtpError(ftpTransferFatalPort);
  2714.       Inc(FTransferCounter);
  2715.       fpTransferFinished;
  2716.    end
  2717.    else
  2718.       fpTransfer5(Line);
  2719. end;
  2720.  
  2721. procedure TMFtp.fpTransfer5;
  2722. var GetToFileSize, GetFromFileSize: Integer;
  2723. begin
  2724.    if Line[1] <> '2' then
  2725.    begin
  2726.       fpTransfer3(Line);
  2727.    end
  2728.    else
  2729.    begin
  2730.       GetToFileSize := FTransferToFtp.FileExists(FTargetName);
  2731.       if GetToFileSize<> - 1 then
  2732.       begin
  2733.          GetToFileSize := UnformatInteger(FTransferToFtp.Files.Items[GetToFileSize].Size);
  2734.          GetFromFileSize := FTransferFromFtp.FileExists(FSourceName);
  2735.  
  2736.          if GetFromFileSize = - 1 then
  2737.          begin
  2738.             FTransferSuccess := False;
  2739.             FTransferFromFtp.DoFtpError(ftpTransferGet);
  2740.             Inc(FTransferCounter);
  2741.             fpTransferFinished;
  2742.             Exit;
  2743.          end;
  2744.  
  2745.          GetFromFileSize := UnformatInteger(FTransferFromFtp.Files.Items[GetFromFileSize].Size);
  2746.  
  2747.          if GetToFileSize <> 0 then
  2748.          begin
  2749.             if (GetFromFileSize>GetToFileSize) and (FTransferResume) and (FTransferToFtp.FSupportResume) then
  2750.             begin
  2751.                TempInt := GetToFileSize;
  2752.                DoFTPInfo(ftpTransferResume, FTargetName);
  2753.                FTransferToFtp.Proceed('APPE ' + FTargetName, fpTransfer6b);
  2754.                Exit;
  2755.             end;
  2756.          end;
  2757.       end;
  2758.       FTransferToFtp.Proceed('STOR ' + FTargetName, fpTransfer6);
  2759.    end;
  2760. end;
  2761.  
  2762. procedure TMFtp.fpTransfer6; // from 'Stor TargetName'
  2763. begin
  2764.    case Line[1] of
  2765.       '1':
  2766.       begin
  2767.          DoFTPInfo(ftpTransferPutStart, FSourceName);
  2768.          fpTransfer7b('3');
  2769.       end;
  2770.       else
  2771.          fpTransfer6b(Line);
  2772.    end;
  2773. end;
  2774.  
  2775. procedure TMFtp.fpTransfer6b; // from 'Appe TargetName'
  2776. begin
  2777.    case Line[1] of
  2778.       '1':
  2779.       begin
  2780.          DoFTPInfo(ftpTransferPutStart, FTargetName);
  2781.          FTransferFromFtp.Proceed('REST ' + IntToStr(TempInt), fpTransfer7b);
  2782.       end;
  2783.       '2':
  2784.       begin
  2785.          DoFTPInfo(ftpTransferPutFinish, FTargetName);
  2786.          FTransferSuccess := True;
  2787.          fpTransferFinished;
  2788.       end;
  2789.       else
  2790.       begin
  2791.          Inc(FTransferCounter);
  2792.          FTransferSuccess := False;
  2793.          FTransferToFtp.DoFtpError(ftpTransferPut);
  2794.          fpTransferFinished;
  2795.       end;
  2796.    end;
  2797. end;
  2798.  
  2799. procedure TMFtp.fpTransfer7b;
  2800. begin
  2801.    if Line[1] <> '3' then FTransferToFtp.DoFtpError(ftpTransferResumeFailed);
  2802.    FTransferFromFtp.Proceed('RETR ' + FSourceName, fpTransfer8);
  2803. end;
  2804.  
  2805. procedure TMFtp.fpTransfer8; // After Normal/Resume Transfer
  2806. begin
  2807.    case Line[1] of
  2808.       '1': DoFTPInfo(ftpTransferGetStart, FSourceName);
  2809.       '2':
  2810.       begin
  2811.          FTransferSuccess := True;
  2812.          DoFTPInfo(ftpTransferGetFinish, FSourceName);
  2813.          fpTransferFinished;
  2814.       end;
  2815.       else
  2816.       begin
  2817.          FTransferToFtp.StopTransfer;
  2818.          while Copy(FTransferToFtp.LastReply, 1, 3) <> '226' do ProcessMessages;
  2819.          FTransferSuccess := False;
  2820.          FTransferFromFtp.DoFtpError(ftpTransferGet);
  2821. //       Inc(FTransferCounter);
  2822.          fpTransferFinished;
  2823.       end;
  2824.    end;
  2825. end;
  2826.  
  2827. procedure TMFtp.fpTransferFinished;
  2828. begin
  2829.    Inc(FTransferCounter);
  2830.    if FTransferCounter >= 2 then
  2831.    begin
  2832.       FTransferFromFtp.FBusy := False;
  2833.       FTransferToFtp.FBusy := False;
  2834.  
  2835.       if Assigned(FTransferToFtp.FOnReady) then
  2836.       begin
  2837.          FTransferToFtp.FOnReady(Self);
  2838.          FTransferToFtp.CallNEvents(9);
  2839.       end;
  2840.  
  2841.       Ready; //    if Assigned(FTransferFromFtp.FOnReady) then
  2842.              //       FTransferFromFtp.FOnReady(Self);
  2843.    end;
  2844. end;
  2845.  
  2846. procedure TMFtp.fpUpload;
  2847. begin
  2848.    UploadSize := 0;
  2849.  
  2850.    if (FSupportResume) and (FSupportSIZE) then
  2851.       Proceed('SIZE ' + FSelection, fpUpload2)
  2852.    else
  2853.    begin
  2854.       PassiveP := fpUpload4b;
  2855.       fpUpload3('299');
  2856.    end;
  2857. end;
  2858.  
  2859. procedure TMFtp.fpUpload2;
  2860. var s: String;
  2861. begin
  2862.    if Line[1] <> '2' then
  2863.    begin
  2864.       if (Line[1] = '5') and (Line[2] = '0') then FSupportSIZE := False;
  2865.       PassiveP := fpUpload4b;
  2866.    end
  2867.    else
  2868.    begin
  2869.       UploadSize := StrToIntDef(Copy(Line, 5, 999), 0);
  2870.       if UploadSize = 0 then
  2871.       begin
  2872.          PassiveP := fpUpload4b;
  2873.       end
  2874.       else
  2875.       begin
  2876.          if (Assigned(NeedInfo)) then NeedInfo(self, niOverwrite, s);
  2877.          if s = 'Resume' then
  2878.          begin
  2879.             DataFile.Seek(UploadSize, soFromBeginning);
  2880.             PassiveP := fpUpload4a;
  2881.          end
  2882.          else
  2883.          begin
  2884.             if (s = 'Overwrite') or (s = '') then
  2885.             begin
  2886.                PassiveP := fpUpload4b;
  2887.             end
  2888.             else
  2889.             begin
  2890.                MyCloseFile;
  2891.                FTPLastAction := ftplaNone;
  2892.                Ready;
  2893.                Exit;
  2894.             end;
  2895.          end;
  2896.       end;
  2897.    end;
  2898.  
  2899.    fpUpload3('299');
  2900. end;
  2901.  
  2902. procedure TMFtp.fpUpload3;
  2903. begin
  2904.    ReadyPort := False;
  2905.    ReadyMain := False;
  2906.  
  2907.    if Line[1] = '2' then
  2908.    begin
  2909.       if FPassive then
  2910.       begin
  2911.          Proceed('PASV', fpPreparePassive);
  2912.       end
  2913.       else
  2914.          Proceed('PORT ' + SetupDataPort, PassiveP);
  2915.    end
  2916.    else
  2917.    begin
  2918.       DoFtpError(ftpProtocolError);
  2919.       Ready;
  2920.    end;
  2921. end;
  2922.  
  2923. procedure TMFtp.fpUpload4a;
  2924. begin
  2925.    if Line[1] <> '2' then
  2926.    begin
  2927.       DoFtpError(ftpProtocolError);
  2928.       Ready;
  2929.    end
  2930.    else
  2931.    begin
  2932.       with DataSocket do
  2933.       begin
  2934.          OnReadReady := nil;
  2935.          OnDisconnected := DataFileDisconnected;
  2936.          if FPassive then
  2937.          begin
  2938.             OnWriteReady := DataStorConnected;
  2939.             OnConnected := DataListConnected;
  2940.          end
  2941.          else
  2942.          begin
  2943.             OnWriteReady := nil;
  2944.             ListeningSocket.OnAccept := DataStorConnected;
  2945.          end;
  2946.       end;
  2947.  
  2948.       FStartPoint := UploadSize;
  2949.       Proceed('REST ' + IntToStr(FStartPoint), fpUpload5a);
  2950.    end;
  2951. end;
  2952.  
  2953. procedure TMFtp.fpUpload5a;
  2954. begin
  2955.    if Line[1] = '3' then
  2956.       Proceed('STOR ' + FSelection, fpUpload5b)
  2957.    else
  2958.    begin
  2959.       DataSocket.Disconnect;
  2960.       ListeningSocket.Disconnect;
  2961.       errs := msgFResumeU;
  2962.       DoFtpError(ftpResumeFailed);
  2963.       Ready;
  2964.    end;
  2965. end;
  2966.  
  2967. procedure TMFtp.fpUpload4b;
  2968. begin
  2969.    if line[1] <> '2' then
  2970.    begin
  2971.       DoFtpError(ftpProtocolError);
  2972.       Ready;
  2973.    end
  2974.    else
  2975.    begin
  2976.       with DataSocket do
  2977.       begin
  2978.          OnReadReady := nil;
  2979.          OnDisconnected := DataFileDisconnected;
  2980.          OnWriteReady := DataStorFile;
  2981.          if FPassive then
  2982.             OnConnected := DataStorConnected
  2983.          else
  2984.             ListeningSocket.OnAccept := DataStorConnected;
  2985.       end;
  2986.    Proceed('STOR ' + FSelection, fpUpload5b);
  2987. end;
  2988.  
  2989. end;
  2990.  
  2991. procedure TMFtp.fpUpload5b;
  2992. begin
  2993.    case Line[1] of
  2994.       '1':
  2995.       begin
  2996.          NextP := fpProcessGeneral;
  2997.       end;
  2998.       '2':
  2999.       begin
  3000.          ReadyMain := True;
  3001.          if ReadyPort then Ready;
  3002.       end;
  3003.       else
  3004.       begin
  3005.          DataSocket.Disconnect; {close data connection}
  3006.          ListeningSocket.Disconnect;
  3007.          if (Aborted) and (Copy(Line, 1, 3) = '426') then
  3008.          begin
  3009.             if Assigned(FAborted) then FAborted(Self);
  3010.             CallNEvents(13);
  3011.          end
  3012.          else
  3013.          begin
  3014.             errs := msgDenied;
  3015.             DoFtpError(ftpPermissionDenied);
  3016.          end;
  3017.          Ready;
  3018.       end;
  3019.    end;
  3020. end;
  3021.  
  3022. procedure TMFtp.FtpProcess;
  3023. begin
  3024.    if Line = '' then Exit;
  3025.  
  3026.    if Intermediate and (Copy(Line, 1, 4) <> Response + ' ') then
  3027.    begin
  3028.       if Copy(Line, Length(Line) - 1, 2) <> #13#10 then
  3029.          FBannerStore := FBannerStore + Line + #13#10
  3030.       else
  3031.          FBannerStore := FBannerStore + Line;
  3032.       Exit;
  3033.    end;
  3034.  
  3035.    if Line[4] = '-' then
  3036.    begin
  3037.       if not Intermediate then
  3038.       begin
  3039.          Intermediate := True;
  3040.          FBannerStore := Line;
  3041.       end;
  3042.  
  3043.       Response := Copy(Line, 1, 3);
  3044.       Exit;
  3045.    end;
  3046.  
  3047.    if Intermediate then
  3048.    begin
  3049.       Intermediate := False;
  3050.       FBanner.Clear;
  3051.       FBanner.Text := FBannerStore;
  3052.       FBanner.Add(Line);
  3053.       DoFtpInfo(ftpBannerAvailable);
  3054.    end;
  3055.  
  3056.    FLastLine := Line;
  3057.    if Assigned(NextP) then NextP(Line);
  3058. end;
  3059.  
  3060. {=========== data connection routines ===========}
  3061. procedure TMFtp.DataListConnected;
  3062. begin
  3063.    if not FPassive then
  3064.      DataSocket.Accept(ListeningSocket);
  3065.    if DataSocket.LastError <> 0 then
  3066.    begin
  3067.       if (not TransferAborted) and (DataSocket.LastError <> 10038) then FatalError(ftpDataError);
  3068.       Exit;
  3069.    end;
  3070.    Bytes := 0;
  3071.    FSuccess := True;
  3072.    StartTime := GetTickCount;
  3073.    TrTime := 0;
  3074.    DataPartialLine := '';
  3075.    DataConnected := True;
  3076.    TransferAborted := False;
  3077. end;
  3078.  
  3079. procedure TMFtp.DataListDisconnected;
  3080. var
  3081.    e: TNotifyEvent;
  3082. begin
  3083.    with DataSocket do
  3084.    begin
  3085.       e := OnReadReady;
  3086.       OnConnected := nil;
  3087.       if Assigned(e) then OnReadReady(Sender);
  3088.       TrTime := GetTickCount - StartTime;
  3089.       Disconnect;
  3090.       ListeningSocket.Disconnect;
  3091.       DoFtpInfo(ftpDirectoryRefresh);
  3092.       DoFtpInfo(ftpTransferDone);
  3093.       DataConnected := False;
  3094.       FDoingListing := False;
  3095.       ReadyPort := True;
  3096.       if ReadyMain then
  3097.          if ftpLastAction = ftplaSearch then ReadyList := True else Ready;
  3098.    end;
  3099. end;
  3100.  
  3101. procedure TMFtp.DataFileDisconnected;
  3102. var
  3103.    e: TNotifyEvent;
  3104. begin
  3105.    e := DataSocket.OnReadReady;
  3106.    if Assigned(e) then DataSocket.OnReadReady(Sender);
  3107.    TrTime := GetTickCount - StartTime;
  3108.    DataSocket.Disconnect;
  3109.    ListeningSocket.Disconnect;
  3110.    MyCloseFile;
  3111.    DoFtpInfo(ftpTransferDone);
  3112.    DataConnected := False;
  3113.    FDoingListing := False;
  3114.    ReadyPort := True;
  3115.    if ReadyMain then Ready;
  3116. end;
  3117.  
  3118. procedure TMFtp.DataRetrFile;
  3119. var
  3120.    n, Transferred:          Integer;
  3121. begin
  3122.    FDoingListing := False;
  3123.  
  3124.    repeat
  3125.       n := DataSocket.RecvBuf(@InBuffer, IN_BUFFER_SIZE);
  3126.       if DataSocket.LastError <> 0 then
  3127.       begin
  3128.          if (not TransferAborted) and (DataSocket.LastError <> 10038) then FatalError(ftpDataError);
  3129.          Exit;
  3130.       end;
  3131.       if (n = 0) or (FileOpened = False) then Exit;
  3132.       Inc(Bytes, n);
  3133.       TrTime := GetTickCount - StartTime;
  3134.       DoFtpInfo(ftpDataTrace);
  3135.  
  3136.       // if FileOpened ...
  3137.       Transferred := DataFile.Write(InBuffer, n);
  3138.       if n <> Transferred then
  3139.       begin
  3140.          DoFtpError(ftpFileWrite);
  3141.          MyCloseFile;
  3142.       end;
  3143.    until n <= 0;
  3144. end;
  3145.  
  3146. procedure TMFtp.DataDoListing;
  3147. var i, el:                      Integer;
  3148.     d:                          Boolean;
  3149.     Linein, newLine:            String;
  3150.     fname, size, date, symlink: String;
  3151.     attrib:                     String;
  3152.     owner, group:               String;
  3153. begin
  3154.    FDoingListing := True;
  3155.    i := DataSocket.RecvBuf(@InBuffer, IN_BUFFER_SIZE);
  3156.    if DataSocket.LastError <> 0 then
  3157.    begin
  3158.       if (not TransferAborted) and (DataSocket.LastError <> 10038) then FatalError(ftpDataError);
  3159.       Exit;
  3160.    end;
  3161.    InBuffer[i] := #0;
  3162.    Linein := StrPas(@InBuffer);
  3163.    if Linein = '' then Exit;
  3164.    Inc(Bytes, Length(Linein));
  3165.    Linein := DataPartialLine + Linein;
  3166.    repeat
  3167.       el := Pos(#13 + #10, Linein);
  3168.       if el <> 0 then
  3169.       begin
  3170.          newLine := Copy(Linein, 1, el - 1);
  3171.          Delete(Linein, 1, el + 1);
  3172.          TrTime := GetTickCount - StartTime;
  3173.          DoFtpInfo(ftpDataTrace, newLine);
  3174.          try
  3175.             FList.Add(newLine);
  3176.  
  3177.             Inc(pcount);
  3178.             if ParseListingLine(FtpParse.TMFtpServerType(FType), newLine, fname,
  3179.                size, date, symlink, attrib, owner, group, d) then
  3180.             begin
  3181.                if d then
  3182.                begin
  3183.                   if (fname <> '.') and (fname <> '..') then
  3184.                   begin
  3185.                      TDirectories.Add(fname, Attrib, Date, Size, Symlink, owner, group, '');
  3186.                      DoFtpInfo(ftpListingParsed, 'Folder');
  3187.                   end;
  3188.                end
  3189.                else
  3190.                begin
  3191.                   TFiles.Add(fname, Attrib, Date, Size, Symlink, owner, group, '');
  3192.                   DoFtpInfo(ftpListingParsed, 'File');
  3193.                end;
  3194.             end;
  3195.          except
  3196.          end;
  3197.       end;
  3198.    until el = 0;
  3199.  
  3200.    DataPartialLine := Linein;
  3201. end;
  3202.  
  3203. procedure TMFtp.DataStorFile(sender: TObject); {BDS}
  3204. var
  3205.    Totsent, nb, fp:         Longint;
  3206.    BlockingError:           Boolean;
  3207. begin
  3208.    nb := OUT_BUFFER_SIZE;
  3209.    if TransferAborted then
  3210.    begin
  3211.       FSuccess := False;
  3212.    end else begin
  3213.       BlockingError := False;
  3214.       repeat
  3215.          if MyEOF then Break;
  3216.          
  3217.          try
  3218.             fp := TotalBytesToSend - DataFile.Position;
  3219.             if fp < nb then
  3220.               nb := fp;
  3221.             DataFile.Read(OutBuffer, nb);
  3222. //          Inc(Bytes, nb);
  3223.          except
  3224.             DoFtpError(ftpFileRead);
  3225.             MyCloseFile;
  3226.             DataSocket.Disconnect;
  3227.             ListeningSocket.Disconnect;
  3228.             FSuccess := False;
  3229.          end;
  3230.  
  3231.          Totsent := 0;
  3232.          while Totsent < nb do
  3233.          begin
  3234.             ProcessMessages;
  3235.             if Aborted then
  3236.             begin
  3237.                FSuccess := False;
  3238.                break;
  3239.             end else begin
  3240.                DataSocket.WantBlockingErrors := True;
  3241.                Inc(Totsent, DataSocket.SendBuf(@OutBuffer[Totsent], nb - Totsent));
  3242.                DataSocket.WantBlockingErrors := False;
  3243.                BlockingError := DataSocket.LastError = WSAEWOULDBLOCK;
  3244.  
  3245.                if BlockingError then
  3246.                begin
  3247.                  DataFile.Seek(DataFile.Position - (nb - Totsent), soFromBeginning);
  3248.                  break;
  3249.                end;
  3250.  
  3251.                if (DataSocket.LastError <> 0) then
  3252.                begin
  3253.                   if not TransferAborted then FatalError(ftpDataError);
  3254.                   Inc(Bytes, Totsent);
  3255.                   Exit;
  3256.                end;
  3257.             end;
  3258.          end;
  3259.          Inc(Bytes, Totsent);
  3260.       until BlockingError or (not FSuccess);
  3261.       DoFtpInfo(ftpDataTrace);
  3262.       TrTime := GetTickCount - StartTime;
  3263.    end;
  3264.  
  3265.    // check FSuccess and done state
  3266.    if (not FSuccess) or (MyEOF) then
  3267.    begin
  3268.       DataSocket.Disconnect;
  3269.       ListeningSocket.Disconnect;
  3270.       MyCloseFile;
  3271.       TrTime := GetTickCount - TrTime;
  3272.       DoFtpInfo(ftpTransferDone);
  3273.       ReadyPort := True;
  3274.       if ReadyMain then Ready;
  3275.    end;
  3276. end;
  3277.  
  3278. procedure TMFtp.DataStorConnected; {BDS}
  3279. begin
  3280.    if not FPassive then
  3281.      DataSocket.Accept(ListeningSocket);
  3282.    if DataSocket.LastError <> 0 then
  3283.    begin
  3284.       if not TransferAborted then FatalError(ftpDataError);
  3285.       Exit;
  3286.    end;
  3287.    Bytes := 0;
  3288.    FSuccess := True;
  3289.    StartTime := GetTickCount;
  3290.    TrTime := 0;
  3291.    DataPartialLine := '';
  3292.    DataConnected := True;
  3293.    TransferAborted := False;
  3294.    FDoingListing := False;
  3295.    TotalBytesToSend := DataFile.Size;
  3296.    StartTime := GetTickCount;
  3297.    DoFtpInfo(ftpFileSize, IntToStr(DataFile.Size));
  3298. end;
  3299.  
  3300. procedure TMFtp.StopTransfer;
  3301. var data: String;
  3302. begin
  3303.    if TransferAborted then Exit;
  3304.    TransferAborted := True;
  3305.    data := #255 + #244;
  3306.    while data <> '' do
  3307.    begin
  3308.       if Aborted then Exit;
  3309.       Delete(data, 1, SendBuf(PChar(@data[1]), Length(data)));
  3310.       if CheckError then Exit;
  3311.    end;
  3312.    data := #255 + #242;
  3313.    while data <> '' do
  3314.    begin
  3315.       if Aborted then Exit;
  3316.       Delete(data, 1, SendBufOOB(PChar(@data[1]), Length(data)));
  3317.       if CheckError then Exit;
  3318.    end;
  3319.    Proceed('ABOR', NextP);
  3320.    data := #255 + #242;
  3321.    while data <> '' do
  3322.    begin
  3323.       if Aborted then Exit;
  3324.       Delete(data, 1, SendBuf(PChar(@data[1]), Length(data)));
  3325.       if CheckError then Exit;
  3326.    end;
  3327. end;
  3328.  
  3329. procedure TMFtp.Abort;
  3330. begin
  3331.    case FtpLastAction of
  3332.       ftplaGet, ftplaGETIndexFile, ftplaPut, ftplaList:
  3333.       begin
  3334.          StopTransfer;
  3335.       end;
  3336.       ftplaGETS, ftplaPUTS:
  3337.       begin
  3338.          FMFinished := True;
  3339.          StopTransfer;
  3340.       end;
  3341.       ftplaMKDS, ftplaRMDS, ftplaRMS, ftplaRENS:
  3342.       begin
  3343.          FMFinished := True;
  3344.          FMAborted := True;
  3345.       end;
  3346.       ftplaSearch:
  3347.       begin
  3348.          BAborted := True;
  3349.          FSuccess := False;
  3350.  
  3351.          ReadyCWD := True;
  3352.          ReadyList := True;
  3353.       end;
  3354.       ftplaLogin, ftplaNone:
  3355.       begin
  3356.          if not ControlLoggedIn then
  3357.          begin
  3358.             FRemain := -1;
  3359.             {$ifdef USE_RETRYING_TIMER}
  3360.             RTimer.Enabled := False;
  3361.             {$else}
  3362.             SRetry := True;
  3363.             {$endif}
  3364.             Disconnect;
  3365.  
  3366.             if Assigned(FAborted) then FAborted(Self);
  3367.             CallNEvents(13);
  3368.          end;
  3369.       end;
  3370.    end;
  3371. end;
  3372.  
  3373. function TMFtp.SetupDataPort;
  3374. var
  3375.    Line:     String;
  3376.    dataaddr: String;
  3377.    dataport: Word;
  3378.    i:        Word;
  3379. begin
  3380.    { this line should not in the with block }
  3381.    ListeningSocket.Address := GetLocalAddress;
  3382.    with ListeningSocket do
  3383.    begin
  3384.       Port := 0;
  3385.       FillAddress(Address);
  3386.       FillPort(Port);
  3387.       CreateTCPSocket;
  3388.       Listen;
  3389.       dataaddr := GetLocalAddress;
  3390.       dataport := GetLocalPort;
  3391.    end;
  3392.    DataPartialLine := '';
  3393.    i := 1;
  3394.    while i <> 0 do
  3395.    begin
  3396.       i := Pos('.', dataaddr);
  3397.       if i <> 0 then dataaddr[i] := ',';
  3398.    end;
  3399.    Line := dataaddr + ',' + IntToStr(dataport div 256) + ',' + IntToStr(dataport mod 256);
  3400.    Result := Line;
  3401. end;
  3402.  
  3403. procedure TMFtp.SetupDataPortPassive;
  3404. var p:         String;
  3405.     ps:        array[0..5] of String;
  3406.     c, l, i:   Word;
  3407. begin
  3408.    c := 0;
  3409.  
  3410.    p := copy(s, pos('(', s) + 1, length(s));
  3411.    p := copy(p, 1, pos(')', p) - 1);
  3412.    {A bug of Troll Tech ftp server(ftp.troll.no):
  3413.  
  3414.       227 Passive mode OK (195,0,254,75,42,154 )
  3415.  
  3416.     and the correct respondence is:
  3417.  
  3418.       227 Passive mode OK (195,0,254,75,42,154)
  3419.    }
  3420.    {$ifndef NOPATCH} p := Trim(p); {$endif}
  3421.  
  3422.    l := length(p);
  3423.    for i:=1 to l do
  3424.       if p[i] = ',' then
  3425.          Inc(c)
  3426.       else
  3427.          ps[c]:=ps[c] + p[i];
  3428.  
  3429.    DataPartialLine := '';
  3430.  
  3431.    with DataSocket do
  3432.    begin
  3433.       Address := ps[0] + '.' + ps[1] + '.'  + ps[2]+'.' + ps[3];
  3434.       Port := StrToInt(ps[4]) shl 8 + StrToInt(ps[5]);
  3435.       FillAddress(Address);
  3436.       FillPort(Port);
  3437.       CreateTCPSocket;
  3438.       Connect;
  3439.    end;
  3440. end;
  3441.  
  3442. function TMFtp.CheckError;
  3443. begin
  3444.    if (LastError = 0) or (Aborted) then
  3445.    begin
  3446.       FError := ftpNone;
  3447.       Result := False;
  3448.    end
  3449.    else
  3450.    begin
  3451.       case LastError of
  3452.          WSAENETDOWN:
  3453.          begin
  3454.             FError := ftpNetworkDown;
  3455.             errs := msgNetworkDown;
  3456.          end;
  3457.          WSAEACCES:
  3458.          begin
  3459.             FError := ftpInvalidAddress;
  3460.             errs := msgInvalidAddress;
  3461.          end;
  3462.          WSAENOTSOCK:
  3463.          begin
  3464.             FError := ftpNone;
  3465.             {Invalid socket specified (it is usually not a real error)}
  3466.             Result := False;
  3467.             Exit;
  3468.          end;
  3469.          WSAEINVAL:
  3470.          begin
  3471.             FError := ftpInternalError;
  3472.             errs := '';
  3473.          end;
  3474.          WSAETIMEDOUT:
  3475.          begin
  3476.             FError := ftpConnectTimeout;
  3477.             errs := msgTimeOut;
  3478.          end;
  3479.          WSAEMFILE:
  3480.          begin
  3481.             FError := ftpOutofSockets;
  3482.             errs := msgOutOfSocket;
  3483.          end;
  3484.          WSAENETUNREACH:
  3485.          begin
  3486.             FError := ftpNetworkUnreachable;
  3487.             errs := msgNetworkUR;
  3488.          end;
  3489.          WSAEADDRNOTAVAIL:
  3490.          begin
  3491.             FError := ftpAddressNotAvailable;
  3492.             errs := msgNotAvail;
  3493.          end;
  3494.          WSAECONNREFUSED:
  3495.          begin
  3496.             FError := ftpConnectionRefused;
  3497.             errs := msgRefuse;
  3498.          end;
  3499.          WSAENETRESET, WSAENOBUFS:
  3500.          begin
  3501.             FError := ftpGeneralWinsockError;
  3502.             errs := msgGeneralE;
  3503.          end;
  3504.          WSAECONNABORTED:
  3505.          begin
  3506.             FError := ftpConnAborted;
  3507.             errs := msgAborted;
  3508.          end;
  3509.          WSAECONNRESET:
  3510.          begin
  3511.             FError := ftpConnReset;
  3512.             errs := msgReset;
  3513.          end;
  3514.          WSAHOST_NOT_FOUND, WSATRY_AGAIN, WSANO_RECOVERY, WSANO_DATA:
  3515.          begin
  3516.             FError := ftpAddressResolutionError;
  3517.             errs := msgARE;
  3518.          end;
  3519.          WSAEHOSTUNREACH:
  3520.          begin
  3521.             FError := ftpHostUnreachable;
  3522.             errs := msgHostUR;
  3523.          end;
  3524.          WSAENOTCONN: { disconnected from server }
  3525.          begin
  3526.             FError := ftpNone;
  3527.             Result := False;
  3528.             Exit;
  3529.          end;
  3530.          else
  3531.        { WSAEFAULT, WSAEOPNOTSUPP, WSAESHUTDOWN, WSAEMSGSIZE, 
  3532.          WSAEADDRINUSE, WSAEINPROGRESS, WSAEINTR, WSAEAFNOSUPPORT, WSAEISCONN }
  3533.          begin
  3534.             FError := ftpInternalError;
  3535.             errs := msgUnexpected + IntToStr(LastError) + ')';
  3536.          end;
  3537.       end;
  3538. //    FRemain := -1;
  3539.       FatalError(FError);
  3540.       Result := True;
  3541.    end;
  3542. end;
  3543.  
  3544. {call this before an operation is being started}
  3545. function TMFtp.CheckStatus;
  3546. begin
  3547.    Result := False;
  3548.  
  3549.    if not ControlConnected then
  3550.    begin
  3551.       FSuccess := False;
  3552.       DoFtpInfo(ftpServerDisconnected);
  3553.       Exit;
  3554.    end;
  3555.    if FBusy then
  3556.    begin
  3557.       FSuccess := False;
  3558.       DoFtpInfo(ftpAlreadyBusy);
  3559.       Exit;
  3560.    end;
  3561.  
  3562.    FBusy := True;
  3563.    if Assigned(FFtpBusy) then FFtpBusy(Self);
  3564.    CallNEvents(12);
  3565.  
  3566.    FSuccess := True;
  3567.    NTimer.Enabled := False;
  3568.    Result := True;
  3569.  
  3570.    FError := FtpNone;
  3571. end;
  3572.  
  3573. function TMFtp.RecvText;
  3574. var
  3575.    n: Integer;
  3576.    buf: array[0..IN_BUFFER_SIZE] of Char;
  3577. begin
  3578.    n := RecvBuf(buf, IN_BUFFER_SIZE);
  3579.    buf[n] := #0;
  3580.    Result := buf;
  3581. end;
  3582.  
  3583. procedure TMFtp.NTimerTimer;
  3584. begin
  3585.    if FBusy then Exit;
  3586.    if not ControlLoggedIn then exit;
  3587.    if not FSupportNOOP then exit;
  3588.  
  3589.    FBusy := True;
  3590.    FtpLastAction := ftplaNOOP;
  3591.    Proceed('NOOP', fpNOOP);
  3592. end;
  3593.  
  3594. function TMFtp.GetInterval;
  3595. begin
  3596.    Result := NTimer.Interval div 1000;
  3597. end;
  3598.  
  3599. procedure TMFtp.SetInterval;
  3600. begin
  3601.    NTimer.Interval := I * 1000;
  3602. end;
  3603.  
  3604. {$ifdef USE_RETRYING_TIMER}
  3605. procedure TMFtp.RTimerTimer;
  3606. begin
  3607.    RTimer.Enabled := False;
  3608.    LoginMain;
  3609. end;
  3610. {$endif}
  3611.  
  3612. function TMFtp.GetStartPoint;
  3613. begin
  3614.    if (FtpLastAction = ftplaGET) or (FtpLastAction = ftplaPUT) then
  3615.       Result := FStartPoint
  3616.    else
  3617.       Result := 0;
  3618. end;
  3619.  
  3620. procedure TMFtp.SetAsync;
  3621. begin
  3622.    if not FBusy then FAsync := B;
  3623. end;
  3624.  
  3625. procedure TMFtp.SetRetries;
  3626. begin
  3627.    FRetries := I;
  3628. end;
  3629.  
  3630. function TMFtp.FileExists;
  3631. begin
  3632.    Result := FFiles.IndexOf(filename);
  3633. end;
  3634.  
  3635. function TMFtp.DirectoryExists;
  3636. begin
  3637.    Result := FDirectories.IndexOf(dir);
  3638. end;
  3639.  
  3640. procedure TMFtp.FileSetAttr;
  3641. var Value: Integer;
  3642. begin
  3643.    Value := 0;
  3644.    if OwnerRead then Inc(Value, 400);
  3645.    if OwnerWrite then Inc(Value, 200);
  3646.    if OwnerExecute then Inc(Value, 100);
  3647.    if GroupRead then Inc(Value, 40);
  3648.    if GroupWrite then Inc(Value, 20);
  3649.    if GroupExecute then Inc(Value, 10);
  3650.    if PublicRead then Inc(Value, 4);
  3651.    if PublicWrite then Inc(Value, 2);
  3652.    if PublicExecute then Inc(Value);
  3653.    Proceed('SITE CHMOD ' + IntToStr(Value)+' '+ filename, fpChmod);
  3654. end;
  3655.  
  3656. procedure TMFtp.SetTransferMode;
  3657. begin
  3658.    if M = CurrentMode then
  3659.    begin
  3660.       P('299');
  3661.    end
  3662.    else
  3663.    begin
  3664.       CurrentMode := M;
  3665.       Proceed('TYPE ' + M, P);
  3666.    end;
  3667. end;
  3668.  
  3669. procedure TMFtp.CallNEvents;
  3670. var i: Integer;
  3671. begin
  3672.    for i := 1 to MAX_HANDLERS do
  3673.       if Assigned(NEvents[EventType, i]) then NEvents[EventType, i](Self);
  3674. end;
  3675.  
  3676. function TMFtp.RegisterNotifyEvent;
  3677. var i: Integer;
  3678. begin
  3679.    if Assigned(P) then
  3680.    begin
  3681.       for i := 1 to MAX_HANDLERS do
  3682.       begin
  3683.          if not Assigned(NEvents[EventType, i]) then
  3684.          begin
  3685.             NEvents[EventType, i] := P;
  3686.             Result := i;
  3687.             Exit;
  3688.          end;
  3689.       end;
  3690.    end;
  3691.    Result := -1;
  3692. end;
  3693.  
  3694. function TMFtp.RegisterErrorEvent;
  3695. var i: Integer;
  3696. begin
  3697.    if Assigned(P) then
  3698.    begin
  3699.       for i := 1 to MAX_HANDLERS do
  3700.       begin
  3701.          if not Assigned(NOnFtpError[i]) then
  3702.          begin
  3703.             NOnFtpError[i] := P;
  3704.             Result := i;
  3705.             Exit;
  3706.          end;
  3707.       end;
  3708.    end;
  3709.    Result := -1;
  3710. end;
  3711.  
  3712. function TMFtp.RegisterInfoEvent;
  3713. var i: Integer;
  3714. begin
  3715.    if Assigned(P) then
  3716.    begin
  3717.       for i := 1 to MAX_HANDLERS do
  3718.       begin
  3719.          if not Assigned(NOnFtpInfo[i]) then
  3720.          begin
  3721.             NOnFtpInfo[i] := P;
  3722.             Result := i;
  3723.             Exit;
  3724.          end;
  3725.       end;
  3726.    end;
  3727.    Result := -1;
  3728. end;
  3729.  
  3730. procedure TMFtp.UnRegisterNotifyEvent;
  3731. begin
  3732.    NEvents[EventType, i] := nil;
  3733. end;
  3734.  
  3735. procedure TMFtp.UnRegisterErrorEvent;
  3736. begin
  3737.    NOnFtpError[i] := nil;
  3738. end;
  3739.  
  3740. procedure TMFtp.UnRegisterInfoEvent;
  3741. begin
  3742.    NOnFtpInfo[i] := nil;
  3743. end;
  3744.  
  3745. { message processing }
  3746.  
  3747. function TMFtp.ProcessMessage;
  3748. var
  3749.    Msg: TMsg;
  3750. begin
  3751.    if PeekMessage(Msg, 0, 0, 0, PM_REMOVE) then
  3752.    begin
  3753.       Result := True;
  3754.       TranslateMessage(Msg);
  3755.       DispatchMessage(Msg);
  3756.    end
  3757.    else
  3758.       Result := False;
  3759. end;
  3760.  
  3761. procedure TMFtp.ProcessMessages;
  3762. begin
  3763.    if not FMultiThreaded then
  3764.       Application.ProcessMessages
  3765.    else
  3766.       while ProcessMessage do Sleep(500);
  3767. end;
  3768.  
  3769. end.
  3770.