idnntp.pas

photo.163.com 相册下载器 多线程下载

{ $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:  11691: IdNNTP.pas
{
{   Rev 1.27    10/26/2004 10:33:46 PM  JPMugaas
{ Updated refs.
}
{
{   Rev 1.26    2004.05.20 11:37:02 AM  czhower
{ IdStreamVCL
}
{
{   Rev 1.25    16/05/2004 14:30:42  CCostelloe
{ ReceiveHeader checks added in case message has no body
}
{
{   Rev 1.24    3/7/2004 11:21:50 PM  JPMugaas
{ Compiler warnings.
}
{
{   Rev 1.23    2004.03.06 1:31:46 PM  czhower
{ To match Disconnect changes to core.
}
{
{   Rev 1.22    2004.02.03 5:44:10 PM  czhower
{ Name changes
}
{
{   Rev 1.21    2004.01.28 9:36:32 PM  czhower
{ Fixed search and replace error
}
{
{   Rev 1.20    2004.01.27 1:13:36 PM  czhower
{ T --> TId
{ var --> out
}
{
{   Rev 1.19    1/26/2004 1:16:46 PM  JPMugaas
{ SSL Reenabled.
}
{
{   Rev 1.18    2004.01.22 9:28:44 PM  czhower
{ DotNetExclude for TLS.
}
{
{   Rev 1.17    1/21/2004 3:26:50 PM  JPMugaas
{ InitComponent
}
{
{   Rev 1.16    1/5/2004 8:22:18 PM  JMJacobson
{ Updated TIdNNTP.GetCapability to handle empty LIST EXTENSIONS response
{ (response 215)
}
{
{   Rev 1.15    11/11/03 11:06:18 AM  RLebeau
{ Updated SendCmd() to test for a 281 response when issuing an AUTHINFO USER
{ command, as per RFC 2980
}
{
{   Rev 1.14    2003.10.24 10:33:22 AM  czhower
{ Saved first this time.
}
{
    Rev 1.12    10/19/2003 5:31:52 PM  DSiders
  Added localization comments.
}
{
{   Rev 1.11    2003.10.14 9:57:16 PM  czhower
{ Compile todos
}
{
{   Rev 1.10    2003.10.12 4:04:00 PM  czhower
{ compile todos
}
{
{   Rev 1.9    9/10/2003 03:26:12 AM  JPMugaas
{ Updated GetArticle(), GetBody(), and GetHeader() to use new
{ EnsureMsgIDBrackets() function in IdGlobal.  Checked in on behalf of Remy
{ Lebeau
}
{
{   Rev 1.8    6/9/2003 05:14:58 AM  JPMugaas
{ Fixed crical error.
{ Supports HDR and OVER commands defined in
{ http://www.ietf.org/internet-drafts/draft-ietf-nntpext-base-18.txt if feature
{ negotiation indicates that they are supported.
{ Added XHDR data parsing routine.
{ Added events for when we receive a line of data with XOVER or XHDR as per
{ John Jacobson's request.
}
{
{   Rev 1.7    6/9/2003 01:09:40 AM  JPMugaas
{ Host wasn't published when it should have been published.
}
{
{   Rev 1.6    6/5/2003 04:54:00 AM  JPMugaas
{ Reworkings and minor changes for new Reply exception framework.
}
{
{   Rev 1.5    5/8/2003 11:28:06 AM  JPMugaas
{ Moved feature negoation properties down to the ExplicitTLSClient level as
{ feature negotiation goes hand in hand with explicit TLS support.
}
{
{   Rev 1.4    4/5/2003 02:06:20 PM  JPMugaas
{ TLS handshake itself can now be handled.
}
{
{   Rev 1.3    3/27/2003 05:46:36 AM  JPMugaas
{ Updated framework with an event if the TLS negotiation command fails.
{ Cleaned up some duplicate code in the clients.
}
{
{   Rev 1.2    3/26/2003 04:18:22 PM  JPMugaas
{ Now supports implicit and explicit TLS.
}
{
{   Rev 1.1    2/24/2003 09:25:16 PM  JPMugaas
}
{
{   Rev 1.0    11/13/2002 07:57:52 AM  JPMugaas
}
unit IdNNTP;

interface

uses
  Classes,
  IdAssignedNumbers, IdExplicitTLSClientServerBase, IdException, IdStreamVCL,
  IdMessage, IdMessageClient, IdReplyRFC,
  IdTCPServer, IdTCPConnection, IdTStrings;

{
  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"
  TIdModeType = (mtStream, mtIHAVE, mtReader);
  TIdNNTPPermission = (crCanPost, crNoPost, crAuthRequired, crTempUnavailable);
  TIdModeSetResult = (mrCanStream, mrNoStream, mrCanIHAVE, mrNoIHAVE, mrCanPost, mrNoPost);
  TIdEventStreaming = procedure (AMesgID: string; var AAccepted: Boolean)of object;
  TIdNewsTransporTIdEvent = procedure (AMsg: TIdStringList) of object;
   //AMsg can be an index number or a message ID depending upon the parameters of XHDR
  TIdEvenTIdNewsgroupList = procedure(ANewsgroup: string; ALow, AHigh: Integer;
   AType: string; var ACanContinue: Boolean) of object;
  TIdEventXOVER = procedure(AArticleIndex : Integer; ASubject,
     AFrom : String; ADate : TDateTime; AMsgId, AReferences : String; AByteCount,
     ALineCount : Integer; AExtraData : String; var VCanContinue : Boolean) of object;
  TIdEventNewNewsList = procedure(AMsgID: string; var ACanContinue: Boolean) of object;
  TIdEventXHDREntry = procedure(AHeader : String; AMsg, AHeaderData : String; var ACanContinue: Boolean) of object;
  //TODO: Add a TranslateRFC822 Marker - probably need to do it in TCPConnection and modify Capture
  // Better yet, make capture an object
  TIdNNTP = class(TIdMessageClient)
  protected
    FlMsgHigh: Integer;
    FlMsgLow: Integer;
    FlMsgCount: Integer;
    FNewsAgent: string;
    FOnNewsgroupList,
    FOnNewGroupsList: TIdEvenTIdNewsgroupList;
    FOnNewNewsList: TIdEventNewNewsList;
    FOnXHDREntry : TIdEventXHDREntry;
    FOnXOVER : TIdEventXOVER;
    FModeType: TIdModeType;
    FModeResult: TIdModeSetResult;
    FPermission: TIdNNTPPermission;

    FHDRSupported : Boolean;
    FOVERSupported : Boolean;

    //
    procedure AfterConnect;
    procedure GetCapability;
    function ConvertDateTimeDist(ADate: TDateTime; AGMT: boolean;
     ADistributions: string): string;
    function GetSupportsTLS : boolean; override;
    procedure InitComponent; override;
    procedure ProcessGroupList(ACmd: string; AResponse: integer;
     ALisTIdEvent: TIdEvenTIdNewsgroupList);
    procedure XHDRCommon(AHeader, AParam : String);
    procedure XOVERCommon(AParam : String);
    procedure StartTLS;
  public
    procedure Check(AMsgIDs: TIdStringList; var AResponses: TIdStringList);
    procedure Connect; override;
    destructor Destroy; override;
    procedure DisconnectNotifyPeer; override;
    function GetArticle(AMsg: TIdMessage): Boolean; overload;
    function GetArticle(AMsgNo: Integer; AMsg: TIdMessage): Boolean; overload;
    function GetArticle(AMsgID: string; AMsg: TIdMessage): Boolean; overload;
    function GetArticle(AMsg: TIdStrings): Boolean; overload;
    function GetArticle(AMsgNo: Integer; AMsg: TIdStrings): Boolean; overload;
    function GetArticle(AMsgID: string; AMsg: TIdStrings): Boolean; overload;
    function GetArticle(AMsg: TStream): Boolean; overload;
    function GetArticle(AMsgNo: Integer; AMsg: TStream): Boolean; overload;
    function GetArticle(AMsgID: string; AMsg: TStream): Boolean; overload;
    function GetBody(AMsg: TIdMessage): Boolean; overload;
    function GetBody(AMsgNo: Integer; AMsg: TIdMessage): Boolean; overload;
    function GetBody(AMsgID: string; AMsg: TIdMessage): Boolean; overload;
    function GetBody(AMsg: TIdStrings): Boolean; overload;
    function GetBody(AMsgNo: Integer; AMsg: TIdStrings): Boolean; overload;
    function GetBody(AMsgID: string; AMsg: TIdStrings): Boolean; overload;
    function GetBody(AMsg: TStream): Boolean; overload;
    function GetBody(AMsgNo: Integer; AMsg: TStream): Boolean; overload;
    function GetBody(AMsgID: string; AMsg: TStream): Boolean; overload;
    function GetHeader(AMsg: TIdMessage): Boolean; overload;
    function GetHeader(AMsgNo: Integer; AMsg: TIdMessage): Boolean; overload;
    function GetHeader(AMsgID: string; AMsg: TIdMessage): Boolean; overload;
    function GetHeader(AMsg: TIdStrings): Boolean; overload;
    function GetHeader(AMsgNo: Integer; AMsg: TIdStrings): Boolean; overload;
    function GetHeader(AMsgID: string; AMsg: TIdStrings): Boolean; overload;
    function GetHeader(AMsg: TStream): Boolean; overload;
    function GetHeader(AMsgNo: Integer; AMsg: TStream): Boolean; overload;
    function GetHeader(AMsgID: string; AMsg: TStream): Boolean; overload;
    procedure GetNewsgroupList; overload;
    procedure GetNewsgroupList(AList: TIdStrings); overload;
    procedure GetNewsgroupList(AStream: TStream); overload;
    procedure GetNewGroupsList(ADate: TDateTime; AGMT: boolean;
     ADistributions: string); overload;
    procedure GetNewGroupsList(ADate: TDateTime; AGMT: boolean;
     ADistributions: string; AList : TIdStrings); overload;
    procedure GetNewNewsList(ANewsgroups: string;
      ADate: TDateTime; AGMT: boolean; ADistributions: string); overload;
    procedure GetNewNewsList(ANewsgroups: string; ADate: TDateTime;
      AGMT: boolean; ADistributions: string; AList : TIdStrings); overload;
    procedure GetOverviewFMT(AResponse: TIdStringList);
    function IsExtCmdSupported(AExtension : String) : Boolean;
    procedure IHAVE(AMsg: TIdStringList);
    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; out ANewsGroup: string; out AHi, ALo : Integer;
     out AStatus : String);
    procedure ParseXHDRLine(ALine : String; out AMsg : String; out AHeaderData : String);
    procedure Post(AMsg: TIdMessage); overload;
    procedure Post(AStream: TIdStreamVCL); overload;
    function SendCmd(AOut: string; const AResponse: array of SmallInt): SmallInt; override;
    function SelectArticle(AMsgNo: Integer): Boolean;
    procedure SelectGroup(AGroup: string);
    function TakeThis(AMsgID: string; AMsg: TIdStreamVCL): string;
    procedure XHDR(AHeader: string; AParam: string; AResponse: TIdStrings); overload;
    procedure XHDR(AHeader: string; AParam: string); overload;
    procedure XOVER(AParam: string; AResponse: TIdStrings); overload;
    procedure XOVER(AParam: string; AResponse: TStream); overload;
    procedure XOVER(AParam: string); overload;
    //
    property ModeResult: TIdModeSetResult 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: TIdModeType read FModeType write FModeType default mtReader;
    property Password;
    property Username;
    property OnNewsgroupList: TIdEvenTIdNewsgroupList read FOnNewsgroupList write FOnNewsgroupList;
    property OnNewGroupsList: TIdEvenTIdNewsGroupList read FOnNewGroupsList write FOnNewGroupsList;
    property OnNewNewsList: TIdEventNewNewsList read FOnNewNewsList write FOnNewNewsList;
    property OnXHDREntry : TIdEventXHDREntry read FOnXHDREntry write FOnXHDREntry;
    property OnXOVER : TIdEventXOVER read FOnXOVER write FOnXOVER;
    property OnTLSNotAvailable;
    property Port default IdPORT_NNTP;
    property Host;
    property UseTLS;
  end;

  EIdNNTPException = class(EIdException);
  EIdNNTPNoOnNewGroupsList = class(EIdNNTPException);
  EIdNNTPNoOnNewNewsList = class(EIdNNTPException);
  EIdNNTPNoOnNewsgroupList = class(EIdNNTPException);
  EIdNNTPNoOnXHDREntry = class(EIdNNTPException);
  EIdNNTPNoOnXOVER = class(EIdNNTPException);
  EIdNNTPStringListNotInitialized = class(EIdNNTPException);

  EIdNNTPConnectionRefused = class (EIdReplyRFCError);

implementation

uses
  IdComponent,
  IdGlobal,
  IdGlobalProtocols,
  IdResourceStringsProtocols,
  IdSSL,
  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}