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