{ $HDR$}
{**********************************************************************}
{ Unit archived using Team Coherence                                   }
{ Team Coherence is Copyright 2002 by Quality Software Components      }
{                                                                      }
{ For further information / comments, visit our WEB site at            }
{ http://www.TeamCoherence.com                                         }
{**********************************************************************}
{}
{ $Log:  10271: IdNNTP.pas 
{
{   Rev 1.3    5/12/04 9:53:40 AM  RLebeau
{ Updated GetArticle() to call ReceiveBody() only if ReceiveHeader() does not
{ receive the message terminator first
{ 
{ Updated various methods that return a Boolean to actually look at the  return
{ value of SendCmd() when setting the method Result
}
{
{   Rev 1.2    11/11/03 11:06:40 AM  RLebeau
{ Updated SendCmd() to test for a 281 response when issuing an AUTHINFO USER
{ command, as per RFC 2980
}
{
{   Rev 1.1    9/10/2003 03:19:00 AM  JPMugaas
{ Updated GetArticle(), GetBody(), and GetHeader() to use new
{ EnsureMsgIDBrackets() function in IdGlobal.  Checked in on behalf of Remy
{ Lebeau
}
{
{   Rev 1.0    2002.11.12 10:47:18 PM  czhower
}
unit IdNNTP;

interface

uses
  Classes,
  IdAssignedNumbers,
  IdException,
  IdGlobal,
  IdMessage, IdMessageClient,
  IdTCPServer, IdTCPConnection;

{
  2001-Dec - Chad Z. Hower a.k.a. Kudzu
    -Continued modifications
  2001-Oct - Chad Z. Hower a.k.a. Kudzu
    -Massive reworking to fit the Indy 9 model and update a lot of outdated code
     that was left over from Delphi 4 days. Updates now use overloaded functins. There were also
     several problems with message number accounting.
  2000-Jun-23 J. Peter Mugaas
    -GetNewGroupsList, GetNewGroupsList, and GetNewNewsList No longer require
     an Event handler if you provide a TStrings to those procedures
    -ParseXOVER was added so that you could parse XOVER data
    -ParseNewsGroup was ripped from GetNewGroupsList so that newsgroups can
     be parsed while not downloading newsgroups
    -Moved some duplicate code into a separate procedure
    -The IdNNTP now uses the Indy exceptions and IdResourceStrings to facilitate
     internationalization
  2000-Apr=28 Mark L. Holmes
    -Ported to Indy
  2000-Apr-28
    -Final Version
  1999-Dec-29 MTL
    -Moved to new Palette Scheme (Winshoes Servers)
  Ammended and modified by: AHeid, Mark Holmes
  Original Author: Chad Z. Hower a.k.a. Kudzu
}

type
  // Most users of this component should use "mtReader"
  TModeType = (mtStream, mtIHAVE, mtReader);
  TIdNNTPPermission = (crCanPost, crNoPost, crAuthRequired, crTempUnavailable);
  TModeSetResult = (mrCanStream, mrNoStream, mrCanIHAVE, mrNoIHAVE, mrCanPost, mrNoPost);
  TEventStreaming = procedure (const AMesgID: string; var AAccepted: Boolean)of object;
  TNewsTransportEvent = procedure (AMsg: TStringList) of object;
  TEventNewsgroupList = procedure(const ANewsgroup: string; const ALow, AHigh: Integer;
		const AType: string; var ACanContinue: Boolean) of object;

  TEventNewNewsList = procedure(const AMsgID: string; var ACanContinue: Boolean) of object;

  TIdNNTP = class(TIdMessageClient)
  protected
    FlMsgHigh: Integer;
    FlMsgLow: Integer;
    FlMsgCount: Integer;
    FNewsAgent: string;
    FOnNewsgroupList,
    FOnNewGroupsList: TEventNewsgroupList;
    FOnNewNewsList: TEventNewNewsList;
    FModeType: TModeType;
    FModeResult: TModeSetResult;
    FPermission: TIdNNTPPermission;
    //
    function ConvertDateTimeDist(ADate: TDateTime; AGMT: boolean;
     const ADistributions: string): string;
    procedure ProcessGroupList(const ACmd: string; const AResponse: integer;
     const AListEvent: TEventNewsgroupList);
  public
    procedure Check(AMsgIDs: TStringList; var AResponses: TStringList);
    procedure Connect(const ATimeout: Integer = IdTimeoutDefault); override;
    constructor Create(AOwner: TComponent); override;
    procedure Disconnect; override;
    function GetArticle(AMsg: TIdMessage): Boolean; overload;
    function GetArticle(const AMsgNo: Integer; AMsg: TIdMessage): Boolean; overload;
    function GetArticle(const AMsgID: string; AMsg: TIdMessage): Boolean; overload;
    function GetArticle(AMsg: TStrings): Boolean; overload;
    function GetArticle(const AMsgNo: Integer; AMsg: TStrings): Boolean; overload;
    function GetArticle(const AMsgID: string; AMsg: TStrings): Boolean; overload;
    function GetArticle(AMsg: TStream): Boolean; overload;
    function GetArticle(const AMsgNo: Integer; AMsg: TStream): Boolean; overload;
    function GetArticle(const AMsgID: string; AMsg: TStream): Boolean; overload;
    function GetBody(AMsg: TIdMessage): Boolean; overload;
    function GetBody(const AMsgNo: Integer; AMsg: TIdMessage): Boolean; overload;
    function GetBody(const AMsgID: string; AMsg: TIdMessage): Boolean; overload;
    function GetBody(AMsg: TStrings): Boolean; overload;
    function GetBody(const AMsgNo: Integer; AMsg: TStrings): Boolean; overload;
    function GetBody(const AMsgID: string; AMsg: TStrings): Boolean; overload;
    function GetBody(AMsg: TStream): Boolean; overload;
    function GetBody(const AMsgNo: Integer; AMsg: TStream): Boolean; overload;
    function GetBody(const AMsgID: string; AMsg: TStream): Boolean; overload;
    function GetHeader(AMsg: TIdMessage): Boolean; overload;
    function GetHeader(const AMsgNo: Integer; AMsg: TIdMessage): Boolean; overload;
    function GetHeader(const AMsgID: string; AMsg: TIdMessage): Boolean; overload;
    function GetHeader(AMsg: TStrings): Boolean; overload;
    function GetHeader(const AMsgNo: Integer; AMsg: TStrings): Boolean; overload;
    function GetHeader(const AMsgID: string; AMsg: TStrings): Boolean; overload;
    function GetHeader(AMsg: TStream): Boolean; overload;
    function GetHeader(const AMsgNo: Integer; AMsg: TStream): Boolean; overload;
    function GetHeader(const AMsgID: string; AMsg: TStream): Boolean; overload;
    procedure GetNewsgroupList; overload;
    procedure GetNewsgroupList(AList: TStrings); overload;
    procedure GetNewsgroupList(AStream: TStream); overload;
    procedure GetNewGroupsList(const ADate: TDateTime; const AGMT: boolean;
     const ADistributions: string); overload;
    procedure GetNewGroupsList(const ADate: TDateTime; const AGMT: boolean;
     const ADistributions: string; AList : TStrings); overload;
    procedure GetNewNewsList(const ANewsgroups: string;
      const ADate: TDateTime; const AGMT: boolean; ADistributions: string); overload;
    procedure GetNewNewsList(const ANewsgroups: string; const ADate: TDateTime;
      const AGMT: boolean; ADistributions: string; AList : TStrings); overload;
    procedure GetOverviewFMT(var AResponse: TStringList);
    procedure IHAVE(AMsg: TStringList);
    function Next: Boolean;
    function Previous: Boolean;
    procedure ParseXOVER(Aline: String; var AArticleIndex : Integer; var ASubject,
     AFrom : String; var ADate : TDateTime; var AMsgId, AReferences : String; var AByteCount,
     ALineCount : Integer; var AExtraData : String);
    procedure ParseNewsGroup(ALine : String; var ANewsGroup : String; var AHi, ALo : Integer;
     var AStatus : String);
    procedure Post(AMsg: TIdMessage); overload;
    procedure Post(AStream: TStream); overload;
    function SendCmd(const AOut: string; const AResponse: Array of SmallInt): SmallInt; override;
    function SelectArticle(const AMsgNo: Integer): Boolean;
    procedure SelectGroup(const AGroup: string);
    function TakeThis(const AMsgID: string; AMsg: TStream): string;
    procedure XHDR(const AHeader: string; const AParam: string; AResponse: TStrings);
    procedure XOVER(const AParam: string; AResponse: TStrings); overload;
    procedure XOVER(const AParam: string; AResponse: TStream); overload;
    //
    property ModeResult: TModeSetResult read FModeResult write FModeResult;
    property MsgCount: Integer read flMsgCount;
    property MsgHigh: Integer read FlMsgHigh;
    property MsgLow: Integer read FlMsgLow;
    property Permission: TIdNNTPPermission read FPermission;
  published
    property NewsAgent: string read FNewsAgent write FNewsAgent;
    property Mode: TModeType read FModeType write FModeType default mtReader;
    property Password;
    property Username;
    property OnNewsgroupList: TEventNewsgroupList read FOnNewsgroupList write FOnNewsgroupList;
    property OnNewGroupsList: TEventNewsGroupList read FOnNewGroupsList write FOnNewGroupsList;
    property OnNewNewsList: TEventNewNewsList read FOnNewNewsList write FOnNewNewsList;
    property Port default IdPORT_NNTP;
  end;

  EIdNNTPException = class(EIdException);
  EIdNNTPNoOnNewGroupsList = class(EIdNNTPException);
  EIdNNTPNoOnNewNewsList = class(EIdNNTPException);
  EIdNNTPNoOnNewsgroupList = class(EIdNNTPException);
  EIdNNTPStringListNotInitialized = class(EIdNNTPException);
  EIdNNTPConnectionRefused = class (EIdProtocolReplyError);

implementation

uses
  IdComponent,
  IdResourceStrings,
  SysUtils;

Procedure TIdNNTP.ParseXOVER(Aline : String; var AArticleIndex : Integer;
  var ASubject,
      AFrom : String;
  var ADate : TDateTime;
  var AMsgId,
      AReferences : String;
  var AByteCount,
      ALineCount : Integer;
  var AExtraData : String);

begin
  {Strip backspace and tab junk sequences which occur after a tab separator so they don't throw off any code}
  ALine := StringReplace(ALine,#9#8#9,#9,[rfReplaceAll]);
  {Article Index}
  AArticleIndex := StrToCard ( Fetch( ALine, #9 ) );
  {Subject}
  ASubject := Fetch ( ALine, #9 );
  {From}
  AFrom := Fetch ( ALine, #9 );
  {Date}
  ADate := GMTToLocalDateTime ( Fetch ( Aline, #9 ) );
  {Message ID}
  AMsgId := Fetch ( Aline, #9 );
  {References}
  AReferences := Fetch( ALine, #9);
  {Byte Count}
  AByteCount := StrToCard(Fetch(ALine,#9));
  {Line Count}
  ALineCount := StrToCard(Fetch(ALine,#9));
  {Extra data}
  AExtraData := ALine;
end;

Procedure TIdNNTP.ParseNewsGroup(ALine : String; var ANewsGroup : String;
            var AHi, ALo : Integer;
            var AStatus : String);
begin
  ANewsgroup := Fetch(ALine, ' ');
  AHi := StrToCard(Fetch(Aline, ' '));
  ALo := StrToCard(Fetch(ALine, ' '));
  AStatus := ALine;
end;

constructor TIdNNTP.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Mode := mtReader;
  Port := IdPORT_NNTP;
end;

function TIdNNTP.SendCmd(const AOut: string; const AResponse: Array of SmallInt): SmallInt;
begin
  // NOTE: Responses must be passed as arrays so that the proper inherited SendCmd is called
  // and a stack overflow is not caused.
  Result := inherited SendCmd(AOut, []);
  if (Result = 480) or (Result = 450) then begin
    // RLebeau - RFC 2980 says that if the password is not required,
    // then 281 will be returned for the username request, not 381.
    if (inherited SendCmd('AUTHINFO USER ' + Username, [281, 381]) = 381) then begin
      inherited SendCmd('AUTHINFO PASS ' + Password, 281);
    end;
    Result := inherited SendCmd(AOut, AResponse);
  end else begin
    CheckResponse(Result, AResponse);
  end;
end;

procedure TIdNNTP.Connect(const ATimeout: Integer = IdTimeoutDefault);
begin
  inherited;
  try
    GetResponse([]);
    // Here lets check to see what condition we are in after being greeted by
    // the server. The application utilizing NNTPWinshoe should check the value
    // of GreetingResult to determine if further action is warranted.

    case LastCmdResult.NumericCode of
      200: FPermission := crCanPost;
      201: FPermission := crNoPost;
      400: FPermission := crTempUnavailable;
      // This should never happen because the server should immediately close
      // the connection but just in case ....
      // Kudzu: Changed this to an exception, otherwise it produces non-standard usage by the
      // users code
      502: raise EIdNNTPConnectionRefused.CreateError(502, RSNNTPConnectionRefused);
    end;
    // here we call Setmode on the value stored in mode to make sure we can
    // use the mode we have selected
    case Mode of
      mtStream: begin
        SendCmd('MODE STREAM');
        if LastCmdResult.NumericCode <> 203 then begin
          ModeResult := mrNoStream
        end else begin
          ModeResult := mrCanStream;
        end;
      end;
      mtReader: begin
        // We should get the same info we got in the greeting
        // result but we set mode to reader anyway since the
        // server may want to do some internal reconfiguration
        // if it knows that a reader has connected
        SendCmd('MODE READER');
        if LastCmdResult.NumericCode <> 200 then begin
          ModeResult := mrNoPost;
        end else begin
          ModeResult := mrCanPost;
        end;
      end;
    end;
  except
    Disconnect;
    Raise;
  end;
end;

procedure TIdNNTP.Disconnect;
begin
  try
    if Connected then begin
      WriteLn('Quit');
    end;
  finally
    inherited;
  end;
end;

{ This procedure gets the overview format as suported by the server }
procedure TIdNNTP.GetOverviewFMT(var AResponse: TStringList);
begin
  SendCmd('LIST OVERVIEW.FMT', 215);
  Capture(AResponse);
end;

{ Send the XOVER Command.  XOVER [Range]
  Range can be of the form: Article Number i.e. 1
                            Article Number followed by a dash
                            Article Number followed by a dash and aother number
  Remember to select a group first and to issue a GetOverviewFMT so that you
  can interpret the information sent by the server corectly. }
procedure TIdNNTP.XOVER(const AParam: string; AResponse: TStrings);
begin
  SendCmd('XOVER ' + AParam, 224);
  Capture(AResponse);
end;

procedure TIdNNTP.XOVER(const AParam: string; AResponse: TStream);
begin
  SendCmd('XOVER ' + AParam, 224);
  Capture(AResponse);
end;

{ Send the XHDR Command.  XHDR Header (Range | Message-ID)
  Range can be of the form: Article Number i.e. 1
                            Article Number followed by a dash
                            Article Number followed by a dash and aother number
  Parm is either the Range or the MessageID of the articles you want. They
  are Mutually Exclusive}
procedure TIdNNTP.XHDR(const AHeader: string; const AParam: String; AResponse: TStrings);
begin
  { This method will send the XHDR command.
  The programmer is responsible for choosing the correct header. Headers
  that should always work as per RFC 1036 are:

      From
      Date
      Newsgroups
      Subject
      Message-ID