home *** CD-ROM | disk | FTP | other *** search
/ Delphi 2 - Developers' Solutions / Delphi 2 Developers' Solutions.iso / dds / chap10 / howto03 / delphi10 / ccicnntp.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-06-12  |  28.2 KB  |  788 lines

  1. unit Ccicnntp;
  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, CCiccfrm;
  9. type
  10.   { Component to hold NNTP handling capabilities }
  11.   TNNTPComponent = class( TWinControl )
  12.   public
  13.     NNTPCommandInProgress ,
  14.     Connection_Established : Boolean;
  15.     Socket1 : TCCSocket;
  16.     constructor Create( AOwner : TComponent ); override;
  17.     destructor Destroy; override;
  18.     function EstablishConnection( PCRPointer : PConnectionsRecord ) : Boolean;
  19.     function Disconnect : Boolean;
  20.     function DoCStyleFormat(       TheText      : string;
  21.                              const TheArguments : array of const ) : String;
  22.     procedure UpdateGauge( BytesFinished , TotalToHandle : longint );
  23.     procedure AddProgressText( WhatText : String );
  24.     procedure ShowProgressText( WhatText : String );
  25.     procedure ShowProgressErrorText( WhatText : String );
  26.     function GetNNTPServerResponse( var ResponseString : String ) : integer;
  27.     procedure NNTPSocketsErrorOccurred( Sender     : TObject;
  28.                                      ErrorCode  : Integer;
  29.                                      TheMessage : String   );
  30.     function PerformNNTPCommand(
  31.                     TheCommand   : string;
  32.               const TheArguments : array of const ) : Integer;
  33.     function PerformBlindNNTPCommand( TheCommand   : string ) : Integer;
  34.     function PerformNNTPExtendedCommand(
  35.                     TheCommand   : string;
  36.               const TheArguments : array of const ) : Integer;
  37.     function GetNNTPServerExtendedResponse( ResponseString : PChar ) : integer;
  38.     function GetNextSDItem(     WorkingString : String;
  39.                             var TheIndex      : Integer ) : String;
  40.     function GetListOfAvailableNewsGroups : Boolean;
  41.     procedure ParseNewsGroupListing(     TheListing : String;
  42.                                      var GroupName  : String;
  43.                                      var LowCurrent : Longint;
  44.                                      var HighCurrent : Longint;
  45.                                      var Postable    : Boolean  );
  46.     function SetCurrentNewsGroup( TheNGRecord : PNewsGroupRecord;
  47.                                   DoUpdate    : Boolean           ) : Boolean;
  48.     function CheckForNewNews( TheNGRecord : PNewsGroupRecord ) : Boolean;
  49.     function CheckAllNewNews : Boolean;
  50.     procedure ParseArticleListing(     TheListing       : String;
  51.                                    var TotalAvailable   : Longint;
  52.                                    var LowestAvailable  : Longint;
  53.                                    var HighestAvailable : Longint );
  54.   end;
  55.  
  56. implementation
  57.  
  58. { This method splits out the GROUP response line into TAA, LAA , HAA }
  59. procedure TNNTPComponent.ParseArticleListing(     TheListing       : String;
  60.                               var TotalAvailable   : Longint;
  61.                               var LowestAvailable  : Longint;
  62.                               var HighestAvailable : Longint );
  63. var WorkingString ,
  64.     WorkingString2 : String;
  65.     WorkingIndex   : Integer;
  66. begin
  67.   WorkingString := Copy( TheListing , 5, 255 );
  68.   WorkingIndex := Pos( ' ' , WorkingString );
  69.   WorkingString2 := Copy( WorkingString , 1 , WorkingIndex - 1 );
  70.   TotalAvailable := StrToInt( WorkingString2 );
  71.   WorkingString := Copy( WorkingString , WorkingIndex + 1 , 255 );
  72.   WorkingIndex := Pos( ' ' , WorkingString );
  73.   WorkingString2 := Copy( WorkingString , 1 , WorkingIndex - 1 );
  74.   LowestAvailable := StrToInt( WorkingString2 );
  75.   WorkingString := Copy( WorkingString , WorkingIndex + 1 , 255 );
  76.   WorkingIndex := Pos( ' ' , WorkingString );
  77.   WorkingString2 := Copy( WorkingString , 1 , WorkingIndex - 1 );
  78.   HighestAvailable := StrToInt( WorkingString2 );
  79. end;
  80.  
  81. { This function calls an extended response NNTP command routine }
  82. function TNNTPComponent.PerformNNTPExtendedCommand(
  83.                TheCommand   : string;
  84.          const TheArguments : array of const ) : Integer;
  85. var TheBuffer : string; { Text buffer }
  86. begin
  87.   { If command in progress send back -1 error }
  88.   if NNTPCommandInProgress then
  89.   begin
  90.     Result := -1;
  91.     exit;
  92.   end;
  93.   { Set status variable }
  94.   NNTPCommandInProgress := True;
  95.   { Set global error code }
  96.   GlobalErrorCode := 0;
  97.   { Format output string }
  98.   TheBuffer := Format( TheCommand , TheArguments );
  99.   { Preset failure code }
  100.   Result := TCPIP_STATUS_FATAL_ERROR;
  101.   { If invalid socket or no connection abort }
  102.   if ( Socket1.TheSocket = INVALID_SOCKET ) or not Connection_Established then
  103.    exit;
  104.   { Send the buffer plus EOL chars }
  105.   Socket1.StringData := TheBuffer + #13#10;
  106.   { if abort due to timeout or other error exit }
  107.   if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 )) then exit;
  108.   { Otherwise return preliminary code }
  109.   Result := TCPIP_STATUS_PRELIMINARY;
  110. end;
  111.  
  112. { This function gets an extended period-ended multiline response from the server }
  113. function TNNTPComponent.GetNNTPServerExtendedResponse( ResponseString : PChar ) : integer;
  114. var
  115.   { Assume ResponseString already allocated as 0..513 }
  116.   { Pointer to the response string }
  117.   TheBuffer ,
  118.   BufferPointer : array[0..255] of char;
  119.   HolderBuffer : array[0..513] of char;
  120.   { Character to check for response code }
  121.   ResponseChar   : char;
  122.   { Pointers into returned string }
  123.   TheIndex ,
  124.   TheLength     : integer;
  125.   { Control variable }
  126.   LeftoversInPan ,
  127.   Finished      : Boolean;
  128.   BufferString : String;
  129. begin
  130.   { Preset fatal error }
  131.   Result := TCPIP_STATUS_FATAL_ERROR;
  132.   { Start loop control }
  133.   LeftoversInPan := false;
  134.   Finished := false;
  135.   StrCopy( HolderBuffer , '' );
  136.   repeat
  137.     { Do a peek }
  138.     BufferString := Socket1.PeekData;
  139.     { If timeout or other error exit }
  140.     if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 )) then exit;
  141.     { Find end of line character }
  142.     TheIndex := Pos( #10 , BufferString );
  143.     if TheIndex = 0 then
  144.     begin
  145.       TheIndex := Pos( #13 , BufferString );
  146.       if TheIndex = 0 then
  147.       begin
  148.         TheIndex := Pos( #0 , BufferString );
  149.         if TheIndex = 0 then
  150.         begin
  151.           TheIndex := Length( BufferString );
  152.           LeftoversInPan := True;
  153.           StrPCopy( TheBuffer , BufferString );
  154.           StrCat( HolderBuffer , TheBuffer );
  155.           LeftoversOnTable := false;
  156.         end;
  157.       end;
  158.     end;
  159.     { If an end of line then process the line }
  160.     if TheIndex > 0 then
  161.     begin
  162.       { Get length of string }
  163.       TheLength := TheIndex;
  164.       { Receive actual data }
  165.       Socket1.CCSockReceive( Socket1.TheSocket   ,
  166.                              @BufferPointer[ 0 ] ,
  167.                              TheLength              );
  168.       { Abort if timeout or error }
  169.       if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 )) then exit;
  170.       { Put in the length byte }
  171.       BufferPointer[ TheLength ] := Chr( 0 );
  172.       if LeftOversOnTable then
  173.       begin
  174.         LeftOversOnTable := false;
  175.         StrCopy( ResponseString , HolderBuffer );
  176.         StrCat( ResponseString , BufferPointer );
  177.       end
  178.       else
  179.       begin
  180.         if not LeftoversInPan then StrCopy( ResponseString , BufferPointer );
  181.       end;
  182.       if LeftoversInPan then
  183.       begin
  184.         LeftoversInPan := false;
  185.         LeftoversOnTable := true;
  186.       end
  187.       else
  188.       begin
  189.         ResponseChar := ResponseString[ 0 ];
  190.         if (( ResponseChar = '.' ) and ( StrLen( ResponseString ) <= 3 )) then
  191.         begin
  192.           Finished := true;
  193.           Result := TCPIP_STATUS_COMPLETED;
  194.         end
  195.         else
  196.         begin
  197.           if ResponseChar = '.' then ResponseString[ 0 ] := ' ';
  198.           Finished := true;
  199.           Result := TCPIP_STATUS_PRELIMINARY;
  200.         end;
  201.       end;
  202.     end;
  203.   until ( Finished and ( not LeftoversOnTable ));
  204.   StrLCopy( ResponseString , ResponseString , StrLen( ResponseString ) - 2 );
  205. end;
  206.  
  207. { This function moves along a string from an index, getting the next }
  208. { string delimited item or last one on string.                       }
  209. function TNNTPComponent.GetNextSDItem(     WorkingString : String;
  210.                                        var TheIndex      : Integer ) : String;
  211. var HoldingString : String;
  212. begin
  213.   HoldingString := Copy( WorkingString , TheIndex + 1 , 255 );
  214.   TheIndex := Pos( ' ' , HoldingString );
  215.   if TheIndex = 0 then
  216.   begin
  217.     Result := HoldingString;
  218.   end
  219.   else
  220.   begin
  221.     HoldingString := Copy( HoldingString , 1 , TheIndex - 1 );
  222.     Result := HoldingString;
  223.   end;
  224. end;
  225.  
  226. { This is the first true "network" function; it sends a LIST command, eats }
  227. { a single 215 response and then grabs PChars of data from the server till }
  228. { It returns a period character. The returned line is sent to a NEWSGRP    }
  229. { file and a status update is send through.                                }
  230. function TNNTPComponent.GetListOfAvailableNewsGroups : Boolean;
  231. var TheReturnString : String;  { Internal string holder }
  232.     TheResult       : Integer; { Internal int holder    }
  233.     HoldPChar ,
  234.     TheHoldingPChar ,
  235.     TheReturnPChar  : PChar;
  236.     TheNGFile       : TextFile;
  237.     D1 , D2     : Longint;
  238.     D3          : Boolean;
  239.     GroupString : String;
  240.     TotalGroups : Longint;
  241. begin
  242.   Result := false;
  243.   TheReturnString :=
  244.    DoCStyleFormat( 'LIST' ,
  245.     [ nil ] );
  246.   { Put result in progress and status line }
  247.   AddProgressText( TheReturnString );
  248.   ShowProgressText( TheReturnString );
  249.   { Begin login sequence with user name }
  250.   TheResult := PerformNNTPCommand( 'LIST', [ nil ] );
  251.   if TheResult <> TCPIP_STATUS_PRELIMINARY then
  252.   begin
  253.     NNTPCommandInProgress := false;
  254.     Result := false;
  255.     exit;
  256.   end;
  257.   repeat
  258.     TheResult := GetNNTPServerResponse( TheReturnString );
  259.     { Put result in progress and status line }
  260.     AddProgressText( TheReturnString );
  261.     ShowProgressText( TheReturnString );
  262.   until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  263.   NNTPCommandInProgress := false;
  264.   if ( GlobalAbortedFlag or ( TheResult <> TCPIP_STATUS_COMPLETED )) then
  265.   begin
  266.     { Do clever C formatting trick }
  267.     TheReturnString :=
  268.      DoCStyleFormat( 'LIST Failed!' ,
  269.       [ nil ] );
  270.     { Put result in progress and status line }
  271.     AddProgressText( TheReturnString );
  272.     ShowProgressErrorText( TheReturnString );
  273.     { Signal error }
  274.     Result := False;
  275.     { leave }
  276.     exit;
  277.   end;
  278.   try
  279.     AssignFile( TheNGFile , NewsPath + '\NEWSGRP.TXT' );
  280.     Rewrite( TheNGFile );
  281.   except
  282.     Socket1.OutOfBand := 'ABOR'+#13#10;
  283.     repeat
  284.       TheResult := GetNNTPServerResponse( TheReturnString );
  285.       { Put result in progress and status line }
  286.       AddProgressText( TheReturnString );
  287.       ShowProgressText( TheReturnString );
  288.     until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  289.     Result := false;
  290.     exit;
  291.   end;
  292.   GetMem( TheReturnPChar , 514 );
  293.   HoldPChar := TheReturnPChar;
  294.   TotalGroups := 0;
  295.   CCICInfoDlg.ListBox1.Clear;
  296.   repeat
  297.     Application.ProcessMessages;
  298.     if GlobalAbortedFlag then exit;
  299.     Inc(TotalGroups );
  300.     TheResult := GetNNTPServerExtendedResponse( TheReturnPChar );
  301.     if StrLen( TheReturnPChar ) > 255 then
  302.     begin
  303.       Getmem( TheHoldingPChar , 255 );
  304.       while StrLen( TheReturnPChar ) > 255 do
  305.       begin
  306.         StrCopy( TheHoldingPChar , '' );
  307.         StrMove( TheHoldingPChar , TheReturnPChar , 255 );
  308.         TheReturnPChar := TheReturnPChar + 256;
  309.         TheReturnString := StrPas( TheHoldingPChar );
  310.         ParseNewsGroupListing( TheReturnString, GroupString, D1 , D2 , D3 );
  311.       end;
  312.       FreeMem( TheHoldingPChar , 255 );
  313.       Writeln( TheNGFile , GroupString );
  314.       CCICInfoDlg.ListBox1.Items.Add( GroupString );
  315.       CCINetCCForm.Panel1.Caption := GroupString +
  316.        '(' + IntToStr( TotalGroups ) + ')';
  317.     end
  318.     else
  319.     begin
  320.       TheReturnString := StrPas( TheReturnPChar );
  321.       ParseNewsGroupListing( TheReturnString, GroupString, D1 , D2 , D3 );
  322.       Writeln( TheNGFile , GroupString );
  323.       CCICInfoDlg.ListBox1.Items.Add( GroupString );
  324.       CCINetCCForm.Panel1.Caption := GroupString +
  325.        '(' + IntToStr( TotalGroups ) + ')';
  326.     end;
  327.   until (( GlobalAbortedFlag ) or ( TheResult = TCPIP_STATUS_COMPLETED ));
  328.   FreeMem( HoldPChar , 514 );
  329.   CloseFile( TheNGFile );
  330.   Result := true;
  331.   CCINetCCForm.Panel1.Caption := 'Finished LIST!';
  332. end;
  333.  
  334. { This method sets a news group and updates its internal data }
  335. function TNNTPComponent.CheckForNewNews( TheNGRecord : PNewsGroupRecord ) : Boolean;
  336. begin
  337.   { Gee, that was easy! }
  338.   Result := SetCurrentNewsGroup( TheNGRecord , true );
  339. end;
  340.  
  341. { This method takes all the data in the NewsRCList and if subscribed, CNN's it }
  342. function TNNTPComponent.CheckAllNewNews : Boolean;
  343. var Counter_1   : Integer;
  344.     TheNGRecord : PNewsGroupRecord;
  345. begin
  346.   Result := true;
  347.   for Counter_1 := 0 to TheNewsRCList.Count - 1 do
  348.   begin
  349.     TheNGRecord := PNewsGroupRecord( TheNewsRCList.Items[ Counter_1 ] );
  350.     if TheNGRecord^.GSubScribed then Result := CheckForNewNews( TheNGRecord );
  351.   end;
  352. end;
  353.  
  354. { This method splits up a listing and pulls out its component data }
  355. procedure TNNTPComponent.ParseNewsGroupListing(     TheListing : String;
  356.                                 var GroupName  : String;
  357.                                 var LowCurrent : Longint;
  358.                                 var HighCurrent : Longint;
  359.                                 var Postable    : Boolean  );
  360. var HoldingString ,
  361.     HoldingString2 : String;
  362.     WorkingIndex  : Integer;
  363. begin
  364.   WorkingIndex := Pos( ' ' , TheListing );
  365.   if WorkingIndex = 0 then
  366.   begin
  367.     GroupName := TheListing;
  368.     LowCurrent :=  -1;
  369.     HighCurrent := -1;
  370.     Postable := false;
  371.     exit;
  372.   end;
  373.   GroupName := Copy( TheListing , 1 , WorkingIndex - 1 );
  374.   HoldingString := Copy( TheListing , WorkingIndex + 1 , 255 );
  375.   WorkingIndex := Pos(  ' ' , HoldingString );
  376.   HoldingString2 := Copy( HoldingString , 1 , WorkingIndex - 1 );
  377.   LowCurrent := StrToInt( HoldingString2 );
  378.   HoldingString := Copy( HoldingString , WorkingIndex + 1 , 255 );
  379.   WorkingIndex := Pos(  ' ' , HoldingString );
  380.   HoldingString2 := Copy( HoldingString , 1 , WorkingIndex - 1 );
  381.   HighCurrent := StrToInt( HoldingString2 );
  382.   HoldingString := Copy( HoldingString , WorkingIndex + 1 , 255 );
  383.   if (( HoldingString[ 1 ] = 'y' ) or ( HoldingString[ 1 ] = 'Y' )) then
  384.    Postable := true else Postable := false;
  385. end;
  386.  
  387. { This is another "Network" command which sets the GROUP to the name of the }
  388. { imported record. The imported record is also updated to reflect current   }
  389. { available articles.                                                       }
  390. function TNNTPComponent.SetCurrentNewsGroup(
  391.           TheNGRecord : PNewsGroupRecord; DoUpdate : Boolean ) : Boolean;
  392. var TheReturnString : String;  { Internal string holder }
  393.     TheResult       : Integer; { Internal int holder    }
  394.     TAA , LAA , HAA : Longint;
  395. begin
  396.   TheReturnString :=
  397.    DoCStyleFormat( 'GROUP %s' ,
  398.     [ TheNGRecord^.GRealName ] );
  399.   { Put result in progress and status line }
  400.   AddProgressText( TheReturnString );
  401.   ShowProgressText( TheReturnString );
  402.   { Begin login sequence with user name }
  403.   TheResult := PerformNNTPCommand( 'GROUP %s',
  404.                                   [ TheNGRecord^.GRealName ] );
  405.   if TheResult <> TCPIP_STATUS_PRELIMINARY then
  406.   begin
  407.     NNTPCommandInProgress := false;
  408.     Result := false;
  409.     exit;
  410.   end;
  411.   repeat
  412.     TheResult := GetNNTPServerResponse( TheReturnString );
  413.     { Put result in progress and status line }
  414.     AddProgressText( TheReturnString );
  415.     ShowProgressText( TheReturnString );
  416.   until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  417.   NNTPCommandInProgress := false;
  418.   if ( GlobalAbortedFlag or ( TheResult <> TCPIP_STATUS_COMPLETED )) then
  419.   begin
  420.     { Do clever C formatting trick }
  421.     TheReturnString :=
  422.      DoCStyleFormat( 'GROUP %s Not Available!' ,
  423.       [ TheNGRecord^.GRealName ] );
  424.     { Put result in progress and status line }
  425.     AddProgressText( TheReturnString );
  426.     ShowProgressErrorText( TheReturnString );
  427.     { Signal error }
  428.     Result := False;
  429.     { leave }
  430.     exit;
  431.   end;
  432.   Result := True;
  433.   { Leave if only want to set group }
  434.   if not DoUpdate then exit;
  435.   { Split out the articles listing into its three numbers }
  436.   ParseArticleListing( TheReturnString , TAA , LAA , HAA );
  437.   { Work on the numbers to make sure display is consistent }
  438.   with TheNGRecord^ do
  439.   begin
  440.     { Set internal pointers }
  441.     GTotalAvailable := TAA;
  442.     GLowestAvailable := LAA;
  443.     GHighestAvailable := HAA;
  444.     if GLowest < GLowestAvailable then
  445.     begin { All stored articles have expired or there are none }
  446.       GTotalNew := GTotalAvailable;      { Total new is total available    }
  447.       GLowest := GLowestAvailable - 1;   { set low and high to below start }
  448.       GHighest := GLowestAvailable - 1; { until something is read }
  449.     end
  450.     else
  451.     begin { Some read articles haven't expired; assume all still good }
  452.       GTotalNew := GHighestAvailable - GHighest; { Total since last download }
  453.       if GTotalNew < 0 then GTotalNew := 0; { Just in case... }
  454.     end;
  455.   end;
  456. end;
  457.  
  458.  
  459. { This sends FTP progress text to the Inet form }
  460. procedure TNNTPComponent.ShowProgressErrorText( WhatText : String );
  461. begin
  462.   CCInetCCForm.ShowProgressErrorText( WhatText );
  463. end;
  464.  
  465. { This is a core function! It performs an FTP command and if no timeout }
  466. { return a preliminary ok.                                              }
  467. function TNNTPComponent.PerformNNTPCommand(
  468.                  TheCommand        : string;
  469.            const TheArguments      : array of const ) : Integer;
  470. var TheBuffer : string; { Text buffer }
  471. begin
  472.   { If command in progress send back -1 error }
  473.   if NNTPCommandInProgress then
  474.   begin
  475.     Result := -1;
  476.     exit;
  477.   end;
  478.   { Set status variable }
  479.   NNTPCommandInProgress := True;
  480.   { Set global error code }
  481.   GlobalErrorCode := 0;
  482.   { Format output string }
  483.   TheBuffer := Format( TheCommand , TheArguments );
  484.   { Preset failure code }
  485.   Result := TCPIP_STATUS_FATAL_ERROR;
  486.   { If invalid socket or no connection abort }
  487.   if ( Socket1.TheSocket = INVALID_SOCKET ) or not Connection_Established then
  488.    exit;
  489.   { Send the buffer plus EOL chars }
  490.   Socket1.StringData := TheBuffer + #13#10;
  491.   { if abort due to timeout or other error exit }
  492.   if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 )) then exit;
  493.   { Otherwise return preliminary code }
  494.   Result := TCPIP_STATUS_PRELIMINARY;
  495. end;
  496.  
  497. { This is a core function! It performs an FTP command and if no timeout }
  498. { return a preliminary ok.                                              }
  499. function TNNTPComponent.PerformBlindNNTPCommand( TheCommand : string ) : Integer;
  500. var TheBuffer : string; { Text buffer }
  501. begin
  502.   { If command in progress send back -1 error }
  503.   if NNTPCommandInProgress then
  504.   begin
  505.     Result := -1;
  506.     exit;
  507.   end;
  508.   { Set status variable }
  509.   NNTPCommandInProgress := True;
  510.   { Set global error code }
  511.   GlobalErrorCode := 0;
  512.   { Format output string }
  513.   TheBuffer := TheCommand;
  514.   { Preset failure code }
  515.   Result := TCPIP_STATUS_FATAL_ERROR;
  516.   { If invalid socket or no connection abort }
  517.   if ( Socket1.TheSocket = INVALID_SOCKET ) or not Connection_Established then
  518.    exit;
  519.   { Send the buffer plus EOL chars }
  520.   Socket1.StringData := TheBuffer + #13#10;
  521.   { if abort due to timeout or other error exit }
  522.   if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 )) then exit;
  523.   { Otherwise return preliminary code }
  524.   Result := TCPIP_STATUS_PRELIMINARY;
  525. end;
  526.  
  527. { This function gets up to 255 chars of data plus a return code from FTP serv }
  528. function TNNTPComponent.GetNNTPServerResponse(
  529.           var ResponseString : String ) : integer;
  530. var
  531.   { Buffer string for response line }
  532.   TheBuffer     : string;
  533.   { Pointer to the response string }
  534.   BufferPointer : array[0..255] of char absolute TheBuffer;
  535.   { Character to check for response code }
  536.   ResponseChar   : char;
  537.   { Pointers into returned string }
  538.   TheIndex ,
  539.   TheLength     : integer;
  540.   { Control variable }
  541.   LeftoversInPan ,
  542.   Finished      : Boolean;
  543. begin
  544.   { Preset fatal error }
  545.   Result := TCPIP_STATUS_FATAL_ERROR;
  546.   { Start loop control }
  547.   LeftoversInPan := false;
  548.   Finished := false;
  549.   repeat
  550.     { Do a peek }
  551.     TheBuffer := Socket1.PeekData;
  552.     { If timeout or other error exit }
  553.     if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 )) then exit;
  554.     { Find end of line character }
  555.     TheIndex := Pos( #10 , TheBuffer );
  556.     if TheIndex = 0 then
  557.     begin
  558.       TheIndex := Pos( #13 , TheBuffer );
  559.       if TheIndex = 0 then
  560.       begin
  561.         TheIndex := Pos( #0 , TheBuffer );
  562.         if TheIndex = 0 then
  563.         begin
  564.           TheIndex := Length( TheBuffer );
  565.           LeftoversInPan := True;
  566.           LeftoverText := LeftoverText + TheBuffer;
  567.           LeftoversOnTable := false;
  568.         end;
  569.       end;
  570.     end;
  571.     { If an end of line then process the line }
  572.     if TheIndex > 0 then
  573.     begin
  574.       { Get length of string }
  575.       TheLength := TheIndex;
  576.       { Receive actual data }
  577.       Socket1.CCSockReceive( Socket1.TheSocket   ,
  578.                              @BufferPointer[ 1 ] ,
  579.                              TheLength              );
  580.       { Abort if timeout or error }
  581.       if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 )) then exit;
  582.       { Put in the length byte }
  583.       BufferPointer[ 0 ] := Chr( TheLength );
  584.       if LeftOversOnTable then
  585.       begin
  586.         LeftOversOnTable := false;
  587.         ResponseString := LeftoverText + TheBuffer;
  588.         TheBuffer := ResponseString;
  589.         LeftoverText := '';
  590.       end;
  591.       if LeftoversInPan then
  592.       begin
  593.         LeftoversInPan := false;
  594.         LeftoversOnTable := true;
  595.       end;
  596.       { Get first number character }
  597.       ResponseChar := TheBuffer[ 1 ];
  598.       { Get the value of the number from 1 to 5 }
  599.       if (( ResponseChar >= '1' ) and ( ResponseChar <= '5' )) then
  600.       begin
  601.         Finished := true;
  602.         Result := Ord( ResponseChar ) - 48;
  603.       end;
  604.     end
  605.     else
  606.     begin
  607.     end;
  608.   until ( Finished and ( not LeftoversOnTable ));
  609.   { Return buffer as response string }
  610.   ResponseString := TheBuffer;
  611. end;
  612.  
  613. { Boilerplate error routine }
  614. procedure TNNTPComponent.NNTPSocketsErrorOccurred( Sender     : TObject;
  615.                                                  ErrorCode  : Integer;
  616.                                                  TheMessage : String   );
  617. begin
  618.   CCInetCCForm.SocketsErrorOccurred( Sender,ErrorCode,TheMessage );
  619. end;
  620.  
  621. { This is the FTP components initial connection routine }
  622. function TNNTPComponent.EstablishConnection(
  623.           PCRPointer : PConnectionsRecord ) : Boolean;
  624. var TheReturnString : String;  { Internal string holder }
  625.     TheResult       : Integer; { Internal int holder    }
  626. begin
  627.   { Set default FTP Port value }
  628.   Socket1.PortName := '119';
  629.   { Get the ip address from the record }
  630.   Socket1.IPAddressName := PCRPointer^.CIPAddress;
  631.   { Set blocking mode }
  632.   Socket1.AsynchMode := False;
  633.   { Clear condition variables }
  634.   GlobalErrorCode := 0;
  635.   GlobalAbortedFlag := false;
  636.   { Actually attempt to connect }
  637.   Socket1.CCSockConnect;
  638.   { Check if connected }
  639.   if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 ) or
  640.       ( Socket1.TheSocket = INVALID_SOCKET )) then
  641.   begin { Didn't connect; signal error and abort }
  642.     { Do clever C formatting trick }
  643.     TheReturnString :=
  644.      DoCStyleFormat( 'NNTP Host %s Connection Failed!' ,
  645.       [ PCRPointer^.CIPAddress ] );
  646.     { Put result in progress and status line }
  647.     AddProgressText( TheReturnString );
  648.     ShowProgressErrorText( TheReturnString );
  649.     { Signal error }
  650.     Result := False;
  651.     { leave }
  652.     exit;
  653.   end
  654.   else
  655.   begin
  656.     Connection_Established := true;
  657.     { Signal successful connection }
  658.     TheReturnString := DoCStyleFormat(
  659.       'Connected on Local port: %s with IP: %s',
  660.       [ Socket1.GetSocketPort( Socket1.TheSocket ),
  661.         Socket1.GetSocketIPAddress( Socket1.TheSocket )]);
  662.     { Put result in progress and status line }
  663.     CCINetCCForm.AddProgressText( TheReturnString );
  664.     CCINetCCForm.ShowProgressText( TheReturnString );
  665.     TheReturnString := DoCStyleFormat(
  666.      'Connected to Remote port: %s with IP: %s',
  667.       [ Socket1.GetSocketPeerPort( Socket1.TheSocket ),
  668.         Socket1.GetSocketPeerIPAddress( Socket1.TheSocket )]);
  669.     { Put result in progress and status line }
  670.     CCINetCCForm.AddProgressText( TheReturnString );
  671.     CCINetCCForm.ShowProgressText( TheReturnString );
  672.     TheReturnString := DoCStyleFormat( 'Successfully connected to %s',
  673.      [ Socket1.IPAddressName ]);
  674.     { Put result in progress and status line }
  675.     CCINetCCForm.AddProgressText( TheReturnString );
  676.     CCINetCCForm.ShowProgressText( TheReturnString );
  677.     repeat
  678.       TheResult := GetNNTPServerResponse( TheReturnString );
  679.       { Put result in progress and status line }
  680.       AddProgressText( TheReturnString );
  681.       ShowProgressText( TheReturnString );
  682.     until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  683.     if ( GlobalAbortedFlag or ( TheResult <> TCPIP_STATUS_COMPLETED )) then
  684.     begin
  685.       { Do clever C formatting trick }
  686.       TheReturnString :=
  687.        DoCStyleFormat( 'NNTP Host %s Connection Failed!' ,
  688.         [ PCRPointer^.CIPAddress ] );
  689.       { Put result in progress and status line }
  690.       AddProgressText( TheReturnString );
  691.       ShowProgressErrorText( TheReturnString );
  692.       { Signal error }
  693.       Result := False;
  694.       { leave }
  695.       exit;
  696.     end
  697.     else Result := true; { Signal no problem }
  698.   end;
  699. end;
  700.  
  701. { This is the FTP component constructor; it creates 2 sockets }
  702. constructor TNNTPComponent.Create( AOwner : TComponent );
  703. begin
  704.   { do inherited create }
  705.   inherited Create( AOwner );
  706.   { Create socket, put in their parent, and error procs }
  707.   Socket1 := TCCSocket.Create( Self );
  708.   Socket1.Parent := Self;
  709.   Socket1.OnErrorOccurred := NNTPSocketsErrorOccurred;
  710.   { Set up booleans }
  711.   Connection_Established := false;
  712.   NNTPCommandInProgress := false;
  713. end;
  714.  
  715. { This is the FTP component destructor; it frees 2 sockets }
  716. destructor TNNTPComponent.Destroy;
  717. begin
  718.   { Free the socket }
  719.   Socket1.Free;
  720.   { and call inherited }
  721.   inherited Destroy;
  722. end;
  723.  
  724. procedure TNNTPComponent.UpdateGauge( BytesFinished , TotalToHandle : longint );
  725. begin
  726.   CCInetCCForm.UpdateGauge( BytesFinished , TotalToHandle );
  727. end;
  728.  
  729. { This sends FTP progress text to the Inet form }
  730. procedure TNNTPComponent.AddProgressText( WhatText : String );
  731. begin
  732.   CCInetCCForm.AddProgressText( WhatText );
  733. end;
  734.  
  735. { This sends FTP progress text to the Inet form }
  736. procedure TNNTPComponent.ShowProgressText( WhatText : String );
  737. begin
  738.   CCInetCCForm.ShowProgressText( WhatText );
  739. end;
  740.  
  741. { This is the FTP components QUIT routine }
  742. function TNNTPComponent.Disconnect : Boolean;
  743. var TheReturnString : String;  { Internal string holder }
  744.     TheResult       : Integer; { Internal int holder    }
  745. begin
  746.   TheReturnString :=
  747.    DoCStyleFormat( 'QUIT' ,
  748.     [ nil ] );
  749.   { Put result in progress and status line }
  750.   AddProgressText( TheReturnString );
  751.   ShowProgressText( TheReturnString );
  752.   { Begin login sequence with user name }
  753.   PerformNNTPCommand( 'QUIT', [ nil ] );
  754.   repeat
  755.     TheResult := GetNNTPServerResponse( TheReturnString );
  756.     { Put result in progress and status line }
  757.     AddProgressText( TheReturnString );
  758.     ShowProgressText( TheReturnString );
  759.   until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  760.   NNTPCommandInProgress := false;
  761.   if ( GlobalAbortedFlag or ( TheResult <> TCPIP_STATUS_COMPLETED )) then
  762.   begin
  763.     { Do clever C formatting trick }
  764.     TheReturnString :=
  765.      DoCStyleFormat( 'NNTP Host Connection Failed!' ,
  766.       [ nil ] );
  767.     { Put result in progress and status line }
  768.     AddProgressText( TheReturnString );
  769.     ShowProgressErrorText( TheReturnString );
  770.     { Signal error }
  771.     Result := False;
  772.     { leave }
  773.     exit;
  774.   end
  775.   else Result := true; { Signal no problem }
  776. end;
  777.  
  778. { This is a clever c-style formatting trick }
  779. function TNNTPComponent.DoCStyleFormat(
  780.                 TheText      : string;
  781.           const TheArguments : array of const ) : String;
  782. begin
  783.   Result := Format( TheText , TheArguments ) + #13#10;
  784. end;
  785.  
  786.  
  787. end.
  788.