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