home *** CD-ROM | disk | FTP | other *** search
/ Delphi 2 - Developers' Solutions / Delphi 2 Developers' Solutions.iso / dds / chap09 / howto10 / delphi10 / cciccfrm.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-01-29  |  111.1 KB  |  3,279 lines
  1. unit Cciccfrm;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, ExtCtrls, StdCtrls, Buttons, Menus, FileCtrl, CCWSock, CCICCInf,
  8.   CCICCPrf, IniFiles, Gauges;
  9.  
  10. type
  11.   { This record holds the information for a number of internet connections }
  12.   PConnectionsRecord = ^TConnectionsRecord;
  13.   TConnectionsRecord = record
  14.     CProfile   : String; { Connection profile; used in lists }
  15.     CIPAddress : String; { Dotted character IP Address       }
  16.     CUserName  : String; { Login name to site; can be anonym }
  17.     CPassword  : String; { Password; won't be shown          }
  18.     CStartDir  : String; { Starting directory; used for FTP  }
  19.   end;
  20.   { Array of TCR }
  21.   CRFile = file of TConnectionsRecord; { File type for TCRec }
  22.   TCCINetCCForm = class(TForm)
  23.     MainMenu1: TMainMenu;
  24.     Network1: TMenuItem;
  25.     N1: TMenuItem;
  26.     Exit1: TMenuItem;
  27.     Services1: TMenuItem;
  28.     IPAddress1: TMenuItem;
  29.     EMail1: TMenuItem;
  30.     FTP1: TMenuItem;
  31.     UsenetNws1: TMenuItem;
  32.     WorldWideWeb1: TMenuItem;
  33.     Panel1: TPanel;
  34.     Panel2: TPanel;
  35.     Panel3: TPanel;
  36.     Panel4: TPanel;
  37.     Panel5: TPanel;
  38.     Panel6: TPanel;
  39.     ListBox1: TListBox;
  40.     Panel7: TPanel;
  41.     SpeedButton1: TSpeedButton;
  42.     SpeedButton2: TSpeedButton;
  43.     ListBox2: TListBox;
  44.     ComboBox1: TComboBox;
  45.     Button1: TButton;
  46.     Memo1: TMemo;
  47.     Files1: TMenuItem;
  48.     Edit1: TMenuItem;
  49.     Encoding1: TMenuItem;
  50.     EMail2: TMenuItem;
  51.     FTP2: TMenuItem;
  52.     News1: TMenuItem;
  53.     WWW1: TMenuItem;
  54.     Help1: TMenuItem;
  55.     Load1: TMenuItem;
  56.     Save1: TMenuItem;
  57.     Cut1: TMenuItem;
  58.     Copy1: TMenuItem;
  59.     CopytoFile1: TMenuItem;
  60.     Paste1: TMenuItem;
  61.     PastefromFile1: TMenuItem;
  62.     UUDecode1: TMenuItem;
  63.     MIMEDecode1: TMenuItem;
  64.     UUEncode1: TMenuItem;
  65.     MIMEEncode1: TMenuItem;
  66.     CheckMail1: TMenuItem;
  67.     ReplyToCurrentMessage1: TMenuItem;
  68.     SendCurrentMessage1: TMenuItem;
  69.     SendQueue1: TMenuItem;
  70.     Mailboxes1: TMenuItem;
  71.     Correspondents1: TMenuItem;
  72.     EmptyTrash1: TMenuItem;
  73.     SpeedButton4: TSpeedButton;
  74.     SpeedButton5: TSpeedButton;
  75.     SpeedButton3: TSpeedButton;
  76.     Panel8: TPanel;
  77.     Label1: TLabel;
  78.     Label2: TLabel;
  79.     ComboBox2: TComboBox;
  80.     Label3: TLabel;
  81.     ComboBox3: TComboBox;
  82.     ConnectToSite1: TMenuItem;
  83.     Disconnect1: TMenuItem;
  84.     UploadMarked1: TMenuItem;
  85.     DownloadMarked1: TMenuItem;
  86.     Directory1: TMenuItem;
  87.     ASCII1: TMenuItem;
  88.     Binary1: TMenuItem;
  89.     ASCII2: TMenuItem;
  90.     Binary2: TMenuItem;
  91.     ViewRemoteasText1: TMenuItem;
  92.     FTPSites1: TMenuItem;
  93.     ConnectToServer1: TMenuItem;
  94.     LogOffServer1: TMenuItem;
  95.     UpdateNewsgroups1: TMenuItem;
  96.     ReplyToCurrentArticle1: TMenuItem;
  97.     CreateNewMessage1: TMenuItem;
  98.     PostNewArticle1: TMenuItem;
  99.     PostCurrentArticle1: TMenuItem;
  100.     PostQueue1: TMenuItem;
  101.     SubscribedNewsgroups1: TMenuItem;
  102.     PurgeTrashedArticles1: TMenuItem;
  103.     JumptoURL1: TMenuItem;
  104.     Preferences1: TMenuItem;
  105.     Hotlists1: TMenuItem;
  106.     Contents1: TMenuItem;
  107.     About1: TMenuItem;
  108.     EMail3: TMenuItem;
  109.     FTP3: TMenuItem;
  110.     News2: TMenuItem;
  111.     WWW2: TMenuItem;
  112.     Viewer1: TMenuItem;
  113.     Files2: TMenuItem;
  114.     DownloadMarkedMessages1: TMenuItem;
  115.     Label4: TLabel;
  116.     Label5: TLabel;
  117.     ViewasText1: TMenuItem;
  118.     Change1: TMenuItem;
  119.     Create1: TMenuItem;
  120.     Delete3: TMenuItem;
  121.     ChangeLocal1: TMenuItem;
  122.     DisplayReadArticles1: TMenuItem;
  123.     Hide1: TMenuItem;
  124.     Show1: TMenuItem;
  125.     Enable1: TMenuItem;
  126.     Disable1: TMenuItem;
  127.     OpenDialog1: TOpenDialog;
  128.     SaveDialog1: TSaveDialog;
  129.     PrintDialog1: TPrintDialog;
  130.     PrinterSetupDialog1: TPrinterSetupDialog;
  131.     FindDialog1: TFindDialog;
  132.     ReplaceDialog1: TReplaceDialog;
  133.     Find1: TMenuItem;
  134.     Replace1: TMenuItem;
  135.     Print1: TMenuItem;
  136.     PrinterSetup1: TMenuItem;
  137.     HTML1: TMenuItem;
  138.     Link1: TMenuItem;
  139.     Graphic1: TMenuItem;
  140.     Anchor1: TMenuItem;
  141.     Local2: TMenuItem;
  142.     NonLocalURL1: TMenuItem;
  143.     HTTPURL1: TMenuItem;
  144.     FTPURL1: TMenuItem;
  145.     LocalGraphic1: TMenuItem;
  146.     IPGraphic1: TMenuItem;
  147.     Text1: TMenuItem;
  148.     Graphic2: TMenuItem;
  149.     Text2: TMenuItem;
  150.     Graphic3: TMenuItem;
  151.     Text3: TMenuItem;
  152.     Graphic4: TMenuItem;
  153.     Text4: TMenuItem;
  154.     Graphic5: TMenuItem;
  155.     CreateHTMLDocument1: TMenuItem;
  156.     ViewMode1: TMenuItem;
  157.     EditMode1: TMenuItem;
  158.     Paths1: TMenuItem;
  159.     ProgressInfo1: TMenuItem;
  160.     N2: TMenuItem;
  161.     ViewInEditWindow1: TMenuItem;
  162.     ViewInStatusLine1: TMenuItem;
  163.     SaveToFile1: TMenuItem;
  164.     ViewWinsockInfo1: TMenuItem;
  165.     Description1: TMenuItem;
  166.     SystemStatus1: TMenuItem;
  167.     VendorSpecific1: TMenuItem;
  168.     Gauge1: TGauge;
  169.     procedure Exit1Click(Sender: TObject);
  170.     procedure FormCreate(Sender: TObject);
  171.     procedure FormDestroy(Sender: TObject);
  172.     procedure Description1Click(Sender: TObject);
  173.     procedure SystemStatus1Click(Sender: TObject);
  174.     procedure VendorSpecific1Click(Sender: TObject);
  175.     procedure ViewInEditWindow1Click(Sender: TObject);
  176.     procedure ViewInStatusLine1Click(Sender: TObject);
  177.     procedure SaveToFile1Click(Sender: TObject);
  178.     procedure IPAddress1Click(Sender: TObject);
  179.     procedure FTP1Click(Sender: TObject);
  180.     procedure FormResize(Sender: TObject);
  181.     procedure FTPSites1Click(Sender: TObject);
  182.     procedure FTP3Click(Sender: TObject);
  183.     procedure ConnectToSite1Click(Sender: TObject);
  184.     procedure Button1Click(Sender: TObject);
  185.     procedure ViewasText1Click(Sender: TObject);
  186.     procedure Disconnect1Click(Sender: TObject);
  187.     procedure ToDisplay1Click(Sender: TObject);
  188.     procedure ToFile1Click(Sender: TObject);
  189.     procedure Binary2Click(Sender: TObject);
  190.     procedure Change1Click(Sender: TObject);
  191.     procedure ChangeLocal1Click(Sender: TObject);
  192.     procedure ListBox1DblClick(Sender: TObject);
  193.     procedure ListBox2DblClick(Sender: TObject);
  194.     procedure ASCII1Click(Sender: TObject);
  195.     procedure DeleteRemoteFiles1Click(Sender: TObject);
  196.     procedure Binary1Click(Sender: TObject);
  197.     procedure Delete3Click(Sender: TObject);
  198.     procedure Create1Click(Sender: TObject);
  199.   private
  200.     { Private declarations }
  201.   public
  202.     { Public declarations }
  203.     procedure EnableFTPMenus;
  204.     procedure DisableFTPMenus;
  205.     procedure UpdateGauge( BytesFinished , TotalToHandle : longint );
  206.     function DoFTPConnection( PCRPointer : PConnectionsRecord ) : boolean;
  207.     procedure DoFTPDisconnect;
  208.     procedure ReadIniData;
  209.     procedure WriteIniData;
  210.     procedure LoadFTPSiteFile;
  211.     procedure SaveFTPSiteFile;
  212.     procedure SetupFTPSiteLists;
  213.     procedure AddNullTermTextToMemo( TheTextToAdd   : String;
  214.                                      TheMemoToAddTo : TMemo   );
  215.     function AddNullTermTextToLabel( TheTextToAdd   : String ) : String;
  216.     procedure SetHGCursors;
  217.     procedure SetNormalCursors;
  218.     procedure AddProgressText( WhatText : String );
  219.     procedure ShowProgressText( WhatText : String );
  220.     procedure ShowProgressErrorText( WhatText : String );
  221.     procedure SocketsErrorOccurred( Sender     : TObject;
  222.                                      ErrorCode  : Integer;
  223.                                      TheMessage : String   );
  224.   end;
  225.   { Component to hold FTP handling capabilities }
  226.   TFTPComponent = class( TWinControl )
  227.   public
  228.     FTPCommandInProgress ,
  229.     Connection_Established : Boolean;
  230.     Socket1 : TCCSocket;
  231.     Socket2 : TCCSocket;
  232.     constructor Create( AOwner : TComponent ); override;
  233.     destructor Destroy; override;
  234.     function GetTotalBytesToReceive( TheString : String ) : Longint;
  235.     function StripBrackets( TheString : String ) : String;
  236.     function GetShortPathname( TheString : String ) : String;
  237.     function GetWin16FileName( InputName : String ) : String;
  238.     function GetRemoteWorkingDirectory( var RemoteDir : String ) : Boolean;
  239.     function SetRemoteDirectory( TheDir : String ) : Boolean;
  240.     function DeleteRemoteDirectory( TheDir : String ) : Boolean;
  241.     function CreateRemoteDirectory( TheDir : String ) : Boolean;
  242.     function DeleteRemoteFile( TheFileName : String ) : Boolean;
  243.     function EstablishConnection( PCRPointer : PConnectionsRecord ) : Boolean;
  244.     function LoginUser( PCRPointer : PConnectionsRecord ) : Boolean;
  245.     function SendPassword( PCRPointer : PConnectionsRecord ) : Boolean;
  246.     function SetRemoteStartupDirectory( PCRPointer : PConnectionsRecord )
  247.               : Boolean;
  248.     function GetRemoteDirectoryListing( TheListBox : TListBox ) : Boolean;
  249.     function GetRemoteDirectoryListingToMemo : Boolean;
  250.     procedure SendASCIILocalFile( LocalName : String );
  251.     procedure SendBinaryLocalFile( LocalName : String );
  252.     procedure ReceiveASCIIRemoteFile( RemoteName , LocalName : String );
  253.     procedure ReceiveBinaryRemoteFile( RemoteName , LocalName : String );
  254.     function GetLocalDirectoryAndListing( var TheString : String;
  255.                                               TheListBox : TListBox )
  256.               : Boolean;
  257.     function GetUNIXTextString( var StringIn : String ) : String;
  258.     procedure ReceiveASCIIRemoteFileToMemo( RemoteName : String );
  259.     function GetListeningPort : Integer;
  260.     procedure GetFileNameFromUNIXFileName( var TheName : String );
  261.     function Disconnect : Boolean;
  262.     function DoCStyleFormat(       TheText      : string;
  263.                              const TheArguments : array of const ) : String;
  264.     procedure UpdateGauge( BytesFinished , TotalToHandle : longint );
  265.     function GetQuotedString( TheString : String ) : String;
  266.     procedure AddProgressText( WhatText : String );
  267.     procedure ShowProgressText( WhatText : String );
  268.     procedure ShowProgressErrorText( WhatText : String );
  269.     function GetFTPServerResponse( var ResponseString : String ) : integer;
  270.     procedure FTPSocketsErrorOccurred( Sender     : TObject;
  271.                                      ErrorCode  : Integer;
  272.                                      TheMessage : String   );
  273.     function PerformFTPCommand(
  274.                     TheCommand   : string;
  275.               const TheArguments : array of const ) : Integer;
  276.   end;
  277. const
  278.   POV_MEMO                 = 1; { Progress to the Memo           }
  279.   POV_STAT                 = 2; { Progress to the status caption }
  280.   FTP_STATUS_PRELIMINARY   = 1; { Wait; command being processed  }
  281.   FTP_STATUS_COMPLETED     = 2; { Done; command fully succeded   }
  282.   FTP_STATUS_CONTINUING    = 3; { OK; send more data to finish   }
  283.   FTP_STATUS_RETRY_COMMAND = 4; { Temporary Error; try cmd again }
  284.   FTP_STATUS_FATAL_ERROR   = 5; { Fatal Error; don't retry cmd   }
  285.  
  286. var
  287.   CCINetCCForm         : TCCINetCCForm;
  288.   GlobalErrorCode      : Integer;        { Used to pass around error info  }
  289.   GlobalAbortedFlag    : Boolean;        { Used to signal timeout error    }
  290.   ProgressList         : TStringList;    { Used to hold progress text info }
  291.   ProgressFileName     : String;         { Used to hold progress file name }
  292.   ProgressOutputVector : Integer;        { Used to direct progress output  }
  293.   TheFTPSiteList       : TList;          { Used to store the FTP site recs }
  294.   TheWorkingFTPSL      : TList;          { Used to store working copy of l }
  295.   TheFTPSiteFile       : CRFile;         { Used to load the FTP site file  }
  296.   TheICCIniFile        : TIniFile;       { Used to retrieve the INI File   }
  297.   MailPath             : String;         { Used for path to Mail Files     }
  298.   NewsPath             : String;         { Used for path to News Files     }
  299.   WWWPath              : String;         { Used for path to WWW Files      }
  300.   FTPPath              : String;         { Used for path to FTP Files      }
  301.   CurrentPassWordString : String;        { Used to hold login id for anons }
  302.   PassWordControlVector : Integer;       { Used to hold display of pw vect }
  303.   CurrentRealPWString   : String;        { Used to hold a real password    }
  304.   TheFTPComponent       : TFTPComponent; { FTP Object                      }
  305.   TheLine ,
  306.   HolderLine ,
  307.   GlobalTextBuffer      : String;
  308.   TheAnonRedialVector ,
  309.   DefaultDownloadVector : Integer;
  310.   LeftoverText          : String;
  311.   LeftoversOnTable      : Boolean;
  312.   FileNameToXFer        : String;
  313.  
  314. implementation
  315.  
  316. {$R *.DFM}
  317.  
  318. { This is the FTP component constructor; it creates 2 sockets }
  319. constructor TFTPComponent.Create( AOwner : TComponent );
  320. begin
  321.   { do inherited create }
  322.   inherited Create( AOwner );
  323.   { Create sockets, put in their parents, and error procs }
  324.   Socket1 := TCCSocket.Create( Self );
  325.   Socket1.Parent := Self;
  326.   Socket1.OnErrorOccurred := FTPSocketsErrorOccurred;
  327.   Socket2 := TCCSocket.Create( Self );
  328.   Socket2.Parent := Self;
  329.   Socket2.OnErrorOccurred := FTPSocketsErrorOccurred;
  330.   { Set up booleans }
  331.   Connection_Established := false;
  332.   FTPCommandInProgress := false;
  333. end;
  334.  
  335. { This is the FTP component destructor; it frees 2 sockets }
  336. destructor TFTPComponent.Destroy;
  337. begin
  338.   { Free the sockets }
  339.   Socket1.Free;
  340.   Socket2.Free;
  341.   { and call inherited }
  342.   inherited Destroy;
  343. end;
  344.  
  345. function TFTPComponent.GetShortPathname( TheString : String ) : String;
  346. var HoldingString : String;
  347. begin
  348.   HoldingString := Copy( TheString , 1 , 3 );
  349.   HoldingString := HoldingString + '..\' + ExtractFileName( TheString );
  350.   Result := HoldingString;
  351. end;
  352.  
  353. function TFTPComponent.StripBrackets( TheString : String ) : String;
  354. var HoldingString : String;
  355.     HoldingPosition : Integer;
  356. begin
  357.   HoldingPosition := Pos( '[' , TheString );
  358.   if HoldingPosition = 0 then
  359.   begin
  360.     Result := TheString;
  361.     exit;
  362.   end
  363.   else
  364.   begin
  365.     HoldingString := Copy( TheString , HoldingPosition + 1 , 255 );
  366.     HoldingPosition := Pos( ']' , HoldingString );
  367.     if HoldingPosition = 0 then
  368.     begin
  369.       Result := HoldingString;
  370.       exit;
  371.     end
  372.     else
  373.     begin
  374.       HoldingString := Copy( HoldingString , 1 , HoldingPosition - 1 );
  375.       Result := HoldingString;
  376.       exit;
  377.     end;
  378.   end;
  379. end;
  380.  
  381. { This function takes a UNIX filespec and turns it into a Win16 filename }
  382. function TFTPComponent.GetWin16FileName( InputName : String ) : String;
  383. var WorkingString ,
  384.     HoldingString   : String; { Holding string }
  385. begin
  386.   WorkingString := ExtractFileExt( InputName );
  387.   if WorkingString = '' then
  388.   begin
  389.     if Length( InputName ) > 8 then
  390.      WorkingString := Copy( InputName , 1 , 8 ) else
  391.       WorkingString := InputName;
  392.   end
  393.   else
  394.   begin
  395.     if Length( WorkingString ) > 4 then
  396.      WorkingString := Copy( WorkingString , 1 , 4 );
  397.     HoldingString :=
  398.      Copy( InputName , 1 , Pos( WorkingString , InputName ) - 1 );
  399.     if Length( HoldingString ) > 8 then
  400.      HoldingString := Copy( HoldingString , 1 , 8 );
  401.     if HoldingString = '' then
  402.     begin
  403.       { Dot file }
  404.       HoldingString := Copy( InputName , 2 , 255 ) + '.TXT';
  405.       WorkingString := HoldingString;
  406.     end
  407.     else WorkingString := HoldingString + WorkingString;
  408.   end;
  409.   Result := WorkingString;
  410. end;
  411.  
  412. { This sends a local file in binary mode to the remote server }
  413. procedure TFTPComponent.SendBinaryLocalFile( LocalName : String );
  414. var TheReturnString : String;  { Internal string holder }
  415.     TheResult       : Integer; { Internal int holder    }
  416.     InputString     : String;
  417.     Through ,
  418.     Finished        : Boolean;
  419.     FileNamePChar   : array[ 0 .. 255 ] of char;
  420.     OutputFileHandle : Integer;
  421.     TotalBytesSent ,
  422.     BytesRead ,
  423.     FileToSendSize    : Longint;
  424.     CopyBuffer       : array[ 0 .. 255 ] of char absolute TheReturnString;
  425. begin
  426.   LocalName := ExpandFileName( LocalName );
  427.   StrPCopy( FileNamePChar , LocalName );
  428.   OutputFileHandle := _lopen( FileNamePChar , 0 );
  429.   if OutputFileHandle = -1 then
  430.   begin
  431.     MessageDlg( 'Cannot Open local file ' + LocalName ,
  432.      mtError , [mbOK] , 0 );
  433.     exit;
  434.   end;
  435.   FileToSendSize := _llseek( OutputFileHandle , 0 , 2 );
  436.   _llseek( OutputFileHandle , 0 , 0 );
  437.   TheReturnString :=
  438.    DoCStyleFormat( 'TYPE I' ,
  439.     [ nil ] );
  440.   { Put result in progress and status line }
  441.   AddProgressText( TheReturnString );
  442.   ShowProgressText( TheReturnString );
  443.   { Send Password sequence }
  444.   TheResult := PerformFTPCommand( 'TYPE I',
  445.                                   [ nil ] );
  446.   if TheResult <> FTP_STATUS_PRELIMINARY then
  447.   begin
  448.     FTPCommandInProgress := false;
  449.     exit;
  450.   end;
  451.   repeat
  452.     TheResult := GetFTPServerResponse( TheReturnString );
  453.     { Put result in progress and status line }
  454.     AddProgressText( TheReturnString );
  455.     ShowProgressText( TheReturnString );
  456.   until (( GlobalAbortedFlag ) or ( TheResult <> FTP_STATUS_PRELIMINARY ));
  457.   FTPCommandInProgress := false;
  458.   if ( GlobalAbortedFlag or ( TheResult <> FTP_STATUS_COMPLETED )) then
  459.   begin
  460.     { Do clever C formatting trick }
  461.     TheReturnString :=
  462.      DoCStyleFormat( 'FTP File Send Failed!' ,
  463.       [ nil ] );
  464.     { Put result in progress and status line }
  465.     AddProgressText( TheReturnString );
  466.     ShowProgressErrorText( TheReturnString );
  467.     { leave }
  468.     exit;
  469.   end
  470.   else
  471.   begin
  472.     { Set up socket 2 for listening }
  473.     Socket2.AsynchMode := False;
  474.     Socket2.NonAsynchTimeoutValue := 60;
  475.     { do a listen and send command to server that this is receipt socket }
  476.     if GetListeningPort = FTP_STATUS_FATAL_ERROR then
  477.     begin
  478.       Socket2.CCSockCancelListen;
  479.       exit;
  480.     end;
  481.     Socket1.NonAsynchTimeoutValue := 0; {infinite timeout}
  482.     TheReturnString :=
  483.      DoCStyleFormat( 'STOR %s' ,
  484.       [ ExtractFileName( LocalName ) ] );
  485.     { Put result in progress and status line }
  486.     AddProgressText( TheReturnString );
  487.     ShowProgressText( TheReturnString );
  488.     TheResult := PerformFTPCommand( 'STOR %s' , [ ExtractFileName( LocalName ) ] );
  489.     GetFTPServerResponse( TheReturnString );
  490.     AddProgressText( TheReturnString );
  491.     ShowProgressText( TheReturnString );
  492.     Socket1.NonAsynchTimeoutValue := 30;
  493.     if (( TheResult = FTP_STATUS_RETRY_COMMAND ) or
  494.        ( TheResult = FTP_STATUS_FATAL_ERROR )) then
  495.     begin
  496.       TheReturnString :=
  497.        DoCStyleFormat( 'Could not create remote file!' ,
  498.         [ nil ] );
  499.       { Put result in progress and status line }
  500.       AddProgressText( TheReturnString );
  501.       ShowProgressErrorText( TheReturnString );
  502.       Socket2.CCSockCancelListen;
  503.       exit;
  504.     end;
  505.     Socket2.CCSockAccept;
  506.     if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 )) then
  507.     begin
  508.       TheReturnString :=
  509.        DoCStyleFormat( 'Could not establish send socket!' ,
  510.         [ nil ] );
  511.       { Put result in progress and status line }
  512.       AddProgressText( TheReturnString );
  513.       ShowProgressErrorText( TheReturnString );
  514.       exit;
  515.     end;
  516.     Through := false;
  517.     TotalBytesSent := 0;
  518.     BytesRead := _lread( OutputFileHandle , @CopyBuffer[ 1 ] , 255 );
  519.     repeat
  520.       if BytesRead = 0 then Through := true;
  521.       if BytesRead > 0 then
  522.       begin
  523.         CopyBuffer[ 0 ] := Chr( BytesRead );
  524.         Socket2.StringData := TheReturnString;
  525.         TotalBytesSent := TotalBytesSent + BytesRead;
  526.         UpdateGauge( TotalBytesSent , FileToSendSize );
  527.         BytesRead := _lread( OutputFileHandle , @CopyBuffer[ 1 ] , 255 );
  528.         if BytesRead = -1 then
  529.         begin
  530.           MessageDlg( 'File Read Error on ' + LocalName , mtError , [mbOK] , 0 );
  531.           GlobalAbortedFlag := True;
  532.         end;
  533.       end;
  534.       if GlobalAbortedFlag then
  535.       begin
  536.         Socket1.OutOfBand := 'ABOR'+#13#10;
  537.         repeat
  538.           TheResult := GetFTPServerResponse( TheReturnString );
  539.           { Put result in progress and status line }
  540.           AddProgressText( TheReturnString );
  541.           ShowProgressText( TheReturnString );
  542.         until (( GlobalAbortedFlag ) or ( TheResult <> FTP_STATUS_PRELIMINARY ));
  543.         exit;
  544.       end;
  545.     until Through;
  546.     FTPCommandInProgress := false;
  547.     { cancel listening on second socket and close it }
  548.     Socket2.CCSockCancelListen;
  549.     Socket2.CCSockClose;
  550.     TheReturnString := 'Transfer Succeeded' + #13#10;
  551.     AddProgressText( TheReturnString );
  552.     ShowProgressText( TheReturnString );
  553.     FTPCommandInProgress := false;
  554.     TheResult := PerformFTPCommand( 'TYPE A',
  555.                                     [ nil ] );
  556.     Through := false;
  557.     repeat
  558.       TheResult := GetFTPServerResponse( TheReturnString );
  559.       if Pos( 'TYPE' , Uppercase( TheReturnString )) > 0 then
  560.        Through := true;
  561.       { Put result in progress and status line }
  562.       AddProgressText( TheReturnString );
  563.       ShowProgressText( TheReturnString );
  564.     until (( GlobalAbortedFlag ) or Through );
  565.   end;
  566.   _lclose( OutputFileHandle );
  567.   FTPCommandInProgress := false;
  568. end;
  569.  
  570. { This sends a local file in ascii mode to remote server }
  571. procedure TFTPComponent.SendASCIILocalFile( LocalName : String );
  572. var TheReturnString : String;  { Internal string holder }
  573.     TheResult       : Integer; { Internal int holder    }
  574.     InputString     : String;
  575.     Through ,
  576.     Finished        : Boolean;
  577.     FileNamePChar   : array[ 0 .. 255 ] of char;
  578.     OutputFileHandle : Integer;
  579.     TotalBytesSent ,
  580.     BytesRead ,
  581.     FileToSendSize    : Longint;
  582.     CopyBuffer       : array[ 0 .. 255 ] of char absolute TheReturnString;
  583. begin
  584.   LocalName := ExpandFileName( LocalName );
  585.   StrPCopy( FileNamePChar , LocalName );
  586.   OutputFileHandle := _lopen( FileNamePChar , 0 );
  587.   if OutputFileHandle = -1 then
  588.   begin
  589.     MessageDlg( 'Cannot Open local file ' + LocalName ,
  590.      mtError , [mbOK] , 0 );
  591.     exit;
  592.   end;
  593.   FileToSendSize := _llseek( OutputFileHandle , 0 , 2 );
  594.   _llseek( OutputFileHandle , 0 , 0 );
  595.   TheReturnString :=
  596.    DoCStyleFormat( 'TYPE A' ,
  597.     [ nil ] );
  598.   { Put result in progress and status line }
  599.   AddProgressText( TheReturnString );
  600.   ShowProgressText( TheReturnString );
  601.   { Send Password sequence }
  602.   TheResult := PerformFTPCommand( 'TYPE A',
  603.                                   [ nil ] );
  604.   if TheResult <> FTP_STATUS_PRELIMINARY then
  605.   begin
  606.     FTPCommandInProgress := false;
  607.     exit;
  608.   end;
  609.   repeat
  610.     TheResult := GetFTPServerResponse( TheReturnString );
  611.     { Put result in progress and status line }
  612.     AddProgressText( TheReturnString );
  613.     ShowProgressText( TheReturnString );
  614.   until (( GlobalAbortedFlag ) or ( TheResult <> FTP_STATUS_PRELIMINARY ));
  615.   FTPCommandInProgress := false;
  616.   if ( GlobalAbortedFlag or ( TheResult <> FTP_STATUS_COMPLETED )) then
  617.   begin
  618.     { Do clever C formatting trick }
  619.     TheReturnString :=
  620.      DoCStyleFormat( 'FTP File Send Failed!' ,
  621.       [ nil ] );
  622.     { Put result in progress and status line }
  623.     AddProgressText( TheReturnString );
  624.     ShowProgressErrorText( TheReturnString );
  625.     { leave }
  626.     exit;
  627.   end
  628.   else
  629.   begin
  630.     { Set up socket 2 for listening }
  631.     Socket2.AsynchMode := False;
  632.     Socket2.NonAsynchTimeoutValue := 60;
  633.     { do a listen and send command to server that this is receipt socket }
  634.     if GetListeningPort = FTP_STATUS_FATAL_ERROR then
  635.     begin
  636.       Socket2.CCSockCancelListen;
  637.       exit;
  638.     end;
  639.     Socket1.NonAsynchTimeoutValue := 0; {infinite timeout}
  640.     TheReturnString :=
  641.      DoCStyleFormat( 'STOR %s' ,
  642.       [ ExtractFileName( LocalName ) ] );
  643.     { Put result in progress and status line }
  644.     AddProgressText( TheReturnString );
  645.     ShowProgressText( TheReturnString );
  646.     TheResult := PerformFTPCommand( 'STOR %s' , [ ExtractFileName( LocalName )]);
  647.     GetFTPServerResponse( TheReturnString );
  648.     AddProgressText( TheReturnString );
  649.     ShowProgressText( TheReturnString );
  650.     Socket1.NonAsynchTimeoutValue := 30;
  651.     if (( TheResult = FTP_STATUS_RETRY_COMMAND ) or
  652.        ( TheResult = FTP_STATUS_FATAL_ERROR )) then
  653.     begin
  654.       TheReturnString :=
  655.        DoCStyleFormat( 'Could not create remote file!' ,
  656.         [ nil ] );
  657.       { Put result in progress and status line }
  658.       AddProgressText( TheReturnString );
  659.       ShowProgressErrorText( TheReturnString );
  660.       Socket2.CCSockCancelListen;
  661.       exit;
  662.     end;
  663.     Socket2.CCSockAccept;
  664.     if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 )) then
  665.     begin
  666.       TheReturnString :=
  667.        DoCStyleFormat( 'Could not establish send socket!' ,
  668.         [ nil ] );
  669.       { Put result in progress and status line }
  670.       AddProgressText( TheReturnString );
  671.       ShowProgressErrorText( TheReturnString );
  672.       exit;
  673.     end;
  674.     Through := false;
  675.     TotalBytesSent := 0;
  676.     BytesRead := _lread( OutputFileHandle , @CopyBuffer[ 1 ] , 255 );
  677.     repeat
  678.       if BytesRead = 0 then Through := true;
  679.       if BytesRead > 0 then
  680.       begin
  681.         CopyBuffer[ 0 ] := Chr( BytesRead );
  682.         Socket2.StringData := TheReturnString;
  683.         TotalBytesSent := TotalBytesSent + BytesRead;
  684.         UpdateGauge( TotalBytesSent , FileToSendSize );
  685.         BytesRead := _lread( OutputFileHandle , @CopyBuffer[ 1 ] , 255 );
  686.         if BytesRead = -1 then
  687.         begin
  688.           MessageDlg( 'File Read Error on ' + LocalName , mtError , [mbOK] , 0 );
  689.           GlobalAbortedFlag := True;
  690.         end;
  691.       end;
  692.       if GlobalAbortedFlag then
  693.       begin
  694.         Socket1.OutOfBand := 'ABOR'+#13#10;
  695.         repeat
  696.           TheResult := GetFTPServerResponse( TheReturnString );
  697.           { Put result in progress and status line }
  698.           AddProgressText( TheReturnString );
  699.           ShowProgressText( TheReturnString );
  700.         until (( GlobalAbortedFlag ) or ( TheResult <> FTP_STATUS_PRELIMINARY ));
  701.         exit;
  702.       end;
  703.     until Through;
  704.     { cancel listening on second socket and close it }
  705.     Socket2.CCSockCancelListen;
  706.     Socket2.CCSockClose;
  707.     TheReturnString := 'Transfer Succeeded' + #13#10;
  708.     AddProgressText( TheReturnString );
  709.     ShowProgressText( TheReturnString );
  710.     FTPCommandInProgress := false;
  711.     TheResult := PerformFTPCommand( 'TYPE A',
  712.                                     [ nil ] );
  713.     Through := false;
  714.     repeat
  715.       TheResult := GetFTPServerResponse( TheReturnString );
  716.       if Pos( 'TYPE' , Uppercase( TheReturnString )) > 0 then
  717.        Through := true;
  718.       { Put result in progress and status line }
  719.       AddProgressText( TheReturnString );
  720.       ShowProgressText( TheReturnString );
  721.     until (( GlobalAbortedFlag ) or Through );
  722.   end;
  723.   _lclose( OutputFileHandle );
  724.   FTPCommandInProgress := false;
  725. end;
  726.  
  727. { This function strips out the FTP response for bytes to send }
  728. function TFTPComponent.GetTotalBytesToReceive( TheString : String ) : Longint;
  729. var
  730.   LeftPosition ,
  731.   RightPosition  : integer;
  732.   TempString     : string;
  733. begin
  734.   LeftPosition := Pos( '(' , TheString );
  735.   TempString := Copy( TheString ,
  736.                       LeftPosition + 1 , 255 );
  737.   RightPosition := Pos( ' ' , TempString );
  738.   if (( LeftPosition = 0 ) or ( RightPosition = 0 )) then
  739.   begin
  740.     Result := 0;
  741.     exit;
  742.   end;
  743.   if RightPosition <> 0 then
  744.     TempString := Copy( TempString , 1 , RightPosition - 1  );
  745.   try
  746.     Result := StrToInt( TempString );
  747.   except
  748.     on EConvertError do Result := 0;
  749.   end;
  750. end;
  751.  
  752. procedure TFTPComponent.UpdateGauge( BytesFinished , TotalToHandle : longint );
  753. begin
  754.   CCInetCCForm.UpdateGauge( BytesFinished , TotalToHandle );
  755. end;
  756.  
  757. { This sends FTP progress text to the Inet form }
  758. procedure TFTPComponent.AddProgressText( WhatText : String );
  759. begin
  760.   CCInetCCForm.AddProgressText( WhatText );
  761. end;
  762.  
  763. { This sends FTP progress text to the Inet form }
  764. procedure TFTPComponent.ShowProgressText( WhatText : String );
  765. begin
  766.   CCInetCCForm.ShowProgressText( WhatText );
  767. end;
  768.  
  769. { This procedure receives a binary remote file }
  770. procedure TFTPComponent.ReceiveASCIIRemoteFileToMemo( RemoteName : String );
  771. var TheReturnString : String;  { Internal string holder }
  772.     TheResult       : Integer; { Internal int holder    }
  773.     InputString     : String;
  774.     Through ,
  775.     Finished        : Boolean;
  776.     TotalBytesSent ,
  777.     FileToGetSize    : Longint;
  778. begin
  779.   TheReturnString :=
  780.    DoCStyleFormat( 'TYPE A' ,
  781.     [ nil ] );
  782.   { Put result in progress and status line }
  783.   AddProgressText( TheReturnString );
  784.   ShowProgressText( TheReturnString );
  785.   { Send Password sequence }
  786.   FTPCommandInProgress := false;
  787.   TheResult := PerformFTPCommand( 'TYPE A',
  788.                                   [ nil ] );
  789.   if TheResult <> FTP_STATUS_PRELIMINARY then
  790.   begin
  791.     FTPCommandInProgress := false;
  792.     exit;
  793.   end;
  794.   repeat
  795.     TheResult := GetFTPServerResponse( TheReturnString );
  796.     { Put result in progress and status line }
  797.     AddProgressText( TheReturnString );
  798.     ShowProgressText( TheReturnString );
  799.   until (( GlobalAbortedFlag ) or ( TheResult <> FTP_STATUS_PRELIMINARY ));
  800.   FTPCommandInProgress := false;
  801.   if ( GlobalAbortedFlag or ( TheResult <> FTP_STATUS_COMPLETED )) then
  802.   begin
  803.     { Do clever C formatting trick }
  804.     TheReturnString :=
  805.      DoCStyleFormat( 'FTP File Receive Failed!' ,
  806.       [ nil ] );
  807.     { Put result in progress and status line }
  808.     AddProgressText( TheReturnString );
  809.     ShowProgressErrorText( TheReturnString );
  810.     { leave }
  811.     exit;
  812.   end
  813.   else
  814.   begin
  815.     { Set up socket 2 for listening }
  816.     Socket2.AsynchMode := False;
  817.     Socket2.NonAsynchTimeoutValue := 60;
  818.     { do a listen and send command to server that this is receipt socket }
  819.     if GetListeningPort = FTP_STATUS_FATAL_ERROR then
  820.     begin
  821.       Socket2.CCSockCancelListen;
  822.       exit;
  823.     end;
  824.     Socket1.NonAsynchTimeoutValue := 0; {infinite timeout}
  825.     TheReturnString :=
  826.      DoCStyleFormat( 'RETR %s' ,
  827.       [ RemoteName ] );
  828.     { Put result in progress and status line }
  829.     AddProgressText( TheReturnString );
  830.     ShowProgressText( TheReturnString );
  831.     TheResult := PerformFTPCommand( 'RETR %s' , [RemoteName] );
  832.     GetFTPServerResponse( TheReturnString );
  833.     AddProgressText( TheReturnString );
  834.     ShowProgressText( TheReturnString );
  835.     FileToGetSize := GetTotalBytesToReceive( TheReturnString );
  836.     Socket1.NonAsynchTimeoutValue := 30;
  837.     if (( TheResult = FTP_STATUS_RETRY_COMMAND ) or
  838.        ( TheResult = FTP_STATUS_FATAL_ERROR )) then
  839.     begin
  840.       TheReturnString :=
  841.        DoCStyleFormat( 'Could not obtain remote file!' ,
  842.         [ nil ] );
  843.       { Put result in progress and status line }
  844.       AddProgressText( TheReturnString );
  845.       ShowProgressErrorText( TheReturnString );
  846.       Socket2.CCSockCancelListen;
  847.       exit;
  848.     end;
  849.     Socket2.CCSockAccept;
  850.     if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 )) then
  851.     begin
  852.       TheReturnString :=
  853.        DoCStyleFormat( 'Could not establish receive socket!' ,
  854.         [ nil ] );
  855.       { Put result in progress and status line }
  856.       AddProgressText( TheReturnString );
  857.       ShowProgressErrorText( TheReturnString );
  858.       exit;
  859.     end;
  860.     Through := false;
  861.     TotalBytesSent := 0;
  862.     repeat
  863.       TheReturnString := Socket2.StringData;
  864.       if Length( TheReturnString ) = 0 then Through := true;
  865.       if Length( TheReturnString ) > 0 then
  866.       begin
  867.         TotalBytesSent := TotalBytesSent + Length( TheReturnString );
  868.         UpdateGauge( TotalBytesSent , FileToGetSize );
  869.         { Put result in progress and status line }
  870.         AddProgressText( TheReturnString );
  871.         ShowProgressText( TheReturnString );
  872.       end;
  873.       if GlobalAbortedFlag then
  874.       begin
  875.         Socket1.OutOfBand := 'ABOR'+#13#10;
  876.         repeat
  877.           TheResult := GetFTPServerResponse( TheReturnString );
  878.           { Put result in progress and status line }
  879.           AddProgressText( TheReturnString );
  880.           ShowProgressText( TheReturnString );
  881.         until (( GlobalAbortedFlag ) or ( TheResult <> FTP_STATUS_PRELIMINARY ));
  882.         exit;
  883.       end;
  884.     until Through;
  885.     { cancel listening on second socket and close it }
  886.     Socket2.CCSockCancelListen;
  887.     Socket2.CCSockClose;
  888.     FTPCommandInProgress := false;
  889.     TheResult := PerformFTPCommand( 'TYPE A',
  890.                                     [ nil ] );
  891.     Through := false;
  892.     repeat
  893.       TheResult := GetFTPServerResponse( TheReturnString );
  894.       if Pos( 'TYPE' , Uppercase( TheReturnString )) > 0 then
  895.        Through := true;
  896.       { Put result in progress and status line }
  897.       AddProgressText( TheReturnString );
  898.       ShowProgressText( TheReturnString );
  899.     until (( GlobalAbortedFlag ) or Through );
  900.   end;
  901.   FTPCommandInProgress := false;
  902. end;
  903.  
  904. { This procedure receives a binary remote file }
  905. procedure TFTPComponent.ReceiveASCIIRemoteFile( RemoteName , LocalName : String );
  906. var TheReturnString : String;  { Internal string holder }
  907.     TheResult       : Integer; { Internal int holder    }
  908.     InputString     : String;
  909.     Through ,
  910.     Finished        : Boolean;
  911.     FileNamePChar   : array[ 0 .. 255 ] of char;
  912.     OutputFileHandle : Integer;
  913.     TotalBytesSent ,
  914.     FileToGetSize    : Longint;
  915.     CopyBuffer       : array[ 0 .. 255 ] of char;
  916. begin
  917.   LocalName := ExpandFileName( LocalName );
  918.   StrPCopy( FileNamePChar , LocalName );
  919.   OutputFileHandle := _lcreat( FileNamePChar , 0 );
  920.   if OutputFileHandle = -1 then
  921.   begin
  922.     MessageDlg( 'Cannot Create local file ' + LocalName ,
  923.      mtError , [mbOK] , 0 );
  924.     exit;
  925.   end;
  926.   TheReturnString :=
  927.    DoCStyleFormat( 'TYPE A' ,
  928.     [ nil ] );
  929.   { Put result in progress and status line }
  930.   AddProgressText( TheReturnString );
  931.   ShowProgressText( TheReturnString );
  932.   { Send Password sequence }
  933.   TheResult := PerformFTPCommand( 'TYPE A',
  934.                                   [ nil ] );
  935.   if TheResult <> FTP_STATUS_PRELIMINARY then
  936.   begin
  937.     FTPCommandInProgress := false;
  938.     exit;
  939.   end;
  940.   repeat
  941.     TheResult := GetFTPServerResponse( TheReturnString );
  942.     { Put result in progress and status line }
  943.     AddProgressText( TheReturnString );
  944.     ShowProgressText( TheReturnString );
  945.   until (( GlobalAbortedFlag ) or ( TheResult <> FTP_STATUS_PRELIMINARY ));
  946.   FTPCommandInProgress := false;
  947.   if ( GlobalAbortedFlag or ( TheResult <> FTP_STATUS_COMPLETED )) then
  948.   begin
  949.     { Do clever C formatting trick }
  950.     TheReturnString :=
  951.      DoCStyleFormat( 'FTP File Receive Failed!' ,
  952.       [ nil ] );
  953.     { Put result in progress and status line }
  954.     AddProgressText( TheReturnString );
  955.     ShowProgressErrorText( TheReturnString );
  956.     { leave }
  957.     exit;
  958.   end
  959.   else
  960.   begin
  961.     { Set up socket 2 for listening }
  962.     Socket2.AsynchMode := False;
  963.     Socket2.NonAsynchTimeoutValue := 60;
  964.     { do a listen and send command to server that this is receipt socket }
  965.     if GetListeningPort = FTP_STATUS_FATAL_ERROR then
  966.     begin
  967.       Socket2.CCSockCancelListen;
  968.       exit;
  969.     end;
  970.     Socket1.NonAsynchTimeoutValue := 0; {infinite timeout}
  971.     TheReturnString :=
  972.      DoCStyleFormat( 'RETR %s' ,
  973.       [ RemoteName ] );
  974.     { Put result in progress and status line }
  975.     AddProgressText( TheReturnString );
  976.     ShowProgressText( TheReturnString );
  977.     TheResult := PerformFTPCommand( 'RETR %s' , [RemoteName] );
  978.     GetFTPServerResponse( TheReturnString );
  979.     AddProgressText( TheReturnString );
  980.     ShowProgressText( TheReturnString );
  981.     FileToGetSize := GetTotalBytesToReceive( TheReturnString );
  982.     Socket1.NonAsynchTimeoutValue := 30;
  983.     if (( TheResult = FTP_STATUS_RETRY_COMMAND ) or
  984.        ( TheResult = FTP_STATUS_FATAL_ERROR )) then
  985.     begin
  986.       TheReturnString :=
  987.        DoCStyleFormat( 'Could not obtain remote file!' ,
  988.         [ nil ] );
  989.       { Put result in progress and status line }
  990.       AddProgressText( TheReturnString );
  991.       ShowProgressErrorText( TheReturnString );
  992.       Socket2.CCSockCancelListen;
  993.       exit;
  994.     end;
  995.     Socket2.CCSockAccept;
  996.     if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 )) then
  997.     begin
  998.       TheReturnString :=
  999.        DoCStyleFormat( 'Could not establish receive socket!' ,
  1000.         [ nil ] );
  1001.       { Put result in progress and status line }
  1002.       AddProgressText( TheReturnString );
  1003.       ShowProgressErrorText( TheReturnString );
  1004.       exit;
  1005.     end;
  1006.     Through := false;
  1007.     TotalBytesSent := 0;
  1008.     repeat
  1009.       TheReturnString := Socket2.StringData;
  1010.       if Length( TheReturnString ) = 0 then Through := true;
  1011.       if Length( TheReturnString ) > 0 then
  1012.       begin
  1013.         StrPCopy( CopyBuffer , TheReturnString );
  1014.         TotalBytesSent := TotalBytesSent + Length( TheReturnString );
  1015.         UpdateGauge( TotalBytesSent , FileToGetSize );
  1016.         if _lwrite( OutputFileHandle , CopyBuffer , Length( TheReturnString ))
  1017.          = -1 then
  1018.         begin
  1019.           MessageDlg( 'File Write Error on ' + LocalName , mtError , [mbOK] , 0 );
  1020.           GlobalAbortedFlag := True;
  1021.         end;
  1022.       end;
  1023.       if GlobalAbortedFlag then
  1024.       begin
  1025.         Socket1.OutOfBand := 'ABOR'+#13#10;
  1026.         repeat
  1027.           TheResult := GetFTPServerResponse( TheReturnString );
  1028.           { Put result in progress and status line }
  1029.           AddProgressText( TheReturnString );
  1030.           ShowProgressText( TheReturnString );
  1031.         until (( GlobalAbortedFlag ) or ( TheResult <> FTP_STATUS_PRELIMINARY ));
  1032.         exit;
  1033.       end;
  1034.     until Through;
  1035.     { cancel listening on second socket and close it }
  1036.     Socket2.CCSockCancelListen;
  1037.     Socket2.CCSockClose;
  1038.     FTPCommandInProgress := false;
  1039.     TheResult := PerformFTPCommand( 'TYPE A',
  1040.                                     [ nil ] );
  1041.     Through := false;
  1042.     repeat
  1043.       TheResult := GetFTPServerResponse( TheReturnString );
  1044.       if Pos( 'TYPE' , Uppercase( TheReturnString )) > 0 then
  1045.        Through := true;
  1046.       { Put result in progress and status line }
  1047.       AddProgressText( TheReturnString );
  1048.       ShowProgressText( TheReturnString );
  1049.     until (( GlobalAbortedFlag ) or Through );
  1050.   end;
  1051.   _lclose( OutputFileHandle );
  1052.   FTPCommandInProgress := false;
  1053. end;
  1054.  
  1055. { This procedure receives a binary remote file }
  1056. procedure TFTPComponent.ReceiveBinaryRemoteFile( RemoteName , LocalName : String );
  1057. var TheReturnString : String;  { Internal string holder }
  1058.     TheResult       : Integer; { Internal int holder    }
  1059.     InputString     : String;
  1060.     Through ,
  1061.     Finished        : Boolean;
  1062.     FileNamePChar   : array[ 0 .. 255 ] of char;
  1063.     OutputFileHandle : Integer;
  1064.     TotalBytesSent ,
  1065.     FileToGetSize    : Longint;
  1066.     CopyBuffer       : array[ 0 .. 255 ] of char;
  1067. begin
  1068.   LocalName := ExpandFileName( LocalName );
  1069.   StrPCopy( FileNamePChar , LocalName );
  1070.   OutputFileHandle := _lcreat( FileNamePChar , 0 );
  1071.   if OutputFileHandle = -1 then
  1072.   begin
  1073.     MessageDlg( 'Cannot Create local file ' + LocalName ,
  1074.      mtError , [mbOK] , 0 );
  1075.     exit;
  1076.   end;
  1077.   TheReturnString :=
  1078.    DoCStyleFormat( 'TYPE I' ,
  1079.     [ nil ] );
  1080.   { Put result in progress and status line }
  1081.   AddProgressText( TheReturnString );
  1082.   ShowProgressText( TheReturnString );
  1083.   { Send Password sequence }
  1084.   TheResult := PerformFTPCommand( 'TYPE I',
  1085.                                   [ nil ] );
  1086.   if TheResult <> FTP_STATUS_PRELIMINARY then
  1087.   begin
  1088.     FTPCommandInProgress := false;
  1089.     exit;
  1090.   end;
  1091.   repeat
  1092.     TheResult := GetFTPServerResponse( TheReturnString );
  1093.     { Put result in progress and status line }
  1094.     AddProgressText( TheReturnString );
  1095.     ShowProgressText( TheReturnString );
  1096.   until (( GlobalAbortedFlag ) or ( TheResult <> FTP_STATUS_PRELIMINARY ));
  1097.   FTPCommandInProgress := false;
  1098.   if ( GlobalAbortedFlag or ( TheResult <> FTP_STATUS_COMPLETED )) then
  1099.   begin
  1100.     { Do clever C formatting trick }
  1101.     TheReturnString :=
  1102.      DoCStyleFormat( 'FTP File Receive Failed!' ,
  1103.       [ nil ] );
  1104.     { Put result in progress and status line }
  1105.     AddProgressText( TheReturnString );
  1106.     ShowProgressErrorText( TheReturnString );
  1107.     { leave }
  1108.     exit;
  1109.   end
  1110.   else
  1111.   begin
  1112.     { Set up socket 2 for listening }
  1113.     Socket2.AsynchMode := False;
  1114.     Socket2.NonAsynchTimeoutValue := 60;
  1115.     { do a listen and send command to server that this is receipt socket }
  1116.     if GetListeningPort = FTP_STATUS_FATAL_ERROR then
  1117.     begin
  1118.       Socket2.CCSockCancelListen;
  1119.       exit;
  1120.     end;
  1121.     Socket1.NonAsynchTimeoutValue := 0; {infinite timeout}
  1122.     TheReturnString :=
  1123.      DoCStyleFormat( 'RETR %s' ,
  1124.       [ RemoteName ] );
  1125.     { Put result in progress and status line }
  1126.     AddProgressText( TheReturnString );
  1127.     ShowProgressText( TheReturnString );
  1128.     TheResult := PerformFTPCommand( 'RETR %s' , [RemoteName] );
  1129.     GetFTPServerResponse( TheReturnString );
  1130.     AddProgressText( TheReturnString );
  1131.     ShowProgressText( TheReturnString );
  1132.     FileToGetSize := GetTotalBytesToReceive( TheReturnString );
  1133.     Socket1.NonAsynchTimeoutValue := 30;
  1134.     if (( TheResult = FTP_STATUS_RETRY_COMMAND ) or
  1135.        ( TheResult = FTP_STATUS_FATAL_ERROR )) then
  1136.     begin
  1137.       TheReturnString :=
  1138.        DoCStyleFormat( 'Could not obtain remote file!' ,
  1139.         [ nil ] );
  1140.       { Put result in progress and status line }
  1141.       AddProgressText( TheReturnString );
  1142.       ShowProgressErrorText( TheReturnString );
  1143.       Socket2.CCSockCancelListen;
  1144.       exit;
  1145.     end;
  1146.     Socket2.CCSockAccept;
  1147.     if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 )) then
  1148.     begin
  1149.       TheReturnString :=
  1150.        DoCStyleFormat( 'Could not establish receive socket!' ,
  1151.         [ nil ] );
  1152.       { Put result in progress and status line }
  1153.       AddProgressText( TheReturnString );
  1154.       ShowProgressErrorText( TheReturnString );
  1155.       exit;
  1156.     end;
  1157.     Through := false;
  1158.     TotalBytesSent := 0;
  1159.     repeat
  1160.       TheReturnString := Socket2.StringData;
  1161.       if Length( TheReturnString ) = 0 then Through := true;
  1162.       if Length( TheReturnString ) > 0 then
  1163.       begin
  1164.         StrPCopy( CopyBuffer , TheReturnString );
  1165.         TotalBytesSent := TotalBytesSent + Length( TheReturnString );
  1166.         UpdateGauge( TotalBytesSent , FileToGetSize );
  1167.         if _lwrite( OutputFileHandle , CopyBuffer , Length( TheReturnString ))
  1168.          = -1 then
  1169.         begin
  1170.           MessageDlg( 'File Write Error on ' + LocalName , mtError , [mbOK] , 0 );
  1171.           GlobalAbortedFlag := True;
  1172.         end;
  1173.       end;
  1174.       if GlobalAbortedFlag then
  1175.       begin
  1176.         Socket1.OutOfBand := 'ABOR'+#13#10;
  1177.         repeat
  1178.           TheResult := GetFTPServerResponse( TheReturnString );
  1179.           { Put result in progress and status line }
  1180.           AddProgressText( TheReturnString );
  1181.           ShowProgressText( TheReturnString );
  1182.         until (( GlobalAbortedFlag ) or ( TheResult <> FTP_STATUS_PRELIMINARY ));
  1183.         exit;
  1184.       end;
  1185.     until Through;
  1186.     { cancel listening on second socket and close it }
  1187.     Socket2.CCSockCancelListen;
  1188.     Socket2.CCSockClose;
  1189.     FTPCommandInProgress := false;
  1190.     TheResult := PerformFTPCommand( 'TYPE A',
  1191.                                     [ nil ] );
  1192.     Through := false;
  1193.     repeat
  1194.       TheResult := GetFTPServerResponse( TheReturnString );
  1195.       if Pos( 'TYPE' , Uppercase( TheReturnString )) > 0 then
  1196.        Through := true;
  1197.       { Put result in progress and status line }
  1198.       AddProgressText( TheReturnString );
  1199.       ShowProgressText( TheReturnString );
  1200.     until (( GlobalAbortedFlag ) or Through );
  1201.   end;
  1202.   _lclose( OutputFileHandle );
  1203.   FTPCommandInProgress := false;
  1204. end;
  1205.  
  1206. { This sends FTP progress text to the Inet form }
  1207. procedure TFTPComponent.ShowProgressErrorText( WhatText : String );
  1208. begin
  1209.   CCInetCCForm.ShowProgressErrorText( WhatText );
  1210. end;
  1211.  
  1212. { This is a core function! It performs an FTP command and if no timeout }
  1213. { return a preliminary ok.                                              }
  1214. function TFTPComponent.PerformFTPCommand(
  1215.                  TheCommand        : string;
  1216.            const TheArguments      : array of const ) : Integer;
  1217. var TheBuffer : string; { Text buffer }
  1218. begin
  1219.   { If command in progress send back -1 error }
  1220.   if FTPCommandInProgress then
  1221.   begin
  1222.     Result := -1;
  1223.     exit;
  1224.   end;
  1225.   { Set status variable }
  1226.   FTPCommandInProgress := True;
  1227.   { Set global error code }
  1228.   GlobalErrorCode := 0;
  1229.   { Format output string }
  1230.   TheBuffer := Format( TheCommand , TheArguments );
  1231.   { Preset failure code }
  1232.   Result := FTP_STATUS_FATAL_ERROR;
  1233.   { If invalid socket or no connection abort }
  1234.   if ( Socket1.TheSocket = INVALID_SOCKET ) or not Connection_Established then
  1235.    exit;
  1236.   { Send the buffer plus EOL chars }
  1237.   Socket1.StringData := TheBuffer + #13#10;
  1238.   { if abort due to timeout or other error exit }
  1239.   if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 )) then exit;
  1240.   { Otherwise return preliminary code }
  1241.   Result := FTP_STATUS_PRELIMINARY;
  1242. end;
  1243.  
  1244. { This function gets up to 255 chars of data plus a return code from FTP serv }
  1245. function TFTPComponent.GetFTPServerResponse(
  1246.           var ResponseString : String ) : integer;
  1247. var
  1248.   { Buffer string for response line }
  1249.   TheBuffer     : string;
  1250.   { Pointer to the response string }
  1251.   BufferPointer : array[0..255] of char absolute TheBuffer;
  1252.   { Character to check for response code }
  1253.   ResponseChar   : char;
  1254.   { Pointers into returned string }
  1255.   TheIndex ,
  1256.   TheLength     : integer;
  1257.   { Control variable }
  1258.   LeftoversInPan ,
  1259.   Finished      : Boolean;
  1260. begin
  1261.   { Preset fatal error }
  1262.   Result := FTP_STATUS_FATAL_ERROR;
  1263.   { Start loop control }
  1264.   LeftoversInPan := false;
  1265.   Finished := false;
  1266.   repeat
  1267.     { Do a peek }
  1268.     TheBuffer := Socket1.PeekData;
  1269.     { If timeout or other error exit }
  1270.     if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 )) then exit;
  1271.     { Find end of line character }
  1272.     TheIndex := Pos( #10 , TheBuffer );
  1273.     if TheIndex = 0 then
  1274.     begin
  1275.       TheIndex := Pos( #13 , TheBuffer );
  1276.       if TheIndex = 0 then
  1277.       begin
  1278.         TheIndex := Pos( #0 , TheBuffer );
  1279.         if TheIndex = 0 then
  1280.         begin
  1281.           TheIndex := Length( TheBuffer );
  1282.           LeftoversInPan := True;
  1283.           LeftoverText := LeftoverText + TheBuffer;
  1284.           LeftoversOnTable := false;
  1285.         end;
  1286.       end;
  1287.     end;
  1288.     { If an end of line then process the line }
  1289.     if TheIndex > 0 then
  1290.     begin
  1291.       { Get length of string }
  1292.       TheLength := TheIndex;
  1293.       { Receive actual data }
  1294.       Socket1.CCSockReceive( Socket1.TheSocket   ,
  1295.                              @BufferPointer[ 1 ] ,
  1296.                              TheLength              );
  1297.       { Abort if timeout or error }
  1298.       if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 )) then exit;
  1299.       { Put in the length byte }
  1300.       BufferPointer[ 0 ] := Chr( TheLength );
  1301.       if LeftOversOnTable then
  1302.       begin
  1303.         LeftOversOnTable := false;
  1304.         ResponseString := LeftoverText + TheBuffer;
  1305.         TheBuffer := ResponseString;
  1306.         LeftoverText := '';
  1307.       end;
  1308.       if LeftoversInPan then
  1309.       begin
  1310.         LeftoversInPan := false;
  1311.         LeftoversOnTable := true;
  1312.       end;
  1313.       { If not a continuation line }
  1314.       if TheBuffer[ 4 ] <> '-' then
  1315.       begin
  1316.         { Get first number character }
  1317.         ResponseChar := TheBuffer[ 1 ];
  1318.         { Get the value of the number from 1 to 5 }
  1319.         if (( ResponseChar >= '1' ) and ( ResponseChar <= '5' )) then
  1320.         begin
  1321.           Finished := true;
  1322.           Result := Ord( ResponseChar ) - 48;
  1323.         end;
  1324.       end
  1325.       else
  1326.       begin
  1327.         { otherwise return preliminary result }
  1328.         Finished := true;
  1329.         Result := FTP_STATUS_PRELIMINARY;
  1330.       end;
  1331.     end
  1332.     else
  1333.     begin
  1334.     end;
  1335.   until ( Finished and ( not LeftoversOnTable ));
  1336.   { Return buffer as response string }
  1337.   ResponseString := TheBuffer;
  1338. end;
  1339.  
  1340. { Boilerplate error routine }
  1341. procedure TFTPComponent.FTPSocketsErrorOccurred( Sender     : TObject;
  1342.                                                  ErrorCode  : Integer;
  1343.                                                  TheMessage : String   );
  1344. begin
  1345.   CCInetCCForm.SocketsErrorOccurred( Sender,ErrorCode,TheMessage );
  1346. end;
  1347.  
  1348. { This is the FTP components initial connection routine }
  1349. function TFTPComponent.EstablishConnection(
  1350.           PCRPointer : PConnectionsRecord ) : Boolean;
  1351. var TheReturnString : String;  { Internal string holder }
  1352.     TheResult       : Integer; { Internal int holder    }
  1353. begin
  1354.   { Set default FTP Port value }
  1355.   Socket1.PortName := '21';
  1356.   { Get the ip address from the record }
  1357.   Socket1.IPAddressName := PCRPointer^.CIPAddress;
  1358.   { Set blocking mode }
  1359.   Socket1.AsynchMode := False;
  1360.   { Clear condition variables }
  1361.   GlobalErrorCode := 0;
  1362.   GlobalAbortedFlag := false;
  1363.   { Actually attempt to connect }
  1364.   Socket1.CCSockConnect;
  1365.   { Check if connected }
  1366.   if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 ) or
  1367.       ( Socket1.TheSocket = INVALID_SOCKET )) then
  1368.   begin { Didn't connect; signal error and abort }
  1369.     { Do clever C formatting trick }
  1370.     TheReturnString :=
  1371.      DoCStyleFormat( 'FTP Host %s Connection Failed!' ,
  1372.       [ PCRPointer^.CIPAddress ] );
  1373.     { Put result in progress and status line }
  1374.     AddProgressText( TheReturnString );
  1375.     ShowProgressErrorText( TheReturnString );
  1376.     { Signal error }
  1377.     Result := False;
  1378.     { leave }
  1379.     exit;
  1380.   end
  1381.   else
  1382.   begin
  1383.     Connection_Established := true;
  1384.     { Signal successful connection }
  1385.     TheReturnString := DoCStyleFormat(
  1386.       'Connected on Local port: %s with IP: %s',
  1387.       [ Socket1.GetSocketPort( Socket1.TheSocket ),
  1388.         Socket1.GetSocketIPAddress( Socket1.TheSocket )]);
  1389.     { Put result in progress and status line }
  1390.     CCINetCCForm.AddProgressText( TheReturnString );
  1391.     CCINetCCForm.ShowProgressText( TheReturnString );
  1392.     TheReturnString := DoCStyleFormat(
  1393.      'Connected to Remote port: %s with IP: %s',
  1394.       [ Socket1.GetSocketPeerPort( Socket1.TheSocket ),
  1395.         Socket1.GetSocketPeerIPAddress( Socket1.TheSocket )]);
  1396.     { Put result in progress and status line }
  1397.     CCINetCCForm.AddProgressText( TheReturnString );
  1398.     CCINetCCForm.ShowProgressText( TheReturnString );
  1399.     TheReturnString := DoCStyleFormat( 'Successfully connected to %s',
  1400.      [ Socket1.IPAddressName ]);
  1401.     { Put result in progress and status line }
  1402.     CCINetCCForm.AddProgressText( TheReturnString );
  1403.     CCINetCCForm.ShowProgressText( TheReturnString );
  1404.     repeat
  1405.       TheResult := GetFTPServerResponse( TheReturnString );
  1406.       { Put result in progress and status line }
  1407.       AddProgressText( TheReturnString );
  1408.       ShowProgressText( TheReturnString );
  1409.     until (( GlobalAbortedFlag ) or ( TheResult <> FTP_STATUS_PRELIMINARY ));
  1410.     if ( GlobalAbortedFlag or ( TheResult <> FTP_STATUS_COMPLETED )) then
  1411.     begin
  1412.       { Do clever C formatting trick }
  1413.       TheReturnString :=
  1414.        DoCStyleFormat( 'FTP Host %s Connection Failed!' ,
  1415.         [ PCRPointer^.CIPAddress ] );
  1416.       { Put result in progress and status line }
  1417.       AddProgressText( TheReturnString );
  1418.       ShowProgressErrorText( TheReturnString );
  1419.       { Signal error }
  1420.       Result := False;
  1421.       { leave }
  1422.       exit;
  1423.     end
  1424.     else Result := true; { Signal no problem }
  1425.   end;
  1426. end;
  1427.  
  1428. { This is the FTP components USER login routine }
  1429. function TFTPComponent.LoginUser(
  1430.           PCRPointer : PConnectionsRecord ) : Boolean;
  1431. var TheReturnString : String;  { Internal string holder }
  1432.     TheResult       : Integer; { Internal int holder    }
  1433. begin
  1434.   TheReturnString :=
  1435.    DoCStyleFormat( 'USER %s' ,
  1436.     [ PCRPointer^.CUserName ] );
  1437.   { Put result in progress and status line }
  1438.   AddProgressText( TheReturnString );
  1439.   ShowProgressText( TheReturnString );
  1440.   { Begin login sequence with user name }
  1441.   TheResult := PerformFTPCommand( 'USER %s',
  1442.                                   [ PCRPointer^.CUserName ] );
  1443.   if TheResult <> FTP_STATUS_PRELIMINARY then
  1444.   begin
  1445.     FTPCommandInProgress := false;
  1446.     Result := false;
  1447.     exit;
  1448.   end;
  1449.   repeat
  1450.     TheResult := GetFTPServerResponse( TheReturnString );
  1451.     { Put result in progress and status line }
  1452.     AddProgressText( TheReturnString );
  1453.     ShowProgressText( TheReturnString );
  1454.   until (( GlobalAbortedFlag ) or ( TheResult <> FTP_STATUS_PRELIMINARY ));
  1455.   FTPCommandInProgress := false;
  1456.   if ( GlobalAbortedFlag or ( TheResult <> FTP_STATUS_CONTINUING )) then
  1457.   begin
  1458.     { Do clever C formatting trick }
  1459.     TheReturnString :=
  1460.      DoCStyleFormat( 'FTP Host %s Connection Failed!' ,
  1461.       [ PCRPointer^.CIPAddress ] );
  1462.     { Put result in progress and status line }
  1463.     AddProgressText( TheReturnString );
  1464.     ShowProgressErrorText( TheReturnString );
  1465.     { Signal error }
  1466.     Result := False;
  1467.     { leave }
  1468.     exit;
  1469.   end
  1470.   else Result := true; { Signal no problem }
  1471. end;
  1472.  
  1473. function TFTPComponent.DeleteRemoteDirectory( TheDir : String ) : Boolean;
  1474. var TheReturnString : String;  { Internal string holder }
  1475.     TheResult       : Integer; { Internal int holder    }
  1476. begin
  1477.   TheReturnString := DoCStyleFormat( 'RMD %s' ,
  1478.    [ TheDir ] );
  1479.   { Put result in progress and status line }
  1480.   AddProgressText( TheReturnString );
  1481.   ShowProgressText( TheReturnString );
  1482.   { Send Password sequence }
  1483.   TheResult := PerformFTPCommand( 'RMD %s',
  1484.                                   [ TheDir ] );
  1485.   if TheResult <> FTP_STATUS_PRELIMINARY then
  1486.   begin
  1487.     Result := false;
  1488.     FTPCommandInProgress := false;
  1489.     exit;
  1490.   end;
  1491.   repeat
  1492.     TheResult := GetFTPServerResponse( TheReturnString );
  1493.     { Put result in progress and status line }
  1494.     AddProgressText( TheReturnString );
  1495.     ShowProgressText( TheReturnString );
  1496.   until (( GlobalAbortedFlag ) or ( TheResult <> FTP_STATUS_PRELIMINARY ));
  1497.   FTPCommandInProgress := false;
  1498.   if ( GlobalAbortedFlag or ( TheResult <> FTP_STATUS_COMPLETED )) then
  1499.   begin
  1500.     { Do clever C formatting trick }
  1501.     TheReturnString :=
  1502.      DoCStyleFormat( 'Delete Directory %s Failed!' ,
  1503.       [ TheDir ] );
  1504.     { Put result in progress and status line }
  1505.     AddProgressText( TheReturnString );
  1506.     ShowProgressErrorText( TheReturnString );
  1507.     { Signal error }
  1508.     Result := False;
  1509.     { leave }
  1510.     exit;
  1511.   end
  1512.   else Result := true; { Signal no problem }
  1513. end;
  1514.  
  1515. function TFTPComponent.CreateRemoteDirectory( TheDir : String ) : Boolean;
  1516. var TheReturnString : String;  { Internal string holder }
  1517.     TheResult       : Integer; { Internal int holder    }
  1518. begin
  1519.   TheReturnString := DoCStyleFormat( 'MKD %s' ,
  1520.     [ TheDir ] );
  1521.   { Put result in progress and status line }
  1522.   AddProgressText( TheReturnString );
  1523.   ShowProgressText( TheReturnString );
  1524.   { Send Password sequence }
  1525.   TheResult := PerformFTPCommand( 'MKD %s',
  1526.                                   [ TheDir ] );
  1527.   if TheResult <> FTP_STATUS_PRELIMINARY then
  1528.   begin
  1529.     Result := false;
  1530.     FTPCommandInProgress := false;
  1531.     exit;
  1532.   end;
  1533.   repeat
  1534.     TheResult := GetFTPServerResponse( TheReturnString );
  1535.     { Put result in progress and status line }
  1536.     AddProgressText( TheReturnString );
  1537.     ShowProgressText( TheReturnString );
  1538.   until (( GlobalAbortedFlag ) or ( TheResult <> FTP_STATUS_PRELIMINARY ));
  1539.   FTPCommandInProgress := false;
  1540.   if ( GlobalAbortedFlag or ( TheResult <> FTP_STATUS_COMPLETED )) then
  1541.   begin
  1542.     { Do clever C formatting trick }
  1543.     TheReturnString :=
  1544.      DoCStyleFormat( 'Create Directory %s Failed!' ,
  1545.       [ TheDir ] );
  1546.     { Put result in progress and status line }
  1547.     AddProgressText( TheReturnString );
  1548.     ShowProgressErrorText( TheReturnString );
  1549.     { Signal error }
  1550.     Result := False;
  1551.     { leave }
  1552.     exit;
  1553.   end
  1554.   else Result := true; { Signal no problem }
  1555. end;
  1556.  
  1557.  
  1558. function TFTPComponent.DeleteRemoteFile( TheFileName : String ) : Boolean;
  1559. var TheReturnString : String;  { Internal string holder }
  1560.     TheResult       : Integer; { Internal int holder    }
  1561. begin
  1562.   TheReturnString := DoCStyleFormat( 'DELE %s' ,
  1563.     [ TheFileName ] );
  1564.   { Put result in progress and status line }
  1565.   AddProgressText( TheReturnString );
  1566.   ShowProgressText( TheReturnString );
  1567.   { Send Password sequence }
  1568.   TheResult := PerformFTPCommand( 'DELE %s',
  1569.                                   [ TheFileName ] );
  1570.   if TheResult <> FTP_STATUS_PRELIMINARY then
  1571.   begin
  1572.     Result := false;
  1573.     FTPCommandInProgress := false;
  1574.     exit;
  1575.   end;
  1576.   repeat
  1577.     TheResult := GetFTPServerResponse( TheReturnString );
  1578.     { Put result in progress and status line }
  1579.     AddProgressText( TheReturnString );
  1580.     ShowProgressText( TheReturnString );
  1581.   until (( GlobalAbortedFlag ) or ( TheResult <> FTP_STATUS_PRELIMINARY ));
  1582.   FTPCommandInProgress := false;
  1583.   if ( GlobalAbortedFlag or ( TheResult <> FTP_STATUS_COMPLETED )) then
  1584.   begin
  1585.     { Do clever C formatting trick }
  1586.     TheReturnString :=
  1587.      DoCStyleFormat( 'Delete File %s Failed!' ,
  1588.       [ TheFileName ] );
  1589.     { Put result in progress and status line }
  1590.     AddProgressText( TheReturnString );
  1591.     ShowProgressErrorText( TheReturnString );
  1592.     { Signal error }
  1593.     Result := False;
  1594.     { leave }
  1595.     exit;
  1596.   end
  1597.   else Result := true; { Signal no problem }
  1598. end;
  1599.  
  1600. { This is the FTP components PASSWORD routine }
  1601. function TFTPComponent.SendPassword(
  1602.           PCRPointer : PConnectionsRecord ) : Boolean;
  1603. var TheReturnString : String;  { Internal string holder }
  1604.     TheResult       : Integer; { Internal int holder    }
  1605. begin
  1606.   TheReturnString := 'PASS XXXXXX' + #13#10;
  1607.   { Put result in progress and status line }
  1608.   AddProgressText( TheReturnString );
  1609.   ShowProgressText( TheReturnString );
  1610.   { Send Password sequence }
  1611.   TheResult := PerformFTPCommand( 'PASS %s',
  1612.                                   [ PCRPointer^.CPassword ] );
  1613.   if TheResult <> FTP_STATUS_PRELIMINARY then
  1614.   begin
  1615.     Result := false;
  1616.     FTPCommandInProgress := false;
  1617.     exit;
  1618.   end;
  1619.   repeat
  1620.     TheResult := GetFTPServerResponse( TheReturnString );
  1621.     { Put result in progress and status line }
  1622.     AddProgressText( TheReturnString );
  1623.     ShowProgressText( TheReturnString );
  1624.   until (( GlobalAbortedFlag ) or ( TheResult <> FTP_STATUS_PRELIMINARY ));
  1625.   FTPCommandInProgress := false;
  1626.   if ( GlobalAbortedFlag or ( TheResult <> FTP_STATUS_COMPLETED )) then
  1627.   begin
  1628.     { Do clever C formatting trick }
  1629.     TheReturnString :=
  1630.      DoCStyleFormat( 'FTP Host %s Connection Failed!' ,
  1631.       [ PCRPointer^.CIPAddress ] );
  1632.     { Put result in progress and status line }
  1633.     AddProgressText( TheReturnString );
  1634.     ShowProgressErrorText( TheReturnString );
  1635.     { Signal error }
  1636.     Result := False;
  1637.     { leave }
  1638.     exit;
  1639.   end
  1640.   else Result := true; { Signal no problem }
  1641. end;
  1642.  
  1643. { This is the FTP components CWD routine }
  1644. function TFTPComponent.SetRemoteStartupDirectory(
  1645.           PCRPointer : PConnectionsRecord ) : Boolean;
  1646. var TheReturnString : String;  { Internal string holder }
  1647.     TheResult       : Integer; { Internal int holder    }
  1648. begin
  1649.   Result := true;
  1650.   if PCRPointer^.CStartDir <> '' then
  1651.   begin
  1652.     TheReturnString :=
  1653.      DoCStyleFormat( 'CWD %s' ,
  1654.       [ PCRPointer^.CStartDir ] );
  1655.     { Put result in progress and status line }
  1656.     AddProgressText( TheReturnString );
  1657.     ShowProgressText( TheReturnString );
  1658.     { Send Password sequence }
  1659.     TheResult := PerformFTPCommand( 'CWD %s',
  1660.                                     [ PCRPointer^.CStartDir ] );
  1661.     if TheResult <> FTP_STATUS_PRELIMINARY then
  1662.     begin
  1663.       Result := false;
  1664.       FTPCommandInProgress := false;
  1665.       exit;
  1666.     end;
  1667.     repeat
  1668.       TheResult := GetFTPServerResponse( TheReturnString );
  1669.       { Put result in progress and status line }
  1670.       AddProgressText( TheReturnString );
  1671.       ShowProgressText( TheReturnString );
  1672.    until (( GlobalAbortedFlag ) or ( TheResult <> FTP_STATUS_PRELIMINARY ));
  1673.    FTPCommandInProgress := false;
  1674.    if ( GlobalAbortedFlag or ( TheResult <> FTP_STATUS_COMPLETED )) then
  1675.     begin
  1676.       { Do clever C formatting trick }
  1677.       TheReturnString :=
  1678.        DoCStyleFormat( 'CWD to %s Failed!' ,
  1679.         [ PCRPointer^.CStartDir ] );
  1680.       { Put result in progress and status line }
  1681.       AddProgressText( TheReturnString );
  1682.       ShowProgressErrorText( TheReturnString );
  1683.       { Signal error }
  1684.       Result := False;
  1685.       { leave }
  1686.       exit;
  1687.     end
  1688.     else Result := true; { Signal no problem }
  1689.   end;
  1690. end;
  1691.  
  1692. { This is the FTP components CWD routine }
  1693. function TFTPComponent.SetRemoteDirectory( TheDir : String ) : Boolean;
  1694. var TheReturnString : String;  { Internal string holder }
  1695.     TheResult       : Integer; { Internal int holder    }
  1696. begin
  1697.   Result := true;
  1698.   if TheDir <> '' then
  1699.   begin
  1700.     TheReturnString :=
  1701.      DoCStyleFormat( 'CWD %s' ,
  1702.       [ TheDir ] );
  1703.     { Put result in progress and status line }
  1704.     AddProgressText( TheReturnString );
  1705.     ShowProgressText( TheReturnString );
  1706.     { Send Password sequence }
  1707.     TheResult := PerformFTPCommand( 'CWD %s',
  1708.                                     [ TheDir ] );
  1709.     if TheResult <> FTP_STATUS_PRELIMINARY then
  1710.     begin
  1711.       Result := false;
  1712.       FTPCommandInProgress := false;
  1713.       exit;
  1714.     end;
  1715.     repeat
  1716.       TheResult := GetFTPServerResponse( TheReturnString );
  1717.       { Put result in progress and status line }
  1718.       AddProgressText( TheReturnString );
  1719.       ShowProgressText( TheReturnString );
  1720.    until (( GlobalAbortedFlag ) or ( TheResult <> FTP_STATUS_PRELIMINARY ));
  1721.    FTPCommandInProgress := false;
  1722.    if ( GlobalAbortedFlag or ( TheResult <> FTP_STATUS_COMPLETED )) then
  1723.     begin
  1724.       { Do clever C formatting trick }
  1725.       TheReturnString :=
  1726.        DoCStyleFormat( 'CWD to %s Failed!' ,
  1727.         [ TheDir ] );
  1728.       { Put result in progress and status line }
  1729.       AddProgressText( TheReturnString );
  1730.       ShowProgressErrorText( TheReturnString );
  1731.       { Signal error }
  1732.       Result := False;
  1733.       { leave }
  1734.       exit;
  1735.     end
  1736.     else Result := true; { Signal no problem }
  1737.   end;
  1738. end;
  1739.  
  1740. { This is the FTP components QUIT routine }
  1741. function TFTPComponent.Disconnect : Boolean;
  1742. var TheReturnString : String;  { Internal string holder }
  1743.     TheResult       : Integer; { Internal int holder    }
  1744. begin
  1745.   TheReturnString :=
  1746.    DoCStyleFormat( 'QUIT' ,
  1747.     [ nil ] );
  1748.   { Put result in progress and status line }
  1749.   AddProgressText( TheReturnString );
  1750.   ShowProgressText( TheReturnString );
  1751.   { Begin login sequence with user name }
  1752.   TheResult := PerformFTPCommand( 'QUIT',
  1753.                                   [ nil ] );
  1754.   repeat
  1755.     TheResult := GetFTPServerResponse( TheReturnString );
  1756.     { Put result in progress and status line }
  1757.     AddProgressText( TheReturnString );
  1758.     ShowProgressText( TheReturnString );
  1759.   until (( GlobalAbortedFlag ) or ( TheResult <> FTP_STATUS_PRELIMINARY ));
  1760.   FTPCommandInProgress := false;
  1761.   if ( GlobalAbortedFlag or ( TheResult <> FTP_STATUS_COMPLETED )) then
  1762.   begin
  1763.     { Do clever C formatting trick }
  1764.     TheReturnString :=
  1765.      DoCStyleFormat( 'FTP Host Connection Failed!' ,
  1766.       [ nil ] );
  1767.     { Put result in progress and status line }
  1768.     AddProgressText( TheReturnString );
  1769.     ShowProgressErrorText( TheReturnString );
  1770.     { Signal error }
  1771.     Result := False;
  1772.     { leave }
  1773.     exit;
  1774.   end
  1775.   else Result := true; { Signal no problem }
  1776. end;
  1777.  
  1778. { This is the FTP components PWD routine }
  1779. function TFTPComponent.GetRemoteWorkingDirectory( var RemoteDir : String )
  1780.           : Boolean;
  1781. var TheReturnString : String;  { Internal string holder }
  1782.     TheResult       : Integer; { Internal int holder    }
  1783. begin
  1784.   Result := true;
  1785.   TheReturnString :=
  1786.    DoCStyleFormat( 'PWD' ,
  1787.     [ nil ] );
  1788.   { Put result in progress and status line }
  1789.   AddProgressText( TheReturnString );
  1790.   ShowProgressText( TheReturnString );
  1791.   { Send Password sequence }
  1792.   TheResult := PerformFTPCommand( 'PWD',
  1793.                                   [ nil ] );
  1794.   if TheResult <> FTP_STATUS_PRELIMINARY then
  1795.   begin
  1796.     Result := false;
  1797.     FTPCommandInProgress := false;
  1798.     exit;
  1799.   end;
  1800.   repeat
  1801.     TheResult := GetFTPServerResponse( TheReturnString );
  1802.     { Put result in progress and status line }
  1803.     AddProgressText( TheReturnString );
  1804.     ShowProgressText( TheReturnString );
  1805.   until (( GlobalAbortedFlag ) or ( TheResult <> FTP_STATUS_PRELIMINARY ));
  1806.   FTPCommandInProgress := false;
  1807.   if ( GlobalAbortedFlag or ( TheResult <> FTP_STATUS_COMPLETED )) then
  1808.   begin
  1809.     { Do clever C formatting trick }
  1810.     TheReturnString :=
  1811.      DoCStyleFormat( 'FTP Host Connection Failed!' ,
  1812.       [ nil ] );
  1813.     { Put result in progress and status line }
  1814.     AddProgressText( TheReturnString );
  1815.     ShowProgressErrorText( TheReturnString );
  1816.     { Signal error }
  1817.     Result := False;
  1818.     { leave }
  1819.     exit;
  1820.   end
  1821.   else
  1822.   begin
  1823.     Result := true; { Signal no problem }
  1824.     RemoteDir := TheReturnString; { Send back last string on faith }
  1825.   end;
  1826. end;
  1827.  
  1828. { This function sets up a listening port on socekt 2 and handle text replies }
  1829. function TFTPComponent.GetListeningPort : Integer;
  1830. var
  1831.   Address1 ,
  1832.   Address2 ,
  1833.   Address3 ,
  1834.   Address4        : integer; { Address integer conversions }
  1835.   IPAddress       : string;  { IP Address holder           }
  1836.   PortCommand     : string;  { Command holder              }
  1837.   TheResult       : Integer; { Result holder               }
  1838.   TheReturnString : String;  { ditto                       }
  1839. begin
  1840.   { Set up any port on socket 2 }
  1841.   Socket2.PortName := '0';
  1842.   { Listen on a socket }
  1843.   Socket2.CCSockListen;
  1844.   { Get the IP Address of socket 1 and convert it to numbers }
  1845.   IPAddress := Socket1.GetSocketIPAddress( Socket1.TheSocket );
  1846.   Address1 := StrToInt( copy( IPAddress , 1 , Pos( '.' , IPAddress ) -1 ));
  1847.   IPAddress := copy( IPAddress , Pos( '.' , IPAddress ) + 1 , 255 );
  1848.   Address2 := StrToInt( copy( IPAddress , 1 , Pos( '.' , IPAddress) -1 ));
  1849.   IPAddress := copy( IPAddress , Pos( '.' , IPAddress ) + 1 , 255 );
  1850.   Address3 := StrToInt( copy( IPAddress , 1 , Pos( '.' , IPAddress ) -1 ));
  1851.   Address4 := StrToInt( copy( IPAddress , Pos( '.' , IPAddress ) + 1 , 255 ));
  1852.   { Turn it into a command and add socket 2 stuff }
  1853.   PortCommand := format( 'PORT %d,%d,%d,%d,%d,%d' ,
  1854.    [ Address1 , Address2 , Address3 , Address4 ,
  1855.     StrToInt( Socket2.GetSocketPort( Socket2.TheMasterSocket )) Shr 8,
  1856.     StrToInt( Socket2.GetSocketPort( Socket2.TheMasterSocket )) and $ff ]);
  1857.   { Put result in progress and status line }
  1858.   AddProgressText( PortCommand + #13#10 );
  1859.   ShowProgressText( PortCommand  + #13#10 );
  1860.   TheResult := PerformFTPCommand( PortCommand , [nil] );
  1861.   if TheResult <> FTP_STATUS_PRELIMINARY then
  1862.   begin
  1863.     Result := FTP_STATUS_FATAL_ERROR;
  1864.     FTPCommandInProgress := false;
  1865.     exit;
  1866.   end;
  1867.   repeat
  1868.     TheResult := GetFTPServerResponse( TheReturnString );
  1869.     { Put result in progress and status line }
  1870.     AddProgressText( TheReturnString );
  1871.     ShowProgressText( TheReturnString );
  1872.   until (( GlobalAbortedFlag ) or ( TheResult <> FTP_STATUS_PRELIMINARY ));
  1873.   FTPCommandInProgress := false;
  1874.   if ( GlobalAbortedFlag or ( TheResult <> FTP_STATUS_COMPLETED )) then
  1875.   begin
  1876.     { Do clever C formatting trick }
  1877.     TheReturnString :=
  1878.      DoCStyleFormat( 'FTP Host Connection Failed!' ,
  1879.       [ nil ] );
  1880.     { Put result in progress and status line }
  1881.     AddProgressText( TheReturnString );
  1882.     ShowProgressErrorText( TheReturnString );
  1883.     { Signal error }
  1884.     Result := TheResult;
  1885.     { leave }
  1886.     exit;
  1887.   end
  1888.   else
  1889.   begin
  1890.     { Return good result and leave }
  1891.     Result := TheResult;
  1892.     exit;
  1893.   end;
  1894. end;
  1895.  
  1896. { This function returns part of a unit text string }
  1897. function TFTPComponent.GetUNIXTextString( var StringIn : String ) : String;
  1898. var
  1899.   ReturnString : String;
  1900.   TheLength ,
  1901.   Counter_1   : integer;
  1902. begin
  1903.   TheLength := Length( StringIn );
  1904.   if TheLength > 1 then
  1905.   begin
  1906.     for Counter_1 := 1 to TheLength do
  1907.     begin
  1908.       if StringIn[ Counter_1 ] = #10 then
  1909.       begin
  1910.         ReturnString := HolderLine;
  1911.         HolderLine := '';
  1912.         StringIn := Copy( StringIn , Counter_1 + 1 , 255 );
  1913.         Result := ReturnString;
  1914.         exit;
  1915.       end
  1916.       else
  1917.       begin
  1918.         if StringIn[ Counter_1 ] <> #0 then
  1919.         begin
  1920.           if StringIn[ Counter_1 ] <> #13 then
  1921.            HolderLine := HolderLine + StringIn[ Counter_1 ];
  1922.         end
  1923.         else
  1924.         begin
  1925.           Result := '';
  1926.           StringIn := '';
  1927.         end;
  1928.       end;
  1929.     end;
  1930.   end;
  1931.   Result := '';
  1932.   StringIn := '';
  1933. end;
  1934.  
  1935. procedure TFTPComponent.GetFileNameFromUNIXFileName( var TheName : String );
  1936. var Counter_1 : Integer;
  1937.     ResultString : String;
  1938.     Finished : Boolean;
  1939. begin
  1940.   if Pos( 'TOTAL' , Uppercase( TheName )) <> 0 then
  1941.   begin
  1942.     TheName := '';
  1943.     exit;
  1944.   end;
  1945.   Counter_1 := Length( TheName );
  1946.   ResultString := '';
  1947.   Finished := false;
  1948.   while not Finished do
  1949.   begin
  1950.     if TheName[ Counter_1 ] <> ' ' then
  1951.     begin
  1952.       Counter_1 := Counter_1 - 1;
  1953.       if Counter_1 = 0 then
  1954.       begin
  1955.         ResultString := TheName;
  1956.         Finished := true;
  1957.       end;
  1958.     end
  1959.     else
  1960.     begin
  1961.       Finished := true;
  1962.       ResultString := Copy( TheName , Counter_1 + 1 , 255 );
  1963.     end;
  1964.   end;
  1965.   TheName := ResultString;
  1966. end;
  1967.  
  1968. { This is the FTP components get remote directory listing into a list box }
  1969. function TFTPComponent.GetRemoteDirectoryListing( TheListBox : TListBox )
  1970.           : Boolean;
  1971. var TheReturnString : String;  { Internal string holder }
  1972.     TheResult       : Integer; { Internal int holder    }
  1973.     InputString     : String;
  1974.     Through ,
  1975.     Finished        : Boolean;
  1976. begin
  1977.   TheListBox.Clear;
  1978.   TheListBox.Items.Add('..');
  1979.   Result := true;
  1980.   TheReturnString :=
  1981.    DoCStyleFormat( 'TYPE A' ,
  1982.     [ nil ] );
  1983.   { Put result in progress and status line }
  1984.   AddProgressText( TheReturnString );
  1985.   ShowProgressText( TheReturnString );
  1986.   { Send Password sequence }
  1987.   TheResult := PerformFTPCommand( 'TYPE A',
  1988.                                   [ nil ] );
  1989.   if TheResult <> FTP_STATUS_PRELIMINARY then
  1990.   begin
  1991.     Result := true;
  1992.     FTPCommandInProgress := false;
  1993.     exit;
  1994.   end;
  1995.   repeat
  1996.     TheResult := GetFTPServerResponse( TheReturnString );
  1997.     { Put result in progress and status line }
  1998.     AddProgressText( TheReturnString );
  1999.     ShowProgressText( TheReturnString );
  2000.   until (( GlobalAbortedFlag ) or ( TheResult <> FTP_STATUS_PRELIMINARY ));
  2001.   FTPCommandInProgress := false;
  2002.   if ( GlobalAbortedFlag or ( TheResult <> FTP_STATUS_COMPLETED )) then
  2003.   begin
  2004.     { Do clever C formatting trick }
  2005.     TheReturnString :=
  2006.      DoCStyleFormat( 'FTP Host Connection Failed!' ,
  2007.       [ nil ] );
  2008.     { Put result in progress and status line }
  2009.     AddProgressText( TheReturnString );
  2010.     ShowProgressErrorText( TheReturnString );
  2011.     { Signal error }
  2012.     Result := true;
  2013.     { leave }
  2014.     exit;
  2015.   end
  2016.   else
  2017.   begin
  2018.     { Set up socket 2 for listening }
  2019.     Socket2.AsynchMode := False;
  2020.     Socket2.NonAsynchTimeoutValue := 60;
  2021.     { do a listen and send command to server that this is receipt socket }
  2022.     if GetListeningPort = FTP_STATUS_FATAL_ERROR then
  2023.     begin
  2024.       Socket2.CCSockCancelListen;
  2025.       exit;
  2026.     end;
  2027.     Socket1.NonAsynchTimeoutValue := 0; {infinite timeout}
  2028.     TheResult := PerformFTPCommand( 'LIST' , [nil] );
  2029.     GetFTPServerResponse( TheReturnString );
  2030.     AddProgressText( TheReturnString );
  2031.     ShowProgressText( TheReturnString );
  2032.     Socket1.NonAsynchTimeoutValue := 30;
  2033.     if (( TheResult = FTP_STATUS_RETRY_COMMAND ) or
  2034.        ( TheResult = FTP_STATUS_FATAL_ERROR )) then
  2035.     begin
  2036.       TheReturnString :=
  2037.        DoCStyleFormat( 'Could not obtain remote directory!' ,
  2038.         [ nil ] );
  2039.       { Put result in progress and status line }
  2040.       AddProgressText( TheReturnString );
  2041.       ShowProgressErrorText( TheReturnString );
  2042.       Socket2.CCSockCancelListen;
  2043.       Result := true;
  2044.       exit;
  2045.     end;
  2046.     Socket2.CCSockAccept;
  2047.     if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 )) then
  2048.     begin
  2049.       TheReturnString :=
  2050.        DoCStyleFormat( 'Could not establish receive socket!' ,
  2051.         [ nil ] );
  2052.       { Put result in progress and status line }
  2053.       AddProgressText( TheReturnString );
  2054.       ShowProgressErrorText( TheReturnString );
  2055.       Result := true;
  2056.       exit;
  2057.     end;
  2058.     Through := false;
  2059.     repeat
  2060.       TheReturnString := Socket2.StringData;
  2061.       if Length( TheReturnString ) = 0 then Through := true;
  2062.       if Length( TheReturnString ) > 0 then
  2063.       begin
  2064.         finished := false;
  2065.         while not finished do
  2066.         begin
  2067.           InputString := GetUNIXTextString( TheReturnString );
  2068.           if InputString = '' then Finished := true else
  2069.           begin
  2070.             GetFileNameFromUNIXFileName( InputString);
  2071.             If InputString <> '' then
  2072.             TheListBox.Items.Add( InputString );
  2073.           end;
  2074.         end;
  2075.       end;
  2076.       if GlobalAbortedFlag then
  2077.       begin
  2078.         Socket1.OutOfBand := 'ABOR'+#13#10;
  2079.         repeat
  2080.           TheResult := GetFTPServerResponse( TheReturnString );
  2081.           { Put result in progress and status line }
  2082.           AddProgressText( TheReturnString );
  2083.           ShowProgressText( TheReturnString );
  2084.         until (( GlobalAbortedFlag ) or ( TheResult <> FTP_STATUS_PRELIMINARY ));
  2085.         result := true;
  2086.         exit;
  2087.       end;
  2088.     until Through;
  2089.     GetFTPServerResponse( TheReturnString );
  2090.     AddProgressText( TheReturnString );
  2091.     ShowProgressText( TheReturnString );
  2092.     { cancel listening on second socket and close it }
  2093.     Socket2.CCSockCancelListen;
  2094.     Socket2.CCSockClose;
  2095.   end;
  2096.   FTPCommandInProgress := false;
  2097. end;
  2098.  
  2099. { This is the FTP components get remote directory listing into a list box }
  2100. function TFTPComponent.GetRemoteDirectoryListingToMemo : Boolean;
  2101. var TheReturnString : String;  { Internal string holder }
  2102.     TheResult       : Integer; { Internal int holder    }
  2103.     InputString     : String;
  2104.     Through ,
  2105.     Finished        : Boolean;
  2106. begin
  2107.   Result := true;
  2108.   TheReturnString :=
  2109.    DoCStyleFormat( 'TYPE A' ,
  2110.     [ nil ] );
  2111.   { Put result in progress and status line }
  2112.   AddProgressText( TheReturnString );
  2113.   ShowProgressText( TheReturnString );
  2114.   { Send Password sequence }
  2115.   TheResult := PerformFTPCommand( 'TYPE A',
  2116.                                   [ nil ] );
  2117.   if TheResult <> FTP_STATUS_PRELIMINARY then
  2118.   begin
  2119.     Result := true;
  2120.     FTPCommandInProgress := false;
  2121.     exit;
  2122.   end;
  2123.   repeat
  2124.     TheResult := GetFTPServerResponse( TheReturnString );
  2125.     { Put result in progress and status line }
  2126.     AddProgressText( TheReturnString );
  2127.     ShowProgressText( TheReturnString );
  2128.   until (( GlobalAbortedFlag ) or ( TheResult <> FTP_STATUS_PRELIMINARY ));
  2129.   FTPCommandInProgress := false;
  2130.   if ( GlobalAbortedFlag or ( TheResult <> FTP_STATUS_COMPLETED )) then
  2131.   begin
  2132.     { Do clever C formatting trick }
  2133.     TheReturnString :=
  2134.      DoCStyleFormat( 'FTP Host Connection Failed!' ,
  2135.       [ nil ] );
  2136.     { Put result in progress and status line }
  2137.     AddProgressText( TheReturnString );
  2138.     ShowProgressErrorText( TheReturnString );
  2139.     { Signal error }
  2140.     Result := true;
  2141.     { leave }
  2142.     exit;
  2143.   end
  2144.   else
  2145.   begin
  2146.     { Set up socket 2 for listening }
  2147.     Socket2.AsynchMode := False;
  2148.     Socket2.NonAsynchTimeoutValue := 30;
  2149.     { do a listen and send command to server that this is receipt socket }
  2150.     if GetListeningPort = FTP_STATUS_FATAL_ERROR then
  2151.     begin
  2152.       Socket2.CCSockCancelListen;
  2153.       exit;
  2154.     end;
  2155.     Socket1.NonAsynchTimeoutValue := 0; {infinite timeout}
  2156.     TheResult := PerformFTPCommand( 'LIST' , [nil] );
  2157.     GetFTPServerResponse( TheReturnString );
  2158.     AddProgressText( TheReturnString );
  2159.     ShowProgressText( TheReturnString );
  2160.     Socket1.NonAsynchTimeoutValue := 30;
  2161.     if (( TheResult = FTP_STATUS_RETRY_COMMAND ) or
  2162.        ( TheResult = FTP_STATUS_FATAL_ERROR )) then
  2163.     begin
  2164.       TheReturnString :=
  2165.        DoCStyleFormat( 'Could not obtain remote directory!' ,
  2166.         [ nil ] );
  2167.       { Put result in progress and status line }
  2168.       AddProgressText( TheReturnString );
  2169.       ShowProgressErrorText( TheReturnString );
  2170.       Socket2.CCSockCancelListen;
  2171.       Result := true;
  2172.       exit;
  2173.     end;
  2174.     Socket2.CCSockAccept;
  2175.     if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 )) then
  2176.     begin
  2177.       TheReturnString :=
  2178.        DoCStyleFormat( 'Could not establish receive socket!' ,
  2179.         [ nil ] );
  2180.       { Put result in progress and status line }
  2181.       AddProgressText( TheReturnString );
  2182.       ShowProgressErrorText( TheReturnString );
  2183.       Result := true;
  2184.       exit;
  2185.     end;
  2186.     Through := false;
  2187.     repeat
  2188.       TheReturnString := Socket2.StringData;
  2189.       if Length( TheReturnString ) = 0 then Through := true;
  2190.       if Length( TheReturnString ) > 0 then
  2191.       begin
  2192.         { Put result in progress and status line }
  2193.         AddProgressText( TheReturnString );
  2194.         ShowProgressText( TheReturnString );
  2195.       end;
  2196.       if GlobalAbortedFlag then
  2197.       begin
  2198.         Socket1.OutOfBand := 'ABOR'+#13#10;
  2199.         repeat
  2200.           TheResult := GetFTPServerResponse( TheReturnString );
  2201.           { Put result in progress and status line }
  2202.           AddProgressText( TheReturnString );
  2203.           ShowProgressText( TheReturnString );
  2204.         until (( GlobalAbortedFlag ) or ( TheResult <> FTP_STATUS_PRELIMINARY ));
  2205.         result := true;
  2206.         exit;
  2207.       end;
  2208.     until Through;
  2209.     GetFTPServerResponse( TheReturnString );
  2210.     AddProgressText( TheReturnString );
  2211.     ShowProgressText( TheReturnString );
  2212.     { cancel listening on second socket and close it }
  2213.     Socket2.CCSockCancelListen;
  2214.     Socket2.CCSockClose;
  2215.   end;
  2216. end;
  2217.  
  2218. { This is the FTP components get local directory listing into a list box }
  2219. function TFTPComponent.GetLocalDirectoryAndListing( var TheString : String;
  2220.                                                         TheListBox : TListBox )
  2221.           : Boolean;
  2222. var TheFLB : TFileListBox;
  2223. begin
  2224.   { Get the working directory }
  2225.   GetDir( 0 , TheString );
  2226.   { Clear incoming LB }
  2227.   TheListBox.Clear;
  2228.   TheFLB := TFileListBox.Create( Application.MainForm );
  2229.   TheFLB.Visible := false;
  2230.   TheFLB.Parent := Application.MainForm;
  2231.   TheFLB.FileType := [ ftNormal , ftDirectory ];
  2232.   TheFLB.Directory := TheString;
  2233.   TheFLB.Update;
  2234.   TheListBox.Items.Assign( TheFLB.Items );
  2235.   TheFLB.Free;
  2236.   result := true;
  2237. end;
  2238.  
  2239. { This is a clever c-style formatting trick }
  2240. function TFTPComponent.DoCStyleFormat(
  2241.                 TheText      : string;
  2242.           const TheArguments : array of const ) : String;
  2243. begin
  2244.   Result := Format( TheText , TheArguments ) + #13#10;
  2245. end;
  2246.  
  2247. function TFTPComponent.GetQuotedString( TheString : String ) : String;
  2248. var TheIndex     : Integer; { Holder var }
  2249.     ResultString : String;  { ditto      }
  2250. begin
  2251.   { Find out if " present at all }
  2252.   TheIndex := Pos( '"' , TheString );
  2253.   If TheIndex = 0 then
  2254.   begin
  2255.     { If not, return null string and exit }
  2256.     Result := '';
  2257.     exit;
  2258.   end
  2259.   else
  2260.   begin
  2261.     { Get from first " to end of string in holder }
  2262.     ResultString := Copy( TheString , TheIndex + 1 , 255 );
  2263.     { Find position to second " }
  2264.     TheIndex := Pos( '"' , ResultString );
  2265.     { If no ending " then return whole string and leave }
  2266.     if TheIndex = 0 then
  2267.     begin
  2268.       Result := ResultString;
  2269.       exit;
  2270.     end
  2271.     else
  2272.     begin
  2273.       { Get internal text between quotes and exit }
  2274.       ResultString := Copy( ResultString , 1 , TheIndex - 1 );
  2275.       Result := ResultString;
  2276.     end;
  2277.   end;
  2278. end;
  2279.  
  2280. procedure TCCINetCCForm.UpdateGauge( BytesFinished , TotalToHandle : longint );
  2281. var
  2282.   Percentage : longint;
  2283. begin
  2284.   if BytesFinished > TotalToHandle then BytesFinished := TotalToHandle;
  2285.   if TotalToHandle = 0 then exit;
  2286.   Percentage := Trunc( 100.0 / ( TotalToHandle / BytesFinished ));
  2287.   Gauge1.Progress := Percentage;
  2288.   Panel1.Caption := '  Status: Transfered ' + IntToStr( BytesFinished ) +
  2289.    ' bytes of file ' + FileNameToXFer + ' (' + IntToStr( Percentage ) + '% Complete)';
  2290. end;
  2291.  
  2292. { This procedure actually attempts to connect to the internet at an ftp site }
  2293. function TCCINetCCForm.DoFTPConnection( PCRPointer : PConnectionsRecord ) : boolean;
  2294. var TheReturnString : String; { Display results of connection in status lines }
  2295.     TheResult       : Integer;{ Result from FTP server                        }
  2296.     FTPLoggedIn     : Boolean;{ Boolean to signal successful login            }
  2297. begin
  2298.   { Create the component }
  2299.   Result := false;
  2300.   { Do busy cursors }
  2301.   SetHGCursors;
  2302.   if not TheFTPComponent.EstablishConnection( PCRPointer ) then
  2303.   begin
  2304.     { Do saved cursors }
  2305.     TheFTPComponent.FTPCommandInProgress := false;
  2306.     TheFTPComponent.Connection_Established := false;
  2307.     SetNormalCursors;
  2308.     exit;
  2309.   end
  2310.   else
  2311.   begin { Connected; continue login process }
  2312.     if not TheFTPComponent.LoginUser( PCRPointer ) then
  2313.     begin
  2314.       { Do saved cursors }
  2315.       TheFTPComponent.FTPCommandInProgress := false;
  2316.       TheFTPComponent.Connection_Established := false;
  2317.       SetNormalCursors;
  2318.       exit;
  2319.     end;
  2320.     if not TheFTPComponent.SendPassword( PCRPointer ) then
  2321.     begin
  2322.       { Do saved cursors }
  2323.       TheFTPComponent.FTPCommandInProgress := false;
  2324.       TheFTPComponent.Connection_Established := false;
  2325.       SetNormalCursors;
  2326.       exit;
  2327.     end;
  2328.     if not TheFTPComponent.SetRemoteStartupDirectory( PCRPointer ) then
  2329.     begin
  2330.       { Do saved cursors }
  2331.       SetNormalCursors;
  2332.       TheFTPComponent.Connection_Established := false;
  2333.       TheFTPComponent.FTPCommandInProgress := false;
  2334.       exit;
  2335.     end;
  2336.     if not TheFTPComponent.GetRemoteWorkingDirectory( TheReturnString ) then
  2337.     begin
  2338.       { Do saved cursors }
  2339.       TheFTPComponent.Connection_Established := false;
  2340.       TheFTPComponent.FTPCommandInProgress := false;
  2341.       SetNormalCursors;
  2342.       exit;
  2343.     end;
  2344.     { Put up remote directory via PWD and strip quotes }
  2345.     Label4.Caption := TheFTPComponent.GetQuotedString( TheReturnString );
  2346.     { Get the listings of directories and exit OK }
  2347.     TheFTPComponent.GetRemoteDirectoryListing( Listbox1 );
  2348.     TheFTPComponent.GetLocalDirectoryAndListing( TheReturnString ,
  2349.      Listbox2 );
  2350.     if Label5.Canvas.TextWidth( TheReturnString ) > Label5.Width then
  2351.      TheReturnString := TheFTPComponent.GetShortPathName( TheReturnString );
  2352.     Label5.Caption := TheReturnString;
  2353.     SetNormalCursors;
  2354.     Result := true;
  2355.     EnableFTPMenus;
  2356.     TheFTPComponent.FTPCommandInProgress := false;
  2357.     Panel1.Caption := '  Status : Connected to ' + PCRPointer^.CIPAddress;
  2358.   end;
  2359. end;
  2360.  
  2361. { This procedure actually attempts to disconnect to the internet at an ftp site}
  2362. procedure TCCINetCCForm.DoFTPDisconnect;
  2363. begin
  2364.   { Call QUIT command }
  2365.   TheFTPComponent.Disconnect;
  2366.   { Kill the socket }
  2367.   TheFTPComponent.Socket1.CCSockClose;
  2368. end;
  2369.  
  2370. { This procedure reads in the ini file and default path info }
  2371. procedure TCCINetCCForm.ReadIniData;
  2372. begin
  2373.   TheICCIniFile := TIniFile.Create( 'CCICC.INI' );
  2374.   MailPath := TheICCIniFile.ReadString( 'Paths','MailPath','C:\WINDOWS' );
  2375.   NewsPath := TheICCIniFile.ReadString( 'Paths','NewsPath','C:\WINDOWS' );
  2376.   WWWPath := TheICCIniFile.ReadString( 'Paths','WWWPath','C:\WINDOWS' );
  2377.   FTPPath := TheICCIniFile.ReadString( 'Paths','FTPPath','C:\WINDOWS' );
  2378.   PasswordControlVector := TheICCIniFile.ReadInteger( 'Vectors','PWControl',2 );
  2379.   DefaultDownloadVector := TheICCIniFile.ReadInteger( 'Vectors','DefDL', 3 );
  2380.   TheAnonRedialVector := TheICCIniFile.ReadInteger( 'Vectors','AnonRD', 20 );
  2381.   TheICCIniFile.Free;
  2382. end;
  2383.  
  2384. { This procedure writes out default path data to the ini file }
  2385. procedure TCCINetCCForm.WriteIniData;
  2386. begin
  2387.   TheICCIniFile := TIniFile.Create( 'CCICC.INI' );
  2388.   TheICCIniFile.WriteString( 'Paths','MailPath',MailPath );
  2389.   TheICCIniFile.WriteString( 'Paths','NewsPath',NewsPath );
  2390.   TheICCIniFile.WriteString( 'Paths','WWWPath',WWWPath );
  2391.   TheICCIniFile.WriteString( 'Paths','FTPPath',FTPPath );
  2392.   TheICCIniFile.WriteInteger( 'Vectors','PWControl',PasswordControlVector );
  2393.   TheICCIniFile.WriteInteger( 'Vectors','DefDL',DefaultDownloadVector );
  2394.   TheICCIniFile.WriteInteger( 'Vectors','AnonRD', TheAnonRedialVector );
  2395.   TheICCIniFile.Free;
  2396. end;
  2397.  
  2398. { Procedure to load the FTP Site list }
  2399. procedure TCCINetCCForm.LoadFTPSiteFile;
  2400. var TheTCRecord : PConnectionsRecord; { Generic TCR Pointer    }
  2401.     FTPSLName   : String;             { FTP Site List filename }
  2402.     Counter_1   : Integer;            { Loop counter           }
  2403. begin
  2404.   { Create the sites list list }
  2405.   TheFTPSiteList := TList.Create;
  2406.   { Set up the FTP sites list file name }
  2407.   FTPSLName := FTPPath + '\FTPSITES.TCR';
  2408.   { If the FTP Site List exists load it in }
  2409.   if FileExists( FTPSLName ) then
  2410.   begin
  2411.     { set up the file and open it }
  2412.     AssignFile( TheFTPSiteFile , FTPSLName );
  2413.     Reset( TheFTPSiteFile );
  2414.     { read in the records }
  2415.     for Counter_1 := 0 to FileSize( TheFTPSiteFile ) - 1 do
  2416.     begin
  2417.       { Create the TCRecord }
  2418.       New( TheTCRecord );
  2419.       { Read in the data record }
  2420.       Seek( TheFTPSiteFile , Counter_1 );
  2421.       Read( TheFTPSiteFile , TheTCRecord^ );
  2422.       { Add the record to the list }
  2423.       TheFTPSiteList.Add( TheTCRecord );
  2424.     end;
  2425.     { close the file }
  2426.     CloseFile( TheFTPSiteFile );
  2427.   end
  2428.   else
  2429.   { Otherwise create a default one with a few anonymous sites }
  2430.   begin
  2431.     { create new record }
  2432.     New( TheTCRecord );
  2433.     { fill in its info }
  2434.     with TheTCRecord^ do
  2435.     begin
  2436.       CProfile   := 'Winsite Windows Archive';
  2437.       CIPAddress := 'ftp.winsite.com';
  2438.       CUserName  := 'anonymous';
  2439.       CPassword  := 'guest@nowhere.com';
  2440.       CStartDir  := '/pub';
  2441.     end;
  2442.     { add it to the list }
  2443.     { do it three more times }
  2444.     TheFTPSiteList.Add( TheTCRecord );
  2445.     New( TheTCRecord );
  2446.     with TheTCRecord^ do
  2447.     begin
  2448.       CProfile   := 'Digital Equipment Corp';
  2449.       CIPAddress := 'gatekeeper.dec.com';
  2450.       CUserName  := 'anonymous';
  2451.       CPassword  := 'guest@nowhere.com';
  2452.       CStartDir  := '/pub';
  2453.     end;
  2454.     TheFTPSiteList.Add( TheTCRecord );
  2455.     New( TheTCRecord );
  2456.     with TheTCRecord^ do
  2457.     begin
  2458.       CProfile   := 'Microsoft FTP Site';
  2459.       CIPAddress := 'ftp.microsoft.com';
  2460.       CUserName  := 'anonymous';
  2461.       CPassword  := 'guest@nowhere.com';
  2462.       CStartDir  := '/pub';
  2463.     end;
  2464.     TheFTPSiteList.Add( TheTCRecord );
  2465.     New( TheTCRecord );
  2466.     with TheTCRecord^ do
  2467.     begin
  2468.       CProfile   := 'Oakland MSDOS Archive';
  2469.       CIPAddress := 'oak.oakland.edu';
  2470.       CUserName  := 'anonymous';
  2471.       CPassword  := 'guest@nowhere.com';
  2472.       CStartDir  := '/pub';
  2473.     end;
  2474.     TheFTPSiteList.Add( TheTCRecord );
  2475.     { create the file and write out the data, then close it }
  2476.     AssignFile( TheFTPSiteFile , FTPSLName );
  2477.     Rewrite( TheFTPSiteFile );
  2478.     for Counter_1 := 0 to 3 do
  2479.     begin
  2480.       TheTCRecord :=
  2481.        PConnectionsRecord( TheFTPSiteList.Items[ Counter_1 ] );
  2482.       Seek( TheFTPSiteFile , Counter_1 );
  2483.       Write( TheFTPSiteFile , TheTCRecord^ );
  2484.     end;
  2485.     CloseFile( TheFTPSiteFile );
  2486.   end;
  2487. end;
  2488.  
  2489. { This procedure saves off the FTP Site List }
  2490. procedure TCCINetCCForm.SaveFTPSiteFile;
  2491. var TheTCRecord : PConnectionsRecord; { The TC Record pointer  }
  2492.     FTPSLName   : String;             { FTP Site List filename }
  2493.     Counter_1   : Integer;            { Loop counter           }
  2494. begin
  2495.   { Set up the file name }
  2496.   FTPSLName := FTPPath + '\FTPSITES.TCR';
  2497.   { Assign the file }
  2498.   AssignFile( TheFTPSiteFile , FTPSLName );
  2499.   { Rewrite it }
  2500.   Rewrite( TheFTPSiteFile );
  2501.   { run the list through the procedure }
  2502.   for Counter_1 := 0 to TheFTPSiteList.Count - 1 do
  2503.   begin
  2504.     { get the record from the list }
  2505.     TheTCRecord :=
  2506.      PConnectionsRecord( TheFTPSiteList.Items[ Counter_1 ] );
  2507.     { Do the seek/write }
  2508.     Seek( TheFTPSiteFile , Counter_1 );
  2509.     Write( TheFTPSiteFile , TheTCRecord^ );
  2510.     { free the record }
  2511.     Dispose( TheTCRecord );
  2512.   end;
  2513.   { Close the file }
  2514.   CloseFile( TheFTPSiteFile );
  2515.   { Free the list pointers }
  2516.   TheFTPSiteList.Free;
  2517.   TheWorkingFTPSL.Free;
  2518. end;
  2519.  
  2520. { This procedure switches in the FTP sites list to the info dlg and main cbox }
  2521. procedure TCCINetCCForm.SetupFTPSiteLists;
  2522. var ThePointer : PConnectionsRecord; { Generic PCR Pointer }
  2523.     Counter_1  : Integer;            { Loop counter        } 
  2524. begin
  2525.   { Set up display for main form }
  2526.   CCINetCCForm.Tag := 2;
  2527.   CCINetCCForm.Caption := 'CC Internet Command Center -- FTP Mode';
  2528.   CCINetCCForm.ViewWinsockInfo1.Enabled := false;
  2529.   CCINetCCForm.FTP1.Enabled := false;
  2530.   CCINetCCForm.FTP2.Enabled := true;
  2531.   CCINetCCForm.Label1.Caption := 'FTP Site:';
  2532.   CCINetCCForm.Button1.Caption := 'Connect';
  2533.   CCINetCCForm.Label4.Caption := 'Local Dir';
  2534.   CCINetCCForm.Label5.Caption := 'Remote Dir';
  2535.   { Set tag for FTP stuff }
  2536.   CCICInfoDlg.Tag := 2;
  2537.   { set up caption of main label }
  2538.   CCICInfoDlg.Label2.Caption := 'FTP Sites';
  2539.   { hide outline panel }
  2540.   CCICInfoDlg.Panel6.Visible := false;
  2541.   { clear the list box }
  2542.   CCICInfoDlg.ListBox2.Clear;
  2543.   CCINetCCForm.ComboBox1.Clear;
  2544.   { add profile strings to the list box }
  2545.   for Counter_1 := 0 to TheFTPSiteList.Count - 1 do
  2546.   begin
  2547.     CCICInfoDlg.ListBox2.Items.Add( PConnectionsRecord(
  2548.      TheFTPSiteList.Items[ Counter_1 ] )^.CProfile );
  2549.     CCINetCCForm.ComboBox1.Items.Add( PConnectionsRecord(
  2550.      TheFTPSiteList.Items[ Counter_1 ] )^.CProfile );
  2551.   end;
  2552.   { Set up caption of special button }
  2553.   CCICInfoDlg.Button1.Caption := 'Anonymous Login';
  2554.   { Start with top record }
  2555.   CCICInfoDlg.ListBox2.ItemIndex := 0;
  2556.   CCINetCCForm.ComboBox1.ItemIndex := 0;
  2557.   { put in data from top record and reset captions }
  2558.   with PConnectionsRecord( TheFTPSiteList.Items[ 0 ] )^ do
  2559.   begin
  2560.     with CCICInfoDlg do
  2561.     begin
  2562.       Edit1.Text := CProfile;
  2563.       Panel2.Caption := '            Name:';
  2564.       Edit2.Text := CIPAddress;
  2565.       Panel3.Caption := '     IP Address:';
  2566.       Edit3.Text := CUserName;
  2567.       Panel5.Caption := '    User Name:';
  2568.       case PasswordControlVector of
  2569.         1 : Edit4.Text := CPassword;
  2570.         2 : Edit4.Text := '**********';
  2571.       end;
  2572.       Panel8.Caption := '      Password:';
  2573.       Edit5.Text := CStartDir;
  2574.       Panel9.Caption := '    Starting Dir:';
  2575.     end;
  2576.   end;
  2577.   { Create the working copy for use to make safe changes in info dlg }
  2578.   TheWorkingFTPSL := TList.Create;
  2579.   For Counter_1 := 0 to TheFTPSiteList.Count - 1 do
  2580.   begin
  2581.     New( ThePointer );
  2582.     ThePointer^ := PConnectionsRecord( TheFTPSiteList.Items[ Counter_1 ] )^;
  2583.     TheWorkingFTPSL.Add( ThePointer );
  2584.   end;
  2585. end;
  2586.  
  2587. { This procedure scans a line of UNIX-style text for #10's and }
  2588. { outputs them as lines to the memo. It stops at #0.           }
  2589. procedure TCCINetCCForm.AddNullTermTextToMemo( TheTextToAdd   : String;
  2590.                                  TheMemoToAddTo : TMemo   );
  2591. var
  2592.   TextLength ,            { Total chars to output         }
  2593.   Counter_1    : integer; { Loop Index                    }
  2594. begin
  2595.   { Make the target memo visible just in case }
  2596.   TheMemoToAddTo.Visible := true;
  2597.   { Find total chars to output }
  2598.   TextLength := Length( TheTextToAdd );
  2599.   { If none then leave }
  2600.   if TextLength = 0 then exit;
  2601.   { Loop along the string }
  2602.   for Counter_1 := 1 to TextLength do
  2603.   begin
  2604.     { If hit ASCII 10 then assume end of line and output }
  2605.     if TheTextToAdd[ Counter_1 ] = #10 then
  2606.     begin
  2607.       { Use a try loop incase memo fills up }
  2608.       try
  2609.         { Add the line }
  2610.         TheMemoToAddTo.Lines.Add( TheLine );
  2611.       except
  2612.         { If memo fills up }
  2613.         on EOutOfResources do
  2614.         begin
  2615.           { Clear the old data }
  2616.           TheMemoToAddTo.Clear;
  2617.           { Output the new }
  2618.           TheMemoToAddTo.Lines.Add( TheLine );
  2619.         end;
  2620.       end;
  2621.       { clear the output buffer }
  2622.       TheLine := '';
  2623.     end
  2624.     else
  2625.     { Otherwise look for null terminator from Winsock }
  2626.     begin
  2627.       { If don't hit null terminator then add the char to op buffer }
  2628.       if TheTextToAdd[ Counter_1 ] <> #0 then
  2629.       begin
  2630.         TheLine := TheLine + TheTextToAdd[ Counter_1 ];
  2631.       end
  2632.       else break; { Otherwise drop out of the loop }
  2633.     end;
  2634.   end;
  2635. end;
  2636.  
  2637. { This function scans a line of UNIX-style text for #10's and }
  2638. { outputs the first line as its return value,stopping at #0.  }
  2639. function TCCINetCCForm.AddNullTermTextToLabel( TheTextToAdd   : String ) : String;
  2640. var
  2641.   TheLine      : String;  { Buffer to output current line }
  2642.   TextLength ,            { Total chars to output         }
  2643.   Counter_1    : integer; { Loop Index                    }
  2644. begin
  2645.   { Clear output buffer }
  2646.   TheLine := '';
  2647.   { Find total chars to output }
  2648.   TextLength := Length( TheTextToAdd );
  2649.   { If none then leave }
  2650.   if TextLength = 0 then
  2651.   begin
  2652.     { Return nothing }
  2653.     Result := '';
  2654.     { Leave }
  2655.     exit;
  2656.   end;
  2657.   { Loop along the string }
  2658.   for Counter_1 := 1 to TextLength do
  2659.   begin
  2660.     { If hit ASCII 10 then assume end of line and output }
  2661.     if TheTextToAdd[ Counter_1 ] = #10 then
  2662.     begin
  2663.       { Return first line }
  2664.       Result := TheLine;
  2665.       { Leave }
  2666.       exit;
  2667.     end
  2668.     else
  2669.     { Otherwise look for null terminator from Winsock }
  2670.     begin
  2671.       { If don't hit null terminator then add the char to op buffer }
  2672.       if TheTextToAdd[ Counter_1 ] <> #0 then
  2673.       begin
  2674.         TheLine := TheLine + TheTextToAdd[ Counter_1 ];
  2675.       end
  2676.       else break; { Otherwise drop out of the loop }
  2677.     end;
  2678.   end;
  2679.   { If hit #0 before #10 return buffer }
  2680.   Result := TheLine;
  2681. end;
  2682.  
  2683. { Show busy cursors }
  2684. procedure TCCINetCCForm.SetHGCursors;
  2685. begin
  2686.   CCInetCCForm.Cursor := crHourGlass;
  2687.   CCInetCCForm.Memo1.Cursor := crHourGlass;
  2688. end;
  2689.  
  2690. { Show normal cursors }
  2691. procedure TCCINetCCForm.SetNormalCursors;
  2692. begin
  2693.   CCInetCCForm.Cursor := crDefault;
  2694.   CCInetCCForm.Memo1.Cursor := crDefault;
  2695. end;
  2696.  
  2697. { Exit method }
  2698. procedure TCCINetCCForm.Exit1Click(Sender: TObject);
  2699. begin
  2700.   Close;
  2701. end;
  2702.  
  2703. { This method adds a line to the progress text stringlist  }
  2704. { If an exception occurs, the list is full, and it is auto }
  2705. { saved to the progress text file name, then cleared.      }
  2706. procedure TCCINetCCForm.AddProgressText( WhatText : String );
  2707. begin
  2708.   { Use a try..except loop to catch list overflows }
  2709.   try
  2710.     { Try the normal add }
  2711.     ProgressList.Add( WhatText );
  2712.   except
  2713.     { Any list error is assumed to be a list overflow }
  2714.     on EListError do
  2715.     begin
  2716.       { Save the list to the preset file name }
  2717.       ProgressList.SaveToFile( ProgressFileName );
  2718.       { Clear the list to make more room }
  2719.       ProgressList.Clear;
  2720.       { And redo the add; any further errors will except normally }
  2721.       ProgressList.Add( WhatText );
  2722.     end;
  2723.     { This might happen too! }
  2724.     on EOutOfResources do
  2725.     begin
  2726.       { Save the list to the preset file name }
  2727.       ProgressList.SaveToFile( ProgressFileName );
  2728.       { Clear the list to make more room }
  2729.       ProgressList.Clear;
  2730.       { And redo the add; any further errors will except normally }
  2731.       ProgressList.Add( WhatText );
  2732.     end;
  2733.   end;
  2734. end;
  2735.  
  2736. { This method either adds the progress line to the current memo }
  2737. { or puts it in the status caption at normal colors.            }
  2738. procedure TCCINetCCForm.ShowProgressText( WhatText : String );
  2739. begin
  2740.   { Use the POV to determine where to show progress info }
  2741.   case ProgressOutputVector of
  2742.     POV_MEMO : begin { Output into the memo  }
  2743.                  AddNullTermTextToMemo( WhatText , Memo1 );
  2744.                end;
  2745.     POV_STAT : begin { Output on status line }
  2746.                  { Set panel caption font to black }
  2747.                  Panel1.Font.Color := clBlack;
  2748.                  { Get the first line of text and put in caption }
  2749.                  Panel1.Caption := AddNullTermTextToLabel( WhatText );
  2750.                end;
  2751.   end;
  2752. end;
  2753.  
  2754. { This method is identical with SPT except sets status color to red and beeps }
  2755. procedure TCCINetCCForm.ShowProgressErrorText( WhatText : String );
  2756. begin
  2757.   { Do error beep }
  2758.   MessageBeep( mb_IconExclamation );
  2759.   { Use the POV to determine where to show progress info }
  2760.   case ProgressOutputVector of
  2761.     POV_MEMO : begin { Output into the memo  }
  2762.                  AddNullTermTextToMemo( WhatText , Memo1 );
  2763.                end;
  2764.     POV_STAT : begin { Output on status line }
  2765.                  { Set panel caption font to black }
  2766.                  Panel1.Font.Color := clRed;
  2767.                  { Get the first line of text and put in caption }
  2768.                  Panel1.Caption := AddNullTermTextToLabel( WhatText );
  2769.                end;
  2770.   end;
  2771. end;
  2772.  
  2773. { This is the boilerplate method used to handle Socket errors gracefully }
  2774. procedure TCCINetCCForm.SocketsErrorOccurred( Sender     : TObject;
  2775.                                               ErrorCode  : Integer;
  2776.                                               TheMessage : String   );
  2777. begin
  2778.   { Set the global error code flag }
  2779.   GlobalErrorCode := ErrorCode;
  2780.   { If a timeout error }
  2781.   if ErrorCode = WSAETIMEDOUT then
  2782.   begin
  2783.     { Set the aborted flag }
  2784.     GlobalAbortedFlag := True;
  2785.     { But clear the error code for graceful handling }
  2786.     GlobalErrorCode := 0;
  2787.   end
  2788.   else
  2789.   begin
  2790.     { Otherwise set the progress buffer to the error message }
  2791.     AddProgressText( TheMessage );
  2792.     { And show the progress text as set by option }
  2793.     ShowProgressErrorText( TheMessage );
  2794.   end;
  2795. end;
  2796.  
  2797. procedure TCCINetCCForm.FormCreate(Sender: TObject);
  2798. begin
  2799.   { Create the progress string list }
  2800.   ProgressList := TStringList.Create;
  2801.   { Create the file name for saving the progress list }
  2802.   ProgressFileName := ExpandFileName( 'PROGRESS.TXT' );
  2803.   { Default progress output to status line }
  2804.   ProgressOutputVector := POV_STAT;
  2805.   { Set password control stuff }
  2806.   PasswordControlVector := 2;
  2807.   CurrentPasswordString := 'guest@nowhere.com';
  2808.   CurrentRealPWString := 'guest@nowhere.com';
  2809.   { Get Ini file Data }
  2810.   ReadIniData;
  2811.   LoadFTPSiteFile;
  2812. end;
  2813.  
  2814. procedure TCCINetCCForm.FormDestroy(Sender: TObject);
  2815. begin
  2816.   { Free the progress text stringlist if assigned }
  2817.   if assigned( ProgressList ) then ProgressList.Free;
  2818.   { Save off the Ini data }
  2819.   WriteIniData;
  2820.   { Save and remove FTP site list stuff }
  2821.   SaveFTPSiteFile;
  2822.   if Assigned( TheFTPComponent ) then TheFTPComponent.Free;
  2823. end;
  2824.  
  2825. procedure TCCINetCCForm.Description1Click(Sender: TObject);
  2826. var
  2827.   TempSocket : TCCSocket; { Temporary socket just to get Winsock info }
  2828.   TheData    : String;    { Holder for data                           }
  2829. begin
  2830.   { Create socket; auto calls WSAStartup }
  2831.   TempSocket := TCCSocket.Create( Self );
  2832.   { Do parent just for kicks; no longer needed }
  2833.   TempSocket.Parent := self;
  2834.   { Put in error handler }
  2835.   TempSocket.OnErrorOccurred := SocketsErrorOccurred;
  2836.   TheData := StrPas( TempSocket.Socket_WSA_Data.Description_String );
  2837.   { Display the Description String }
  2838.   AddProgressText( TheData );
  2839.   { And show the progress text as set by option }
  2840.   ShowProgressText( TheData );
  2841.   { Free the socket; auto calls WSACleanup }
  2842.   TempSocket.Free;
  2843. end;
  2844.  
  2845. procedure TCCINetCCForm.SystemStatus1Click(Sender: TObject);
  2846. var
  2847.   TempSocket : TCCSocket; { Temporary socket just to get Winsock info }
  2848.   TheData    : String;    { Holder for data                           }
  2849. begin
  2850.   { Create socket; auto calls WSAStartup }
  2851.   TempSocket := TCCSocket.Create( Self );
  2852.   { Do parent just for kicks; no longer needed }
  2853.   TempSocket.Parent := self;
  2854.   { Put in error handler }
  2855.   TempSocket.OnErrorOccurred := SocketsErrorOccurred;
  2856.   TheData := StrPas( TempSocket.Socket_WSA_Data.System_Status_String );
  2857.   { Display the Description String }
  2858.   AddProgressText( TheData );
  2859.   { And show the progress text as set by option }
  2860.   ShowProgressText( TheData );
  2861.   { Free the socket; auto calls WSACleanup }
  2862.   TempSocket.Free;
  2863. end;
  2864.  
  2865. procedure TCCINetCCForm.VendorSpecific1Click(Sender: TObject);
  2866. var
  2867.   TempSocket : TCCSocket; { Temporary socket just to get Winsock info }
  2868.   TheData    : String;    { Holder for data                           }
  2869. begin
  2870.   { Create socket; auto calls WSAStartup }
  2871.   TempSocket := TCCSocket.Create( Self );
  2872.   { Do parent just for kicks; no longer needed }
  2873.   TempSocket.Parent := self;
  2874.   { Put in error handler }
  2875.   TempSocket.OnErrorOccurred := SocketsErrorOccurred;
  2876.   TheData := StrPas( TempSocket.Socket_WSA_Data.Vendor_Specific_String );
  2877.   { Display the Description String }
  2878.   AddProgressText( TheData );
  2879.   { And show the progress text as set by option }
  2880.   ShowProgressText( TheData );
  2881.   { Free the socket; auto calls WSACleanup }
  2882.   TempSocket.Free;
  2883. end;
  2884.  
  2885. { This method sets the progress output vector to the memo }
  2886. procedure TCCINetCCForm.ViewInEditWindow1Click(Sender: TObject);
  2887. begin
  2888.   { Set the vector }
  2889.   ProgressOutputVector := POV_MEMO;
  2890.   { Keep the menu options consistent }
  2891.   ViewInEditWindow1.Checked := true;
  2892.   ViewInStatusLine1.Checked := false;
  2893. end;
  2894.  
  2895. { This method sets the progress output vector to the status line }
  2896. procedure TCCINetCCForm.ViewInStatusLine1Click(Sender: TObject);
  2897. begin
  2898.   { Set the vector }
  2899.   ProgressOutputVector := POV_STAT;
  2900.   { Keep the menus consistent }
  2901.   ViewInEditWindow1.Checked := false;
  2902.   ViewInStatusLine1.Checked := true;
  2903. end;
  2904.  
  2905. procedure TCCINetCCForm.SaveToFile1Click(Sender: TObject);
  2906. begin
  2907.   { Set up the dialog parameters }
  2908.   OpenDialog1.Filename := ProgressFileName;
  2909.   OpenDialog1.Title := 'Select Filename for Progress File';
  2910.   OpenDialog1.Filter := 'Text Files|*.txt';
  2911.   { If the dialog is not cancelled then save and clear }
  2912.   if OpenDialog1.Execute then
  2913.   begin
  2914.     ProgressFileName := OpenDialog1.FileName;
  2915.     ProgressList.SaveToFile( ProgressFileName );
  2916.     ProgressList.Clear;
  2917.   end;
  2918. end;
  2919.  
  2920. procedure TCCINetCCForm.IPAddress1Click(Sender: TObject);
  2921. begin
  2922.   { Set up info dialog for IP Address getting }
  2923.   CCICInfoDlg.Caption := 'CC Internet Center -- Translate IP Address';
  2924.   CCICInfoDlg.Panel4.Visible := false;
  2925.   CCICInfoDlg.Panel6.Visible := false;
  2926.   CCICInfoDlg.Panel9.Visible := false;
  2927.   CCICInfoDlg.Panel8.Visible := false;
  2928.   CCICInfoDlg.BitBtn2.Visible := false;
  2929.   CCICInfoDlg.Button1.Caption := 'Get IP Address';
  2930.   CCICInfoDlg.Button2.Visible := false;
  2931.   CCICInfoDlg.Button3.Visible := false;
  2932.   CCICInfoDlg.Button4.Visible := false;
  2933.   CCICInfoDlg.Panel2.Caption := 'IP Addr Name:';
  2934.   CCICInfoDlg.Panel3.Caption := '    Dotted Dec:';
  2935.   CCICInfoDlg.Panel5.Caption := '           Binary:';
  2936.   CCICInfoDlg.Edit1.Text := '';
  2937.   CCICInfoDlg.Edit2.Text := '';
  2938.   CCICInfoDlg.Edit3.Text := '';
  2939.   { Set IP Address Mode }
  2940.   CCICInfoDlg.Tag := 1;
  2941.   { Show Modally to get the information }
  2942.   CCICInfoDlg.ShowModal;
  2943.   { Reset the info dialog to default conditions }
  2944.   CCICInfoDlg.Caption := 'CC Internet Command Center Information Dialog';
  2945.   CCICInfoDlg.Panel4.Visible := true;
  2946.   CCICInfoDlg.Panel6.Visible := true;
  2947.   CCICInfoDlg.Panel9.Visible := true;
  2948.   CCICInfoDlg.Panel8.Visible := true;
  2949.   CCICInfoDlg.BitBtn2.Visible := true;
  2950.   CCICInfoDlg.Button1.Caption := 'Anonymous Login';
  2951.   CCICInfoDlg.Button2.Visible := true;
  2952.   CCICInfoDlg.Button3.Visible := true;
  2953.   CCICInfoDlg.Button4.Visible := true;
  2954.   CCICInfoDlg.Panel2.Caption := '             Name:';
  2955.   CCICInfoDlg.Panel3.Caption := '    IP Address:';
  2956.   CCICInfoDlg.Panel5.Caption := ' User Name:';
  2957.   CCICInfoDlg.Edit1.Text := '';
  2958.   CCICInfoDlg.Edit2.Text := '';
  2959.   CCICInfoDlg.Edit3.Text := '';
  2960. end;
  2961.  
  2962. procedure TCCINetCCForm.FTP1Click(Sender: TObject);
  2963. begin
  2964.   { Set up the FTP Data displays }
  2965.   SetupFTPSiteLists;
  2966.   TheFTPComponent := TFTPComponent.Create( CCInetCCForm );
  2967.   TheFTPComponent.Parent := CCInetCCForm;
  2968. end;
  2969.  
  2970. procedure TCCINetCCForm.FormResize(Sender: TObject);
  2971. begin
  2972.   { Use tag vector to determine what to do }
  2973.   case Tag of
  2974.     { if FTP , make sure two list boxes are same height }
  2975.     2 : Panel6.Height := (( Panel4.Height div 2 ) - 30 );
  2976.   end;
  2977. end;
  2978.  
  2979. procedure TCCINetCCForm.FTPSites1Click(Sender: TObject);
  2980. begin
  2981.   { Show Modally to get the information }
  2982.   CCICInfoDlg.ShowModal;
  2983. end;
  2984.  
  2985. procedure TCCINetCCForm.FTP3Click(Sender: TObject);
  2986. begin
  2987.   CCICPrefsDlg.TabbedNoteBook1.PageIndex := 1;
  2988.   CCICPrefsDlg.Tag := 2;
  2989.   CCICPrefsDlg.ShowModal;
  2990. end;
  2991.  
  2992. procedure TCCINetCCForm.ConnectToSite1Click(Sender: TObject);
  2993. var Counter_1 : Integer;
  2994. begin
  2995.   if Lowercase( PConnectionsRecord( TheFTPSiteList.Items[
  2996.    ComboBox1.ItemIndex ] )^.CUserName ) = 'anonymous' then
  2997.   begin
  2998.     for Counter_1 := 1 to TheAnonRedialVector do
  2999.     begin
  3000.       DoFTPConnection( PConnectionsRecord(
  3001.          TheFTPSiteList.Items[ ComboBox1.ItemIndex ] ));
  3002.       if TheFTPComponent.Connection_Established then exit;
  3003.     end;
  3004.   end
  3005.   else DoFTPConnection( PConnectionsRecord(
  3006.    TheFTPSiteList.Items[ ComboBox1.ItemIndex ] ));
  3007. end;
  3008.  
  3009. procedure TCCINetCCForm.Button1Click(Sender: TObject);
  3010. begin
  3011.   case Tag of
  3012.     2 : begin
  3013.           if not TheFTPComponent.Connection_Established then
  3014.            ConnectToSite1Click( Self ) else
  3015.            begin
  3016.              DoFTPDisconnect;
  3017.              TheFTPComponent.Connection_Established := false;
  3018.              DisableFTPMenus;
  3019.            end;
  3020.         end;
  3021.   end;
  3022. end;
  3023.  
  3024. procedure TCCINetCCForm.ViewasText1Click(Sender: TObject);
  3025. begin
  3026.   { Assume valid FTP component and have it send its text into the progress text}
  3027.   TheFTPComponent.GetRemoteDirectoryListingToMemo;
  3028. end;
  3029.  
  3030. procedure TCCINetCCForm.Disconnect1Click(Sender: TObject);
  3031. begin
  3032.   DoFTPDisconnect;
  3033.   DisableFTPMenus;
  3034. end;
  3035.  
  3036. procedure TCCINetCCForm.EnableFTPMenus;
  3037. begin
  3038.   Button1.Caption := 'Disconnect';
  3039.   ConnectToSite1.Enabled := false;
  3040.   Disconnect1.Enabled := true;
  3041.   Directory1.Enabled := true;
  3042.   UploadMarked1.Enabled := true;
  3043.   DownloadMarked1.Enabled := true;
  3044. end;
  3045.  
  3046. procedure TCCINetCCForm.DisableFTPMenus;
  3047. begin
  3048.   Button1.Caption := 'Connect';
  3049.   ConnectToSite1.Enabled := true;
  3050.   Disconnect1.Enabled := false;
  3051.   Directory1.Enabled := false;
  3052.   UploadMarked1.Enabled := false;
  3053.   DownloadMarked1.Enabled := false;
  3054. end;
  3055.  
  3056. procedure TCCINetCCForm.ToDisplay1Click(Sender: TObject);
  3057. var Counter_1 : Integer;
  3058. begin
  3059.   for Counter_1 := 0 to Listbox1.Items.Count - 1 do
  3060.   begin
  3061.     if Listbox1.Selected[ Counter_1 ] then
  3062.     begin
  3063.       FileNameToXFer := ListBox1.Items[ Counter_1 ];
  3064.       TheFTPComponent.
  3065.        ReceiveASCIIRemoteFileToMemo( Listbox1.Items[ Counter_1 ] );
  3066.     end;
  3067.   end;
  3068. end;
  3069.  
  3070. procedure TCCINetCCForm.ToFile1Click(Sender: TObject);
  3071. var Counter_1 : Integer;
  3072.     W16Name   : String;
  3073. begin
  3074.   for Counter_1 := 0 to Listbox1.Items.Count - 1 do
  3075.   begin
  3076.     if Listbox1.Selected[ Counter_1 ] then
  3077.     begin
  3078.       FileNameToXFer := ListBox1.Items[ Counter_1 ];
  3079.       W16Name := TheFTPComponent.GetWin16Filename( FileNameToXFer );
  3080.       TheFTPComponent.
  3081.        ReceiveASCIIRemoteFile( Listbox1.Items[ Counter_1 ] , W16Name );
  3082.     end;
  3083.   end;
  3084. end;
  3085.  
  3086. procedure TCCINetCCForm.Binary2Click(Sender: TObject);
  3087. var Counter_1 : Integer;
  3088.     W16Name   : String;
  3089. begin
  3090.   for Counter_1 := 0 to Listbox1.Items.Count - 1 do
  3091.   begin
  3092.     if Listbox1.Selected[ Counter_1 ] then
  3093.     begin
  3094.       FileNameToXFer := ListBox1.Items[ Counter_1 ];
  3095.       W16Name := TheFTPComponent.GetWin16Filename( FileNameToXFer );
  3096.       TheFTPComponent.
  3097.        ReceiveBinaryRemoteFile( Listbox1.Items[ Counter_1 ] , W16Name );
  3098.     end;
  3099.   end;
  3100. end;
  3101.  
  3102. procedure TCCINetCCForm.Change1Click(Sender: TObject);
  3103. var TheDir : String;
  3104. begin
  3105.   if ListBox1.ItemIndex = -1 then exit;
  3106.   TheDir := ListBox1.Items[ ListBox1.ItemIndex ];
  3107.   if TheFTPComponent.SetRemoteDirectory( TheDir ) then
  3108.   begin
  3109.     TheFTPComponent.GetRemoteWorkingDirectory( TheDir ); 
  3110.     { Put up remote directory via PWD and strip quotes }
  3111.     Label4.Caption := TheFTPComponent.GetQuotedString( TheDir );
  3112.     { Get the listings of directories and exit OK }
  3113.     TheFTPComponent.GetRemoteDirectoryListing( Listbox1 );
  3114.   end;
  3115. end;
  3116.  
  3117. procedure TCCINetCCForm.ChangeLocal1Click(Sender: TObject);
  3118. var TheDir : String;
  3119. begin
  3120.   if ListBox2.ItemIndex = -1 then exit;
  3121.   TheDir := ListBox2.Items[ ListBox2.ItemIndex ];
  3122.   TheDir := TheFTPComponent.StripBrackets( TheDir );
  3123.   if TheDir = '..' then
  3124.   begin
  3125.     ChDir( TheDir );
  3126.   end
  3127.   else
  3128.   begin
  3129.     TheDir := ExpandFileName( TheDir );
  3130.     ChDir( TheDir );
  3131.   end;
  3132.   TheFTPComponent.GetLocalDirectoryAndListing( TheDir , Listbox2 );
  3133.   if Label5.Canvas.TextWidth( TheDir ) > Label5.Width then
  3134.    TheDir := TheFTPComponent.GetShortPathName( TheDir );
  3135.   Label5.Caption := TheDir;
  3136. end;
  3137.  
  3138. procedure TCCINetCCForm.ListBox1DblClick(Sender: TObject);
  3139. begin
  3140.   case Tag of
  3141.     2 : begin
  3142.           case DefaultDownLoadVector of
  3143.             1 : Binary2Click( Self );
  3144.             2 : ToFile1Click( Self );
  3145.             3 : Change1Click( Self );
  3146.           end;
  3147.         end;
  3148.   end;
  3149. end;
  3150.  
  3151. procedure TCCINetCCForm.ListBox2DblClick(Sender: TObject);
  3152. begin
  3153.   case Tag of
  3154.     2 : begin
  3155.           case DefaultDownLoadVector of
  3156.             1 : Binary1Click( Self );
  3157.             2 : ASCII1Click( Self );
  3158.             3 : ChangeLocal1Click( Self );
  3159.           end;
  3160.         end;
  3161.   end;
  3162. end;
  3163.  
  3164. procedure TCCINetCCForm.ASCII1Click(Sender: TObject);
  3165. var Counter_1 : Integer;
  3166.     TheDir    : String;
  3167. begin
  3168.   for Counter_1 := 0 to Listbox2.Items.Count - 1 do
  3169.   begin
  3170.     if Listbox2.Selected[ Counter_1 ] then
  3171.     begin
  3172.       FileNameToXFer := ListBox2.Items[ Counter_1 ];
  3173.       TheFTPComponent.
  3174.        SendASCIILocalFile( Listbox2.Items[ Counter_1 ] );
  3175.     end;
  3176.   end;
  3177.   TheFTPComponent.GetRemoteWorkingDirectory( TheDir );
  3178.   { Put up remote directory via PWD and strip quotes }
  3179.   Label4.Caption := TheFTPComponent.GetQuotedString( TheDir );
  3180.   { Get the listings of directories and exit OK }
  3181.   TheFTPComponent.GetRemoteDirectoryListing( Listbox1 );
  3182. end;
  3183.  
  3184. procedure TCCINetCCForm.DeleteRemoteFiles1Click(Sender: TObject);
  3185. var Counter_1 : Integer;
  3186.     TheDir    : String;
  3187.     DoAll     : Boolean;
  3188.     TheResult : Integer;
  3189. begin
  3190.   DoAll := false;
  3191.   for Counter_1 := 0 to Listbox1.Items.Count - 1 do
  3192.   begin
  3193.     if Listbox1.Selected[ Counter_1 ] then
  3194.     begin
  3195.       if not DoAll then
  3196.       begin
  3197.         TheResult := MessageDlg( 'Delete Remote File ' +
  3198.          ListBox1.Items[ Counter_1 ] + ' ?',mtConfirmation,
  3199.           [mbYes,mbNo,mbCancel,mbAll],0 );
  3200.         case TheResult of
  3201.           mrYes : ;
  3202.           mrNo  : ;
  3203.           mrCancel : break;
  3204.           mrAll : begin
  3205.                     TheResult := mrYes;
  3206.                     DoAll := true;
  3207.                   end;
  3208.         end;
  3209.       end;
  3210.       if TheResult = mrYes then TheFTPComponent.
  3211.          DeleteRemoteFile( Listbox1.Items[ Counter_1 ] );
  3212.     end;
  3213.   end;
  3214.   TheFTPComponent.GetRemoteWorkingDirectory( TheDir );
  3215.   { Put up remote directory via PWD and strip quotes }
  3216.   Label4.Caption := TheFTPComponent.GetQuotedString( TheDir );
  3217.   { Get the listings of directories and exit OK }
  3218.   TheFTPComponent.GetRemoteDirectoryListing( Listbox1 );
  3219. end;
  3220.  
  3221. procedure TCCINetCCForm.Binary1Click(Sender: TObject);
  3222. var Counter_1 : Integer;
  3223.     TheDir    : String;
  3224. begin
  3225.   for Counter_1 := 0 to Listbox2.Items.Count - 1 do
  3226.   begin
  3227.     if Listbox2.Selected[ Counter_1 ] then
  3228.     begin
  3229.       FileNameToXFer := ListBox2.Items[ Counter_1 ];
  3230.       TheFTPComponent.
  3231.        SendBinaryLocalFile( Listbox2.Items[ Counter_1 ] );
  3232.     end;
  3233.   end;
  3234.   TheFTPComponent.GetRemoteWorkingDirectory( TheDir );
  3235.   { Put up remote directory via PWD and strip quotes }
  3236.   Label4.Caption := TheFTPComponent.GetQuotedString( TheDir );
  3237.   { Get the listings of directories and exit OK }
  3238.   TheFTPComponent.GetRemoteDirectoryListing( Listbox1 );
  3239. end;
  3240.  
  3241. procedure TCCINetCCForm.Delete3Click(Sender: TObject);
  3242. var Counter_1 : Integer;
  3243.     TheDir    : String;
  3244. begin
  3245.   for Counter_1 := 0 to Listbox1.Items.Count - 1 do
  3246.   begin
  3247.     if Listbox1.Selected[ Counter_1 ] then
  3248.     begin
  3249.       if ListBox1.Items[ Counter_1 ] <> '..' then
  3250.        TheFTPComponent.
  3251.         DeleteRemoteDirectory( Listbox1.Items[ Counter_1 ] );
  3252.     end;
  3253.   end;
  3254.   TheFTPComponent.GetRemoteWorkingDirectory( TheDir );
  3255.   { Put up remote directory via PWD and strip quotes }
  3256.   Label4.Caption := TheFTPComponent.GetQuotedString( TheDir );
  3257.   { Get the listings of directories and exit OK }
  3258.   TheFTPComponent.GetRemoteDirectoryListing( Listbox1 );
  3259. end;
  3260.  
  3261. procedure TCCINetCCForm.Create1Click(Sender: TObject);
  3262. var TheDir : String;
  3263. begin
  3264.   OpenDialog1.Filename := '*.*';
  3265.   OpenDialog1.Title := 'Enter Remote Directory Name';
  3266.   if OpenDialog1.Execute then
  3267.   begin
  3268.     TheFTPComponent.
  3269.      CreateRemoteDirectory( ExtractFileName( OpenDialog1.FileName ));
  3270.     TheFTPComponent.GetRemoteWorkingDirectory( TheDir );
  3271.     { Put up remote directory via PWD and strip quotes }
  3272.     Label4.Caption := TheFTPComponent.GetQuotedString( TheDir );
  3273.     { Get the listings of directories and exit OK }
  3274.     TheFTPComponent.GetRemoteDirectoryListing( Listbox1 );
  3275.   end;
  3276. end;
  3277.  
  3278. end.
  3279.