home *** CD-ROM | disk | FTP | other *** search
/ Delphi 2 - Developers' Solutions / Delphi 2 Developers' Solutions.iso / dds / chap10 / howto01 / delphi10 / cciccfrm.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-06-12  |  145.1 KB  |  4,220 lines
  1. unit Cciccfrm;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, ExtCtrls, StdCtrls, Buttons, Menus, FileCtrl, CCWSock, CCICCInf,
  8.   CCICCPrf, IniFiles, Gauges;
  9.  
  10. type
  11.   { This record holds the information for a number of internet connections }
  12.   PConnectionsRecord = ^TConnectionsRecord;
  13.   TConnectionsRecord = record
  14.     CProfile   : String; { Connection profile; used in lists }
  15.     CIPAddress : String; { Dotted character IP Address       }
  16.     CUserName  : String; { Login name to site; can be anonym }
  17.     CPassword  : String; { Password; won't be shown          }
  18.     CStartDir  : String; { Starting directory; used for FTP  }
  19.   end;
  20.   { Array of TCR }
  21.   CRFile = file of TConnectionsRecord; { File type for TCRec }
  22.   { This record is used to hold information about a newsgroup            }
  23.   { NOTE : hi and low pointers indicate either dl or trashing without dl }
  24.   { "read" is for an article dl'd but not trashed.                       }
  25.   PNewsGroupRecord = ^TNewsGroupRecord;
  26.   TNewsGroupRecord = record
  27.     GName                : String;  { Profile of the newsgroup              }
  28.     GRealName            : String;  { Real Newsrc name of the newsgroup     }
  29.     GLowest              : Longint; { Number of lowest dl/trashed article   }
  30.     GHighest             : Longint; { Number of highest dl/trashed article  }
  31.     GTotalNew            : Longint; { Total New articles available          }
  32.     GTotalAvailable      : Longint; { After update, shows how many arts on s}
  33.     GLowestAvailable     : Longint; { au, shows lowest a# on server         }
  34.     GHighestAvailable    : Longint; { au, shows highest a# on server        }
  35.     GPostable            : Boolean; { Can post to newsgroup                 }
  36.     GSubscribed          : Boolean; { Subscribed to newsgroup               }
  37.     GTotalArticles       : Longint; { Total articles maintained on system   }
  38.     GTotalUnReadArticles : Longint; { Total unread articles on system       }
  39.     GIDNumber            : Integer;
  40.     GFileName            : String;  { Name of file holding articles records }
  41.     GLTag                : Longint; { Tag field to hold pointer to arts TL  }
  42.   end;
  43.   NGRFile = file of TNewsGroupRecord; { File type for NGRec }
  44.   { This record is used to hold information about Newsgroup articles }
  45.   PNewsGroupArticleRecord = ^TNewsGroupArticleRecord;
  46.   TNewsGroupArticleRecord = record
  47.     NGAGroupname   : String;  { Newsgroup name (redundancy safeguard)     }
  48.     NGASubject     : String;  { Subject of article                        }
  49.     NGANumber      : Longint; { Article number                            }
  50.     NGADownloaded  : boolean; { Article attempted/succeeded downloading   }
  51.     NGASender      : String;  { Article's putative sender (CIUPKC158=us)  }
  52.     NGARead        : Boolean; { Article read flag                         }
  53.     NGAPosted      : Boolean; { Article posted flag                       }
  54.     NGAArtFileName : String;  { Name of system-gen file with article text }
  55.   end;
  56.   NGARFile = file of TNewsGroupArticleRecord;
  57.   TCCINetCCForm = class(TForm)
  58.     MainMenu1: TMainMenu;
  59.     Network1: TMenuItem;
  60.     N1: TMenuItem;
  61.     Exit1: TMenuItem;
  62.     Services1: TMenuItem;
  63.     IPAddress1: TMenuItem;
  64.     EMail1: TMenuItem;
  65.     FTP1: TMenuItem;
  66.     UsenetNws1: TMenuItem;
  67.     Panel1: TPanel;
  68.     Panel2: TPanel;
  69.     Panel3: TPanel;
  70.     Panel4: TPanel;
  71.     Panel5: TPanel;
  72.     Panel6: TPanel;
  73.     ListBox1: TListBox;
  74.     Panel7: TPanel;
  75.     SpeedButton1: TSpeedButton;
  76.     SpeedButton2: TSpeedButton;
  77.     ListBox2: TListBox;
  78.     ComboBox1: TComboBox;
  79.     Button1: TButton;
  80.     Memo1: TMemo;
  81.     Files1: TMenuItem;
  82.     Edit1: TMenuItem;
  83.     Encoding1: TMenuItem;
  84.     EMail2: TMenuItem;
  85.     FTP2: TMenuItem;
  86.     News1: TMenuItem;
  87.     Load1: TMenuItem;
  88.     Save1: TMenuItem;
  89.     Cut1: TMenuItem;
  90.     Copy1: TMenuItem;
  91.     CopytoFile1: TMenuItem;
  92.     Paste1: TMenuItem;
  93.     PastefromFile1: TMenuItem;
  94.     UUDecode1: TMenuItem;
  95.     MIMEDecode1: TMenuItem;
  96.     UUEncode1: TMenuItem;
  97.     MIMEEncode1: TMenuItem;
  98.     CheckMail1: TMenuItem;
  99.     ReplyToCurrentMessage1: TMenuItem;
  100.     SendCurrentMessage1: TMenuItem;
  101.     SendQueue1: TMenuItem;
  102.     Mailboxes1: TMenuItem;
  103.     Correspondents1: TMenuItem;
  104.     EmptyTrash1: TMenuItem;
  105.     SpeedButton4: TSpeedButton;
  106.     SpeedButton5: TSpeedButton;
  107.     SpeedButton3: TSpeedButton;
  108.     Panel8: TPanel;
  109.     Label1: TLabel;
  110.     Label2: TLabel;
  111.     ComboBox2: TComboBox;
  112.     Label3: TLabel;
  113.     ComboBox3: TComboBox;
  114.     ConnectToSite1: TMenuItem;
  115.     Disconnect1: TMenuItem;
  116.     UploadMarked1: TMenuItem;
  117.     DownloadMarked1: TMenuItem;
  118.     Directory1: TMenuItem;
  119.     ASCII1: TMenuItem;
  120.     Binary1: TMenuItem;
  121.     ASCII2: TMenuItem;
  122.     Binary2: TMenuItem;
  123.     ViewRemoteasText1: TMenuItem;
  124.     FTPSites1: TMenuItem;
  125.     CheckNewNews1: TMenuItem;
  126.     GetMarked1: TMenuItem;
  127.     CreateNewMessage1: TMenuItem;
  128.     Article1: TMenuItem;
  129.     SubscribedNewsgroups1: TMenuItem;
  130.     Trash1: TMenuItem;
  131.     Preferences1: TMenuItem;
  132.     EMail3: TMenuItem;
  133.     FTP3: TMenuItem;
  134.     News2: TMenuItem;
  135.     Label4: TLabel;
  136.     Label5: TLabel;
  137.     ViewasText1: TMenuItem;
  138.     Change1: TMenuItem;
  139.     Create1: TMenuItem;
  140.     Delete3: TMenuItem;
  141.     ChangeLocal1: TMenuItem;
  142.     OpenDialog1: TOpenDialog;
  143.     SaveDialog1: TSaveDialog;
  144.     Paths1: TMenuItem;
  145.     ProgressInfo1: TMenuItem;
  146.     N2: TMenuItem;
  147.     ViewInEditWindow1: TMenuItem;
  148.     ViewInStatusLine1: TMenuItem;
  149.     SaveToFile1: TMenuItem;
  150.     ViewWinsockInfo1: TMenuItem;
  151.     Description1: TMenuItem;
  152.     SystemStatus1: TMenuItem;
  153.     VendorSpecific1: TMenuItem;
  154.     Gauge1: TGauge;
  155.     NewsServers1: TMenuItem;
  156.     AllReadArticles1: TMenuItem;
  157.     AllMarkedArticles1: TMenuItem;
  158.     AllAvailableArticles1: TMenuItem;
  159.     NewArticle1: TMenuItem;
  160.     FollowupArticle1: TMenuItem;
  161.     Post1: TMenuItem;
  162.     CurrentArticle1: TMenuItem;
  163.     EntireQueue1: TMenuItem;
  164.     ConnectandUpdate1: TMenuItem;
  165.     Disconnect2: TMenuItem;
  166.     Headers1: TMenuItem;
  167.     RetrieveMarked1: TMenuItem;
  168.     RetrieveAll1: TMenuItem;
  169.     DownloadActiveNewsgroups1: TMenuItem;
  170.     PutinQueue1: TMenuItem;
  171.     TrashMarkedMessages1: TMenuItem;
  172.     MailServers1: TMenuItem;
  173.     ExitEMailRequired1: TMenuItem;
  174.     ToCurrentMessage1: TMenuItem;
  175.     ToNewMessage1: TMenuItem;
  176.     ToFile2: TMenuItem;
  177.     AbortNewsgroupDownload1: TMenuItem;
  178.     Catchup1: TMenuItem;
  179.     Marked1: TMenuItem;
  180.     All1: TMenuItem;
  181.     File1: TMenuItem;
  182.     SelectedArticle1: TMenuItem;
  183.     SelectMultipleArticles1: TMenuItem;
  184.     DecodeSelections1: TMenuItem;
  185.     procedure Exit1Click(Sender: TObject);
  186.     procedure FormCreate(Sender: TObject);
  187.     procedure FormDestroy(Sender: TObject);
  188.     procedure Description1Click(Sender: TObject);
  189.     procedure SystemStatus1Click(Sender: TObject);
  190.     procedure VendorSpecific1Click(Sender: TObject);
  191.     procedure ViewInEditWindow1Click(Sender: TObject);
  192.     procedure ViewInStatusLine1Click(Sender: TObject);
  193.     procedure SaveToFile1Click(Sender: TObject);
  194.     procedure IPAddress1Click(Sender: TObject);
  195.     procedure FTP1Click(Sender: TObject);
  196.     procedure FormResize(Sender: TObject);
  197.     procedure FTPSites1Click(Sender: TObject);
  198.     procedure FTP3Click(Sender: TObject);
  199.     procedure ConnectToSite1Click(Sender: TObject);
  200.     procedure Button1Click(Sender: TObject);
  201.     procedure ViewasText1Click(Sender: TObject);
  202.     procedure Disconnect1Click(Sender: TObject);
  203.     procedure ToDisplay1Click(Sender: TObject);
  204.     procedure ToFile1Click(Sender: TObject);
  205.     procedure Binary2Click(Sender: TObject);
  206.     procedure Change1Click(Sender: TObject);
  207.     procedure ChangeLocal1Click(Sender: TObject);
  208.     procedure ListBox1DblClick(Sender: TObject);
  209.     procedure ListBox2DblClick(Sender: TObject);
  210.     procedure ASCII1Click(Sender: TObject);
  211.     procedure DeleteRemoteFiles1Click(Sender: TObject);
  212.     procedure Binary1Click(Sender: TObject);
  213.     procedure Delete3Click(Sender: TObject);
  214.     procedure Create1Click(Sender: TObject);
  215.     procedure ListBox1Click(Sender: TObject);
  216.     procedure UsenetNws1Click(Sender: TObject);
  217.     procedure Disconnect2Click(Sender: TObject);
  218.     procedure News2Click(Sender: TObject);
  219.     procedure ConnectandUpdate1Click(Sender: TObject);
  220.     procedure NewsServers1Click(Sender: TObject);
  221.     procedure SubscribedNewsgroups1Click(Sender: TObject);
  222.     procedure Load1Click(Sender: TObject);
  223.     procedure Save1Click(Sender: TObject);
  224.     procedure Paths1Click(Sender: TObject);
  225.     procedure Cut1Click(Sender: TObject);
  226.     procedure Copy1Click(Sender: TObject);
  227.     procedure CopytoFile1Click(Sender: TObject);
  228.     procedure Paste1Click(Sender: TObject);
  229.     procedure PastefromFile1Click(Sender: TObject);
  230.     procedure SpeedButton1Click(Sender: TObject);
  231.     procedure SpeedButton2Click(Sender: TObject);
  232.     procedure ListBox2Click(Sender: TObject);
  233.   private
  234.     { Private declarations }
  235.   public
  236.     { Public declarations }
  237.     procedure EnableFTPMenus;
  238.     procedure DisableFTPMenus;
  239.     procedure EnableNNTPMenus;
  240.     procedure DisableNNTPMenus;
  241.     procedure UpdateGauge( BytesFinished , TotalToHandle : longint );
  242.     procedure UpdateUUGauge( BytesFinished , TotalToHandle : longint );
  243.     function DoFTPConnection( PCRPointer : PConnectionsRecord ) : boolean;
  244.     function DoNNTPConnection( PCRPointer : PConnectionsRecord ) : boolean;
  245.     procedure DoFTPDisconnect;
  246.     procedure DoNNTPDisconnect;
  247.     procedure ReadIniData;
  248.     procedure WriteIniData;
  249.     procedure LoadFTPSiteFile;
  250.     procedure LoadNNTPSiteFile;
  251.     procedure SetupNNTPServersInfoDisplay;
  252.     procedure SaveFTPSiteFile;
  253.     procedure SetupFTPSiteLists;
  254.     procedure SaveNNTPSiteFile;
  255.     procedure SetupNNTPSiteLists;
  256.     procedure SetupNNTPNewsGroupsInfoDisplay;
  257.     procedure SetupNNTPNewsGroupLists;
  258.     procedure SaveNNTPNewsGroupLists;
  259.     procedure SetupNewsGroupListboxes;
  260.     procedure PopulateLB2WithArticleHeaders;
  261.     procedure AddNullTermTextToMemo( TheTextToAdd   : String;
  262.                                      TheMemoToAddTo : TMemo   );
  263.     function AddNullTermTextToLabel( TheTextToAdd   : String ) : String;
  264.     procedure SetHGCursors;
  265.     procedure SetNormalCursors;
  266.     procedure AddProgressText( WhatText : String );
  267.     procedure ShowProgressText( WhatText : String );
  268.     procedure ShowProgressErrorText( WhatText : String );
  269.     procedure SocketsErrorOccurred( Sender     : TObject;
  270.                                      ErrorCode  : Integer;
  271.                                      TheMessage : String   );
  272.   end;
  273.   { Component to hold FTP handling capabilities }
  274.   TFTPComponent = class( TWinControl )
  275.   public
  276.     FTPCommandInProgress ,
  277.     Connection_Established : Boolean;
  278.     Socket1 : TCCSocket;
  279.     Socket2 : TCCSocket;
  280.     constructor Create( AOwner : TComponent ); override;
  281.     destructor Destroy; override;
  282.     function GetTotalBytesToReceive( TheString : String ) : Longint;
  283.     function StripBrackets( TheString : String ) : String;
  284.     function GetShortPathname( TheString : String ) : String;
  285.     function GetWin16FileName( InputName : String ) : String;
  286.     function GetRemoteWorkingDirectory( var RemoteDir : String ) : Boolean;
  287.     function SetRemoteDirectory( TheDir : String ) : Boolean;
  288.     function DeleteRemoteDirectory( TheDir : String ) : Boolean;
  289.     function CreateRemoteDirectory( TheDir : String ) : Boolean;
  290.     function DeleteRemoteFile( TheFileName : String ) : Boolean;
  291.     function EstablishConnection( PCRPointer : PConnectionsRecord ) : Boolean;
  292.     function LoginUser( PCRPointer : PConnectionsRecord ) : Boolean;
  293.     function SendPassword( PCRPointer : PConnectionsRecord ) : Boolean;
  294.     function SetRemoteStartupDirectory( PCRPointer : PConnectionsRecord )
  295.               : Boolean;
  296.     function GetRemoteDirectoryListing( TheListBox : TListBox ) : Boolean;
  297.     function GetRemoteDirectoryListingToMemo : Boolean;
  298.     procedure SendASCIILocalFile( LocalName : String );
  299.     procedure SendBinaryLocalFile( LocalName : String );
  300.     procedure ReceiveASCIIRemoteFile( RemoteName , LocalName : String );
  301.     procedure ReceiveBinaryRemoteFile( RemoteName , LocalName : String );
  302.     function GetLocalDirectoryAndListing( var TheString : String;
  303.                                               TheListBox : TListBox )
  304.               : Boolean;
  305.     function GetUNIXTextString( var StringIn : String ) : String;
  306.     procedure ReceiveASCIIRemoteFileToMemo( RemoteName : String );
  307.     function GetListeningPort : Integer;
  308.     procedure GetFileNameFromUNIXFileName( var TheName : String );
  309.     function Disconnect : Boolean;
  310.     function DoCStyleFormat(       TheText      : string;
  311.                              const TheArguments : array of const ) : String;
  312.     procedure UpdateGauge( BytesFinished , TotalToHandle : longint );
  313.     function GetQuotedString( TheString : String ) : String;
  314.     procedure AddProgressText( WhatText : String );
  315.     procedure ShowProgressText( WhatText : String );
  316.     procedure ShowProgressErrorText( WhatText : String );
  317.     function GetFTPServerResponse( var ResponseString : String ) : integer;
  318.     procedure FTPSocketsErrorOccurred( Sender     : TObject;
  319.                                      ErrorCode  : Integer;
  320.                                      TheMessage : String   );
  321.     function PerformFTPCommand(
  322.                     TheCommand   : string;
  323.               const TheArguments : array of const ) : Integer;
  324.   end;
  325. const
  326.   POV_MEMO                 = 1; { Progress to the Memo           }
  327.   POV_STAT                 = 2; { Progress to the status caption }
  328.   TCPIP_STATUS_PRELIMINARY   = 1; { Wait; command being processed  }
  329.   TCPIP_STATUS_COMPLETED     = 2; { Done; command fully succeded   }
  330.   TCPIP_STATUS_CONTINUING    = 3; { OK; send more data to finish   }
  331.   TCPIP_STATUS_RETRY_COMMAND = 4; { Temporary Error; try cmd again }
  332.   TCPIP_STATUS_FATAL_ERROR   = 5; { Fatal Error; don't retry cmd   }
  333.  
  334. var
  335.   CCINetCCForm         : TCCINetCCForm;
  336.   GlobalErrorCode      : Integer;        { Used to pass around error info  }
  337.   GlobalAbortedFlag    : Boolean;        { Used to signal timeout error    }
  338.   ProgressList         : TStringList;    { Used to hold progress text info }
  339.   ProgressFileName     : String;         { Used to hold progress file name }
  340.   ProgressOutputVector : Integer;        { Used to direct progress output  }
  341.   TheFTPSiteList       : TList;          { Used to store the FTP site recs }
  342.   TheWorkingFTPSL      : TList;          { Used to store working copy of l }
  343.   TheNewsServerList    : TList;          { Used to hold list of NNTP servs }
  344.   TheWorkingNSSL       : TList;          { Used for working copy of above  }
  345.   TheEMailServerList   : TList;          { Used for list of POP3/SMTP serv }
  346.   TheWorkingEMSL       : TList;          { Used for working copy of above  }
  347.   TheNewsRCList        : TList;          { Used for list of available ngs  }
  348.   TheWorkingNRCSL      : TList;          { Used for working copy of above  }
  349.   TheNGArticlesList    : TList;          { Used for current articles list  }
  350.                                          { (will hot swap from pointer of  }
  351.                                          {  Tlist of Tlists in base rec.)  }
  352.   TheNewsServerFile    : CRFile;         { File of NNTP servers records    }
  353.   TheNewsRCFile        : NGRFile;        { File of Newsgroups records      }
  354.   TheNewsArticleFile   : NGARFile;       { Current ng articles records file}
  355.   TheFTPSiteFile       : CRFile;         { Used to load the FTP site file  }
  356.   TheICCIniFile        : TIniFile;       { Used to retrieve the INI File   }
  357.   MailPath             : String;         { Used for path to Mail Files     }
  358.   NewsPath             : String;         { Used for path to News Files     }
  359.   FTPPath              : String;         { Used for path to FTP Files      }
  360.   CurrentPassWordString : String;        { Used to hold login id for anons }
  361.   CurrentEMPassWordString : String;      { Used to hold login id for anons }
  362.   PassWordControlVector : Integer;       { Used to hold display of pw vect }
  363.   CurrentRealPWString   : String;        { Used to hold a real password    }
  364.   EMPassWordControlVector : Integer;       { Used to hold display of pw vect }
  365.   CurrentEMRealPWString   : String;        { Used to hold a real password    }
  366.   TheFTPComponent       : TFTPComponent; { FTP Object                      }
  367.   TheLine ,
  368.   HolderLine ,
  369.   GlobalTextBuffer      : String;
  370.   TheAnonRedialVector ,
  371.   DefaultDownloadVector : Integer;
  372.   NewsReadArticlePurgingVector : Integer;
  373.   NewsPostQueueingVector : Integer;
  374.   NewsReadArticleDisplayVector : Integer;
  375.   NewsUUMIMEVector : Integer;
  376.   NewsInitialUpdateVector : Integer;
  377.   LeftoverText          : String;
  378.   LeftoversOnTable      : Boolean;
  379.   FileNameToXFer        : String;
  380.   WhichServer           : Integer;       { Holds current NNTP server }
  381.   WhichGroup            : Integer;       { Holds current NNTP newsgroup }
  382.   EMRemoteDeletionVector : Integer;
  383.   EMChokeVector : Integer;
  384.   EMDefaultDownloadVector : Integer;
  385.   EMQueueVector : Integer;
  386.   NewsgroupListLoaded ,
  387.   EmailLoaded ,
  388.   NewMessageInProgress : Boolean;
  389.   TheUUDecodeList      : TStringList;
  390.   
  391. implementation
  392.  
  393. uses CCICNNTP;
  394.  
  395. var
  396.   TheNNTPComponent      : TNNTPComponent;{ NNTP News Object                }
  397.  
  398. {$R *.DFM}
  399.  
  400.  
  401.  
  402. { This is the FTP component constructor; it creates 2 sockets }
  403. constructor TFTPComponent.Create( AOwner : TComponent );
  404. begin
  405.   { do inherited create }
  406.   inherited Create( AOwner );
  407.   { Create sockets, put in their parents, and error procs }
  408.   Socket1 := TCCSocket.Create( Self );
  409.   Socket1.Parent := Self;
  410.   Socket1.OnErrorOccurred := FTPSocketsErrorOccurred;
  411.   Socket2 := TCCSocket.Create( Self );
  412.   Socket2.Parent := Self;
  413.   Socket2.OnErrorOccurred := FTPSocketsErrorOccurred;
  414.   { Set up booleans }
  415.   Connection_Established := false;
  416.   FTPCommandInProgress := false;
  417. end;
  418.  
  419. { This is the FTP component destructor; it frees 2 sockets }
  420. destructor TFTPComponent.Destroy;
  421. begin
  422.   { Free the sockets }
  423.   Socket1.Free;
  424.   Socket2.Free;
  425.   { and call inherited }
  426.   inherited Destroy;
  427. end;
  428.  
  429. function TFTPComponent.GetShortPathname( TheString : String ) : String;
  430. var HoldingString : String;
  431. begin
  432.   HoldingString := Copy( TheString , 1 , 3 );
  433.   HoldingString := HoldingString + '..\' + ExtractFileName( TheString );
  434.   Result := HoldingString;
  435. end;
  436.  
  437. function TFTPComponent.StripBrackets( TheString : String ) : String;
  438. var HoldingString : String;
  439.     HoldingPosition : Integer;
  440. begin
  441.   HoldingPosition := Pos( '[' , TheString );
  442.   if HoldingPosition = 0 then
  443.   begin
  444.     Result := TheString;
  445.     exit;
  446.   end
  447.   else
  448.   begin
  449.     HoldingString := Copy( TheString , HoldingPosition + 1 , 255 );
  450.     HoldingPosition := Pos( ']' , HoldingString );
  451.     if HoldingPosition = 0 then
  452.     begin
  453.       Result := HoldingString;
  454.       exit;
  455.     end
  456.     else
  457.     begin
  458.       HoldingString := Copy( HoldingString , 1 , HoldingPosition - 1 );
  459.       Result := HoldingString;
  460.       exit;
  461.     end;
  462.   end;
  463. end;
  464.  
  465. { This function takes a UNIX filespec and turns it into a Win16 filename }
  466. function TFTPComponent.GetWin16FileName( InputName : String ) : String;
  467. var WorkingString ,
  468.     HoldingString   : String; { Holding string }
  469. begin
  470.   WorkingString := ExtractFileExt( InputName );
  471.   if WorkingString = '' then
  472.   begin
  473.     if Length( InputName ) > 8 then
  474.      WorkingString := Copy( InputName , 1 , 8 ) else
  475.       WorkingString := InputName;
  476.   end
  477.   else
  478.   begin
  479.     if Length( WorkingString ) > 4 then
  480.      WorkingString := Copy( WorkingString , 1 , 4 );
  481.     HoldingString :=
  482.      Copy( InputName , 1 , Pos( WorkingString , InputName ) - 1 );
  483.     if Length( HoldingString ) > 8 then
  484.      HoldingString := Copy( HoldingString , 1 , 8 );
  485.     if HoldingString = '' then
  486.     begin
  487.       { Dot file }
  488.       HoldingString := Copy( InputName , 2 , 255 ) + '.TXT';
  489.       WorkingString := HoldingString;
  490.     end
  491.     else WorkingString := HoldingString + WorkingString;
  492.   end;
  493.   Result := WorkingString;
  494. end;
  495.  
  496. { This sends a local file in binary mode to the remote server }
  497. procedure TFTPComponent.SendBinaryLocalFile( LocalName : String );
  498. var TheReturnString : String;  { Internal string holder }
  499.     TheResult       : Integer; { Internal int holder    }
  500.     Through         : Boolean;
  501.     FileNamePChar   : array[ 0 .. 255 ] of char;
  502.     OutputFileHandle : Integer;
  503.     TotalBytesSent ,
  504.     BytesRead ,
  505.     FileToSendSize    : Longint;
  506.     CopyBuffer       : array[ 0 .. 255 ] of char absolute TheReturnString;
  507. begin
  508.   LocalName := ExpandFileName( LocalName );
  509.   StrPCopy( FileNamePChar , LocalName );
  510.   OutputFileHandle := _lopen( FileNamePChar , 0 );
  511.   if OutputFileHandle = -1 then
  512.   begin
  513.     MessageDlg( 'Cannot Open local file ' + LocalName ,
  514.      mtError , [mbOK] , 0 );
  515.     exit;
  516.   end;
  517.   FileToSendSize := _llseek( OutputFileHandle , 0 , 2 );
  518.   _llseek( OutputFileHandle , 0 , 0 );
  519.   TheReturnString :=
  520.    DoCStyleFormat( 'TYPE I' ,
  521.     [ nil ] );
  522.   { Put result in progress and status line }
  523.   AddProgressText( TheReturnString );
  524.   ShowProgressText( TheReturnString );
  525.   { Send Password sequence }
  526.   TheResult := PerformFTPCommand( 'TYPE I',
  527.                                   [ nil ] );
  528.   if TheResult <> TCPIP_STATUS_PRELIMINARY then
  529.   begin
  530.     FTPCommandInProgress := false;
  531.     exit;
  532.   end;
  533.   repeat
  534.     TheResult := GetFTPServerResponse( TheReturnString );
  535.     { Put result in progress and status line }
  536.     AddProgressText( TheReturnString );
  537.     ShowProgressText( TheReturnString );
  538.   until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  539.   FTPCommandInProgress := false;
  540.   if ( GlobalAbortedFlag or ( TheResult <> TCPIP_STATUS_COMPLETED )) then
  541.   begin
  542.     { Do clever C formatting trick }
  543.     TheReturnString :=
  544.      DoCStyleFormat( 'FTP File Send Failed!' ,
  545.       [ nil ] );
  546.     { Put result in progress and status line }
  547.     AddProgressText( TheReturnString );
  548.     ShowProgressErrorText( TheReturnString );
  549.     { leave }
  550.     exit;
  551.   end
  552.   else
  553.   begin
  554.     { Set up socket 2 for listening }
  555.     Socket2.AsynchMode := False;
  556.     Socket2.NonAsynchTimeoutValue := 60;
  557.     { do a listen and send command to server that this is receipt socket }
  558.     if GetListeningPort = TCPIP_STATUS_FATAL_ERROR then
  559.     begin
  560.       Socket2.CCSockCancelListen;
  561.       exit;
  562.     end;
  563.     Socket1.NonAsynchTimeoutValue := 0; {infinite timeout}
  564.     TheReturnString :=
  565.      DoCStyleFormat( 'STOR %s' ,
  566.       [ ExtractFileName( LocalName ) ] );
  567.     { Put result in progress and status line }
  568.     AddProgressText( TheReturnString );
  569.     ShowProgressText( TheReturnString );
  570.     TheResult := PerformFTPCommand( 'STOR %s' , [ ExtractFileName( LocalName ) ] );
  571.     GetFTPServerResponse( TheReturnString );
  572.     AddProgressText( TheReturnString );
  573.     ShowProgressText( TheReturnString );
  574.     Socket1.NonAsynchTimeoutValue := 30;
  575.     if (( TheResult = TCPIP_STATUS_RETRY_COMMAND ) or
  576.        ( TheResult = TCPIP_STATUS_FATAL_ERROR )) then
  577.     begin
  578.       TheReturnString :=
  579.        DoCStyleFormat( 'Could not create remote file!' ,
  580.         [ nil ] );
  581.       { Put result in progress and status line }
  582.       AddProgressText( TheReturnString );
  583.       ShowProgressErrorText( TheReturnString );
  584.       Socket2.CCSockCancelListen;
  585.       exit;
  586.     end;
  587.     Socket2.CCSockAccept;
  588.     if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 )) then
  589.     begin
  590.       TheReturnString :=
  591.        DoCStyleFormat( 'Could not establish send socket!' ,
  592.         [ nil ] );
  593.       { Put result in progress and status line }
  594.       AddProgressText( TheReturnString );
  595.       ShowProgressErrorText( TheReturnString );
  596.       exit;
  597.     end;
  598.     Through := false;
  599.     TotalBytesSent := 0;
  600.     BytesRead := _lread( OutputFileHandle , @CopyBuffer[ 1 ] , 255 );
  601.     repeat
  602.       if BytesRead = 0 then Through := true;
  603.       if BytesRead > 0 then
  604.       begin
  605.         CopyBuffer[ 0 ] := Chr( BytesRead );
  606.         Socket2.StringData := TheReturnString;
  607.         TotalBytesSent := TotalBytesSent + BytesRead;
  608.         UpdateGauge( TotalBytesSent , FileToSendSize );
  609.         BytesRead := _lread( OutputFileHandle , @CopyBuffer[ 1 ] , 255 );
  610.         if BytesRead = -1 then
  611.         begin
  612.           MessageDlg( 'File Read Error on ' + LocalName , mtError , [mbOK] , 0 );
  613.           GlobalAbortedFlag := True;
  614.         end;
  615.       end;
  616.       if GlobalAbortedFlag then
  617.       begin
  618.         Socket1.OutOfBand := 'ABOR'+#13#10;
  619.         repeat
  620.           TheResult := GetFTPServerResponse( TheReturnString );
  621.           { Put result in progress and status line }
  622.           AddProgressText( TheReturnString );
  623.           ShowProgressText( TheReturnString );
  624.         until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  625.         exit;
  626.       end;
  627.     until Through;
  628.     FTPCommandInProgress := false;
  629.     { cancel listening on second socket and close it }
  630.     Socket2.CCSockCancelListen;
  631.     Socket2.CCSockClose;
  632.     TheReturnString := 'Transfer Succeeded' + #13#10;
  633.     AddProgressText( TheReturnString );
  634.     ShowProgressText( TheReturnString );
  635.     FTPCommandInProgress := false;
  636.     PerformFTPCommand( 'TYPE A',
  637.                                     [ nil ] );
  638.     Through := false;
  639.     repeat
  640.       GetFTPServerResponse( TheReturnString );
  641.       if Pos( 'TYPE' , Uppercase( TheReturnString )) > 0 then
  642.        Through := true;
  643.       { Put result in progress and status line }
  644.       AddProgressText( TheReturnString );
  645.       ShowProgressText( TheReturnString );
  646.     until (( GlobalAbortedFlag ) or Through );
  647.   end;
  648.   _lclose( OutputFileHandle );
  649.   FTPCommandInProgress := false;
  650. end;
  651.  
  652. { This sends a local file in ascii mode to remote server }
  653. procedure TFTPComponent.SendASCIILocalFile( LocalName : String );
  654. var TheReturnString : String;  { Internal string holder }
  655.     TheResult       : Integer; { Internal int holder    }
  656.     Through         : Boolean;
  657.     FileNamePChar   : array[ 0 .. 255 ] of char;
  658.     OutputFileHandle : Integer;
  659.     TotalBytesSent ,
  660.     BytesRead ,
  661.     FileToSendSize    : Longint;
  662.     CopyBuffer       : array[ 0 .. 255 ] of char absolute TheReturnString;
  663. begin
  664.   LocalName := ExpandFileName( LocalName );
  665.   StrPCopy( FileNamePChar , LocalName );
  666.   OutputFileHandle := _lopen( FileNamePChar , 0 );
  667.   if OutputFileHandle = -1 then
  668.   begin
  669.     MessageDlg( 'Cannot Open local file ' + LocalName ,
  670.      mtError , [mbOK] , 0 );
  671.     exit;
  672.   end;
  673.   FileToSendSize := _llseek( OutputFileHandle , 0 , 2 );
  674.   _llseek( OutputFileHandle , 0 , 0 );
  675.   TheReturnString :=
  676.    DoCStyleFormat( 'TYPE A' ,
  677.     [ nil ] );
  678.   { Put result in progress and status line }
  679.   AddProgressText( TheReturnString );
  680.   ShowProgressText( TheReturnString );
  681.   { Send Password sequence }
  682.   TheResult := PerformFTPCommand( 'TYPE A',
  683.                                   [ nil ] );
  684.   if TheResult <> TCPIP_STATUS_PRELIMINARY then
  685.   begin
  686.     FTPCommandInProgress := false;
  687.     exit;
  688.   end;
  689.   repeat
  690.     TheResult := GetFTPServerResponse( TheReturnString );
  691.     { Put result in progress and status line }
  692.     AddProgressText( TheReturnString );
  693.     ShowProgressText( TheReturnString );
  694.   until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  695.   FTPCommandInProgress := false;
  696.   if ( GlobalAbortedFlag or ( TheResult <> TCPIP_STATUS_COMPLETED )) then
  697.   begin
  698.     { Do clever C formatting trick }
  699.     TheReturnString :=
  700.      DoCStyleFormat( 'FTP File Send Failed!' ,
  701.       [ nil ] );
  702.     { Put result in progress and status line }
  703.     AddProgressText( TheReturnString );
  704.     ShowProgressErrorText( TheReturnString );
  705.     { leave }
  706.     exit;
  707.   end
  708.   else
  709.   begin
  710.     { Set up socket 2 for listening }
  711.     Socket2.AsynchMode := False;
  712.     Socket2.NonAsynchTimeoutValue := 60;
  713.     { do a listen and send command to server that this is receipt socket }
  714.     if GetListeningPort = TCPIP_STATUS_FATAL_ERROR then
  715.     begin
  716.       Socket2.CCSockCancelListen;
  717.       exit;
  718.     end;
  719.     Socket1.NonAsynchTimeoutValue := 0; {infinite timeout}
  720.     TheReturnString :=
  721.      DoCStyleFormat( 'STOR %s' ,
  722.       [ ExtractFileName( LocalName ) ] );
  723.     { Put result in progress and status line }
  724.     AddProgressText( TheReturnString );
  725.     ShowProgressText( TheReturnString );
  726.     TheResult := PerformFTPCommand( 'STOR %s' , [ ExtractFileName( LocalName )]);
  727.     GetFTPServerResponse( TheReturnString );
  728.     AddProgressText( TheReturnString );
  729.     ShowProgressText( TheReturnString );
  730.     Socket1.NonAsynchTimeoutValue := 30;
  731.     if (( TheResult = TCPIP_STATUS_RETRY_COMMAND ) or
  732.        ( TheResult = TCPIP_STATUS_FATAL_ERROR )) then
  733.     begin
  734.       TheReturnString :=
  735.        DoCStyleFormat( 'Could not create remote file!' ,
  736.         [ nil ] );
  737.       { Put result in progress and status line }
  738.       AddProgressText( TheReturnString );
  739.       ShowProgressErrorText( TheReturnString );
  740.       Socket2.CCSockCancelListen;
  741.       exit;
  742.     end;
  743.     Socket2.CCSockAccept;
  744.     if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 )) then
  745.     begin
  746.       TheReturnString :=
  747.        DoCStyleFormat( 'Could not establish send socket!' ,
  748.         [ nil ] );
  749.       { Put result in progress and status line }
  750.       AddProgressText( TheReturnString );
  751.       ShowProgressErrorText( TheReturnString );
  752.       exit;
  753.     end;
  754.     Through := false;
  755.     TotalBytesSent := 0;
  756.     BytesRead := _lread( OutputFileHandle , @CopyBuffer[ 1 ] , 255 );
  757.     repeat
  758.       if BytesRead = 0 then Through := true;
  759.       if BytesRead > 0 then
  760.       begin
  761.         CopyBuffer[ 0 ] := Chr( BytesRead );
  762.         Socket2.StringData := TheReturnString;
  763.         TotalBytesSent := TotalBytesSent + BytesRead;
  764.         UpdateGauge( TotalBytesSent , FileToSendSize );
  765.         BytesRead := _lread( OutputFileHandle , @CopyBuffer[ 1 ] , 255 );
  766.         if BytesRead = -1 then
  767.         begin
  768.           MessageDlg( 'File Read Error on ' + LocalName , mtError , [mbOK] , 0 );
  769.           GlobalAbortedFlag := True;
  770.         end;
  771.       end;
  772.       if GlobalAbortedFlag then
  773.       begin
  774.         Socket1.OutOfBand := 'ABOR'+#13#10;
  775.         repeat
  776.           TheResult := GetFTPServerResponse( TheReturnString );
  777.           { Put result in progress and status line }
  778.           AddProgressText( TheReturnString );
  779.           ShowProgressText( TheReturnString );
  780.         until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  781.         exit;
  782.       end;
  783.     until Through;
  784.     { cancel listening on second socket and close it }
  785.     Socket2.CCSockCancelListen;
  786.     Socket2.CCSockClose;
  787.     TheReturnString := 'Transfer Succeeded' + #13#10;
  788.     AddProgressText( TheReturnString );
  789.     ShowProgressText( TheReturnString );
  790.     FTPCommandInProgress := false;
  791.     PerformFTPCommand( 'TYPE A', [ nil ] );
  792.     Through := false;
  793.     repeat
  794.       GetFTPServerResponse( TheReturnString );
  795.       if Pos( 'TYPE' , Uppercase( TheReturnString )) > 0 then
  796.        Through := true;
  797.       { Put result in progress and status line }
  798.       AddProgressText( TheReturnString );
  799.       ShowProgressText( TheReturnString );
  800.     until (( GlobalAbortedFlag ) or Through );
  801.   end;
  802.   _lclose( OutputFileHandle );
  803.   FTPCommandInProgress := false;
  804. end;
  805.  
  806. { This function strips out the FTP response for bytes to send }
  807. function TFTPComponent.GetTotalBytesToReceive( TheString : String ) : Longint;
  808. var
  809.   LeftPosition ,
  810.   RightPosition  : integer;
  811.   TempString     : string;
  812. begin
  813.   LeftPosition := Pos( '(' , TheString );
  814.   TempString := Copy( TheString ,
  815.                       LeftPosition + 1 , 255 );
  816.   RightPosition := Pos( ' ' , TempString );
  817.   if (( LeftPosition = 0 ) or ( RightPosition = 0 )) then
  818.   begin
  819.     Result := 0;
  820.     exit;
  821.   end;
  822.   if RightPosition <> 0 then
  823.     TempString := Copy( TempString , 1 , RightPosition - 1  );
  824.   try
  825.     Result := StrToInt( TempString );
  826.   except
  827.     on EConvertError do Result := 0;
  828.   end;
  829. end;
  830.  
  831. procedure TFTPComponent.UpdateGauge( BytesFinished , TotalToHandle : longint );
  832. begin
  833.   CCInetCCForm.UpdateGauge( BytesFinished , TotalToHandle );
  834. end;
  835.  
  836. { This sends FTP progress text to the Inet form }
  837. procedure TFTPComponent.AddProgressText( WhatText : String );
  838. begin
  839.   CCInetCCForm.AddProgressText( WhatText );
  840. end;
  841.  
  842. { This sends FTP progress text to the Inet form }
  843. procedure TFTPComponent.ShowProgressText( WhatText : String );
  844. begin
  845.   CCInetCCForm.ShowProgressText( WhatText );
  846. end;
  847.  
  848. { This procedure receives a binary remote file }
  849. procedure TFTPComponent.ReceiveASCIIRemoteFileToMemo( RemoteName : String );
  850. var TheReturnString : String;  { Internal string holder }
  851.     TheResult       : Integer; { Internal int holder    }
  852.     Through         : Boolean;
  853.     TotalBytesSent ,
  854.     FileToGetSize    : Longint;
  855. begin
  856.   TheReturnString :=
  857.    DoCStyleFormat( 'TYPE A' ,
  858.     [ nil ] );
  859.   { Put result in progress and status line }
  860.   AddProgressText( TheReturnString );
  861.   ShowProgressText( TheReturnString );
  862.   { Send Password sequence }
  863.   FTPCommandInProgress := false;
  864.   TheResult := PerformFTPCommand( 'TYPE A',
  865.                                   [ nil ] );
  866.   if TheResult <> TCPIP_STATUS_PRELIMINARY then
  867.   begin
  868.     FTPCommandInProgress := false;
  869.     exit;
  870.   end;
  871.   repeat
  872.     TheResult := GetFTPServerResponse( TheReturnString );
  873.     { Put result in progress and status line }
  874.     AddProgressText( TheReturnString );
  875.     ShowProgressText( TheReturnString );
  876.   until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  877.   FTPCommandInProgress := false;
  878.   if ( GlobalAbortedFlag or ( TheResult <> TCPIP_STATUS_COMPLETED )) then
  879.   begin
  880.     { Do clever C formatting trick }
  881.     TheReturnString :=
  882.      DoCStyleFormat( 'FTP File Receive Failed!' ,
  883.       [ nil ] );
  884.     { Put result in progress and status line }
  885.     AddProgressText( TheReturnString );
  886.     ShowProgressErrorText( TheReturnString );
  887.     { leave }
  888.     exit;
  889.   end
  890.   else
  891.   begin
  892.     { Set up socket 2 for listening }
  893.     Socket2.AsynchMode := False;
  894.     Socket2.NonAsynchTimeoutValue := 60;
  895.     { do a listen and send command to server that this is receipt socket }
  896.     if GetListeningPort = TCPIP_STATUS_FATAL_ERROR then
  897.     begin
  898.       Socket2.CCSockCancelListen;
  899.       exit;
  900.     end;
  901.     Socket1.NonAsynchTimeoutValue := 0; {infinite timeout}
  902.     TheReturnString :=
  903.      DoCStyleFormat( 'RETR %s' ,
  904.       [ RemoteName ] );
  905.     { Put result in progress and status line }
  906.     AddProgressText( TheReturnString );
  907.     ShowProgressText( TheReturnString );
  908.     TheResult := PerformFTPCommand( 'RETR %s' , [RemoteName] );
  909.     GetFTPServerResponse( TheReturnString );
  910.     AddProgressText( TheReturnString );
  911.     ShowProgressText( TheReturnString );
  912.     FileToGetSize := GetTotalBytesToReceive( TheReturnString );
  913.     Socket1.NonAsynchTimeoutValue := 30;
  914.     if (( TheResult = TCPIP_STATUS_RETRY_COMMAND ) or
  915.        ( TheResult = TCPIP_STATUS_FATAL_ERROR )) then
  916.     begin
  917.       TheReturnString :=
  918.        DoCStyleFormat( 'Could not obtain remote file!' ,
  919.         [ nil ] );
  920.       { Put result in progress and status line }
  921.       AddProgressText( TheReturnString );
  922.       ShowProgressErrorText( TheReturnString );
  923.       Socket2.CCSockCancelListen;
  924.       exit;
  925.     end;
  926.     Socket2.CCSockAccept;
  927.     if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 )) then
  928.     begin
  929.       TheReturnString :=
  930.        DoCStyleFormat( 'Could not establish receive socket!' ,
  931.         [ nil ] );
  932.       { Put result in progress and status line }
  933.       AddProgressText( TheReturnString );
  934.       ShowProgressErrorText( TheReturnString );
  935.       exit;
  936.     end;
  937.     Through := false;
  938.     TotalBytesSent := 0;
  939.     repeat
  940.       TheReturnString := Socket2.StringData;
  941.       if Length( TheReturnString ) = 0 then Through := true;
  942.       if Length( TheReturnString ) > 0 then
  943.       begin
  944.         TotalBytesSent := TotalBytesSent + Length( TheReturnString );
  945.         UpdateGauge( TotalBytesSent , FileToGetSize );
  946.         { Put result in progress and status line }
  947.         AddProgressText( TheReturnString );
  948.         ShowProgressText( TheReturnString );
  949.       end;
  950.       if GlobalAbortedFlag then
  951.       begin
  952.         Socket1.OutOfBand := 'ABOR'+#13#10;
  953.         repeat
  954.           TheResult := GetFTPServerResponse( TheReturnString );
  955.           { Put result in progress and status line }
  956.           AddProgressText( TheReturnString );
  957.           ShowProgressText( TheReturnString );
  958.         until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  959.         exit;
  960.       end;
  961.     until Through;
  962.     { cancel listening on second socket and close it }
  963.     Socket2.CCSockCancelListen;
  964.     Socket2.CCSockClose;
  965.     FTPCommandInProgress := false;
  966.     PerformFTPCommand( 'TYPE A', [ nil ] );
  967.     Through := false;
  968.     repeat
  969.       GetFTPServerResponse( TheReturnString );
  970.       if Pos( 'TYPE' , Uppercase( TheReturnString )) > 0 then
  971.        Through := true;
  972.       { Put result in progress and status line }
  973.       AddProgressText( TheReturnString );
  974.       ShowProgressText( TheReturnString );
  975.     until (( GlobalAbortedFlag ) or Through );
  976.   end;
  977.   FTPCommandInProgress := false;
  978. end;
  979.  
  980. { This procedure receives a binary remote file }
  981. procedure TFTPComponent.ReceiveASCIIRemoteFile( RemoteName , LocalName : String );
  982. var TheReturnString : String;  { Internal string holder }
  983.     TheResult       : Integer; { Internal int holder    }
  984.     Through         : Boolean;
  985.     FileNamePChar   : array[ 0 .. 255 ] of char;
  986.     OutputFileHandle : Integer;
  987.     TotalBytesSent ,
  988.     FileToGetSize    : Longint;
  989.     CopyBuffer       : array[ 0 .. 255 ] of char;
  990. begin
  991.   LocalName := ExpandFileName( LocalName );
  992.   StrPCopy( FileNamePChar , LocalName );
  993.   OutputFileHandle := _lcreat( FileNamePChar , 0 );
  994.   if OutputFileHandle = -1 then
  995.   begin
  996.     MessageDlg( 'Cannot Create local file ' + LocalName ,
  997.      mtError , [mbOK] , 0 );
  998.     exit;
  999.   end;
  1000.   TheReturnString :=
  1001.    DoCStyleFormat( 'TYPE A' ,
  1002.     [ nil ] );
  1003.   { Put result in progress and status line }
  1004.   AddProgressText( TheReturnString );
  1005.   ShowProgressText( TheReturnString );
  1006.   { Send Password sequence }
  1007.   TheResult := PerformFTPCommand( 'TYPE A',
  1008.                                   [ nil ] );
  1009.   if TheResult <> TCPIP_STATUS_PRELIMINARY then
  1010.   begin
  1011.     FTPCommandInProgress := false;
  1012.     exit;
  1013.   end;
  1014.   repeat
  1015.     TheResult := GetFTPServerResponse( TheReturnString );
  1016.     { Put result in progress and status line }
  1017.     AddProgressText( TheReturnString );
  1018.     ShowProgressText( TheReturnString );
  1019.   until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  1020.   FTPCommandInProgress := false;
  1021.   if ( GlobalAbortedFlag or ( TheResult <> TCPIP_STATUS_COMPLETED )) then
  1022.   begin
  1023.     { Do clever C formatting trick }
  1024.     TheReturnString :=
  1025.      DoCStyleFormat( 'FTP File Receive Failed!' ,
  1026.       [ nil ] );
  1027.     { Put result in progress and status line }
  1028.     AddProgressText( TheReturnString );
  1029.     ShowProgressErrorText( TheReturnString );
  1030.     { leave }
  1031.     exit;
  1032.   end
  1033.   else
  1034.   begin
  1035.     { Set up socket 2 for listening }
  1036.     Socket2.AsynchMode := False;
  1037.     Socket2.NonAsynchTimeoutValue := 60;
  1038.     { do a listen and send command to server that this is receipt socket }
  1039.     if GetListeningPort = TCPIP_STATUS_FATAL_ERROR then
  1040.     begin
  1041.       Socket2.CCSockCancelListen;
  1042.       exit;
  1043.     end;
  1044.     Socket1.NonAsynchTimeoutValue := 0; {infinite timeout}
  1045.     TheReturnString :=
  1046.      DoCStyleFormat( 'RETR %s' ,
  1047.       [ RemoteName ] );
  1048.     { Put result in progress and status line }
  1049.     AddProgressText( TheReturnString );
  1050.     ShowProgressText( TheReturnString );
  1051.     TheResult := PerformFTPCommand( 'RETR %s' , [RemoteName] );
  1052.     GetFTPServerResponse( TheReturnString );
  1053.     AddProgressText( TheReturnString );
  1054.     ShowProgressText( TheReturnString );
  1055.     FileToGetSize := GetTotalBytesToReceive( TheReturnString );
  1056.     Socket1.NonAsynchTimeoutValue := 30;
  1057.     if (( TheResult = TCPIP_STATUS_RETRY_COMMAND ) or
  1058.        ( TheResult = TCPIP_STATUS_FATAL_ERROR )) then
  1059.     begin
  1060.       TheReturnString :=
  1061.        DoCStyleFormat( 'Could not obtain remote file!' ,
  1062.         [ nil ] );
  1063.       { Put result in progress and status line }
  1064.       AddProgressText( TheReturnString );
  1065.       ShowProgressErrorText( TheReturnString );
  1066.       Socket2.CCSockCancelListen;
  1067.       exit;
  1068.     end;
  1069.     Socket2.CCSockAccept;
  1070.     if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 )) then
  1071.     begin
  1072.       TheReturnString :=
  1073.        DoCStyleFormat( 'Could not establish receive socket!' ,
  1074.         [ nil ] );
  1075.       { Put result in progress and status line }
  1076.       AddProgressText( TheReturnString );
  1077.       ShowProgressErrorText( TheReturnString );
  1078.       exit;
  1079.     end;
  1080.     Through := false;
  1081.     TotalBytesSent := 0;
  1082.     repeat
  1083.       TheReturnString := Socket2.StringData;
  1084.       if Length( TheReturnString ) = 0 then Through := true;
  1085.       if Length( TheReturnString ) > 0 then
  1086.       begin
  1087.         StrPCopy( CopyBuffer , TheReturnString );
  1088.         TotalBytesSent := TotalBytesSent + Length( TheReturnString );
  1089.         UpdateGauge( TotalBytesSent , FileToGetSize );
  1090.         if _lwrite( OutputFileHandle , CopyBuffer , Length( TheReturnString ))
  1091.          = -1 then
  1092.         begin
  1093.           MessageDlg( 'File Write Error on ' + LocalName , mtError , [mbOK] , 0 );
  1094.           GlobalAbortedFlag := True;
  1095.         end;
  1096.       end;
  1097.       if GlobalAbortedFlag then
  1098.       begin
  1099.         Socket1.OutOfBand := 'ABOR'+#13#10;
  1100.         repeat
  1101.           TheResult := GetFTPServerResponse( TheReturnString );
  1102.           { Put result in progress and status line }
  1103.           AddProgressText( TheReturnString );
  1104.           ShowProgressText( TheReturnString );
  1105.         until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  1106.         exit;
  1107.       end;
  1108.     until Through;
  1109.     { cancel listening on second socket and close it }
  1110.     Socket2.CCSockCancelListen;
  1111.     Socket2.CCSockClose;
  1112.     FTPCommandInProgress := false;
  1113.     PerformFTPCommand( 'TYPE A', [ nil ] );
  1114.     Through := false;
  1115.     repeat
  1116.       GetFTPServerResponse( TheReturnString );
  1117.       if Pos( 'TYPE' , Uppercase( TheReturnString )) > 0 then
  1118.        Through := true;
  1119.       { Put result in progress and status line }
  1120.       AddProgressText( TheReturnString );
  1121.       ShowProgressText( TheReturnString );
  1122.     until (( GlobalAbortedFlag ) or Through );
  1123.   end;
  1124.   _lclose( OutputFileHandle );
  1125.   FTPCommandInProgress := false;
  1126. end;
  1127.  
  1128. { This procedure receives a binary remote file }
  1129. procedure TFTPComponent.ReceiveBinaryRemoteFile( RemoteName , LocalName : String );
  1130. var TheReturnString : String;  { Internal string holder }
  1131.     TheResult       : Integer; { Internal int holder    }
  1132.     Through         : Boolean;
  1133.     FileNamePChar   : array[ 0 .. 255 ] of char;
  1134.     OutputFileHandle : Integer;
  1135.     TotalBytesSent ,
  1136.     FileToGetSize    : Longint;
  1137.     CopyBuffer       : array[ 0 .. 255 ] of char;
  1138. begin
  1139.   LocalName := ExpandFileName( LocalName );
  1140.   StrPCopy( FileNamePChar , LocalName );
  1141.   OutputFileHandle := _lcreat( FileNamePChar , 0 );
  1142.   if OutputFileHandle = -1 then
  1143.   begin
  1144.     MessageDlg( 'Cannot Create local file ' + LocalName ,
  1145.      mtError , [mbOK] , 0 );
  1146.     exit;
  1147.   end;
  1148.   TheReturnString :=
  1149.    DoCStyleFormat( 'TYPE I' ,
  1150.     [ nil ] );
  1151.   { Put result in progress and status line }
  1152.   AddProgressText( TheReturnString );
  1153.   ShowProgressText( TheReturnString );
  1154.   { Send Password sequence }
  1155.   TheResult := PerformFTPCommand( 'TYPE I',
  1156.                                   [ nil ] );
  1157.   if TheResult <> TCPIP_STATUS_PRELIMINARY then
  1158.   begin
  1159.     FTPCommandInProgress := false;
  1160.     exit;
  1161.   end;
  1162.   repeat
  1163.     TheResult := GetFTPServerResponse( TheReturnString );
  1164.     { Put result in progress and status line }
  1165.     AddProgressText( TheReturnString );
  1166.     ShowProgressText( TheReturnString );
  1167.   until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  1168.   FTPCommandInProgress := false;
  1169.   if ( GlobalAbortedFlag or ( TheResult <> TCPIP_STATUS_COMPLETED )) then
  1170.   begin
  1171.     { Do clever C formatting trick }
  1172.     TheReturnString :=
  1173.      DoCStyleFormat( 'FTP File Receive Failed!' ,
  1174.       [ nil ] );
  1175.     { Put result in progress and status line }
  1176.     AddProgressText( TheReturnString );
  1177.     ShowProgressErrorText( TheReturnString );
  1178.     { leave }
  1179.     exit;
  1180.   end
  1181.   else
  1182.   begin
  1183.     { Set up socket 2 for listening }
  1184.     Socket2.AsynchMode := False;
  1185.     Socket2.NonAsynchTimeoutValue := 60;
  1186.     { do a listen and send command to server that this is receipt socket }
  1187.     if GetListeningPort = TCPIP_STATUS_FATAL_ERROR then
  1188.     begin
  1189.       Socket2.CCSockCancelListen;
  1190.       exit;
  1191.     end;
  1192.     Socket1.NonAsynchTimeoutValue := 0; {infinite timeout}
  1193.     TheReturnString :=
  1194.      DoCStyleFormat( 'RETR %s' ,
  1195.       [ RemoteName ] );
  1196.     { Put result in progress and status line }
  1197.     AddProgressText( TheReturnString );
  1198.     ShowProgressText( TheReturnString );
  1199.     TheResult := PerformFTPCommand( 'RETR %s' , [RemoteName] );
  1200.     GetFTPServerResponse( TheReturnString );
  1201.     AddProgressText( TheReturnString );
  1202.     ShowProgressText( TheReturnString );
  1203.     FileToGetSize := GetTotalBytesToReceive( TheReturnString );
  1204.     Socket1.NonAsynchTimeoutValue := 30;
  1205.     if (( TheResult = TCPIP_STATUS_RETRY_COMMAND ) or
  1206.        ( TheResult = TCPIP_STATUS_FATAL_ERROR )) then
  1207.     begin
  1208.       TheReturnString :=
  1209.        DoCStyleFormat( 'Could not obtain remote file!' ,
  1210.         [ nil ] );
  1211.       { Put result in progress and status line }
  1212.       AddProgressText( TheReturnString );
  1213.       ShowProgressErrorText( TheReturnString );
  1214.       Socket2.CCSockCancelListen;
  1215.       exit;
  1216.     end;
  1217.     Socket2.CCSockAccept;
  1218.     if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 )) then
  1219.     begin
  1220.       TheReturnString :=
  1221.        DoCStyleFormat( 'Could not establish receive socket!' ,
  1222.         [ nil ] );
  1223.       { Put result in progress and status line }
  1224.       AddProgressText( TheReturnString );
  1225.       ShowProgressErrorText( TheReturnString );
  1226.       exit;
  1227.     end;
  1228.     Through := false;
  1229.     TotalBytesSent := 0;
  1230.     repeat
  1231.       TheReturnString := Socket2.StringData;
  1232.       if Length( TheReturnString ) = 0 then Through := true;
  1233.       if Length( TheReturnString ) > 0 then
  1234.       begin
  1235.         StrPCopy( CopyBuffer , TheReturnString );
  1236.         TotalBytesSent := TotalBytesSent + Length( TheReturnString );
  1237.         UpdateGauge( TotalBytesSent , FileToGetSize );
  1238.         if _lwrite( OutputFileHandle , CopyBuffer , Length( TheReturnString ))
  1239.          = -1 then
  1240.         begin
  1241.           MessageDlg( 'File Write Error on ' + LocalName , mtError , [mbOK] , 0 );
  1242.           GlobalAbortedFlag := True;
  1243.         end;
  1244.       end;
  1245.       if GlobalAbortedFlag then
  1246.       begin
  1247.         Socket1.OutOfBand := 'ABOR'+#13#10;
  1248.         repeat
  1249.           TheResult := GetFTPServerResponse( TheReturnString );
  1250.           { Put result in progress and status line }
  1251.           AddProgressText( TheReturnString );
  1252.           ShowProgressText( TheReturnString );
  1253.         until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  1254.         exit;
  1255.       end;
  1256.     until Through;
  1257.     { cancel listening on second socket and close it }
  1258.     Socket2.CCSockCancelListen;
  1259.     Socket2.CCSockClose;
  1260.     FTPCommandInProgress := false;
  1261.     PerformFTPCommand( 'TYPE A', [ nil ] );
  1262.     Through := false;
  1263.     repeat
  1264.       GetFTPServerResponse( TheReturnString );
  1265.       if Pos( 'TYPE' , Uppercase( TheReturnString )) > 0 then
  1266.        Through := true;
  1267.       { Put result in progress and status line }
  1268.       AddProgressText( TheReturnString );
  1269.       ShowProgressText( TheReturnString );
  1270.     until (( GlobalAbortedFlag ) or Through );
  1271.   end;
  1272.   _lclose( OutputFileHandle );
  1273.   FTPCommandInProgress := false;
  1274. end;
  1275.  
  1276. { This sends FTP progress text to the Inet form }
  1277. procedure TFTPComponent.ShowProgressErrorText( WhatText : String );
  1278. begin
  1279.   CCInetCCForm.ShowProgressErrorText( WhatText );
  1280. end;
  1281.  
  1282. { This is a core function! It performs an FTP command and if no timeout }
  1283. { return a preliminary ok.                                              }
  1284. function TFTPComponent.PerformFTPCommand(
  1285.                  TheCommand        : string;
  1286.            const TheArguments      : array of const ) : Integer;
  1287. var TheBuffer : string; { Text buffer }
  1288. begin
  1289.   { If command in progress send back -1 error }
  1290.   if FTPCommandInProgress then
  1291.   begin
  1292.     Result := -1;
  1293.     exit;
  1294.   end;
  1295.   { Set status variable }
  1296.   FTPCommandInProgress := True;
  1297.   { Set global error code }
  1298.   GlobalErrorCode := 0;
  1299.   { Format output string }
  1300.   TheBuffer := Format( TheCommand , TheArguments );
  1301.   { Preset failure code }
  1302.   Result := TCPIP_STATUS_FATAL_ERROR;
  1303.   { If invalid socket or no connection abort }
  1304.   if ( Socket1.TheSocket = INVALID_SOCKET ) or not Connection_Established then
  1305.    exit;
  1306.   { Send the buffer plus EOL chars }
  1307.   Socket1.StringData := TheBuffer + #13#10;
  1308.   { if abort due to timeout or other error exit }
  1309.   if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 )) then exit;
  1310.   { Otherwise return preliminary code }
  1311.   Result := TCPIP_STATUS_PRELIMINARY;
  1312. end;
  1313.  
  1314. { This function gets up to 255 chars of data plus a return code from FTP serv }
  1315. function TFTPComponent.GetFTPServerResponse(
  1316.           var ResponseString : String ) : integer;
  1317. var
  1318.   { Buffer string for response line }
  1319.   TheBuffer     : string;
  1320.   { Pointer to the response string }
  1321.   BufferPointer : array[0..255] of char absolute TheBuffer;
  1322.   { Character to check for response code }
  1323.   ResponseChar   : char;
  1324.   { Pointers into returned string }
  1325.   TheIndex ,
  1326.   TheLength     : integer;
  1327.   { Control variable }
  1328.   LeftoversInPan ,
  1329.   Finished      : Boolean;
  1330. begin
  1331.   { Preset fatal error }
  1332.   Result := TCPIP_STATUS_FATAL_ERROR;
  1333.   { Start loop control }
  1334.   LeftoversInPan := false;
  1335.   Finished := false;
  1336.   repeat
  1337.     { Do a peek }
  1338.     TheBuffer := Socket1.PeekData;
  1339.     { If timeout or other error exit }
  1340.     if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 )) then exit;
  1341.     { Find end of line character }
  1342.     TheIndex := Pos( #10 , TheBuffer );
  1343.     if TheIndex = 0 then
  1344.     begin
  1345.       TheIndex := Pos( #13 , TheBuffer );
  1346.       if TheIndex = 0 then
  1347.       begin
  1348.         TheIndex := Pos( #0 , TheBuffer );
  1349.         if TheIndex = 0 then
  1350.         begin
  1351.           TheIndex := Length( TheBuffer );
  1352.           LeftoversInPan := True;
  1353.           LeftoverText := LeftoverText + TheBuffer;
  1354.           LeftoversOnTable := false;
  1355.         end;
  1356.       end;
  1357.     end;
  1358.     { If an end of line then process the line }
  1359.     if TheIndex > 0 then
  1360.     begin
  1361.       { Get length of string }
  1362.       TheLength := TheIndex;
  1363.       { Receive actual data }
  1364.       Socket1.CCSockReceive( Socket1.TheSocket   ,
  1365.                              @BufferPointer[ 1 ] ,
  1366.                              TheLength              );
  1367.       { Abort if timeout or error }
  1368.       if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 )) then exit;
  1369.       { Put in the length byte }
  1370.       BufferPointer[ 0 ] := Chr( TheLength );
  1371.       if LeftOversOnTable then
  1372.       begin
  1373.         LeftOversOnTable := false;
  1374.         ResponseString := LeftoverText + TheBuffer;
  1375.         TheBuffer := ResponseString;
  1376.         LeftoverText := '';
  1377.       end;
  1378.       if LeftoversInPan then
  1379.       begin
  1380.         LeftoversInPan := false;
  1381.         LeftoversOnTable := true;
  1382.       end;
  1383.       { If not a continuation line }
  1384.       if TheBuffer[ 4 ] <> '-' then
  1385.       begin
  1386.         { Get first number character }
  1387.         ResponseChar := TheBuffer[ 1 ];
  1388.         { Get the value of the number from 1 to 5 }
  1389.         if (( ResponseChar >= '1' ) and ( ResponseChar <= '5' )) then
  1390.         begin
  1391.           Finished := true;
  1392.           Result := Ord( ResponseChar ) - 48;
  1393.         end;
  1394.       end
  1395.       else
  1396.       begin
  1397.         { otherwise return preliminary result }
  1398.         Finished := true;
  1399.         Result := TCPIP_STATUS_PRELIMINARY;
  1400.       end;
  1401.     end
  1402.     else
  1403.     begin
  1404.     end;
  1405.   until ( Finished and ( not LeftoversOnTable ));
  1406.   { Return buffer as response string }
  1407.   ResponseString := TheBuffer;
  1408. end;
  1409.  
  1410. { Boilerplate error routine }
  1411. procedure TFTPComponent.FTPSocketsErrorOccurred( Sender     : TObject;
  1412.                                                  ErrorCode  : Integer;
  1413.                                                  TheMessage : String   );
  1414. begin
  1415.   CCInetCCForm.SocketsErrorOccurred( Sender,ErrorCode,TheMessage );
  1416. end;
  1417.  
  1418. { This is the FTP components initial connection routine }
  1419. function TFTPComponent.EstablishConnection(
  1420.           PCRPointer : PConnectionsRecord ) : Boolean;
  1421. var TheReturnString : String;  { Internal string holder }
  1422.     TheResult       : Integer; { Internal int holder    }
  1423. begin
  1424.   { Set default FTP Port value }
  1425.   Socket1.PortName := '21';
  1426.   { Get the ip address from the record }
  1427.   Socket1.IPAddressName := PCRPointer^.CIPAddress;
  1428.   { Set blocking mode }
  1429.   Socket1.AsynchMode := False;
  1430.   { Clear condition variables }
  1431.   GlobalErrorCode := 0;
  1432.   GlobalAbortedFlag := false;
  1433.   { Actually attempt to connect }
  1434.   Socket1.CCSockConnect;
  1435.   { Check if connected }
  1436.   if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 ) or
  1437.       ( Socket1.TheSocket = INVALID_SOCKET )) then
  1438.   begin { Didn't connect; signal error and abort }
  1439.     { Do clever C formatting trick }
  1440.     TheReturnString :=
  1441.      DoCStyleFormat( 'FTP Host %s Connection Failed!' ,
  1442.       [ PCRPointer^.CIPAddress ] );
  1443.     { Put result in progress and status line }
  1444.     AddProgressText( TheReturnString );
  1445.     ShowProgressErrorText( TheReturnString );
  1446.     { Signal error }
  1447.     Result := False;
  1448.     { leave }
  1449.     exit;
  1450.   end
  1451.   else
  1452.   begin
  1453.     Connection_Established := true;
  1454.     { Signal successful connection }
  1455.     TheReturnString := DoCStyleFormat(
  1456.       'Connected on Local port: %s with IP: %s',
  1457.       [ Socket1.GetSocketPort( Socket1.TheSocket ),
  1458.         Socket1.GetSocketIPAddress( Socket1.TheSocket )]);
  1459.     { Put result in progress and status line }
  1460.     CCINetCCForm.AddProgressText( TheReturnString );
  1461.     CCINetCCForm.ShowProgressText( TheReturnString );
  1462.     TheReturnString := DoCStyleFormat(
  1463.      'Connected to Remote port: %s with IP: %s',
  1464.       [ Socket1.GetSocketPeerPort( Socket1.TheSocket ),
  1465.         Socket1.GetSocketPeerIPAddress( Socket1.TheSocket )]);
  1466.     { Put result in progress and status line }
  1467.     CCINetCCForm.AddProgressText( TheReturnString );
  1468.     CCINetCCForm.ShowProgressText( TheReturnString );
  1469.     TheReturnString := DoCStyleFormat( 'Successfully connected to %s',
  1470.      [ Socket1.IPAddressName ]);
  1471.     { Put result in progress and status line }
  1472.     CCINetCCForm.AddProgressText( TheReturnString );
  1473.     CCINetCCForm.ShowProgressText( TheReturnString );
  1474.     repeat
  1475.       TheResult := GetFTPServerResponse( TheReturnString );
  1476.       { Put result in progress and status line }
  1477.       AddProgressText( TheReturnString );
  1478.       ShowProgressText( TheReturnString );
  1479.     until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  1480.     if ( GlobalAbortedFlag or ( TheResult <> TCPIP_STATUS_COMPLETED )) then
  1481.     begin
  1482.       { Do clever C formatting trick }
  1483.       TheReturnString :=
  1484.        DoCStyleFormat( 'FTP Host %s Connection Failed!' ,
  1485.         [ PCRPointer^.CIPAddress ] );
  1486.       { Put result in progress and status line }
  1487.       AddProgressText( TheReturnString );
  1488.       ShowProgressErrorText( TheReturnString );
  1489.       { Signal error }
  1490.       Result := False;
  1491.       { leave }
  1492.       exit;
  1493.     end
  1494.     else Result := true; { Signal no problem }
  1495.   end;
  1496. end;
  1497.  
  1498. { This is the FTP components USER login routine }
  1499. function TFTPComponent.LoginUser(
  1500.           PCRPointer : PConnectionsRecord ) : Boolean;
  1501. var TheReturnString : String;  { Internal string holder }
  1502.     TheResult       : Integer; { Internal int holder    }
  1503. begin
  1504.   TheReturnString :=
  1505.    DoCStyleFormat( 'USER %s' ,
  1506.     [ PCRPointer^.CUserName ] );
  1507.   { Put result in progress and status line }
  1508.   AddProgressText( TheReturnString );
  1509.   ShowProgressText( TheReturnString );
  1510.   { Begin login sequence with user name }
  1511.   TheResult := PerformFTPCommand( 'USER %s',
  1512.                                   [ PCRPointer^.CUserName ] );
  1513.   if TheResult <> TCPIP_STATUS_PRELIMINARY then
  1514.   begin
  1515.     FTPCommandInProgress := false;
  1516.     Result := false;
  1517.     exit;
  1518.   end;
  1519.   repeat
  1520.     TheResult := GetFTPServerResponse( TheReturnString );
  1521.     { Put result in progress and status line }
  1522.     AddProgressText( TheReturnString );
  1523.     ShowProgressText( TheReturnString );
  1524.   until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  1525.   FTPCommandInProgress := false;
  1526.   if ( GlobalAbortedFlag or ( TheResult <> TCPIP_STATUS_CONTINUING )) then
  1527.   begin
  1528.     { Do clever C formatting trick }
  1529.     TheReturnString :=
  1530.      DoCStyleFormat( 'FTP Host %s Connection Failed!' ,
  1531.       [ PCRPointer^.CIPAddress ] );
  1532.     { Put result in progress and status line }
  1533.     AddProgressText( TheReturnString );
  1534.     ShowProgressErrorText( TheReturnString );
  1535.     { Signal error }
  1536.     Result := False;
  1537.     { leave }
  1538.     exit;
  1539.   end
  1540.   else Result := true; { Signal no problem }
  1541. end;
  1542.  
  1543. function TFTPComponent.DeleteRemoteDirectory( TheDir : String ) : Boolean;
  1544. var TheReturnString : String;  { Internal string holder }
  1545.     TheResult       : Integer; { Internal int holder    }
  1546. begin
  1547.   TheReturnString := DoCStyleFormat( 'RMD %s' ,
  1548.    [ TheDir ] );
  1549.   { Put result in progress and status line }
  1550.   AddProgressText( TheReturnString );
  1551.   ShowProgressText( TheReturnString );
  1552.   { Send Password sequence }
  1553.   TheResult := PerformFTPCommand( 'RMD %s',
  1554.                                   [ TheDir ] );
  1555.   if TheResult <> TCPIP_STATUS_PRELIMINARY then
  1556.   begin
  1557.     Result := false;
  1558.     FTPCommandInProgress := false;
  1559.     exit;
  1560.   end;
  1561.   repeat
  1562.     TheResult := GetFTPServerResponse( TheReturnString );
  1563.     { Put result in progress and status line }
  1564.     AddProgressText( TheReturnString );
  1565.     ShowProgressText( TheReturnString );
  1566.   until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  1567.   FTPCommandInProgress := false;
  1568.   if ( GlobalAbortedFlag or ( TheResult <> TCPIP_STATUS_COMPLETED )) then
  1569.   begin
  1570.     { Do clever C formatting trick }
  1571.     TheReturnString :=
  1572.      DoCStyleFormat( 'Delete Directory %s Failed!' ,
  1573.       [ TheDir ] );
  1574.     { Put result in progress and status line }
  1575.     AddProgressText( TheReturnString );
  1576.     ShowProgressErrorText( TheReturnString );
  1577.     { Signal error }
  1578.     Result := False;
  1579.     { leave }
  1580.     exit;
  1581.   end
  1582.   else Result := true; { Signal no problem }
  1583. end;
  1584.  
  1585. function TFTPComponent.CreateRemoteDirectory( TheDir : String ) : Boolean;
  1586. var TheReturnString : String;  { Internal string holder }
  1587.     TheResult       : Integer; { Internal int holder    }
  1588. begin
  1589.   TheReturnString := DoCStyleFormat( 'MKD %s' ,
  1590.     [ TheDir ] );
  1591.   { Put result in progress and status line }
  1592.   AddProgressText( TheReturnString );
  1593.   ShowProgressText( TheReturnString );
  1594.   { Send Password sequence }
  1595.   TheResult := PerformFTPCommand( 'MKD %s',
  1596.                                   [ TheDir ] );
  1597.   if TheResult <> TCPIP_STATUS_PRELIMINARY then
  1598.   begin
  1599.     Result := false;
  1600.     FTPCommandInProgress := false;
  1601.     exit;
  1602.   end;
  1603.   repeat
  1604.     TheResult := GetFTPServerResponse( TheReturnString );
  1605.     { Put result in progress and status line }
  1606.     AddProgressText( TheReturnString );
  1607.     ShowProgressText( TheReturnString );
  1608.   until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  1609.   FTPCommandInProgress := false;
  1610.   if ( GlobalAbortedFlag or ( TheResult <> TCPIP_STATUS_COMPLETED )) then
  1611.   begin
  1612.     { Do clever C formatting trick }
  1613.     TheReturnString :=
  1614.      DoCStyleFormat( 'Create Directory %s Failed!' ,
  1615.       [ TheDir ] );
  1616.     { Put result in progress and status line }
  1617.     AddProgressText( TheReturnString );
  1618.     ShowProgressErrorText( TheReturnString );
  1619.     { Signal error }
  1620.     Result := False;
  1621.     { leave }
  1622.     exit;
  1623.   end
  1624.   else Result := true; { Signal no problem }
  1625. end;
  1626.  
  1627.  
  1628. function TFTPComponent.DeleteRemoteFile( TheFileName : String ) : Boolean;
  1629. var TheReturnString : String;  { Internal string holder }
  1630.     TheResult       : Integer; { Internal int holder    }
  1631. begin
  1632.   TheReturnString := DoCStyleFormat( 'DELE %s' ,
  1633.     [ TheFileName ] );
  1634.   { Put result in progress and status line }
  1635.   AddProgressText( TheReturnString );
  1636.   ShowProgressText( TheReturnString );
  1637.   { Send Password sequence }
  1638.   TheResult := PerformFTPCommand( 'DELE %s',
  1639.                                   [ TheFileName ] );
  1640.   if TheResult <> TCPIP_STATUS_PRELIMINARY then
  1641.   begin
  1642.     Result := false;
  1643.     FTPCommandInProgress := false;
  1644.     exit;
  1645.   end;
  1646.   repeat
  1647.     TheResult := GetFTPServerResponse( TheReturnString );
  1648.     { Put result in progress and status line }
  1649.     AddProgressText( TheReturnString );
  1650.     ShowProgressText( TheReturnString );
  1651.   until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  1652.   FTPCommandInProgress := false;
  1653.   if ( GlobalAbortedFlag or ( TheResult <> TCPIP_STATUS_COMPLETED )) then
  1654.   begin
  1655.     { Do clever C formatting trick }
  1656.     TheReturnString :=
  1657.      DoCStyleFormat( 'Delete File %s Failed!' ,
  1658.       [ TheFileName ] );
  1659.     { Put result in progress and status line }
  1660.     AddProgressText( TheReturnString );
  1661.     ShowProgressErrorText( TheReturnString );
  1662.     { Signal error }
  1663.     Result := False;
  1664.     { leave }
  1665.     exit;
  1666.   end
  1667.   else Result := true; { Signal no problem }
  1668. end;
  1669.  
  1670. { This is the FTP components PASSWORD routine }
  1671. function TFTPComponent.SendPassword(
  1672.           PCRPointer : PConnectionsRecord ) : Boolean;
  1673. var TheReturnString : String;  { Internal string holder }
  1674.     TheResult       : Integer; { Internal int holder    }
  1675. begin
  1676.   TheReturnString := 'PASS XXXXXX' + #13#10;
  1677.   { Put result in progress and status line }
  1678.   AddProgressText( TheReturnString );
  1679.   ShowProgressText( TheReturnString );
  1680.   { Send Password sequence }
  1681.   TheResult := PerformFTPCommand( 'PASS %s',
  1682.                                   [ PCRPointer^.CPassword ] );
  1683.   if TheResult <> TCPIP_STATUS_PRELIMINARY then
  1684.   begin
  1685.     Result := false;
  1686.     FTPCommandInProgress := false;
  1687.     exit;
  1688.   end;
  1689.   repeat
  1690.     TheResult := GetFTPServerResponse( TheReturnString );
  1691.     { Put result in progress and status line }
  1692.     AddProgressText( TheReturnString );
  1693.     ShowProgressText( TheReturnString );
  1694.   until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  1695.   FTPCommandInProgress := false;
  1696.   if ( GlobalAbortedFlag or ( TheResult <> TCPIP_STATUS_COMPLETED )) then
  1697.   begin
  1698.     { Do clever C formatting trick }
  1699.     TheReturnString :=
  1700.      DoCStyleFormat( 'FTP Host %s Connection Failed!' ,
  1701.       [ PCRPointer^.CIPAddress ] );
  1702.     { Put result in progress and status line }
  1703.     AddProgressText( TheReturnString );
  1704.     ShowProgressErrorText( TheReturnString );
  1705.     { Signal error }
  1706.     Result := False;
  1707.     { leave }
  1708.     exit;
  1709.   end
  1710.   else Result := true; { Signal no problem }
  1711. end;
  1712.  
  1713. { This is the FTP components CWD routine }
  1714. function TFTPComponent.SetRemoteStartupDirectory(
  1715.           PCRPointer : PConnectionsRecord ) : Boolean;
  1716. var TheReturnString : String;  { Internal string holder }
  1717.     TheResult       : Integer; { Internal int holder    }
  1718. begin
  1719.   Result := true;
  1720.   if PCRPointer^.CStartDir <> '' then
  1721.   begin
  1722.     TheReturnString :=
  1723.      DoCStyleFormat( 'CWD %s' ,
  1724.       [ PCRPointer^.CStartDir ] );
  1725.     { Put result in progress and status line }
  1726.     AddProgressText( TheReturnString );
  1727.     ShowProgressText( TheReturnString );
  1728.     { Send Password sequence }
  1729.     TheResult := PerformFTPCommand( 'CWD %s',
  1730.                                     [ PCRPointer^.CStartDir ] );
  1731.     if TheResult <> TCPIP_STATUS_PRELIMINARY then
  1732.     begin
  1733.       Result := false;
  1734.       FTPCommandInProgress := false;
  1735.       exit;
  1736.     end;
  1737.     repeat
  1738.       TheResult := GetFTPServerResponse( TheReturnString );
  1739.       { Put result in progress and status line }
  1740.       AddProgressText( TheReturnString );
  1741.       ShowProgressText( TheReturnString );
  1742.    until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  1743.    FTPCommandInProgress := false;
  1744.    if ( GlobalAbortedFlag or ( TheResult <> TCPIP_STATUS_COMPLETED )) then
  1745.     begin
  1746.       { Do clever C formatting trick }
  1747.       TheReturnString :=
  1748.        DoCStyleFormat( 'CWD to %s Failed!' ,
  1749.         [ PCRPointer^.CStartDir ] );
  1750.       { Put result in progress and status line }
  1751.       AddProgressText( TheReturnString );
  1752.       ShowProgressErrorText( TheReturnString );
  1753.       { Signal error }
  1754.       Result := False;
  1755.       { leave }
  1756.       exit;
  1757.     end
  1758.     else Result := true; { Signal no problem }
  1759.   end;
  1760. end;
  1761.  
  1762. { This is the FTP components CWD routine }
  1763. function TFTPComponent.SetRemoteDirectory( TheDir : String ) : Boolean;
  1764. var TheReturnString : String;  { Internal string holder }
  1765.     TheResult       : Integer; { Internal int holder    }
  1766. begin
  1767.   Result := true;
  1768.   if TheDir <> '' then
  1769.   begin
  1770.     TheReturnString :=
  1771.      DoCStyleFormat( 'CWD %s' ,
  1772.       [ TheDir ] );
  1773.     { Put result in progress and status line }
  1774.     AddProgressText( TheReturnString );
  1775.     ShowProgressText( TheReturnString );
  1776.     { Send Password sequence }
  1777.     TheResult := PerformFTPCommand( 'CWD %s',
  1778.                                     [ TheDir ] );
  1779.     if TheResult <> TCPIP_STATUS_PRELIMINARY then
  1780.     begin
  1781.       Result := false;
  1782.       FTPCommandInProgress := false;
  1783.       exit;
  1784.     end;
  1785.     repeat
  1786.       TheResult := GetFTPServerResponse( TheReturnString );
  1787.       { Put result in progress and status line }
  1788.       AddProgressText( TheReturnString );
  1789.       ShowProgressText( TheReturnString );
  1790.    until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  1791.    FTPCommandInProgress := false;
  1792.    if ( GlobalAbortedFlag or ( TheResult <> TCPIP_STATUS_COMPLETED )) then
  1793.     begin
  1794.       { Do clever C formatting trick }
  1795.       TheReturnString :=
  1796.        DoCStyleFormat( 'CWD to %s Failed!' ,
  1797.         [ TheDir ] );
  1798.       { Put result in progress and status line }
  1799.       AddProgressText( TheReturnString );
  1800.       ShowProgressErrorText( TheReturnString );
  1801.       { Signal error }
  1802.       Result := False;
  1803.       { leave }
  1804.       exit;
  1805.     end
  1806.     else Result := true; { Signal no problem }
  1807.   end;
  1808. end;
  1809.  
  1810. { This is the FTP components QUIT routine }
  1811. function TFTPComponent.Disconnect : Boolean;
  1812. var TheReturnString : String;  { Internal string holder }
  1813.     TheResult       : Integer; { Internal int holder    }
  1814. begin
  1815.   TheReturnString :=
  1816.    DoCStyleFormat( 'QUIT' ,
  1817.     [ nil ] );
  1818.   { Put result in progress and status line }
  1819.   AddProgressText( TheReturnString );
  1820.   ShowProgressText( TheReturnString );
  1821.   { Begin login sequence with user name }
  1822.   PerformFTPCommand( 'QUIT', [ nil ] );
  1823.   repeat
  1824.     TheResult := GetFTPServerResponse( TheReturnString );
  1825.     { Put result in progress and status line }
  1826.     AddProgressText( TheReturnString );
  1827.     ShowProgressText( TheReturnString );
  1828.   until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  1829.   FTPCommandInProgress := false;
  1830.   if ( GlobalAbortedFlag or ( TheResult <> TCPIP_STATUS_COMPLETED )) then
  1831.   begin
  1832.     { Do clever C formatting trick }
  1833.     TheReturnString :=
  1834.      DoCStyleFormat( 'FTP Host Connection Failed!' ,
  1835.       [ nil ] );
  1836.     { Put result in progress and status line }
  1837.     AddProgressText( TheReturnString );
  1838.     ShowProgressErrorText( TheReturnString );
  1839.     { Signal error }
  1840.     Result := False;
  1841.     { leave }
  1842.     exit;
  1843.   end
  1844.   else Result := true; { Signal no problem }
  1845. end;
  1846.  
  1847. { This is the FTP components PWD routine }
  1848. function TFTPComponent.GetRemoteWorkingDirectory( var RemoteDir : String )
  1849.           : Boolean;
  1850. var TheReturnString : String;  { Internal string holder }
  1851.     TheResult       : Integer; { Internal int holder    }
  1852. begin
  1853.   TheReturnString :=
  1854.    DoCStyleFormat( 'PWD' ,
  1855.     [ nil ] );
  1856.   { Put result in progress and status line }
  1857.   AddProgressText( TheReturnString );
  1858.   ShowProgressText( TheReturnString );
  1859.   { Send Password sequence }
  1860.   TheResult := PerformFTPCommand( 'PWD',
  1861.                                   [ nil ] );
  1862.   if TheResult <> TCPIP_STATUS_PRELIMINARY then
  1863.   begin
  1864.     Result := false;
  1865.     FTPCommandInProgress := false;
  1866.     exit;
  1867.   end;
  1868.   repeat
  1869.     TheResult := GetFTPServerResponse( TheReturnString );
  1870.     { Put result in progress and status line }
  1871.     AddProgressText( TheReturnString );
  1872.     ShowProgressText( TheReturnString );
  1873.   until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  1874.   FTPCommandInProgress := false;
  1875.   if ( GlobalAbortedFlag or ( TheResult <> TCPIP_STATUS_COMPLETED )) then
  1876.   begin
  1877.     { Do clever C formatting trick }
  1878.     TheReturnString :=
  1879.      DoCStyleFormat( 'FTP Host Connection Failed!' ,
  1880.       [ nil ] );
  1881.     { Put result in progress and status line }
  1882.     AddProgressText( TheReturnString );
  1883.     ShowProgressErrorText( TheReturnString );
  1884.     { Signal error }
  1885.     Result := False;
  1886.     { leave }
  1887.     exit;
  1888.   end
  1889.   else
  1890.   begin
  1891.     Result := true; { Signal no problem }
  1892.     RemoteDir := TheReturnString; { Send back last string on faith }
  1893.   end;
  1894. end;
  1895.  
  1896. { This function sets up a listening port on socekt 2 and handle text replies }
  1897. function TFTPComponent.GetListeningPort : Integer;
  1898. var
  1899.   Address1 ,
  1900.   Address2 ,
  1901.   Address3 ,
  1902.   Address4        : integer; { Address integer conversions }
  1903.   IPAddress       : string;  { IP Address holder           }
  1904.   PortCommand     : string;  { Command holder              }
  1905.   TheResult       : Integer; { Result holder               }
  1906.   TheReturnString : String;  { ditto                       }
  1907. begin
  1908.   { Set up any port on socket 2 }
  1909.   Socket2.PortName := '0';
  1910.   { Listen on a socket }
  1911.   Socket2.CCSockListen;
  1912.   { Get the IP Address of socket 1 and convert it to numbers }
  1913.   IPAddress := Socket1.GetSocketIPAddress( Socket1.TheSocket );
  1914.   Address1 := StrToInt( copy( IPAddress , 1 , Pos( '.' , IPAddress ) -1 ));
  1915.   IPAddress := copy( IPAddress , Pos( '.' , IPAddress ) + 1 , 255 );
  1916.   Address2 := StrToInt( copy( IPAddress , 1 , Pos( '.' , IPAddress) -1 ));
  1917.   IPAddress := copy( IPAddress , Pos( '.' , IPAddress ) + 1 , 255 );
  1918.   Address3 := StrToInt( copy( IPAddress , 1 , Pos( '.' , IPAddress ) -1 ));
  1919.   Address4 := StrToInt( copy( IPAddress , Pos( '.' , IPAddress ) + 1 , 255 ));
  1920.   { Turn it into a command and add socket 2 stuff }
  1921.   PortCommand := format( 'PORT %d,%d,%d,%d,%d,%d' ,
  1922.    [ Address1 , Address2 , Address3 , Address4 ,
  1923.     StrToInt( Socket2.GetSocketPort( Socket2.TheMasterSocket )) Shr 8,
  1924.     StrToInt( Socket2.GetSocketPort( Socket2.TheMasterSocket )) and $ff ]);
  1925.   { Put result in progress and status line }
  1926.   AddProgressText( PortCommand + #13#10 );
  1927.   ShowProgressText( PortCommand  + #13#10 );
  1928.   TheResult := PerformFTPCommand( PortCommand , [nil] );
  1929.   if TheResult <> TCPIP_STATUS_PRELIMINARY then
  1930.   begin
  1931.     Result := TCPIP_STATUS_FATAL_ERROR;
  1932.     FTPCommandInProgress := false;
  1933.     exit;
  1934.   end;
  1935.   repeat
  1936.     TheResult := GetFTPServerResponse( TheReturnString );
  1937.     { Put result in progress and status line }
  1938.     AddProgressText( TheReturnString );
  1939.     ShowProgressText( TheReturnString );
  1940.   until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  1941.   FTPCommandInProgress := false;
  1942.   if ( GlobalAbortedFlag or ( TheResult <> TCPIP_STATUS_COMPLETED )) then
  1943.   begin
  1944.     { Do clever C formatting trick }
  1945.     TheReturnString :=
  1946.      DoCStyleFormat( 'FTP Host Connection Failed!' ,
  1947.       [ nil ] );
  1948.     { Put result in progress and status line }
  1949.     AddProgressText( TheReturnString );
  1950.     ShowProgressErrorText( TheReturnString );
  1951.     { Signal error }
  1952.     Result := TheResult;
  1953.     { leave }
  1954.     exit;
  1955.   end
  1956.   else
  1957.   begin
  1958.     { Return good result and leave }
  1959.     Result := TheResult;
  1960.     exit;
  1961.   end;
  1962. end;
  1963.  
  1964. { This function returns part of a unit text string }
  1965. function TFTPComponent.GetUNIXTextString( var StringIn : String ) : String;
  1966. var
  1967.   ReturnString : String;
  1968.   TheLength ,
  1969.   Counter_1   : integer;
  1970. begin
  1971.   TheLength := Length( StringIn );
  1972.   if TheLength > 1 then
  1973.   begin
  1974.     for Counter_1 := 1 to TheLength do
  1975.     begin
  1976.       if StringIn[ Counter_1 ] = #10 then
  1977.       begin
  1978.         ReturnString := HolderLine;
  1979.         HolderLine := '';
  1980.         StringIn := Copy( StringIn , Counter_1 + 1 , 255 );
  1981.         Result := ReturnString;
  1982.         exit;
  1983.       end
  1984.       else
  1985.       begin
  1986.         if StringIn[ Counter_1 ] <> #0 then
  1987.         begin
  1988.           if StringIn[ Counter_1 ] <> #13 then
  1989.            HolderLine := HolderLine + StringIn[ Counter_1 ];
  1990.         end
  1991.         else
  1992.         begin
  1993.           Result := '';
  1994.           StringIn := '';
  1995.         end;
  1996.       end;
  1997.     end;
  1998.   end;
  1999.   Result := '';
  2000.   StringIn := '';
  2001. end;
  2002.  
  2003. procedure TFTPComponent.GetFileNameFromUNIXFileName( var TheName : String );
  2004. var Counter_1 : Integer;
  2005.     ResultString : String;
  2006.     Finished : Boolean;
  2007. begin
  2008.   if Pos( 'TOTAL' , Uppercase( TheName )) <> 0 then
  2009.   begin
  2010.     TheName := '';
  2011.     exit;
  2012.   end;
  2013.   Counter_1 := Length( TheName );
  2014.   ResultString := '';
  2015.   Finished := false;
  2016.   while not Finished do
  2017.   begin
  2018.     if TheName[ Counter_1 ] <> ' ' then
  2019.     begin
  2020.       Counter_1 := Counter_1 - 1;
  2021.       if Counter_1 = 0 then
  2022.       begin
  2023.         ResultString := TheName;
  2024.         Finished := true;
  2025.       end;
  2026.     end
  2027.     else
  2028.     begin
  2029.       Finished := true;
  2030.       ResultString := Copy( TheName , Counter_1 + 1 , 255 );
  2031.     end;
  2032.   end;
  2033.   TheName := ResultString;
  2034. end;
  2035.  
  2036. { This is the FTP components get remote directory listing into a list box }
  2037. function TFTPComponent.GetRemoteDirectoryListing( TheListBox : TListBox )
  2038.           : Boolean;
  2039. var TheReturnString : String;  { Internal string holder }
  2040.     TheResult       : Integer; { Internal int holder    }
  2041.     InputString     : String;
  2042.     Through ,
  2043.     Finished        : Boolean;
  2044. begin
  2045.   TheListBox.Clear;
  2046.   TheListbox.Tag := 2;
  2047.   TheListBox.Items.Add('..');
  2048.   Result := true;
  2049.   TheReturnString :=
  2050.    DoCStyleFormat( 'TYPE A' ,
  2051.     [ nil ] );
  2052.   { Put result in progress and status line }
  2053.   AddProgressText( TheReturnString );
  2054.   ShowProgressText( TheReturnString );
  2055.   { Send Password sequence }
  2056.   TheResult := PerformFTPCommand( 'TYPE A',
  2057.                                   [ nil ] );
  2058.   if TheResult <> TCPIP_STATUS_PRELIMINARY then
  2059.   begin
  2060.     Result := true;
  2061.     FTPCommandInProgress := false;
  2062.     exit;
  2063.   end;
  2064.   repeat
  2065.     TheResult := GetFTPServerResponse( TheReturnString );
  2066.     { Put result in progress and status line }
  2067.     AddProgressText( TheReturnString );
  2068.     ShowProgressText( TheReturnString );
  2069.   until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  2070.   FTPCommandInProgress := false;
  2071.   if ( GlobalAbortedFlag or ( TheResult <> TCPIP_STATUS_COMPLETED )) then
  2072.   begin
  2073.     { Do clever C formatting trick }
  2074.     TheReturnString :=
  2075.      DoCStyleFormat( 'FTP Host Connection Failed!' ,
  2076.       [ nil ] );
  2077.     { Put result in progress and status line }
  2078.     AddProgressText( TheReturnString );
  2079.     ShowProgressErrorText( TheReturnString );
  2080.     { Signal error }
  2081.     Result := true;
  2082.     { leave }
  2083.     exit;
  2084.   end
  2085.   else
  2086.   begin
  2087.     { Set up socket 2 for listening }
  2088.     Socket2.AsynchMode := False;
  2089.     Socket2.NonAsynchTimeoutValue := 60;
  2090.     { do a listen and send command to server that this is receipt socket }
  2091.     if GetListeningPort = TCPIP_STATUS_FATAL_ERROR then
  2092.     begin
  2093.       Socket2.CCSockCancelListen;
  2094.       exit;
  2095.     end;
  2096.     Socket1.NonAsynchTimeoutValue := 0; {infinite timeout}
  2097.     TheResult := PerformFTPCommand( 'LIST' , [nil] );
  2098.     GetFTPServerResponse( TheReturnString );
  2099.     AddProgressText( TheReturnString );
  2100.     ShowProgressText( TheReturnString );
  2101.     Socket1.NonAsynchTimeoutValue := 30;
  2102.     if (( TheResult = TCPIP_STATUS_RETRY_COMMAND ) or
  2103.        ( TheResult = TCPIP_STATUS_FATAL_ERROR )) then
  2104.     begin
  2105.       TheReturnString :=
  2106.        DoCStyleFormat( 'Could not obtain remote directory!' ,
  2107.         [ nil ] );
  2108.       { Put result in progress and status line }
  2109.       AddProgressText( TheReturnString );
  2110.       ShowProgressErrorText( TheReturnString );
  2111.       Socket2.CCSockCancelListen;
  2112.       Result := true;
  2113.       exit;
  2114.     end;
  2115.     Socket2.CCSockAccept;
  2116.     if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 )) then
  2117.     begin
  2118.       TheReturnString :=
  2119.        DoCStyleFormat( 'Could not establish receive socket!' ,
  2120.         [ nil ] );
  2121.       { Put result in progress and status line }
  2122.       AddProgressText( TheReturnString );
  2123.       ShowProgressErrorText( TheReturnString );
  2124.       Result := true;
  2125.       exit;
  2126.     end;
  2127.     Through := false;
  2128.     repeat
  2129.       TheReturnString := Socket2.StringData;
  2130.       if Length( TheReturnString ) = 0 then Through := true;
  2131.       if Length( TheReturnString ) > 0 then
  2132.       begin
  2133.         finished := false;
  2134.         while not finished do
  2135.         begin
  2136.           InputString := GetUNIXTextString( TheReturnString );
  2137.           if InputString = '' then Finished := true else
  2138.           begin
  2139.             GetFileNameFromUNIXFileName( InputString);
  2140.             If InputString <> '' then
  2141.             TheListBox.Items.Add( InputString );
  2142.           end;
  2143.         end;
  2144.       end;
  2145.       if GlobalAbortedFlag then
  2146.       begin
  2147.         Socket1.OutOfBand := 'ABOR'+#13#10;
  2148.         repeat
  2149.           TheResult := GetFTPServerResponse( TheReturnString );
  2150.           { Put result in progress and status line }
  2151.           AddProgressText( TheReturnString );
  2152.           ShowProgressText( TheReturnString );
  2153.         until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  2154.         result := true;
  2155.         exit;
  2156.       end;
  2157.     until Through;
  2158.     GetFTPServerResponse( TheReturnString );
  2159.     AddProgressText( TheReturnString );
  2160.     ShowProgressText( TheReturnString );
  2161.     { cancel listening on second socket and close it }
  2162.     Socket2.CCSockCancelListen;
  2163.     Socket2.CCSockClose;
  2164.   end;
  2165.   FTPCommandInProgress := false;
  2166. end;
  2167.  
  2168. { This is the FTP components get remote directory listing into a list box }
  2169. function TFTPComponent.GetRemoteDirectoryListingToMemo : Boolean;
  2170. var TheReturnString : String;  { Internal string holder }
  2171.     TheResult       : Integer; { Internal int holder    }
  2172.     Through         : Boolean;
  2173. begin
  2174.   Result := true;
  2175.   TheReturnString :=
  2176.    DoCStyleFormat( 'TYPE A' ,
  2177.     [ nil ] );
  2178.   { Put result in progress and status line }
  2179.   AddProgressText( TheReturnString );
  2180.   ShowProgressText( TheReturnString );
  2181.   { Send Password sequence }
  2182.   TheResult := PerformFTPCommand( 'TYPE A',
  2183.                                   [ nil ] );
  2184.   if TheResult <> TCPIP_STATUS_PRELIMINARY then
  2185.   begin
  2186.     Result := true;
  2187.     FTPCommandInProgress := false;
  2188.     exit;
  2189.   end;
  2190.   repeat
  2191.     TheResult := GetFTPServerResponse( TheReturnString );
  2192.     { Put result in progress and status line }
  2193.     AddProgressText( TheReturnString );
  2194.     ShowProgressText( TheReturnString );
  2195.   until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  2196.   FTPCommandInProgress := false;
  2197.   if ( GlobalAbortedFlag or ( TheResult <> TCPIP_STATUS_COMPLETED )) then
  2198.   begin
  2199.     { Do clever C formatting trick }
  2200.     TheReturnString :=
  2201.      DoCStyleFormat( 'FTP Host Connection Failed!' ,
  2202.       [ nil ] );
  2203.     { Put result in progress and status line }
  2204.     AddProgressText( TheReturnString );
  2205.     ShowProgressErrorText( TheReturnString );
  2206.     { Signal error }
  2207.     Result := true;
  2208.     { leave }
  2209.     exit;
  2210.   end
  2211.   else
  2212.   begin
  2213.     { Set up socket 2 for listening }
  2214.     Socket2.AsynchMode := False;
  2215.     Socket2.NonAsynchTimeoutValue := 30;
  2216.     { do a listen and send command to server that this is receipt socket }
  2217.     if GetListeningPort = TCPIP_STATUS_FATAL_ERROR then
  2218.     begin
  2219.       Socket2.CCSockCancelListen;
  2220.       exit;
  2221.     end;
  2222.     Socket1.NonAsynchTimeoutValue := 0; {infinite timeout}
  2223.     TheResult := PerformFTPCommand( 'LIST' , [nil] );
  2224.     GetFTPServerResponse( TheReturnString );
  2225.     AddProgressText( TheReturnString );
  2226.     ShowProgressText( TheReturnString );
  2227.     Socket1.NonAsynchTimeoutValue := 30;
  2228.     if (( TheResult = TCPIP_STATUS_RETRY_COMMAND ) or
  2229.        ( TheResult = TCPIP_STATUS_FATAL_ERROR )) then
  2230.     begin
  2231.       TheReturnString :=
  2232.        DoCStyleFormat( 'Could not obtain remote directory!' ,
  2233.         [ nil ] );
  2234.       { Put result in progress and status line }
  2235.       AddProgressText( TheReturnString );
  2236.       ShowProgressErrorText( TheReturnString );
  2237.       Socket2.CCSockCancelListen;
  2238.       Result := true;
  2239.       exit;
  2240.     end;
  2241.     Socket2.CCSockAccept;
  2242.     if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 )) then
  2243.     begin
  2244.       TheReturnString :=
  2245.        DoCStyleFormat( 'Could not establish receive socket!' ,
  2246.         [ nil ] );
  2247.       { Put result in progress and status line }
  2248.       AddProgressText( TheReturnString );
  2249.       ShowProgressErrorText( TheReturnString );
  2250.       Result := true;
  2251.       exit;
  2252.     end;
  2253.     Through := false;
  2254.     repeat
  2255.       TheReturnString := Socket2.StringData;
  2256.       if Length( TheReturnString ) = 0 then Through := true;
  2257.       if Length( TheReturnString ) > 0 then
  2258.       begin
  2259.         { Put result in progress and status line }
  2260.         AddProgressText( TheReturnString );
  2261.         ShowProgressText( TheReturnString );
  2262.       end;
  2263.       if GlobalAbortedFlag then
  2264.       begin
  2265.         Socket1.OutOfBand := 'ABOR'+#13#10;
  2266.         repeat
  2267.           TheResult := GetFTPServerResponse( TheReturnString );
  2268.           { Put result in progress and status line }
  2269.           AddProgressText( TheReturnString );
  2270.           ShowProgressText( TheReturnString );
  2271.         until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  2272.         result := true;
  2273.         exit;
  2274.       end;
  2275.     until Through;
  2276.     GetFTPServerResponse( TheReturnString );
  2277.     AddProgressText( TheReturnString );
  2278.     ShowProgressText( TheReturnString );
  2279.     { cancel listening on second socket and close it }
  2280.     Socket2.CCSockCancelListen;
  2281.     Socket2.CCSockClose;
  2282.   end;
  2283. end;
  2284.  
  2285. { This is the FTP components get local directory listing into a list box }
  2286. function TFTPComponent.GetLocalDirectoryAndListing( var TheString : String;
  2287.                                                         TheListBox : TListBox )
  2288.           : Boolean;
  2289. var TheFLB : TFileListBox;
  2290. begin
  2291.   { Get the working directory }
  2292.   GetDir( 0 , TheString );
  2293.   { Clear incoming LB }
  2294.   TheListBox.Clear;
  2295.   TheListBox.Tag := 2;
  2296.   TheFLB := TFileListBox.Create( Application.MainForm );
  2297.   TheFLB.Visible := false;
  2298.   TheFLB.Parent := Application.MainForm;
  2299.   TheFLB.FileType := [ ftNormal , ftDirectory ];
  2300.   TheFLB.Directory := TheString;
  2301.   TheFLB.Update;
  2302.   TheListBox.Items.Assign( TheFLB.Items );
  2303.   TheFLB.Free;
  2304.   result := true;
  2305. end;
  2306.  
  2307. { This is a clever c-style formatting trick }
  2308. function TFTPComponent.DoCStyleFormat(
  2309.                 TheText      : string;
  2310.           const TheArguments : array of const ) : String;
  2311. begin
  2312.   Result := Format( TheText , TheArguments ) + #13#10;
  2313. end;
  2314.  
  2315. function TFTPComponent.GetQuotedString( TheString : String ) : String;
  2316. var TheIndex     : Integer; { Holder var }
  2317.     ResultString : String;  { ditto      }
  2318. begin
  2319.   { Find out if " present at all }
  2320.   TheIndex := Pos( '"' , TheString );
  2321.   If TheIndex = 0 then
  2322.   begin
  2323.     { If not, return null string and exit }
  2324.     Result := '';
  2325.     exit;
  2326.   end
  2327.   else
  2328.   begin
  2329.     { Get from first " to end of string in holder }
  2330.     ResultString := Copy( TheString , TheIndex + 1 , 255 );
  2331.     { Find position to second " }
  2332.     TheIndex := Pos( '"' , ResultString );
  2333.     { If no ending " then return whole string and leave }
  2334.     if TheIndex = 0 then
  2335.     begin
  2336.       Result := ResultString;
  2337.       exit;
  2338.     end
  2339.     else
  2340.     begin
  2341.       { Get internal text between quotes and exit }
  2342.       ResultString := Copy( ResultString , 1 , TheIndex - 1 );
  2343.       Result := ResultString;
  2344.     end;
  2345.   end;
  2346. end;
  2347.  
  2348. procedure TCCINetCCForm.UpdateGauge( BytesFinished , TotalToHandle : longint );
  2349. var
  2350.   Percentage : longint;
  2351. begin
  2352.   if BytesFinished > TotalToHandle then BytesFinished := TotalToHandle;
  2353.   if TotalToHandle = 0 then exit;
  2354.   Percentage := Trunc( 100.0 / ( TotalToHandle / BytesFinished ));
  2355.   Gauge1.Progress := Percentage;
  2356.   Panel1.Caption := '  Status: ' + IntToStr( BytesFinished ) +
  2357.    ' bytes ' + FileNameToXFer + ' (' + IntToStr( Percentage ) + '% Done)';
  2358. end;
  2359.  
  2360. procedure TCCINetCCForm.UpdateUUGauge( BytesFinished , TotalToHandle : longint );
  2361. var
  2362.   Percentage : longint;
  2363. begin
  2364.   if BytesFinished > TotalToHandle then BytesFinished := TotalToHandle;
  2365.   if TotalToHandle = 0 then exit;
  2366.   Percentage := Trunc( 100.0 / ( TotalToHandle / BytesFinished ));
  2367.   Gauge1.Progress := Percentage;
  2368.   Panel1.Caption := '  Status: ' + IntToStr( BytesFinished ) +
  2369.    ' bytes UUCode (' + IntToStr( Percentage ) + '% Done)';
  2370.   Panel1.Show;
  2371. end;
  2372.  
  2373. { This procedure actually attempts to connect to the internet at an ftp site }
  2374. function TCCINetCCForm.DoFTPConnection( PCRPointer : PConnectionsRecord ) : boolean;
  2375. var TheReturnString : String; { Display results of connection in status lines }
  2376. begin
  2377.   { Create the component }
  2378.   Result := false;
  2379.   { Do busy cursors }
  2380.   SetHGCursors;
  2381.   if not TheFTPComponent.EstablishConnection( PCRPointer ) then
  2382.   begin
  2383.     { Do saved cursors }
  2384.     TheFTPComponent.FTPCommandInProgress := false;
  2385.     TheFTPComponent.Connection_Established := false;
  2386.     SetNormalCursors;
  2387.     exit;
  2388.   end
  2389.   else
  2390.   begin { Connected; continue login process }
  2391.     if not TheFTPComponent.LoginUser( PCRPointer ) then
  2392.     begin
  2393.       { Do saved cursors }
  2394.       TheFTPComponent.FTPCommandInProgress := false;
  2395.       TheFTPComponent.Connection_Established := false;
  2396.       SetNormalCursors;
  2397.       exit;
  2398.     end;
  2399.     if not TheFTPComponent.SendPassword( PCRPointer ) then
  2400.     begin
  2401.       { Do saved cursors }
  2402.       TheFTPComponent.FTPCommandInProgress := false;
  2403.       TheFTPComponent.Connection_Established := false;
  2404.       SetNormalCursors;
  2405.       exit;
  2406.     end;
  2407.     if not TheFTPComponent.SetRemoteStartupDirectory( PCRPointer ) then
  2408.     begin
  2409.       { Do saved cursors }
  2410.       SetNormalCursors;
  2411.       TheFTPComponent.Connection_Established := false;
  2412.       TheFTPComponent.FTPCommandInProgress := false;
  2413.       exit;
  2414.     end;
  2415.     if not TheFTPComponent.GetRemoteWorkingDirectory( TheReturnString ) then
  2416.     begin
  2417.       { Do saved cursors }
  2418.       TheFTPComponent.Connection_Established := false;
  2419.       TheFTPComponent.FTPCommandInProgress := false;
  2420.       SetNormalCursors;
  2421.       exit;
  2422.     end;
  2423.     { Put up remote directory via PWD and strip quotes }
  2424.     Label4.Caption := TheFTPComponent.GetQuotedString( TheReturnString );
  2425.     { Get the listings of directories and exit OK }
  2426.     TheFTPComponent.GetRemoteDirectoryListing( Listbox1 );
  2427.     TheFTPComponent.GetLocalDirectoryAndListing( TheReturnString ,
  2428.      Listbox2 );
  2429.     if Label5.Canvas.TextWidth( TheReturnString ) > Label5.Width then
  2430.      TheReturnString := TheFTPComponent.GetShortPathName( TheReturnString );
  2431.     Label5.Caption := TheReturnString;
  2432.     SetNormalCursors;
  2433.     Result := true;
  2434.     EnableFTPMenus;
  2435.     TheFTPComponent.FTPCommandInProgress := false;
  2436.     Panel1.Caption := '  Status : Connected to ' + PCRPointer^.CIPAddress;
  2437.   end;
  2438. end;
  2439.  
  2440. { This procedure actually attempts to connect to the internet at an nntp site }
  2441. function TCCINetCCForm.DoNNTPConnection( PCRPointer : PConnectionsRecord ) : boolean;
  2442. begin
  2443.   { Create the component }
  2444.   Result := false;
  2445.   { Do busy cursors }
  2446.   SetHGCursors;
  2447.   if not TheNNTPComponent.EstablishConnection( PCRPointer ) then
  2448.   begin
  2449.     { Do saved cursors }
  2450.     TheNNTPComponent.NNTPCommandInProgress := false;
  2451.     TheNNTPComponent.Connection_Established := false;
  2452.     SetNormalCursors;
  2453.     exit;
  2454.   end
  2455.   else
  2456.   begin { Connected; continue login process }
  2457.     SetNormalCursors;
  2458.     Result := true;
  2459.     EnableNNTPMenus;
  2460.     TheNNTPComponent.NNTPCommandInProgress := false;
  2461.     Panel1.Caption := '  Status : Connected to ' + PCRPointer^.CIPAddress;
  2462.   end;
  2463. end;
  2464.  
  2465. { This procedure actually attempts to disconnect to the internet at an ftp site}
  2466. procedure TCCINetCCForm.DoFTPDisconnect;
  2467. begin
  2468.   { Call QUIT command }
  2469.   TheFTPComponent.Disconnect;
  2470.   { Kill the socket }
  2471.   TheFTPComponent.Socket1.CCSockClose;
  2472. end;
  2473.  
  2474. { This procedure actually attempts to disconnect to the internet at an ftp site}
  2475. procedure TCCINetCCForm.DoNNTPDisconnect;
  2476. begin
  2477.   { Call QUIT command }
  2478.   TheNNTPComponent.Disconnect;
  2479.   { Kill the socket }
  2480.   TheNNTPComponent.Socket1.CCSockClose;
  2481. end;
  2482.  
  2483. { This procedure reads in the ini file and default path info }
  2484. procedure TCCINetCCForm.ReadIniData;
  2485. begin
  2486.   TheICCIniFile := TIniFile.Create( 'CCICC.INI' );
  2487.   MailPath := TheICCIniFile.ReadString( 'Paths','MailPath','C:\WINDOWS' );
  2488.   NewsPath := TheICCIniFile.ReadString( 'Paths','NewsPath','C:\WINDOWS' );
  2489.   FTPPath := TheICCIniFile.ReadString( 'Paths','FTPPath','C:\WINDOWS' );
  2490.   PasswordControlVector := TheICCIniFile.ReadInteger( 'Vectors','PWControl',2 );
  2491.   DefaultDownloadVector := TheICCIniFile.ReadInteger( 'Vectors','DefDL', 3 );
  2492.   TheAnonRedialVector := TheICCIniFile.ReadInteger( 'Vectors','AnonRD', 20 );
  2493.   NewsReadArticlePurgingVector := TheICCIniFile.ReadInteger( 'Vectors','NewsPurge', 1 );
  2494.   NewsPostQueueingVector := TheICCIniFile.ReadInteger( 'Vectors','NewsQueue', 1 );
  2495.   NewsReadArticleDisplayVector := TheICCIniFile.ReadInteger( 'Vectors','NewsRDisp', 1 );
  2496.   NewsUUMIMEVector := TheICCIniFile.ReadInteger( 'Vectors','NewsUUMIME', 2 );
  2497.   NewsInitialUpdateVector := TheICCIniFile.ReadInteger( 'Vectors','NewsInitUD', 1 );
  2498.   EMPasswordControlVector := TheICCIniFile.ReadInteger( 'Vectors','EMPWControl', 1 );
  2499.   EMRemoteDeletionVector  := TheICCIniFile.ReadInteger( 'Vectors','EMRemDel', 2 );
  2500.   EMChokeVector           := TheICCIniFile.ReadInteger( 'Vectors','EMChoke', 1 );
  2501.   EMDefaultDownloadVector := TheICCIniFile.ReadInteger( 'Vectors','EMInitUD', 1 );
  2502.   EMQueueVector           := TheICCIniFile.ReadInteger( 'Vectors','EMQueue', 1 );
  2503.   TheICCIniFile.Free;
  2504. end;
  2505.  
  2506. { This procedure writes out default path data to the ini file }
  2507. procedure TCCINetCCForm.WriteIniData;
  2508. begin
  2509.   TheICCIniFile := TIniFile.Create( 'CCICC.INI' );
  2510.   TheICCIniFile.WriteString( 'Paths','MailPath', MailPath );
  2511.   TheICCIniFile.WriteString( 'Paths','NewsPath', NewsPath );
  2512.   TheICCIniFile.WriteString( 'Paths','FTPPath', FTPPath );
  2513.   TheICCIniFile.WriteInteger( 'Vectors','PWControl', PasswordControlVector );
  2514.   TheICCIniFile.WriteInteger( 'Vectors','DefDL', DefaultDownloadVector );
  2515.   TheICCIniFile.WriteInteger( 'Vectors','AnonRD', TheAnonRedialVector );
  2516.   TheICCIniFile.WriteInteger( 'Vectors','NewsPurge',
  2517.    NewsReadArticlePurgingVector );
  2518.   TheICCIniFile.WriteInteger( 'Vectors','NewsQueue', NewsPostQueueingVector );
  2519.   TheICCIniFile.WriteInteger( 'Vectors','NewsRDisp',
  2520.    NewsReadArticleDisplayVector );
  2521.   TheICCIniFile.WriteInteger( 'Vectors','NewsUUMIME', NewsUUMIMEVector );
  2522.   TheICCIniFile.WriteInteger( 'Vectors','NewsInitUD', NewsInitialUpdateVector );
  2523.   TheICCIniFile.WriteInteger( 'Vectors','EMPWControl', EMPasswordControlVector );
  2524.   TheICCIniFile.WriteInteger( 'Vectors','EMRemDel', EMRemoteDeletionVector );
  2525.   TheICCIniFile.WriteInteger( 'Vectors','EMChoke', EMChokeVector );
  2526.   TheICCIniFile.WriteInteger( 'Vectors','EMInitUD', EMDefaultDownloadVector );
  2527.   TheICCIniFile.WriteInteger( 'Vectors','EMQueue', EMQueueVector );
  2528.   TheICCIniFile.Free;
  2529. end;
  2530.  
  2531. { Procedure to load the FTP Site list }
  2532. procedure TCCINetCCForm.LoadFTPSiteFile;
  2533. var TheTCRecord : PConnectionsRecord; { Generic TCR Pointer    }
  2534.     FTPSLName   : String;             { FTP Site List filename }
  2535.     Counter_1   : Integer;            { Loop counter           }
  2536. begin
  2537.   { Create the sites list list }
  2538.   TheFTPSiteList := TList.Create;
  2539.   { Set up the FTP sites list file name }
  2540.   FTPSLName := FTPPath + '\FTPSITES.TCR';
  2541.   { If the FTP Site List exists load it in }
  2542.   if FileExists( FTPSLName ) then
  2543.   begin
  2544.     { set up the file and open it }
  2545.     AssignFile( TheFTPSiteFile , FTPSLName );
  2546.     Reset( TheFTPSiteFile );
  2547.     { read in the records }
  2548.     for Counter_1 := 0 to FileSize( TheFTPSiteFile ) - 1 do
  2549.     begin
  2550.       { Create the TCRecord }
  2551.       New( TheTCRecord );
  2552.       { Read in the data record }
  2553.       Seek( TheFTPSiteFile , Counter_1 );
  2554.       Read( TheFTPSiteFile , TheTCRecord^ );
  2555.       { Add the record to the list }
  2556.       TheFTPSiteList.Add( TheTCRecord );
  2557.     end;
  2558.     { close the file }
  2559.     CloseFile( TheFTPSiteFile );
  2560.   end
  2561.   else
  2562.   { Otherwise create a default one with a few anonymous sites }
  2563.   begin
  2564.     { create new record }
  2565.     New( TheTCRecord );
  2566.     { fill in its info }
  2567.     with TheTCRecord^ do
  2568.     begin
  2569.       CProfile   := 'Winsite Windows Archive';
  2570.       CIPAddress := 'ftp.winsite.com';
  2571.       CUserName  := 'anonymous';
  2572.       CPassword  := 'guest@nowhere.com';
  2573.       CStartDir  := '/pub';
  2574.     end;
  2575.     { add it to the list }
  2576.     { do it three more times }
  2577.     TheFTPSiteList.Add( TheTCRecord );
  2578.     New( TheTCRecord );
  2579.     with TheTCRecord^ do
  2580.     begin
  2581.       CProfile   := 'Digital Equipment Corp';
  2582.       CIPAddress := 'gatekeeper.dec.com';
  2583.       CUserName  := 'anonymous';
  2584.       CPassword  := 'guest@nowhere.com';
  2585.       CStartDir  := '/pub';
  2586.     end;
  2587.     TheFTPSiteList.Add( TheTCRecord );
  2588.     New( TheTCRecord );
  2589.     with TheTCRecord^ do
  2590.     begin
  2591.       CProfile   := 'Microsoft FTP Site';
  2592.       CIPAddress := 'ftp.microsoft.com';
  2593.       CUserName  := 'anonymous';
  2594.       CPassword  := 'guest@nowhere.com';
  2595.       CStartDir  := '/pub';
  2596.     end;
  2597.     TheFTPSiteList.Add( TheTCRecord );
  2598.     New( TheTCRecord );
  2599.     with TheTCRecord^ do
  2600.     begin
  2601.       CProfile   := 'Oakland MSDOS Archive';
  2602.       CIPAddress := 'oak.oakland.edu';
  2603.       CUserName  := 'anonymous';
  2604.       CPassword  := 'guest@nowhere.com';
  2605.       CStartDir  := '/pub';
  2606.     end;
  2607.     TheFTPSiteList.Add( TheTCRecord );
  2608.     { create the file and write out the data, then close it }
  2609.     AssignFile( TheFTPSiteFile , FTPSLName );
  2610.     Rewrite( TheFTPSiteFile );
  2611.     for Counter_1 := 0 to 3 do
  2612.     begin
  2613.       TheTCRecord :=
  2614.        PConnectionsRecord( TheFTPSiteList.Items[ Counter_1 ] );
  2615.       Seek( TheFTPSiteFile , Counter_1 );
  2616.       Write( TheFTPSiteFile , TheTCRecord^ );
  2617.     end;
  2618.     CloseFile( TheFTPSiteFile );
  2619.   end;
  2620.   { Create the working copy for use to make safe changes in info dlg }
  2621.   TheWorkingFTPSL := TList.Create;
  2622.   For Counter_1 := 0 to TheFTPSiteList.Count - 1 do
  2623.   begin
  2624.     New( TheTCRecord );
  2625.     TheTCRecord^ := PConnectionsRecord( TheFTPSiteList.Items[ Counter_1 ] )^;
  2626.     TheWorkingFTPSL.Add( TheTCRecord );
  2627.   end;
  2628. end;
  2629.  
  2630. { Procedure to load the NNTP Site list }
  2631. procedure TCCINetCCForm.LoadNNTPSiteFile;
  2632. var TheNGRecord : PConnectionsRecord; { Generic TCR Pointer    }
  2633.     NNTPSLName  : String;             { NNTP Site List filename }
  2634.     Counter_1   : Integer;            { Loop counter           }
  2635. begin
  2636.   { Create the sites list list }
  2637.   TheNewsServerList := TList.Create;
  2638.   { Set up the FTP sites list file name }
  2639.   NNTPSLName := NewsPath + '\NNTPSITE.TCR';
  2640.   { If the FTP Site List exists load it in }
  2641.   if FileExists( NNTPSLName ) then
  2642.   begin
  2643.     { set up the file and open it }
  2644.     AssignFile( TheNewsServerFile , NNTPSLName );
  2645.     Reset( TheNewsServerFile );
  2646.     { read in the records }
  2647.     for Counter_1 := 0 to FileSize( TheNewsServerFile ) - 1 do
  2648.     begin
  2649.       { Create the TCRecord }
  2650.       New( TheNGRecord );
  2651.       { Read in the data record }
  2652.       Seek( TheNewsServerFile , Counter_1 );
  2653.       Read( TheNewsServerFile , TheNGRecord^ );
  2654.       { Add the record to the list }
  2655.       TheNewsServerList.Add( TheNGRecord );
  2656.     end;
  2657.     { close the file }
  2658.     CloseFile( TheNewsServerFile );
  2659.   end
  2660.   else
  2661.   { Otherwise create a default one with a generic news site (?) }
  2662.   begin
  2663.     { create new record }
  2664.     New( TheNGRecord );
  2665.     { fill in its info }
  2666.     with TheNGRecord^ do
  2667.     begin
  2668.       CProfile   := 'My News Server';
  2669.       CIPAddress := 'news.myprovider.com';
  2670.       CUserName  := '';
  2671.       CPassword  := '';
  2672.       CStartDir  := '';
  2673.     end;
  2674.     { add it to the list }
  2675.     { do it three more times }
  2676.     TheNewsServerList.Add( TheNGRecord );
  2677.     { create the file and write out the data, then close it }
  2678.     AssignFile( TheNewsServerFile , NNTPSLName );
  2679.     Rewrite( TheNewsServerFile );
  2680.     TheNGRecord :=
  2681.        PConnectionsRecord( TheNewsServerList.Items[ 0 ] );
  2682.       Seek( TheNewsServerFile , 0 );
  2683.       Write( TheNewsServerFile , TheNGRecord^ );
  2684.     CloseFile( TheNewsServerFile );
  2685.   end;
  2686.   TheWorkingNSSL := TList.Create;
  2687.   For Counter_1 := 0 to TheNewsServerList.Count - 1 do
  2688.   begin
  2689.     New( TheNGRecord );
  2690.     TheNGRecord^ := PConnectionsRecord( TheNewsServerList.Items[ Counter_1 ] )^;
  2691.     TheWorkingNSSL.Add( TheNGRecord );
  2692.   end;
  2693. end;
  2694.  
  2695. { This procedure saves off the FTP Site List }
  2696. procedure TCCINetCCForm.SaveFTPSiteFile;
  2697. var TheTCRecord : PConnectionsRecord; { The TC Record pointer  }
  2698.     FTPSLName   : String;             { FTP Site List filename }
  2699.     Counter_1   : Integer;            { Loop counter           }
  2700. begin
  2701.   { Set up the file name }
  2702.   FTPSLName := FTPPath + '\FTPSITES.TCR';
  2703.   { Assign the file }
  2704.   AssignFile( TheFTPSiteFile , FTPSLName );
  2705.   { Rewrite it }
  2706.   Rewrite( TheFTPSiteFile );
  2707.   { run the list through the procedure }
  2708.   for Counter_1 := 0 to TheFTPSiteList.Count - 1 do
  2709.   begin
  2710.     { get the record from the list }
  2711.     TheTCRecord :=
  2712.      PConnectionsRecord( TheFTPSiteList.Items[ Counter_1 ] );
  2713.     { Do the seek/write }
  2714.     Seek( TheFTPSiteFile , Counter_1 );
  2715.     Write( TheFTPSiteFile , TheTCRecord^ );
  2716.     { free the record }
  2717.     Dispose( TheTCRecord );
  2718.   end;
  2719.   { Close the file }
  2720.   CloseFile( TheFTPSiteFile );
  2721.   { Free the list pointers }
  2722.   TheFTPSiteList.Free;
  2723.   TheWorkingFTPSL.Free;
  2724. end;
  2725.  
  2726. { This procedure saves off the FTP Site List }
  2727. procedure TCCINetCCForm.SaveNNTPSiteFile;
  2728. var TheNGRecord : PConnectionsRecord; { The TC Record pointer   }
  2729.     NNTPSLName   : String;            { NNTP Site List filename }
  2730.     Counter_1   : Integer;            { Loop counter           }
  2731. begin
  2732.   { Set up the file name }
  2733.   NNTPSLName := NewsPath + '\NNTPSITE.TCR';
  2734.   { Assign the file }
  2735.   AssignFile( TheNewsServerFile , NNTPSLName );
  2736.   { Rewrite it }
  2737.   Rewrite( TheNewsServerFile );
  2738.   { run the list through the procedure }
  2739.   for Counter_1 := 0 to TheNewsServerList.Count - 1 do
  2740.   begin
  2741.     { get the record from the list }
  2742.     TheNGRecord :=
  2743.      PConnectionsRecord( TheNewsServerList.Items[ Counter_1 ] );
  2744.     { Do the seek/write }
  2745.     Seek( TheNewsServerFile , Counter_1 );
  2746.     Write( TheNewsServerFile , TheNGRecord^ );
  2747.     { free the record }
  2748.     Dispose( TheNGRecord );
  2749.   end;
  2750.   { Close the file }
  2751.   CloseFile( TheNewsServerFile );
  2752.   { Free the list pointers }
  2753.   TheNewsServerList.Free;
  2754.   TheWorkingNSSL.Free;
  2755. end;
  2756.  
  2757. { This procedure switches in the FTP sites list to the info dlg and main cbox }
  2758. procedure TCCINetCCForm.SetupFTPSiteLists;
  2759. var Counter_1  : Integer;            { Loop counter        }
  2760. begin
  2761.   { Set up display for main form }
  2762.   CCINetCCForm.Tag := 2;
  2763.   CCINetCCForm.Caption := 'CC Internet Command Center -- FTP Mode';
  2764.   CCINetCCForm.ViewWinsockInfo1.Enabled := false;
  2765.   CCINetCCForm.FTP1.Enabled := false;
  2766.   CCINetCCForm.FTP2.Enabled := true;
  2767.   CCINetCCForm.Label1.Caption := 'FTP Site:';
  2768.   CCINetCCForm.Button1.Caption := 'Connect';
  2769.   CCINetCCForm.Label4.Caption := 'Local Dir';
  2770.   CCINetCCForm.Label5.Caption := 'Remote Dir';
  2771.   { Set tag for FTP stuff }
  2772.   CCICInfoDlg.Tag := 2;
  2773.   { set up caption of main label }
  2774.   CCICInfoDlg.Label2.Caption := 'FTP Sites';
  2775.   { hide outline panel }
  2776.   CCICInfoDlg.Panel6.Visible := false;
  2777.   { clear the list box }
  2778.   CCICInfoDlg.ListBox2.Clear;
  2779.   CCINetCCForm.ComboBox1.Clear;
  2780.   { add profile strings to the list box }
  2781.   for Counter_1 := 0 to TheFTPSiteList.Count - 1 do
  2782.   begin
  2783.     CCICInfoDlg.ListBox2.Items.Add( PConnectionsRecord(
  2784.      TheFTPSiteList.Items[ Counter_1 ] )^.CProfile );
  2785.     CCINetCCForm.ComboBox1.Items.Add( PConnectionsRecord(
  2786.      TheFTPSiteList.Items[ Counter_1 ] )^.CProfile );
  2787.   end;
  2788.   { Set up caption of special button }
  2789.   CCICInfoDlg.Button1.Caption := 'Anonymous Login';
  2790.   { Start with top record }
  2791.   CCICInfoDlg.ListBox2.ItemIndex := 0;
  2792.   CCINetCCForm.ComboBox1.ItemIndex := 0;
  2793.   { put in data from top record and reset captions }
  2794.   with PConnectionsRecord( TheFTPSiteList.Items[ 0 ] )^ do
  2795.   begin
  2796.     with CCICInfoDlg do
  2797.     begin
  2798.       Edit1.Text := CProfile;
  2799.       Panel2.Caption := '            Name:';
  2800.       Edit2.Text := CIPAddress;
  2801.       Panel3.Caption := '     IP Address:';
  2802.       Edit3.Text := CUserName;
  2803.       Panel5.Caption := '    User Name:';
  2804.       case PasswordControlVector of
  2805.         1 : Edit4.Text := CPassword;
  2806.         2 : Edit4.Text := '**********';
  2807.       end;
  2808.       Panel8.Caption := '      Password:';
  2809.       Edit5.Text := CStartDir;
  2810.       Panel9.Caption := '    Starting Dir:';
  2811.     end;
  2812.   end;
  2813. end;
  2814.  
  2815. { This procedure switches in the FTP sites list to the info dlg and main cbox }
  2816. procedure TCCINetCCForm.SetupNNTPSiteLists;
  2817. begin
  2818.   { Set up display for main form }
  2819.   CCINetCCForm.Tag := 4; { Usenet News Tag }
  2820.   CCINetCCForm.Caption := 'CC Internet Command Center -- Usenet News Mode';
  2821.   CCINetCCForm.ViewWinsockInfo1.Enabled := false;
  2822.   CCINetCCForm.FTP1.Enabled := true;
  2823.   CCINetCCForm.FTP2.Enabled := false;
  2824.   CCINetCCForm.UsenetNws1.Enabled := false;
  2825.   CCINetCCForm.News1.Enabled := true;
  2826.   CCINetCCForm.Label1.Caption := 'NNTP Server:';
  2827.   CCINetCCForm.Button1.Caption := 'Connect';
  2828.   CCINetCCForm.Label4.Caption := 'SubScribed Groups';
  2829.   CCINetCCForm.Label5.Caption := 'Unread Articles';
  2830.   { Create the working copy for use to make safe changes in info dlg }
  2831. end;
  2832.  
  2833. { This method saves off the Newsgroup and Article Lists }
  2834. procedure TCCINetCCForm.SaveNNTPNewsGroupLists;
  2835. var TheNGRecord : PNewsGroupRecord; { Generic NGR Pointer       }
  2836.     TheNGARecord : PNewsGroupArticleRecord; {  }
  2837.     WorkingList : TList;
  2838.     Counter_1 ,
  2839.     Counter_2   : Integer;          { Loop counter              }
  2840.     NNTPNGLName ,                   { NewsGroup Articles fname  }
  2841.     NNTPARName  : String;           { NNTP NewsRC filename      }
  2842. begin
  2843.   { Abort if no server to select }
  2844.   if ComboBox1.ItemIndex = -1 then exit;
  2845.   { Get number of server in list }
  2846.   WhichServer := ComboBox1.ItemIndex;
  2847.   { Set up the FTP sites list file name }
  2848.   NNTPNGLName := NewsPath + '\NEWSRC ' + IntToStr( WhichServer ) + '.NRC';
  2849.   { If the FTP Site List exists load it in }
  2850.   { set up the file and open it }
  2851.   AssignFile( TheNewsRCFile , NNTPNGLName );
  2852.   ReWrite( TheNewsRCFile );
  2853.   { read in the records }
  2854.   for Counter_1 := 0 to TheNewsRCList.Count - 1 do
  2855.   begin
  2856.     { Create the TCRecord }
  2857.     TheNGRecord := PNewsGroupRecord( TheNewsRCList.Items[ Counter_1 ] );
  2858.     { Read in the data record }
  2859.     Seek( TheNewsRCFile , Counter_1 );
  2860.     Write( TheNewsRCFile , TheNGRecord^ );
  2861.     { Add the record to the list }
  2862.     WorkingList := TList( TheNGRecord^.GLTag );
  2863.     if WorkingList.Count > 0 then
  2864.     begin
  2865.       NNTPARName := TheNGRecord^.GFileName;
  2866.       TheNGArticlesList := TList.Create;
  2867.       AssignFile( TheNewsArticleFile , NewsPath + '\' + NNTPARName );
  2868.       ReWrite( TheNewsArticleFile );
  2869.       for Counter_2 := 0 to WorkingList.Count - 1 do
  2870.       begin
  2871.         TheNGARecord :=
  2872.          PNewsGroupArticleRecord( WorkingList.Items[ Counter_2 ] );
  2873.         Seek( TheNewsArticleFile , Counter_2 );
  2874.         Write( TheNewsArticleFile , TheNGARecord^ );
  2875.         Dispose( TheNGARecord );
  2876.       end;
  2877.       CloseFile( TheNewsArticleFile );
  2878.     end;
  2879.     WorkingList.Free;
  2880.     Dispose( TheNGRecord );
  2881.   end;
  2882.   { close the file }
  2883.   CloseFile( TheNewsRCFile );
  2884.   { Free the list itself }
  2885.   TheNewsRCList.Free;
  2886. end;
  2887.  
  2888. { This procedure switches in the FTP sites list to the info dlg and main cbox }
  2889. procedure TCCINetCCForm.SetupNNTPNewsGroupLists;
  2890. var TheNGRecord : PNewsGroupRecord; { Generic NGR Pointer       }
  2891.     TheNGARecord : PNewsGroupArticleRecord; {  }
  2892.     Counter_1 ,
  2893.     Counter_2   : Integer;          { Loop counter              }
  2894.     NNTPNGLName ,                   { NewsGroup Articles fname  }
  2895.     NNTPARName  : String;           { NNTP NewsRC filename      }
  2896. begin
  2897.   { Abort if no server to select }
  2898.   if ComboBox1.ItemIndex = -1 then exit;
  2899.   { Get number of server in list }
  2900.   WhichServer := ComboBox1.ItemIndex;
  2901.   { Create the sites list list }
  2902.   TheNewsRCList := TList.Create;
  2903.   { Set up the FTP sites list file name }
  2904.   NNTPNGLName := NewsPath + '\NEWSRC ' + IntToStr( WhichServer ) + '.NRC';
  2905.   { If the FTP Site List exists load it in }
  2906.   if FileExists( NNTPNGLName ) then
  2907.   begin
  2908.     { set up the file and open it }
  2909.     AssignFile( TheNewsRCFile , NNTPNGLName );
  2910.     Reset( TheNewsRCFile );
  2911.     { read in the records }
  2912.     for Counter_1 := 0 to FileSize( TheNewsRCFile ) - 1 do
  2913.     begin
  2914.       { Create the TCRecord }
  2915.       New( TheNGRecord );
  2916.       { Read in the data record }
  2917.       Seek( TheNewsRCFile , Counter_1 );
  2918.       Read( TheNewsRCFile , TheNGRecord^ );
  2919.       { Add the record to the list }
  2920.       TheNewsRCList.Add( TheNGRecord );
  2921.     end;
  2922.     { close the file }
  2923.     CloseFile( TheNewsRCFile );
  2924.   end
  2925.   else
  2926.   { Otherwise create a default one with 3 delphi newsgroups }
  2927.   begin
  2928.     { create new record }
  2929.     New( TheNGRecord );
  2930.     { fill in its info }
  2931.     with TheNGRecord^ do
  2932.     begin
  2933.       GName                := 'Delphi Comps';
  2934.       GRealName            := 'comp.lang.pascal.delphi.components';
  2935.       GLowest              := 0;
  2936.       GHighest             := 0;
  2937.       GPostable            := true;
  2938.       GSubscribed          := true;
  2939.       GTotalArticles       := 0;
  2940.       GTotalAvailable      := 0;
  2941.       GLowestAvailable     := 0;
  2942.       GHighestAvailable    := 0;
  2943.       GTotalUnReadArticles := 0;
  2944.       GIDNumber            := 1;
  2945.       GFileName            := 'NL' + IntToStr( WhichServer ) + 'G1.NGR';
  2946.       GLTag                := 0;
  2947.     end;
  2948.     { add it to the list }
  2949.     TheNewsRCList.Add( TheNGRecord );
  2950.     { create new record }
  2951.     New( TheNGRecord );
  2952.     { fill in its info }
  2953.     with TheNGRecord^ do
  2954.     begin
  2955.       GName                := 'Delphi DB';
  2956.       GRealName            := 'comp.lang.pascal.delphi.databases';
  2957.       GLowest              := 0;
  2958.       GHighest             := 0;
  2959.       GPostable            := true;
  2960.       GSubscribed          := true;
  2961.       GTotalArticles       := 0;
  2962.       GTotalAvailable      := 0;
  2963.       GLowestAvailable     := 0;
  2964.       GHighestAvailable    := 0;
  2965.       GTotalUnReadArticles := 0;
  2966.       GIDNumber            := 2;
  2967.       GFileName            := 'NL' + IntToStr( WhichServer ) + 'G2.NGR';
  2968.       GLTag                := 0;
  2969.     end;
  2970.     { add it to the list }
  2971.     TheNewsRCList.Add( TheNGRecord );
  2972.     { create new record }
  2973.     New( TheNGRecord );
  2974.     { fill in its info }
  2975.     with TheNGRecord^ do
  2976.     begin
  2977.       GName                := 'Delphi Misc';
  2978.       GRealName            := 'comp.lang.pascal.delphi.misc';
  2979.       GLowest              := 0;
  2980.       GHighest             := 0;
  2981.       GPostable            := true;
  2982.       GSubscribed          := true;
  2983.       GTotalArticles       := 0;
  2984.       GTotalAvailable      := 0;
  2985.       GLowestAvailable     := 0;
  2986.       GHighestAvailable    := 0;
  2987.       GTotalUnReadArticles := 0;
  2988.       GIDNumber            := 3;
  2989.       GFileName            := 'NL' + IntToStr( WhichServer ) + 'G3.NGR';
  2990.       GLTag                := 0;
  2991.     end;
  2992.     { add it to the list }
  2993.     TheNewsRCList.Add( TheNGRecord );
  2994.     { create the file and write out the data, then close it }
  2995.     AssignFile( TheNewsRCFile , NNTPNGLName );
  2996.     Rewrite( TheNewsRCFile );
  2997.     for Counter_1 := 0 to 2 do
  2998.     begin
  2999.       TheNGRecord :=
  3000.        PNewsGroupRecord( TheNewsRCList.Items[ Counter_1 ] );
  3001.       Seek( TheNewsRCFile , Counter_1 );
  3002.       Write( TheNewsRCFile , TheNGRecord^ );
  3003.     end;
  3004.     CloseFile( TheNewsRCFile );
  3005.   end;
  3006.   { Load in Articles Records and create storage lists }
  3007.   for Counter_1 := 0 to TheNewsRCList.Count - 1 do
  3008.   begin
  3009.     NNTPARName := PNewsGroupRecord(
  3010.      TheNewsRCList.Items[ Counter_1 ] )^.GFileName;
  3011.     if FileExists( NewsPath + '\' + NNTPARName ) then
  3012.     begin
  3013.       TheNGArticlesList := TList.Create;
  3014.       AssignFile( TheNewsArticleFile , NewsPath + '\' + NNTPARName );
  3015.       Reset( TheNewsArticleFile );
  3016.       for Counter_2 := 0 to FileSize( TheNewsArticleFile ) - 1 do
  3017.       begin
  3018.         New( TheNGARecord );
  3019.         Seek( TheNewsArticleFile , Counter_2 );
  3020.         Read( TheNewsArticleFile , TheNGARecord^ );
  3021.         TheNGArticlesList.Add( TheNGARecord );
  3022.       end;
  3023.       CloseFile( TheNewsArticleFile );
  3024.       PNewsGroupRecord( TheNewsRCList.Items[ Counter_1 ] )^.GLTag :=
  3025.        Longint( TheNGArticlesList );
  3026.     end
  3027.     else
  3028.     begin
  3029.       TheNGArticlesList := TList.Create;
  3030.       PNewsGroupRecord( TheNewsRCList.Items[ Counter_1 ] )^.GLTag :=
  3031.        Longint( TheNGArticlesList );
  3032.     end;
  3033.   end;
  3034.   { Create working Newsgroup list for later }
  3035.   TheWorkingNRCSL := TList.Create;
  3036.   For Counter_1 := 0 to TheNewsRCList.Count - 1 do
  3037.   begin
  3038.     New( TheNGRecord );
  3039.     TheNGRecord^ := PNewsGroupRecord( TheNewsRCList.Items[ Counter_1 ] )^;
  3040.     TheWorkingNRCSL.Add( TheNGRecord );
  3041.   end;
  3042. end;
  3043.  
  3044. { This procedure populates LB2 with article subjects for any }
  3045. { available articles for a given newsgroup.                  }
  3046. procedure TCCINetCCForm.PopulateLB2WithArticleHeaders;
  3047. var Counter_1    : Integer;
  3048.     TheNGARecord : PNewsGroupArticleRecord;
  3049.     TempString   : String;
  3050. begin
  3051.   { Clear target list box }
  3052.   ListBox2.Clear;
  3053.   for Counter_1 := 0 to TheNGArticlesList.Count - 1 do
  3054.   begin
  3055.     TheNGARecord :=
  3056.      PNewsGroupArticleRecord( TheNGArticlesList.Items[ Counter_1 ] );
  3057.     TempString := '    [' + IntToStr( Counter_1 ) + '] ' +
  3058.      TheNGARecord^.NGASubject;
  3059.     if TheNGARecord^.NGADownloaded then TempString[ 1 ] :=
  3060.      'D';
  3061.     if TheNGARecord^.NGARead then TempString[ 3 ] := 'R';
  3062.     if TheNGARecord^.NGAPosted then TempString[ 3 ] := 'S';
  3063.     ListBox2.Items.Add( TempString );
  3064.   end;
  3065. end;
  3066.  
  3067. { This procedure swaps in the list of subscribed newsgroups to LB1 }
  3068. { and calls another procedure to populate LB2 with any available   }
  3069. { articles for the newsgroup.                                      }
  3070. procedure TCCINetCCForm.SetupNewsGroupListboxes;
  3071. var Counter_1   : Integer;
  3072.     TempString  : String;
  3073.     TheNGRecord : PNewsGroupRecord;
  3074. begin
  3075.   ListBox1.Clear;
  3076.   ListBox1.Tag := 5;
  3077.   ListBox2.Tag := 5;
  3078.   Label4.Caption := 'NewsGroups';
  3079.   Label5.Caption := 'Articles';
  3080.   if TheNewsRCList.Count = 0 then
  3081.   begin
  3082.     ListBox2.Clear;
  3083.     exit;
  3084.   end;
  3085.   ComboBox1.Clear;
  3086.   for Counter_1 := 0 to TheNewsRCList.Count - 1 do
  3087.   begin
  3088.     TheNGRecord := PNewsGroupRecord( TheNewsRCList.Items[ Counter_1 ] );
  3089.     TempString := TheNGRecord^.GName;
  3090.     ComboBox1.Items.Add( TheNGRecord^.GRealName );
  3091.     if TheNGRecord^.GSubscribed then
  3092.      TempString := '[S] ' + TempString else TempString := '[U] ' + TempString;
  3093.     TempString := TempString + '{' + IntToStr( TheNGRecord^.GTotalNew ) + '}';
  3094.     ListBox1.Items.Add( TempString );
  3095.   end;
  3096.   TheNGRecord := PNewsGroupRecord( TheNewsRCList.Items[ 0 ] );
  3097.   TheNGArticlesList := TList( TheNGRecord^.GLTag );
  3098.   PopulateLB2WithArticleHeaders;
  3099.   Label1.Caption := 'NewsGroup:';
  3100.   ComboBox1.ItemIndex := 0;
  3101.   Button1.Caption := 'DL Article(s)';
  3102.   Tag := 5; { Set download vector }
  3103. end;
  3104.  
  3105. { This procedure switches in the FTP sites list to the info dlg and main cbox }
  3106. procedure TCCINetCCForm.SetupNNTPServersInfoDisplay;
  3107. var Counter_1  : Integer;            { Loop counter        }
  3108. begin
  3109.   { Set tag for NNTP stuff }
  3110.   CCICInfoDlg.Tag := 4; { Usenet News Tag -- servers }
  3111.   { set up caption of main label }
  3112.   CCICInfoDlg.Label2.Caption := 'News Server Sites';
  3113.   { hide outline panel }
  3114.   CCICInfoDlg.Panel6.Visible := false;
  3115.   CCICInfoDlg.Panel5.Visible := false;
  3116.   CCICInfoDlg.Panel8.Visible := false;
  3117.   CCICInfoDlg.Panel9.Visible := false;
  3118.   { clear the list box }
  3119.   CCICInfoDlg.ListBox2.Clear;
  3120.   CCINetCCForm.ComboBox1.Clear;
  3121.   { add profile strings to the list box }
  3122.   for Counter_1 := 0 to TheNewsServerList.Count - 1 do
  3123.   begin
  3124.     CCICInfoDlg.ListBox2.Items.Add( PConnectionsRecord(
  3125.      TheNewsServerList.Items[ Counter_1 ] )^.CProfile );
  3126.     CCINetCCForm.ComboBox1.Items.Add( PConnectionsRecord(
  3127.      TheNewsServerList.Items[ Counter_1 ] )^.CProfile );
  3128.   end;
  3129.   { Set up caption of special button }
  3130.   CCICInfoDlg.Button1.Visible := false;
  3131.   { Start with top record }
  3132.   CCICInfoDlg.ListBox2.ItemIndex := 0;
  3133.   CCINetCCForm.ComboBox1.ItemIndex := 0;
  3134.   { put in data from top record and reset captions }
  3135.   with PConnectionsRecord( TheNewsServerList.Items[ 0 ] )^ do
  3136.   begin
  3137.     with CCICInfoDlg do
  3138.     begin
  3139.       Edit1.Text := CProfile;
  3140.       Panel2.Caption := '            Name:';
  3141.       Edit2.Text := CIPAddress;
  3142.       Panel3.Caption := '     IP Address:';
  3143.     end;
  3144.   end;
  3145. end;
  3146.  
  3147. { This procedure switches in the FTP sites list to the info dlg and main cbox }
  3148. procedure TCCINetCCForm.SetupNNTPNewsGroupsInfoDisplay;
  3149. var Counter_1  : Integer;            { Loop counter        }
  3150.     WorkingFileName : String;
  3151.     TheWorkingSL : TStringList;
  3152. begin
  3153.   { Set tag for NNTP stuff }
  3154.   CCICInfoDlg.Tag := 5; { Usenet News Tag -- newsgroups }
  3155.   { set up caption of main label }
  3156.   CCICInfoDlg.Label2.Caption := 'Active NewsGroups';
  3157.   { hide outline panel }
  3158.   CCICInfoDlg.Panel5.Visible := true;
  3159.   CCICInfoDlg.Panel6.Visible := true;
  3160.   CCICInfoDlg.Panel6.Height := 224;
  3161.   CCICInfoDlg.Panel6.Top := 120;
  3162.   CCICInfoDlg.Label1.Caption := 'Available NewsGroups';
  3163.   CCICInfoDlg.Panel8.Visible := false;
  3164.   CCICInfoDlg.Panel9.Visible := false;
  3165.   { clear the list box }
  3166.   CCICInfoDlg.ListBox2.Clear;
  3167.   { add profile strings to the list box }
  3168.   for Counter_1 := 0 to TheNewsRCList.Count - 1 do
  3169.   begin
  3170.     CCICInfoDlg.ListBox2.Items.Add( PNewsGroupRecord(
  3171.      TheNewsRCList.Items[ Counter_1 ] )^.GName );
  3172.   end;
  3173.   { Set up caption of special button }
  3174.   CCICInfoDlg.Button1.Visible := true;
  3175.   CCICInfoDlg.Button1.Caption := 'Toggle Subscription';
  3176.   { Start with top record }
  3177.   CCICInfoDlg.ListBox2.ItemIndex := 0;
  3178.   { put in data from top record and reset captions }
  3179.   with PNewsGroupRecord( TheNewsRCList.Items[ 0 ] )^ do
  3180.   begin
  3181.     with CCICInfoDlg do
  3182.     begin
  3183.       Edit1.Text := GName;
  3184.       Panel2.Caption := 'NG Name:';
  3185.       Edit2.Text := GRealName;
  3186.       Panel3.Caption := 'NG Real Name:';
  3187.       if GSubscribed then
  3188.       Edit3.Text := 'Subscribed' else Edit3.Text := 'UnSubscribed';
  3189.       Panel5.Caption := 'Status:';
  3190.     end;
  3191.   end;
  3192.   if newsgroupListloaded then exit;
  3193.   WorkingFileName := NewsPath + '\NEWSGRP.TXT';
  3194.   if FileExists( WorkingFileName ) then
  3195.   begin
  3196.     if MessageDlg( 'Load News Groups File? (Long operation...)',
  3197.      mtConfirmation,mbYesNoCancel,0) = mrYes then
  3198.     begin
  3199.       CCICInfoDlg.ListBox1.Clear;
  3200.       TheWorkingSL := TStringList.Create;
  3201.       try
  3202.         TheWorkingSL.LoadFromFile( WorkingFileName );
  3203.         CCICInfoDlg.ListBox1.Items.Assign( TheWorkingSL );
  3204.       except
  3205.         MessageDlg( 'News Group List Too Large! Use WordPad/Write to view ' +
  3206.                       NewsPath + '\NEWGRP.TXT' , mtInformation,[mbOK],0);
  3207.         TheWorkingSL.Free;
  3208.         NewsgroupListLoaded := false;
  3209.         exit;
  3210.       end;
  3211.       TheWorkingSL.Free;
  3212.       NewsgroupListLoaded := true;
  3213.     end;
  3214.   end;
  3215. end;
  3216.  
  3217. { This procedure scans a line of UNIX-style text for #10's and }
  3218. { outputs them as lines to the memo. It stops at #0.           }
  3219. procedure TCCINetCCForm.AddNullTermTextToMemo( TheTextToAdd   : String;
  3220.                                  TheMemoToAddTo : TMemo   );
  3221. var
  3222.   TextLength ,            { Total chars to output         }
  3223.   Counter_1    : integer; { Loop Index                    }
  3224. begin
  3225.   { Make the target memo visible just in case }
  3226.   TheMemoToAddTo.Visible := true;
  3227.   { Find total chars to output }
  3228.   TextLength := Length( TheTextToAdd );
  3229.   { If none then leave }
  3230.   if TextLength = 0 then exit;
  3231.   { Loop along the string }
  3232.   for Counter_1 := 1 to TextLength do
  3233.   begin
  3234.     { If hit ASCII 10 then assume end of line and output }
  3235.     if TheTextToAdd[ Counter_1 ] = #10 then
  3236.     begin
  3237.       { Use a try loop incase memo fills up }
  3238.       try
  3239.         { Add the line }
  3240.         TheMemoToAddTo.Lines.Add( TheLine );
  3241.       except
  3242.         { If memo fills up }
  3243.         on EOutOfResources do
  3244.         begin
  3245.           { Clear the old data }
  3246.           TheMemoToAddTo.Clear;
  3247.           { Output the new }
  3248.           TheMemoToAddTo.Lines.Add( TheLine );
  3249.         end;
  3250.       end;
  3251.       { clear the output buffer }
  3252.       TheLine := '';
  3253.     end
  3254.     else
  3255.     { Otherwise look for null terminator from Winsock }
  3256.     begin
  3257.       { If don't hit null terminator then add the char to op buffer }
  3258.       if TheTextToAdd[ Counter_1 ] <> #0 then
  3259.       begin
  3260.         TheLine := TheLine + TheTextToAdd[ Counter_1 ];
  3261.       end
  3262.       else break; { Otherwise drop out of the loop }
  3263.     end;
  3264.   end;
  3265. end;
  3266.  
  3267. { This function scans a line of UNIX-style text for #10's and }
  3268. { outputs the first line as its return value,stopping at #0.  }
  3269. function TCCINetCCForm.AddNullTermTextToLabel( TheTextToAdd   : String ) : String;
  3270. var
  3271.   TheLine      : String;  { Buffer to output current line }
  3272.   TextLength ,            { Total chars to output         }
  3273.   Counter_1    : integer; { Loop Index                    }
  3274. begin
  3275.   { Clear output buffer }
  3276.   TheLine := '';
  3277.   { Find total chars to output }
  3278.   TextLength := Length( TheTextToAdd );
  3279.   { If none then leave }
  3280.   if TextLength = 0 then
  3281.   begin
  3282.     { Return nothing }
  3283.     Result := '';
  3284.     { Leave }
  3285.     exit;
  3286.   end;
  3287.   { Loop along the string }
  3288.   for Counter_1 := 1 to TextLength do
  3289.   begin
  3290.     { If hit ASCII 10 then assume end of line and output }
  3291.     if TheTextToAdd[ Counter_1 ] = #10 then
  3292.     begin
  3293.       { Return first line }
  3294.       Result := TheLine;
  3295.       { Leave }
  3296.       exit;
  3297.     end
  3298.     else
  3299.     { Otherwise look for null terminator from Winsock }
  3300.     begin
  3301.       { If don't hit null terminator then add the char to op buffer }
  3302.       if TheTextToAdd[ Counter_1 ] <> #0 then
  3303.       begin
  3304.         TheLine := TheLine + TheTextToAdd[ Counter_1 ];
  3305.       end
  3306.       else break; { Otherwise drop out of the loop }
  3307.     end;
  3308.   end;
  3309.   { If hit #0 before #10 return buffer }
  3310.   Result := TheLine;
  3311. end;
  3312.  
  3313. { Show busy cursors }
  3314. procedure TCCINetCCForm.SetHGCursors;
  3315. begin
  3316.   CCInetCCForm.Cursor := crHourGlass;
  3317.   CCInetCCForm.Memo1.Cursor := crHourGlass;
  3318. end;
  3319.  
  3320. { Show normal cursors }
  3321. procedure TCCINetCCForm.SetNormalCursors;
  3322. begin
  3323.   CCInetCCForm.Cursor := crDefault;
  3324.   CCInetCCForm.Memo1.Cursor := crDefault;
  3325. end;
  3326.  
  3327. { Exit method }
  3328. procedure TCCINetCCForm.Exit1Click(Sender: TObject);
  3329. begin
  3330.   Close;
  3331. end;
  3332.  
  3333. { This method adds a line to the progress text stringlist  }
  3334. { If an exception occurs, the list is full, and it is auto }
  3335. { saved to the progress text file name, then cleared.      }
  3336. procedure TCCINetCCForm.AddProgressText( WhatText : String );
  3337. begin
  3338.   { Use a try..except loop to catch list overflows }
  3339.   try
  3340.     { Try the normal add }
  3341.     ProgressList.Add( WhatText );
  3342.   except
  3343.     { Any list error is assumed to be a list overflow }
  3344.     on EListError do
  3345.     begin
  3346.       { Save the list to the preset file name }
  3347.       ProgressList.SaveToFile( ProgressFileName );
  3348.       { Clear the list to make more room }
  3349.       ProgressList.Clear;
  3350.       { And redo the add; any further errors will except normally }
  3351.       ProgressList.Add( WhatText );
  3352.     end;
  3353.     { This might happen too! }
  3354.     on EOutOfResources do
  3355.     begin
  3356.       { Save the list to the preset file name }
  3357.       ProgressList.SaveToFile( ProgressFileName );
  3358.       { Clear the list to make more room }
  3359.       ProgressList.Clear;
  3360.       { And redo the add; any further errors will except normally }
  3361.       ProgressList.Add( WhatText );
  3362.     end;
  3363.   end;
  3364. end;
  3365.  
  3366. { This method either adds the progress line to the current memo }
  3367. { or puts it in the status caption at normal colors.            }
  3368. procedure TCCINetCCForm.ShowProgressText( WhatText : String );
  3369. begin
  3370.   { Use the POV to determine where to show progress info }
  3371.   case ProgressOutputVector of
  3372.     POV_MEMO : begin { Output into the memo  }
  3373.                  AddNullTermTextToMemo( WhatText , Memo1 );
  3374.                end;
  3375.     POV_STAT : begin { Output on status line }
  3376.                  { Set panel caption font to black }
  3377.                  Panel1.Font.Color := clBlack;
  3378.                  { Get the first line of text and put in caption }
  3379.                  Panel1.Caption := AddNullTermTextToLabel( WhatText );
  3380.                end;
  3381.   end;
  3382. end;
  3383.  
  3384. { This method is identical with SPT except sets status color to red and beeps }
  3385. procedure TCCINetCCForm.ShowProgressErrorText( WhatText : String );
  3386. begin
  3387.   { Do error beep }
  3388.   MessageBeep( mb_IconExclamation );
  3389.   { Use the POV to determine where to show progress info }
  3390.   case ProgressOutputVector of
  3391.     POV_MEMO : begin { Output into the memo  }
  3392.                  AddNullTermTextToMemo( WhatText , Memo1 );
  3393.                end;
  3394.     POV_STAT : begin { Output on status line }
  3395.                  { Set panel caption font to black }
  3396.                  Panel1.Font.Color := clRed;
  3397.                  { Get the first line of text and put in caption }
  3398.                  Panel1.Caption := AddNullTermTextToLabel( WhatText );
  3399.                end;
  3400.   end;
  3401. end;
  3402.  
  3403. { This is the boilerplate method used to handle Socket errors gracefully }
  3404. procedure TCCINetCCForm.SocketsErrorOccurred( Sender     : TObject;
  3405.                                               ErrorCode  : Integer;
  3406.                                               TheMessage : String   );
  3407. begin
  3408.   { Set the global error code flag }
  3409.   GlobalErrorCode := ErrorCode;
  3410.   { If a timeout error }
  3411.   if ErrorCode = WSAETIMEDOUT then
  3412.   begin
  3413.     { Set the aborted flag }
  3414.     GlobalAbortedFlag := True;
  3415.     { But clear the error code for graceful handling }
  3416.     GlobalErrorCode := 0;
  3417.   end
  3418.   else
  3419.   begin
  3420.     { Otherwise set the progress buffer to the error message }
  3421.     AddProgressText( TheMessage );
  3422.     { And show the progress text as set by option }
  3423.     ShowProgressErrorText( TheMessage );
  3424.   end;
  3425. end;
  3426.  
  3427. procedure TCCINetCCForm.FormCreate(Sender: TObject);
  3428. begin
  3429.   { Create the progress string list }
  3430.   ProgressList := TStringList.Create;
  3431.   { Create the file name for saving the progress list }
  3432.   ProgressFileName := ExpandFileName( 'PROGRESS.TXT' );
  3433.   { Default progress output to status line }
  3434.   ProgressOutputVector := POV_STAT;
  3435.   { Set password control stuff }
  3436.   PasswordControlVector := 2;
  3437.   CurrentPasswordString := 'guest@nowhere.com';
  3438.   CurrentRealPWString := 'guest@nowhere.com';
  3439.   NewMessageInProgress := false;
  3440.   EmailLoaded := false;
  3441.   NewsGroupListLoaded := false;
  3442.   { Get Ini file Data }
  3443.   ReadIniData;
  3444.   LoadFTPSiteFile;
  3445.   LoadNNTPSiteFile;
  3446.   TheFTPComponent := TFTPComponent.Create( CCInetCCForm );
  3447.   TheFTPComponent.Parent := CCInetCCForm;
  3448.   TheNNTPComponent := TNNTPComponent.Create( CCInetCCForm );
  3449.   TheNNTPComponent.Parent := CCInetCCForm;
  3450. end;
  3451.  
  3452. procedure TCCINetCCForm.FormDestroy(Sender: TObject);
  3453. begin
  3454.   { Free the progress text stringlist if assigned }
  3455.   if assigned( ProgressList ) then ProgressList.Free;
  3456.   { Save off the Ini data }
  3457.   WriteIniData;
  3458.   { Save and remove FTP site list stuff }
  3459.   SaveFTPSiteFile;
  3460.   SaveNNTPSiteFile;
  3461.   if Assigned( TheFTPComponent ) then TheFTPComponent.Free;
  3462.   if Assigned( TheNNTPComponent ) then TheNNTPComponent.Free;
  3463. end;
  3464.  
  3465. procedure TCCINetCCForm.Description1Click(Sender: TObject);
  3466. var
  3467.   TempSocket : TCCSocket; { Temporary socket just to get Winsock info }
  3468.   TheData    : String;    { Holder for data                           }
  3469. begin
  3470.   { Create socket; auto calls WSAStartup }
  3471.   TempSocket := TCCSocket.Create( Self );
  3472.   { Do parent just for kicks; no longer needed }
  3473.   TempSocket.Parent := self;
  3474.   { Put in error handler }
  3475.   TempSocket.OnErrorOccurred := SocketsErrorOccurred;
  3476.   TheData := StrPas( TempSocket.Socket_WSA_Data.Description_String );
  3477.   { Display the Description String }
  3478.   AddProgressText( TheData );
  3479.   { And show the progress text as set by option }
  3480.   ShowProgressText( TheData );
  3481.   { Free the socket; auto calls WSACleanup }
  3482.   TempSocket.Free;
  3483. end;
  3484.  
  3485. procedure TCCINetCCForm.SystemStatus1Click(Sender: TObject);
  3486. var
  3487.   TempSocket : TCCSocket; { Temporary socket just to get Winsock info }
  3488.   TheData    : String;    { Holder for data                           }
  3489. begin
  3490.   { Create socket; auto calls WSAStartup }
  3491.   TempSocket := TCCSocket.Create( Self );
  3492.   { Do parent just for kicks; no longer needed }
  3493.   TempSocket.Parent := self;
  3494.   { Put in error handler }
  3495.   TempSocket.OnErrorOccurred := SocketsErrorOccurred;
  3496.   TheData := StrPas( TempSocket.Socket_WSA_Data.System_Status_String );
  3497.   { Display the Description String }
  3498.   AddProgressText( TheData );
  3499.   { And show the progress text as set by option }
  3500.   ShowProgressText( TheData );
  3501.   { Free the socket; auto calls WSACleanup }
  3502.   TempSocket.Free;
  3503. end;
  3504.  
  3505. procedure TCCINetCCForm.VendorSpecific1Click(Sender: TObject);
  3506. var
  3507.   TempSocket : TCCSocket; { Temporary socket just to get Winsock info }
  3508.   TheData    : String;    { Holder for data                           }
  3509. begin
  3510.   { Create socket; auto calls WSAStartup }
  3511.   TempSocket := TCCSocket.Create( Self );
  3512.   { Do parent just for kicks; no longer needed }
  3513.   TempSocket.Parent := self;
  3514.   { Put in error handler }
  3515.   TempSocket.OnErrorOccurred := SocketsErrorOccurred;
  3516.   TheData := StrPas( TempSocket.Socket_WSA_Data.Vendor_Specific_String );
  3517.   { Display the Description String }
  3518.   AddProgressText( TheData );
  3519.   { And show the progress text as set by option }
  3520.   ShowProgressText( TheData );
  3521.   { Free the socket; auto calls WSACleanup }
  3522.   TempSocket.Free;
  3523. end;
  3524.  
  3525. { This method sets the progress output vector to the memo }
  3526. procedure TCCINetCCForm.ViewInEditWindow1Click(Sender: TObject);
  3527. begin
  3528.   { Set the vector }
  3529.   ProgressOutputVector := POV_MEMO;
  3530.   { Keep the menu options consistent }
  3531.   ViewInEditWindow1.Checked := true;
  3532.   ViewInStatusLine1.Checked := false;
  3533. end;
  3534.  
  3535. { This method sets the progress output vector to the status line }
  3536. procedure TCCINetCCForm.ViewInStatusLine1Click(Sender: TObject);
  3537. begin
  3538.   { Set the vector }
  3539.   ProgressOutputVector := POV_STAT;
  3540.   { Keep the menus consistent }
  3541.   ViewInEditWindow1.Checked := false;
  3542.   ViewInStatusLine1.Checked := true;
  3543. end;
  3544.  
  3545. procedure TCCINetCCForm.SaveToFile1Click(Sender: TObject);
  3546. begin
  3547.   { Set up the dialog parameters }
  3548.   OpenDialog1.Filename := ProgressFileName;
  3549.   OpenDialog1.Title := 'Select Filename for Progress File';
  3550.   OpenDialog1.Filter := 'Text Files|*.txt';
  3551.   { If the dialog is not cancelled then save and clear }
  3552.   if OpenDialog1.Execute then
  3553.   begin
  3554.     ProgressFileName := OpenDialog1.FileName;
  3555.     ProgressList.SaveToFile( ProgressFileName );
  3556.     ProgressList.Clear;
  3557.   end;
  3558. end;
  3559.  
  3560. procedure TCCINetCCForm.IPAddress1Click(Sender: TObject);
  3561. begin
  3562.   { Set up info dialog for IP Address getting }
  3563.   CCICInfoDlg.Caption := 'CC Internet Center -- Translate IP Address';
  3564.   CCICInfoDlg.Panel4.Visible := false;
  3565.   CCICInfoDlg.Panel6.Visible := false;
  3566.   CCICInfoDlg.Panel9.Visible := false;
  3567.   CCICInfoDlg.Panel8.Visible := false;
  3568.   CCICInfoDlg.BitBtn2.Visible := false;
  3569.   CCICInfoDlg.Button1.Caption := 'Get IP Address';
  3570.   CCICInfoDlg.Button2.Visible := false;
  3571.   CCICInfoDlg.Button3.Visible := false;
  3572.   CCICInfoDlg.Button4.Visible := false;
  3573.   CCICInfoDlg.Panel2.Caption := 'IP Addr Name:';
  3574.   CCICInfoDlg.Panel3.Caption := '    Dotted Dec:';
  3575.   CCICInfoDlg.Panel5.Caption := '           Binary:';
  3576.   CCICInfoDlg.Edit1.Text := '';
  3577.   CCICInfoDlg.Edit2.Text := '';
  3578.   CCICInfoDlg.Edit3.Text := '';
  3579.   { Set IP Address Mode }
  3580.   CCICInfoDlg.Tag := 1;
  3581.   { Show Modally to get the information }
  3582.   CCICInfoDlg.ShowModal;
  3583.   { Reset the info dialog to default conditions }
  3584.   CCICInfoDlg.Caption := 'CC Internet Command Center Information Dialog';
  3585.   CCICInfoDlg.Panel4.Visible := true;
  3586.   CCICInfoDlg.Panel6.Visible := true;
  3587.   CCICInfoDlg.Panel9.Visible := true;
  3588.   CCICInfoDlg.Panel8.Visible := true;
  3589.   CCICInfoDlg.BitBtn2.Visible := true;
  3590.   CCICInfoDlg.Button1.Caption := 'Anonymous Login';
  3591.   CCICInfoDlg.Button2.Visible := true;
  3592.   CCICInfoDlg.Button3.Visible := true;
  3593.   CCICInfoDlg.Button4.Visible := true;
  3594.   CCICInfoDlg.Panel2.Caption := '             Name:';
  3595.   CCICInfoDlg.Panel3.Caption := '    IP Address:';
  3596.   CCICInfoDlg.Panel5.Caption := ' User Name:';
  3597.   CCICInfoDlg.Edit1.Text := '';
  3598.   CCICInfoDlg.Edit2.Text := '';
  3599.   CCICInfoDlg.Edit3.Text := '';
  3600. end;
  3601.  
  3602. procedure TCCINetCCForm.FTP1Click(Sender: TObject);
  3603. begin
  3604.   { Set up the FTP Data displays }
  3605.   SetupFTPSiteLists;
  3606.   ListBox1.Clear;
  3607.   ListBox2.Clear;
  3608. end;
  3609.  
  3610. procedure TCCINetCCForm.FormResize(Sender: TObject);
  3611. begin
  3612.   { Use tag vector to determine what to do }
  3613.   case Tag of
  3614.     { if FTP , make sure two list boxes are same height }
  3615.     2 : begin
  3616.           Panel6.Height := (( Panel4.Height div 2 ) - 30 );
  3617.           Panel4.Width := 185;
  3618.         end;
  3619.     4 : begin
  3620.           Panel6.Height := 118;
  3621.           Panel4.Width := 250;
  3622.         end;
  3623.   end;
  3624. end;
  3625.  
  3626. procedure TCCINetCCForm.FTPSites1Click(Sender: TObject);
  3627. begin
  3628.   { Show Modally to get the information }
  3629.   CCICInfoDlg.ShowModal;
  3630. end;
  3631.  
  3632. procedure TCCINetCCForm.FTP3Click(Sender: TObject);
  3633. begin
  3634.   CCICPrefsDlg.TabbedNoteBook1.PageIndex := 1;
  3635.   CCICPrefsDlg.Tag := 2;
  3636.   CCICPrefsDlg.ShowModal;
  3637. end;
  3638.  
  3639. procedure TCCINetCCForm.ConnectToSite1Click(Sender: TObject);
  3640. var Counter_1 : Integer;
  3641. begin
  3642.   if Lowercase( PConnectionsRecord( TheFTPSiteList.Items[
  3643.    ComboBox1.ItemIndex ] )^.CUserName ) = 'anonymous' then
  3644.   begin
  3645.     for Counter_1 := 1 to TheAnonRedialVector do
  3646.     begin
  3647.       DoFTPConnection( PConnectionsRecord(
  3648.          TheFTPSiteList.Items[ ComboBox1.ItemIndex ] ));
  3649.       if TheFTPComponent.Connection_Established then exit;
  3650.     end;
  3651.   end
  3652.   else DoFTPConnection( PConnectionsRecord(
  3653.    TheFTPSiteList.Items[ ComboBox1.ItemIndex ] ));
  3654. end;
  3655.  
  3656. procedure TCCINetCCForm.Button1Click(Sender: TObject);
  3657. begin
  3658.   case Tag of
  3659.     2 : begin
  3660.           if not TheFTPComponent.Connection_Established then
  3661.            ConnectToSite1Click( Self ) else
  3662.            begin
  3663.              DoFTPDisconnect;
  3664.              TheFTPComponent.Connection_Established := false;
  3665.              DisableFTPMenus;
  3666.            end;
  3667.         end;
  3668.     4 : begin
  3669.           ConnectAndUpdate1Click( Self );
  3670.         end;
  3671.   end;
  3672. end;
  3673.  
  3674. procedure TCCINetCCForm.ViewasText1Click(Sender: TObject);
  3675. begin
  3676.   { Assume valid FTP component and have it send its text into the progress text}
  3677.   TheFTPComponent.GetRemoteDirectoryListingToMemo;
  3678. end;
  3679.  
  3680. procedure TCCINetCCForm.Disconnect1Click(Sender: TObject);
  3681. begin
  3682.   DoFTPDisconnect;
  3683.   DisableFTPMenus;
  3684. end;
  3685.  
  3686. procedure TCCINetCCForm.EnableFTPMenus;
  3687. begin
  3688.   Button1.Caption := 'Disconnect';
  3689.   ConnectToSite1.Enabled := false;
  3690.   Disconnect1.Enabled := true;
  3691.   Directory1.Enabled := true;
  3692.   UploadMarked1.Enabled := true;
  3693.   DownloadMarked1.Enabled := true;
  3694. end;
  3695.  
  3696. procedure TCCINetCCForm.DisableFTPMenus;
  3697. begin
  3698.   Button1.Caption := 'Connect';
  3699.   ConnectToSite1.Enabled := true;
  3700.   Disconnect1.Enabled := false;
  3701.   Directory1.Enabled := false;
  3702.   UploadMarked1.Enabled := false;
  3703.   DownloadMarked1.Enabled := false;
  3704.   FTP1.Enabled := true;
  3705.   UseNetNws1.Enabled := true;
  3706.   IPAddress1.Enabled := true;
  3707.   FTP2.Enabled := false;
  3708. end;
  3709.  
  3710. procedure TCCINetCCForm.EnableNNTPMenus;
  3711. begin
  3712.   Button1.Caption := 'Disconnect';
  3713.   ConnectAndUpdate1.Enabled := false;
  3714.   Disconnect2.Enabled := true;
  3715.   CheckNewNews1.Enabled := true;
  3716.   GetMarked1.Enabled := true;
  3717.   Article1.Enabled := true;
  3718.   Post1.Enabled := true;
  3719.   SubScribedNewsgroups1.Enabled := true;
  3720.   Trash1.Enabled := true;
  3721.   Headers1.Enabled := true;
  3722.   DownLoadActiveNewsGroups1.Enabled := true;
  3723. end;
  3724.  
  3725. procedure TCCINetCCForm.DisableNNTPMenus;
  3726. begin
  3727.   Button1.Caption := 'Connect';
  3728.   ConnectAndUpdate1.Enabled := True;
  3729.   Disconnect2.Enabled := false;
  3730.   CheckNewNews1.Enabled := false;
  3731.   GetMarked1.Enabled := false;
  3732.   Article1.Enabled := false;
  3733.   Post1.Enabled := false;
  3734.   SubScribedNewsgroups1.Enabled := false;
  3735.   Trash1.Enabled := false;
  3736.   Headers1.Enabled := false;
  3737.   DownLoadActiveNewsGroups1.Enabled := false;
  3738. end;
  3739.  
  3740. procedure TCCINetCCForm.ToDisplay1Click(Sender: TObject);
  3741. var Counter_1 : Integer;
  3742. begin
  3743.   for Counter_1 := 0 to Listbox1.Items.Count - 1 do
  3744.   begin
  3745.     if Listbox1.Selected[ Counter_1 ] then
  3746.     begin
  3747.       FileNameToXFer := ListBox1.Items[ Counter_1 ];
  3748.       TheFTPComponent.
  3749.        ReceiveASCIIRemoteFileToMemo( Listbox1.Items[ Counter_1 ] );
  3750.     end;
  3751.   end;
  3752. end;
  3753.  
  3754. procedure TCCINetCCForm.ToFile1Click(Sender: TObject);
  3755. var Counter_1 : Integer;
  3756.     W16Name   : String;
  3757. begin
  3758.   for Counter_1 := 0 to Listbox1.Items.Count - 1 do
  3759.   begin
  3760.     if Listbox1.Selected[ Counter_1 ] then
  3761.     begin
  3762.       FileNameToXFer := ListBox1.Items[ Counter_1 ];
  3763.       W16Name := TheFTPComponent.GetWin16Filename( FileNameToXFer );
  3764.       TheFTPComponent.
  3765.        ReceiveASCIIRemoteFile( Listbox1.Items[ Counter_1 ] , W16Name );
  3766.     end;
  3767.   end;
  3768. end;
  3769.  
  3770. procedure TCCINetCCForm.Binary2Click(Sender: TObject);
  3771. var Counter_1 : Integer;
  3772.     W16Name   : String;
  3773. begin
  3774.   for Counter_1 := 0 to Listbox1.Items.Count - 1 do
  3775.   begin
  3776.     if Listbox1.Selected[ Counter_1 ] then
  3777.     begin
  3778.       FileNameToXFer := ListBox1.Items[ Counter_1 ];
  3779.       W16Name := TheFTPComponent.GetWin16Filename( FileNameToXFer );
  3780.       TheFTPComponent.
  3781.        ReceiveBinaryRemoteFile( Listbox1.Items[ Counter_1 ] , W16Name );
  3782.     end;
  3783.   end;
  3784. end;
  3785.  
  3786. procedure TCCINetCCForm.Change1Click(Sender: TObject);
  3787. var TheDir : String;
  3788. begin
  3789.   if ListBox1.ItemIndex = -1 then exit;
  3790.   TheDir := ListBox1.Items[ ListBox1.ItemIndex ];
  3791.   if TheFTPComponent.SetRemoteDirectory( TheDir ) then
  3792.   begin
  3793.     TheFTPComponent.GetRemoteWorkingDirectory( TheDir ); 
  3794.     { Put up remote directory via PWD and strip quotes }
  3795.     Label4.Caption := TheFTPComponent.GetQuotedString( TheDir );
  3796.     { Get the listings of directories and exit OK }
  3797.     TheFTPComponent.GetRemoteDirectoryListing( Listbox1 );
  3798.   end;
  3799. end;
  3800.  
  3801. procedure TCCINetCCForm.ChangeLocal1Click(Sender: TObject);
  3802. var TheDir : String;
  3803. begin
  3804.   if ListBox2.ItemIndex = -1 then exit;
  3805.   TheDir := ListBox2.Items[ ListBox2.ItemIndex ];
  3806.   TheDir := TheFTPComponent.StripBrackets( TheDir );
  3807.   if TheDir = '..' then
  3808.   begin
  3809.     ChDir( TheDir );
  3810.   end
  3811.   else
  3812.   begin
  3813.     TheDir := ExpandFileName( TheDir );
  3814.     ChDir( TheDir );
  3815.   end;
  3816.   TheFTPComponent.GetLocalDirectoryAndListing( TheDir , Listbox2 );
  3817.   if Label5.Canvas.TextWidth( TheDir ) > Label5.Width then
  3818.    TheDir := TheFTPComponent.GetShortPathName( TheDir );
  3819.   Label5.Caption := TheDir;
  3820. end;
  3821.  
  3822. procedure TCCINetCCForm.ListBox1DblClick(Sender: TObject);
  3823. begin
  3824.   case Tag of
  3825.     2 : begin
  3826.           case DefaultDownLoadVector of
  3827.             1 : Binary2Click( Self );
  3828.             2 : ToFile1Click( Self );
  3829.             3 : Change1Click( Self );
  3830.           end;
  3831.         end;
  3832.   end;
  3833. end;
  3834.  
  3835. procedure TCCINetCCForm.ListBox2DblClick(Sender: TObject);
  3836. var WorkingString ,
  3837.     NumberString    : String;
  3838.     TheIDNumber     : Integer;
  3839.     TheNGARecord    : PNewsGroupArticleRecord;
  3840. begin
  3841.   case Tag of
  3842.     2 : begin
  3843.           case DefaultDownLoadVector of
  3844.             1 : Binary1Click( Self );
  3845.             2 : ASCII1Click( Self );
  3846.             3 : ChangeLocal1Click( Self );
  3847.           end;
  3848.         end;
  3849.     5 : begin
  3850.           if ListBox2.Tag <> 5 then exit;
  3851.           if ListBox2.ItemIndex = -1 then exit;
  3852.           WorkingString := ListBox2.Items[ ListBox2.ItemIndex ];
  3853.           NumberString := TheFTPComponent.StripBrackets( WorkingString );
  3854.           TheIDNumber := StrToInt( NumberString );
  3855.           TheNGARecord := PNewsGroupArticleRecord(
  3856.            TheNGArticlesList.Items[ TheIDNumber ] );
  3857.           if TheNGARecord^.NGADownloaded then
  3858.           begin
  3859.             Memo1.Clear;
  3860.             try
  3861.               Memo1.Lines.LoadFromFile( NewsPath + '\' + TheNGARecord^.NGAArtFileName );
  3862.             except
  3863.               MessageDlg( 'Article Too Large to Load! Use Write to View [' +
  3864.                TheNGARecord^.NGAArtFilename + '.',
  3865.                mtError,[mbOK],0);
  3866.               exit;
  3867.             end;
  3868.             Label1.Caption := 'Subject:';
  3869.             ComboBox1.Text := TheNGARecord^.NGASubject;
  3870.             TheNGARecord^.NGARead := true;
  3871.             WorkingString := ListBox2.Items[ ListBox2.ItemIndex ];
  3872.             WorkingString[ 3 ] := 'R';
  3873.             ListBox2.Items[ ListBox2.ItemIndex ] := WorkingString;
  3874.           end
  3875.           else
  3876.           begin
  3877.             MessageDlg( 'Article Not Downloaded!',mtError,[mbOK],0);
  3878.           end;
  3879.         end;
  3880.   end;
  3881. end;
  3882.  
  3883. procedure TCCINetCCForm.ASCII1Click(Sender: TObject);
  3884. var Counter_1 : Integer;
  3885.     TheDir    : String;
  3886. begin
  3887.   for Counter_1 := 0 to Listbox2.Items.Count - 1 do
  3888.   begin
  3889.     if Listbox2.Selected[ Counter_1 ] then
  3890.     begin
  3891.       FileNameToXFer := ListBox2.Items[ Counter_1 ];
  3892.       TheFTPComponent.
  3893.        SendASCIILocalFile( Listbox2.Items[ Counter_1 ] );
  3894.     end;
  3895.   end;
  3896.   TheFTPComponent.GetRemoteWorkingDirectory( TheDir );
  3897.   { Put up remote directory via PWD and strip quotes }
  3898.   Label4.Caption := TheFTPComponent.GetQuotedString( TheDir );
  3899.   { Get the listings of directories and exit OK }
  3900.   TheFTPComponent.GetRemoteDirectoryListing( Listbox1 );
  3901. end;
  3902.  
  3903. procedure TCCINetCCForm.DeleteRemoteFiles1Click(Sender: TObject);
  3904. var Counter_1 : Integer;
  3905.     TheDir    : String;
  3906.     DoAll     : Boolean;
  3907.     TheResult : Integer;
  3908. begin
  3909.   DoAll := false;
  3910.   for Counter_1 := 0 to Listbox1.Items.Count - 1 do
  3911.   begin
  3912.     if Listbox1.Selected[ Counter_1 ] then
  3913.     begin
  3914.       if not DoAll then
  3915.       begin
  3916.         TheResult := MessageDlg( 'Delete Remote File ' +
  3917.          ListBox1.Items[ Counter_1 ] + ' ?',mtConfirmation,
  3918.           [mbYes,mbNo,mbCancel,mbAll],0 );
  3919.         case TheResult of
  3920.           mrYes : ;
  3921.           mrNo  : ;
  3922.           mrCancel : break;
  3923.           mrAll : begin
  3924.                     TheResult := mrYes;
  3925.                     DoAll := true;
  3926.                   end;
  3927.         end;
  3928.       end
  3929.       else TheResult := mrYes;
  3930.       if TheResult = mrYes then TheFTPComponent.
  3931.          DeleteRemoteFile( Listbox1.Items[ Counter_1 ] );
  3932.     end;
  3933.   end;
  3934.   TheFTPComponent.GetRemoteWorkingDirectory( TheDir );
  3935.   { Put up remote directory via PWD and strip quotes }
  3936.   Label4.Caption := TheFTPComponent.GetQuotedString( TheDir );
  3937.   { Get the listings of directories and exit OK }
  3938.   TheFTPComponent.GetRemoteDirectoryListing( Listbox1 );
  3939. end;
  3940.  
  3941. procedure TCCINetCCForm.Binary1Click(Sender: TObject);
  3942. var Counter_1 : Integer;
  3943.     TheDir    : String;
  3944. begin
  3945.   for Counter_1 := 0 to Listbox2.Items.Count - 1 do
  3946.   begin
  3947.     if Listbox2.Selected[ Counter_1 ] then
  3948.     begin
  3949.       FileNameToXFer := ListBox2.Items[ Counter_1 ];
  3950.       TheFTPComponent.
  3951.        SendBinaryLocalFile( Listbox2.Items[ Counter_1 ] );
  3952.     end;
  3953.   end;
  3954.   TheFTPComponent.GetRemoteWorkingDirectory( TheDir );
  3955.   { Put up remote directory via PWD and strip quotes }
  3956.   Label4.Caption := TheFTPComponent.GetQuotedString( TheDir );
  3957.   { Get the listings of directories and exit OK }
  3958.   TheFTPComponent.GetRemoteDirectoryListing( Listbox1 );
  3959. end;
  3960.  
  3961. procedure TCCINetCCForm.Delete3Click(Sender: TObject);
  3962. var Counter_1 : Integer;
  3963.     TheDir    : String;
  3964. begin
  3965.   for Counter_1 := 0 to Listbox1.Items.Count - 1 do
  3966.   begin
  3967.     if Listbox1.Selected[ Counter_1 ] then
  3968.     begin
  3969.       if ListBox1.Items[ Counter_1 ] <> '..' then
  3970.        TheFTPComponent.
  3971.         DeleteRemoteDirectory( Listbox1.Items[ Counter_1 ] );
  3972.     end;
  3973.   end;
  3974.   TheFTPComponent.GetRemoteWorkingDirectory( TheDir );
  3975.   { Put up remote directory via PWD and strip quotes }
  3976.   Label4.Caption := TheFTPComponent.GetQuotedString( TheDir );
  3977.   { Get the listings of directories and exit OK }
  3978.   TheFTPComponent.GetRemoteDirectoryListing( Listbox1 );
  3979. end;
  3980.  
  3981. procedure TCCINetCCForm.Create1Click(Sender: TObject);
  3982. var TheDir : String;
  3983. begin
  3984.   OpenDialog1.Filename := '*.*';
  3985.   OpenDialog1.Title := 'Enter Remote Directory Name';
  3986.   if OpenDialog1.Execute then
  3987.   begin
  3988.     TheFTPComponent.
  3989.      CreateRemoteDirectory( ExtractFileName( OpenDialog1.FileName ));
  3990.     TheFTPComponent.GetRemoteWorkingDirectory( TheDir );
  3991.     { Put up remote directory via PWD and strip quotes }
  3992.     Label4.Caption := TheFTPComponent.GetQuotedString( TheDir );
  3993.     { Get the listings of directories and exit OK }
  3994.     TheFTPComponent.GetRemoteDirectoryListing( Listbox1 );
  3995.   end;
  3996. end;
  3997.  
  3998. procedure TCCINetCCForm.ListBox1Click(Sender: TObject);
  3999. var TheNGRecord : PNewsGroupRecord;
  4000. begin
  4001.   case ListBox1.Tag of
  4002.     5 : begin
  4003.           if ListBox1.ItemIndex = -1 then exit;
  4004.           TheNGRecord :=
  4005.            PNewsGroupRecord( TheNewsRCList.Items[ ListBox1.ItemIndex ] );
  4006.           TheNGArticlesList := TList( TheNGRecord^.GLTag );
  4007.           PopulateLB2WithArticleHeaders;
  4008.           ComboBox1.ItemIndex := ListBox1.ItemIndex;
  4009.         end;
  4010.   end;
  4011. end;
  4012.  
  4013. procedure TCCINetCCForm.UsenetNws1Click(Sender: TObject);
  4014. begin
  4015.   if TheFTPComponent.Connection_Established then
  4016.   begin
  4017.     MessageDlg( 'Must disconnect from current FTP session first!',
  4018.      mtError,[mbOK],0);
  4019.     exit;
  4020.   end;
  4021.   { Show The NNTP servers display }
  4022.   ListBox1.Clear;
  4023.   ListBox2.Clear;
  4024.   SetupNNTPSiteLists;
  4025.   NewsGroupListLoaded := false;
  4026.   SetupNNTPServersInfoDisplay;
  4027. end;
  4028.  
  4029. procedure TCCINetCCForm.Disconnect2Click(Sender: TObject);
  4030. begin
  4031.   SaveNNTPNewsGroupLists;
  4032.   DoNNTPDisconnect;
  4033.   DisableNNTPMenus;
  4034.   ListBox1.Clear;
  4035.   ListBox2.Clear;
  4036. end;
  4037.  
  4038. procedure TCCINetCCForm.News2Click(Sender: TObject);
  4039. begin
  4040.   CCICPrefsDlg.TabbedNoteBook1.PageIndex := 2;
  4041.   CCICPrefsDlg.Tag := 4;
  4042.   CCICPrefsDlg.ShowModal;
  4043. end;
  4044.  
  4045. procedure TCCINetCCForm.ConnectandUpdate1Click(Sender: TObject);
  4046. begin
  4047.   DoNNTPConnection( PConnectionsRecord(
  4048.      TheNewsServerList.Items[ ComboBox1.ItemIndex ] ));
  4049.   if TheNNTPComponent.Connection_Established then
  4050.   begin
  4051.     SetupNNTPNewsGroupLists;
  4052.     { Bring up the files with current NG information }
  4053.     SetupNewsGroupListboxes;
  4054.   end;
  4055. end;
  4056.  
  4057. procedure TCCINetCCForm.NewsServers1Click(Sender: TObject);
  4058. begin
  4059.   { Reset display to NNTP Servers }
  4060.   SetupNNTPServersInfoDisplay;
  4061.   { Show Modally to get the information }
  4062.   CCICInfoDlg.ShowModal;
  4063. end;
  4064.  
  4065. procedure TCCINetCCForm.SubscribedNewsgroups1Click(Sender: TObject);
  4066. begin
  4067.   { Reset display to Usenet Newsgroups }
  4068.   SetupNNTPNewsGroupsInfoDisplay;
  4069.   { Show Modally to get the information }
  4070.   CCICInfoDlg.ShowModal;
  4071.   SetupNewsGroupListboxes;
  4072. end;
  4073.  
  4074. procedure TCCINetCCForm.Load1Click(Sender: TObject);
  4075. var Memo2 : TMemo;
  4076.     Counter_1 : Integer;
  4077. begin
  4078.   OpenDialog1.Filename := '*.txt';
  4079.   OpenDialog1.Title := 'Select File to load into Memo';
  4080.   if OpenDialog1.Execute then
  4081.   begin
  4082.     Memo2 := TMemo.Create( Self );
  4083.     Memo2.Parent := Self;
  4084.     Memo2.Visible := false;
  4085.     Memo2.Width := Memo1.Width;
  4086.     Memo2.Height := Memo1.Height;
  4087.     Memo2.Lines.LoadFromFile( OpenDialog1.FileName );
  4088.     for Counter_1 := 0 to Memo2.Lines.Count - 1 do
  4089.      Memo1.Lines.Add( Memo2.Lines[ Counter_1 ] );
  4090.     Memo2.Free;
  4091.   end;
  4092. end;
  4093.  
  4094. procedure TCCINetCCForm.Save1Click(Sender: TObject);
  4095. begin
  4096.   SaveDialog1.Filename := '*.txt';
  4097.   SaveDialog1.Title := 'Select File to Save Memo to';
  4098.   if OpenDialog1.Execute then
  4099.   begin
  4100.     Memo1.Lines.SaveToFile( SaveDialog1.FileName );
  4101.   end;
  4102. end;
  4103.  
  4104. procedure TCCINetCCForm.Paths1Click(Sender: TObject);
  4105. begin
  4106.   CCICPrefsDlg.TabbedNoteBook1.PageIndex := 3;
  4107.   CCICPrefsDlg.Tag := 3;
  4108.   CCICPrefsDlg.ShowModal;
  4109. end;
  4110.  
  4111. procedure TCCINetCCForm.Cut1Click(Sender: TObject);
  4112. begin
  4113.   Memo1.CutToClipboard;
  4114. end;
  4115.  
  4116. procedure TCCINetCCForm.Copy1Click(Sender: TObject);
  4117. begin
  4118.   Memo1.CopyToClipboard;
  4119. end;
  4120.  
  4121. procedure TCCINetCCForm.CopytoFile1Click(Sender: TObject);
  4122. var TempMemo : TMemo;
  4123. begin
  4124.   TempMemo := TMemo.Create( self );
  4125.   TempMemo.parent := self;
  4126.   Tempmemo.Visible := false;
  4127.   TempMemo.Width := Memo1.Width;
  4128.   TempMemo.Height := Memo1.Height;
  4129.   Memo1.CopyToClipboard;
  4130.   TempMemo.PasteFromClipboard;
  4131.   SaveDialog1.Filename := '*.TXT';
  4132.   SaveDialog1.Title := 'Select File to Save To';
  4133.   if SaveDialog1.Execute then TempMemo.Lines.SaveToFile( SaveDialog1.Filename );
  4134.   TempMemo.Free;
  4135. end;
  4136.  
  4137. procedure TCCINetCCForm.Paste1Click(Sender: TObject);
  4138. begin
  4139.   Memo1.PasteFromClipboard;
  4140. end;
  4141.  
  4142. procedure TCCINetCCForm.PastefromFile1Click(Sender: TObject);
  4143. var TempMemo : TMemo;
  4144. begin
  4145.   TempMemo := TMemo.Create( self );
  4146.   TempMemo.parent := self;
  4147.   Tempmemo.Visible := false;
  4148.   TempMemo.Width := Memo1.Width;
  4149.   TempMemo.Height := Memo1.Height;
  4150.   OpenDialog1.Filename := '*.*';
  4151.   OpenDialog1.Title := 'Select File to Paste From';
  4152.   if OpenDialog1.Execute then TempMemo.Lines.LoadFromFile( OpenDialog1.Filename );
  4153.   TempMemo.SelectAll;
  4154.   TempMemo.CopyToClipboard;
  4155.   Memo1.PasteFromClipboard;
  4156.   TempMemo.Free;
  4157. end;
  4158.  
  4159. procedure TCCINetCCForm.SpeedButton1Click(Sender: TObject);
  4160. begin
  4161.   case Tag of
  4162.     5 : begin
  4163.           if ListBox2.Items.Count = 0 then exit;
  4164.           Listbox2.multiselect := false;
  4165.           If ListBox2.ItemIndex = -1 then ListBox2.ItemIndex := 0;
  4166.           ListBox2.ItemIndex := Listbox2.ItemIndex - 1;
  4167.           if ListBox2.Itemindex < 0 then
  4168.            Listbox2.Itemindex := ListBox2.Items.Count - 1;
  4169.           ListBox2DblClick( Self );
  4170.           ListBox2.Multiselect := true;
  4171.           ListBox2.SetFocus;
  4172.         end;
  4173.   end;
  4174. end;
  4175.  
  4176. procedure TCCINetCCForm.SpeedButton2Click(Sender: TObject);
  4177. begin
  4178.   case Tag of
  4179.     5 : begin
  4180.           if ListBox2.Items.Count = 0 then exit;
  4181.           ListBox2.MultiSelect := false;
  4182.           If ListBox2.ItemIndex = -1 then ListBox2.ItemIndex := 0;
  4183.           ListBox2.ItemIndex := Listbox2.ItemIndex + 1;
  4184.           if ListBox2.Itemindex > ListBox2.Items.Count - 1 then
  4185.            Listbox2.Itemindex := 0;
  4186.           ListBox2DblClick( Self );
  4187.           ListBox2.MultiSelect := true;
  4188.           ListBox2.SetFocus;
  4189.         end;
  4190.   end;
  4191. end;
  4192.  
  4193. procedure TCCINetCCForm.ListBox2Click(Sender: TObject);
  4194. var TheWorkingList : TList;
  4195.     TheNGARecord : PNewsGroupArticleRecord;
  4196.     TheNGRecord : PNewsGroupRecord;
  4197.     TheWorkingName : String;
  4198. begin
  4199.   if ListBox2.Tag = 9 then
  4200.   begin
  4201.     TheNGRecord :=
  4202.      PNewsGroupRecord( TheNewsRCList.Items[ ListBox1.ItemIndex ] );
  4203.     TheWorkingList := TList( TheNGRecord^.GLTag );
  4204.     TheNGARecord := PNewsGroupArticleRecord(
  4205.      TheWorkingList.Items[ ListBox2.ItemIndex ] );
  4206.     TheWorkingName := NewsPath + '\' + TheNGARecord^.NGAArtFileName;
  4207.     TheUUDecodeList.Add( TheWorkingName );
  4208.     exit;
  4209.   end;
  4210.   case Tag of
  4211.     5 : begin
  4212.           If ListBox2.Items.Count = 0 then exit;
  4213.           ComboBox1.Text := ListBox2.Items[ ListBox2.ItemIndex ];
  4214.         end;
  4215.   end;
  4216. end;
  4217.  
  4218. end.
  4219.  
  4220.