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