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