nmnntp.pas

DELPHI里面一些常用的控件

unit NMNNTP;
{$X+}
{$R-}

{$IFDEF VER100}
{$DEFINE NMF3}
{$ENDIF}
{$IFDEF VER110}
{$DEFINE NMF3}
{$ENDIF}
{$IFDEF VER120}
{$DEFINE NMF3}
{$ENDIF}
{$IFDEF VER125}
{$DEFINE NMF3}
{$ENDIF}
{$IFDEF VER130}
{$DEFINE NMF3}
{$ENDIF}
{$IFDEF VER150}
{$DEFINE NMF3}
{$ENDIF}
interface

uses
   SysUtils, Classes, Forms, Psock, NMUUE, NMExtstr, NMConst;
{$IFDEF VER110}
{$ObjExportAll On}
{$ENDIF}
{$IFDEF VER120}
{$ObjExportAll On}
{$ENDIF}
{$IFDEF VER125}
{$ObjExportAll On}
{$ENDIF}

//  CompName='TNMNNTP';
//  Major_Version='4';
//  Minor_Version='03';
//  Date_Version='020398';

const {protocol}

   Trans_None = 0 ;
   Trans_List = 1 ;

   Cons_USerCmd           = 'USER ';                                       
   Cons_PassCmd           = 'PASS ';                                       
   Cons_QuitCmd           = 'QUIT';                                        
   Cons_GrpCmd            = 'GROUP ';                                      
   Cons_GrpPost           = 'POST';                                        
   Cons_GrpArtl           = 'ARTICLE ';                                    
   Cons_GrpList           = 'LIST';                                        
   Cons_GrpHead           = 'HEAD ';                                       
   Cons_GrpBody           = 'BODY ';                                       
   Cons_HdCSubj           = 'SUBJECT:';                                    
   Cons_HdCFrom           = 'FROM:';                                       
   Cons_HdCType           = 'CONTENT-TYPE:';                               
   Cons_HdCMId            = 'MESSAGE-ID:';                                 
   Cons_HdDate            = 'DATE:';                                       
   Cons_HdLine            = 'LINES:';                                      
   Cons_HdFrom            = 'From: ';                                      
   Cons_HdSubj            = 'Subject: ';                                   
   Cons_HdRply            = 'Reply-To: ';                                  
   Cons_HdNews            = 'NewsGroups: ';                                
   Cons_HdDist            = 'Distribution: ';                              
   Cons_HdOrgz            = 'Organization: ';                              
   Cons_HdMime            = 'Mime-Version: 1.0';                           
   Cons_HdText            = 'Content-Type: text/plain, charset="us-ascii"';
   Cons_HdMult            = 'Content-Type: multipart/mixed;                                                 boundary="';
   Cons_HdApp             = 'Content-Type: application/octet-stream;                      name="';
   Cons_HdBase64          = 'Content-Transfer-Encoding: base64';           
   Cons_HdDisp            = 'Content-Disposition: attachment;                                           filename="';
   

   type
   TPostRecordType        = class(TPersistent)
      
   private
      FPostheader: TExStringList;                                          
      function GetPrFromAddress: string;
      procedure SetPrFromAddress(index: string);
      function GetPrReplyTo: string;
      procedure SetPrReplyTo(index: string);
      function GetPrSubject: string;
      procedure SetPrSubject(index: string);
      function GetPrDistribution: string;
      procedure SetPrDistribution(index: string);
      function GetPrAppName: string;
      procedure SetPrAppName(index: string);
      function GetPrTimeDate: string;
      procedure SetPrTimeDate(index: string);
      function GetNewsGroups: string;
      procedure SetNewsGroups(index: string);
      function GetArticleId: integer;
      function GetPrByteCount: integer;
      function GetPrLineCount: integer;
   published
      property PrFromAddress: string read GetPrFromAddress write SetPrFromAddress;
      property PrReplyTo: string read GetPrReplyTo write SetPrReplyTo;
      property PrSubject: string read GetPrSubject write SetPrSubject;
      property PrDistribution: string read GetPrDistribution write SetPrDistribution;
      property PrAppName: string read GetPrAppName write SetPrAppName;
      property PrTimeDate: string read GetPrTimeDate write SetPrTimeDate;
      property PrNewsGroups: string read GetNewsGroups write SetNewsGroups;
      property PrByteCount: integer read GetPrByteCount;
      property PrLineCount: integer read GetPrLineCount;
      property PrArticleId: integer read GetArticleId;
      
   end; {_ TPostRecordType        = class(TPersistent) _}
   
   TCacheMode = (cmMixed, cmRemote, cmLocal);
   NNTPError = class(Exception);
   TGroupRetrievedEvent = procedure (name: string; FirstArticle, LastArticle: integer; Posting: boolean) of object;
   TGroupRetrievedCacheEvent = procedure (var Handled: boolean; name: string; FirstArticle, LastArticle: integer; Posting: boolean) of object;
   THeaderEvent = procedure (IdNo: integer; From, Subject, MsgId, Date: string; NumberLines: integer) of object;
   THeaderCacheEvent = procedure (var Handled: boolean; IdNo: integer; From, Subject, MsgId, Date: string; ArticleNo: integer) of object;
   TVarFileNameEvent = procedure(var FileName: String) of Object;   
   
   TNMNNTP = class(TPowerSock)
   private
      FTransType: integer;
      FUserId: string; {User ID storage}
      FPassword: string; {Password storage}
      FCacheMode: TCacheMode; {Cache Mode}
      FParseAttachments: Boolean; {Automatically Parse any attachments or not}
      FPosting: Boolean; {Is Posting allowed in newsgroup}
      FSelectedGroup: string; {Currently Selected News Group}
      FLoMessage: integer; {Lowest message in Selected news group}
      FHiMessage: integer; {Highest message in Selected news group}
      FHeader: TExStringList; {The Header of a received news message}
      FHeaderRecord: TPostRecordType;
      FBody: TExStringList; {The Body of a received news message}
      FAttachments: TStringList; {The list of filenames of attachments}
      FPostHeader: TExStringList; {The Header of a received news message}
      FPostRecord: TPostRecordType;
      FPostBody: TExStringList; {The Body of a received news message}
      FPostAttachments: TStringList; {The list of filenames of attachments}
      FArticleList: TStringList;
      FAttachmentPath: string; {The directory to save attachments to}
      FGroupList: TStringList; {The List of Groups in current server}
      FNewsDir: string;
      FTransactionInProgress: boolean;
      FBoundary: string;
      FCurrentArticle: integer;
      WaitforReset: integer;
      {Event Handlers}
      FOnDecodeStart: TVarFileNameEvent;
      FOnDecodeEnd: TNotifyEvent;
      FOnConnect: TNotifyEvent;
      FOnGroupSelect: TNotifyEvent;
      FOnGroupListUpdate: TGroupRetrievedEvent;
      FOnGroupListCacheUpdate: TGroupRetrievedCacheEvent;
      FOnGroupSelectRequired: THandlerEvent;
      FOnHeaderList: TNotifyEvent;
      FOnHeaderListCacheUpdate: THandlerEvent;
      FOnHeader: TNotifyEvent;
      FOnHeaderCacheUpdate: THeaderCacheEvent;
      FOnArticle: TNotifyEvent;
      FOnArticleCacheUpdate: THeaderCacheEvent;
      FOnBody: TNotifyEvent;
      FOnBodyCacheUpdate: THandlerEvent;
      FOnAuthenticationNeeded: THandlerEvent;
      FOnAuthenticationFailed: TNotifyEvent;
      FOnAbort: TNotifyEvent;
      FOnPosted: TNotifyEvent;
      FOnPostFailed: TOnErrorEvent;
      FOnInvalidArticle: TNotifyEvent;
      procedure InternalConnect;
      procedure RetreiveArticle(HBMode: integer; Ref: integer);
      procedure RetreiveList(AGMode: integer; Ref: integer);
      procedure AbortResume(Sender: TObject);
      procedure SetAttachmentPath(Path: string);
      procedure SetNewsDir(Dir: string);
      function ReadTillDot(DestinationList: TStringList; Command: string): boolean;
      procedure ReadTillBlankLine(Ref: integer);
      procedure Readfromcache(DestinationList: TStringList; ArticleNo: integer);
      procedure ExtractAttachments;
      procedure ExtractEmbedded;
      procedure ExtractMultipart;
      procedure Decode(AStream: TStream; var TFileName: string);
      procedure SetPostAttachments(Value: TStringList);
      procedure SetPostBody(Value: TExStringList);
      procedure SetPostHeader(Value: TExStringList);
   protected
      { Protected declarations }
   public
      constructor Create(AOwner: TComponent); override;
      destructor Destroy; override;
      procedure Connect; override;
      procedure Disconnect; override;
      procedure Abort; override;
      procedure SetGroup(Group: string);
      procedure PostArticle;
      procedure GetArticle(Ref: integer);
      procedure GetArticleHeader(Ref: integer);
      procedure GetArticleBody(Ref: integer);
      procedure GetGroupList;
      procedure GetArticleList(All: boolean; ArticleNumber: integer);
      function Transaction(const CommandString: string): string; override;
      property SelectedGroup: string read FSelectedGroup;
      property LoMessage: integer read FLoMessage;
      property HiMessage: integer read FHiMessage;
      property Posting: boolean read FPosting;
      property Header: TExStringList read FHeader;
      property HeaderRecord: TPostRecordType read FHeaderRecord write FHeaderRecord;
      property Body: TExStringList read FBody;
      property Attachments: TStringList read FAttachments;
      property GroupList: TStringList read FGroupList;
      property CurrentArticle: integer read FCurrentArticle;
      
   published
      property OnPacketRecvd;
      property UserId: string read FUserId write FUserId;
      property Password: string read FPassword write FPassword;
      property CacheMode: TCacheMode read FCacheMode write FCacheMode;
      property ParseAttachments: boolean read FParseAttachments write FParseAttachments;
      property AttachFilePath: string read FAttachmentPath write SetAttachmentPath;
      property NewsDir: string read FNewsDir write SetNewsDir;
      property PostHeader: TExStringList read FPostHeader write SetPostHeader;
      property PostBody: TExStringList read FPostBody write SetPostBody;
      property PostAttachments: TStringList read FPostAttachments write SetPostAttachments;
      property PostRecord: TPostRecordType read FPostRecord write FPostRecord;
      {Events}
      property OnConnectionRequired;
      property OnConnect: TNotifyEvent read FOnConnect write FOnConnect;
      property OnGroupSelect: TNotifyEvent read FOnGroupSelect write FOnGroupSelect;
      property OnGroupListUpdate: TGroupRetrievedEvent read FOnGroupListUpdate write FOnGroupListUpdate;
      property OnGroupListCacheUpdate: TGroupRetrievedCacheEvent read FOnGroupListCacheUpdate write FOnGroupListCacheUpdate;
      property OnGroupSelectRequired: THandlerEvent read FOnGroupSelectRequired write FOnGroupSelectRequired;
      property OnHeaderList: TNotifyEvent read FOnHeaderList write FOnHeaderList;
      property OnHeaderListCacheUpdate: THandlerEvent read FOnHeaderListCacheUpdate write FOnHeaderListCacheUpdate;
      property OnHeader: TNotifyEvent read FOnHeader write FOnHeader;
      property OnHeaderCacheUpdate: THeaderCacheEvent read FOnHeaderCacheUpdate write FOnHeaderCacheUpdate;
      property OnArticle: TNotifyEvent read FOnArticle write FOnArticle;
      property OnArticleCacheUpdate: THeaderCacheEvent read FOnArticleCacheUpdate write FOnArticleCacheUpdate;
      property OnBody: TNotifyEvent read FOnBody write FOnBody;
      property OnBodyCacheUpdate: THandlerEvent read FOnBodyCacheUpdate write FOnBodyCacheUpdate;
      property OnAuthenticationNeeded: THandlerEvent read FOnAuthenticationNeeded write FOnAuthenticationNeeded;
      property OnAuthenticationFailed: TNotifyEvent read FOnAuthenticationFailed write FOnAuthenticationFailed;
      property OnAbort: TNotifyEvent read FOnAbort write FOnAbort;
      property OnPosted: TNotifyEvent read FOnPosted write FOnPosted;
      property OnPostFailed: TOnErrorEvent read FOnPostFailed write FOnPostFailed;
      property OnInvalidArticle: TNotifyEvent read FOnInvalidArticle write FOnInvalidArticle;
      property OnDecodeStart: TVarFileNameEvent read FOnDecodeStart write FOnDecodeStart;
      property OnDecodeEnd: TNotifyEvent read FOnDecodeEnd write FOnDecodeEnd;
   end; {_ TNMNNTP = class(TPowerSock) _}
   
var
   Stable: array[0..8] of string =
      ('Artid: ',
      'Subject: ',
      'From: ',
      'Date: ',
      'Message-Id: ',
      'References: ',
      'Bytecount: ',
      'Lines: ',
      'Optional-Header: '
      );

      implementation

constructor TNMNNTP.Create;
begin
   inherited Create(AOwner);
   Port := 119;
   OnAbortRestart := AbortResume;
   WaitForReset := 2;
   FPostRecord := TPostRecordType.create;
   FHeaderRecord := TPostRecordType.create;
   FHeader := TExStringList.Create;
   FBody := TExStringList.Create;
   FAttachments := TStringList.Create;
   FPostHeader := TExStringList.Create;
   FPostBody := TExStringList.Create;
   FPostAttachments := TStringList.Create;
   FGroupList := TStringList.Create;
   FArticleList := TStringList.Create;
   FPostRecord.FPostHeader := FPostHeader;
   FHeaderRecord.FPostHeader := FHeader;
   FTransType := Trans_None;
end; {_ constructor TNMNNTP.Create; _}

destructor TNMNNTP.Destroy;
begin
   inherited Destroy;
   FPostRecord.free;
   FHeaderRecord.free;
   FHeader.free;
   FBody.free;
   FAttachments.free;
   FPostHeader.free;
   FPostBody.free;
   FPostAttachments.free;
   FGroupList.free;
   FArticleList.free;
end; {_ destructor TNMNNTP.Destroy; _}

procedure TNMNNTP.Connect;
var
   Done, ConnCalled: boolean;
   
begin
   ConnCalled := FALSE;
   Done := TRUE;
   if FTransactionInProgress then ConnCalled := TRUE else FTransactionInProgress := TRUE;
   try
      InternalConnect;
      Done := TRUE;
   finally
      if not ConnCalled then FTransactionInProgress := FALSE;
      if Done then
         if assigned(OnConnect) and connected
            then OnConnect(self);
   end; {_ try _}
end; {_ procedure TNMNNTP.Connect; _}