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