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