📄 nntpcli.pas
字号:
{*_* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
Author: Fran鏾is PIETTE
Description: TNntpCli is a client for the NNTP protocol (RFC-977)
Creation: December 19, 1997
Version: 1.21
EMail: http://www.overbyte.be http://www.rtfm.be/fpiette
francois.piette@overbyte.be francois.piette@rtfm.be
Support: Use the mailing list twsocket@elists.org
Follow "support" link at http://www.overbyte.be for subscription.
Legal issues: Copyright (C) 1997-2005 by Fran鏾is PIETTE
Rue de Grady 24, 4053 Embourg, Belgium. Fax: +32-4-365.74.56
<francois.piette@overbyte.be>
This software is provided 'as-is', without any express or
implied warranty. In no event will the author be held liable
for any damages arising from the use of this software.
Permission is granted to anyone to use this software for any
purpose, including commercial applications, and to alter it
and redistribute it freely, subject to the following
restrictions:
1. The origin of this software must not be misrepresented,
you must not claim that you wrote the original software.
If you use this software in a product, an acknowledgment
in the product documentation would be appreciated but is
not required.
2. Altered source versions must be plainly marked as such, and
must not be misrepresented as being the original software.
3. This notice may not be removed or altered from any source
distribution.
4. You must register this software by sending a picture postcard
to the author. Use a nice stamp and mention your name, street
address, EMail address and any comment you like to say.
Updates:
Dec 30, 1997 V0.91 Bug: StatusCode was not updated for Connect
Added PostingPermited property and ParseListLine procedure as
suggested by J. Peter Mugaas <oma00215@mail.wvnet.edu>
Dec 31, 1997 V0.92 Added XOVER, LIST OVERVIEW.FMT and DATE commands
Jan 10, 1998 V0.93 Added OnStateChange event as suggested by J. Peter Mugaas
<oma00215@mail.wvnet.edu>
Jan 13, 1998 V0.94 Added readonly property State
Feb 02, 1998 V0.95 Corrected a message in the Quit method.
Added the NntpCliVersion constant.
Feb 03, 1998 V0.96 Added Authenticate method, UserName and PassWord properties.
Apr 13, 1998 V1.00 Added an intermediate message for OnRequestDone event
Created the Handle property and related WndProc stuff
Apr 21, 1998 V1.01 Corrected buffer overflow in the OnDataAvailable event.
Thanks to Tim Skinner tim@palacecs.demon.co.uk who found that bug.
Sep 29, 1998 V1.02 Checked length of FLastResponse before writing it to stream.
Thanks to Michael Bartos <MBartos@ExpoMedia.de> for the hint.
Feb 01, 1999 V1.03 Added nntpConnect to solve connection problem after an
abort. Thanks to Eric Fortier <efortier@videotron.ca>.
Feb 27, 1999 V1.04 Made Connect, Abort and Quit method virtual so that they
can be overriden in descending components.
Checked line length in ParseListLine.
Mar 31, 1999 V1.05 Made all methods virtual.
Aug 14, 1999 V1.06 Implemented MODE READER and XHDR
Aug 20, 1999 V1.07 Revised conditional compilation, adapted for BCB4, set
compile options same as TWSocket.
Jun 18, 2001 V1.08 Use AllocateHWnd and DeallocateHWnd from wsocket.
Renamed property WSocket to CtrlSocket (this require code change
in user application too).
Sep 28, 2002 V1.09 Arnaud SUBTIL <arnaud_courrier@yahoo.fr> changed
WSocketDataAvailable so that it doesn't fail when a line is
longer than the receive buffer.
Oct 26, 2002 V1.10 Fixed double dot problem in GetArticleLineNext.
Thanks to Steve Blinch <steve@blitzaffe.com> who found it.
Use TWSocket LineMode to avoid line length limit.
Introduced LineLimit to allow user to limit max line (accepting
unlimited lines can result in a Denial Of Service security hole.
Nov 02, 2002 V1.11 Added OnSendData event, OnRcvdData event, SendCount property
and RcvdCount property to easy progress bar update.
Nov 11, 2002 V1.12 Revised for Delphi 1
Nov 23, 2002 V1.13 Added a port property to allow use of something else than
NNTP port.
Nov 27, 2002 V1.14 Changed NntpCliVersion to an integer.
Apr 22, 2003 V1.15 Christophe Thiaux <tophet@free.fr> added Port property.
Jul 20, 2003 V1.16 arnaud.mesnews@free.fr added ListNewsgroups and made
a few functions cirtuals so that inheritance is easier.
Jan 11, 2004 V1.17 "Piotr Hellrayzer Dalek" <enigmatical@interia.pl> added
XPAT and ListMOTD features.
May 31, 2004 V1.18 Used ICSDEFS.INC
Jul 24, 2004 V1.19 Arnaud.mesnews@free.fr added GroupName property and related
code.
Jan 01, 2005 V1.20 In WSocketDataAvailable, check for length > 0 before
calling OnDisplay. By Stephan Klimek <Stephan.Klimek@gmx.de>.
Mar 11, 2005 V1.21 Marco van de Voort <marcov@stack.nl> updated the component
to be compatible with NOFORMS concept.
He implemented NNTPCliAllocateHWnd and NNTPCliDeallocateHWnd
based on TWSocket versions.
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
unit NntpCli;
{.DEFINE DUMP}
interface
{$Q-} { Disable overflow checking }
{$B-} { Enable partial boolean evaluation }
{$T-} { Untyped pointers }
{$X+} { Enable extended syntax }
{$I ICSDEFS.INC}
{$IFDEF DELPHI6_UP}
{$WARN SYMBOL_PLATFORM OFF}
{$WARN SYMBOL_LIBRARY OFF}
{$WARN SYMBOL_DEPRECATED OFF}
{$ENDIF}
{$IFNDEF VER80} { Not for Delphi 1 }
{$H+} { Use long strings }
{$J+} { Allow typed constant to be modified }
{$ENDIF}
{$IFDEF BCB3_UP}
{$ObjExportAll On}
{$ENDIF}
uses
Messages,
{$IFDEF USEWINDOWS}
Windows,
{$ELSE}
WinTypes, WinProcs,
{$ENDIF}
SysUtils, Classes,
{$IFNDEF NOFORMS}
Forms,
{$ENDIF}
WinSock, WSocket, MimeUtil;
const
NntpCliVersion = 121;
CopyRight : String = ' TNntpCli (c) 1997-2005 F. Piette V1.21 ';
{$IFDEF VER80}
{ Delphi 1 has a 255 characters string limitation }
NNTP_SND_BUF_SIZE = 255;
{$ELSE}
NNTP_SND_BUF_SIZE = 4096;
{$ENDIF}
WM_NNTP_REQUEST_DONE = WM_USER + 1;
type
TNntpContentType = (nntpHtml, nntpPlainText);
TNntpMimeState = (nntpMimeHeader, nntpMimeIntro,
nntpMimePlainText, nntpMimeHtmlText,
nntpMimeImages, nntpMimeDone);
TNntpShareMode = (nntpShareCompat, nntpShareExclusive,
nntpShareDenyWrite, nntpShareDenyRead,
nntpShareDenyNone);
TNntpDisplay = procedure(Sender : TObject;
MsgBuf : Pointer;
MsgLen : Integer) of object;
TNntpState = (nntpNotConnected, nntpDnsLookup, nntpWaitingBanner,
nntpReady, nntpWaitingResponse);
TNntpRequest = (nntpGroup, nntpList, nntpConnect,
nntpPost, nntpHelp,
nntpNewGroups, nntpNewNews,
nntpArticleByNumber, nntpArticleByID,
nntpBodyByID, nntpBodyByNumber,
nntpHeadByID, nntpHeadByNumber,
nntpStatByID, nntpStatByNumber,
nntpNext, nntpLast,
nntpQuit, nntpAbort,
nntpXOver, nntpListOverViewFmt,
nntpDate, nntpAuthenticate,
nntpModeReader, nntpXHdr,
nntpListNewsgroups, {AS}
nntpXPAT, nntpListMotd); {HLX}
TRequestDone = procedure(Sender: TObject;
RqType: TNntpRequest; ErrCode: Word) of object;
NntpException = class(Exception);
TNntpCli = class(TComponent)
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function NNTPCliAllocateHWnd(Method: TWndMethod) : HWND;
procedure NNTPCliDeallocateHWnd(WHandle : Cardinal);
procedure Connect; virtual;
procedure Abort; virtual;
procedure Quit; virtual;
procedure Group(NewsGroupName : String); virtual;
procedure ArticleByNumber(Number : Integer; DestStream : TStream); virtual;
procedure ArticleByID(ID : String; DestStream : TStream); virtual;
procedure HeadByNumber(Number : Integer; DestStream : TStream); virtual;
procedure HeadByID(ID : String; DestStream : TStream); virtual;
procedure BodyByNumber(Number : Integer; DestStream : TStream); virtual;
procedure BodyByID(ID : String; DestStream : TStream); virtual;
procedure StatByNumber(Number : Integer); virtual;
procedure StatByID(ID : String); virtual;
procedure Next; virtual;
procedure Last; virtual; { It is really Prior, but RFC-977 call it Last !}
procedure List(DestStream : TStream); virtual;
procedure ListNewsgroups(DestStream : TStream;
chFiltre : String); {AS}
procedure Post(FromStream : TStream); virtual;
procedure Help(DestStream : TStream); virtual;
procedure Authenticate; virtual;
procedure XOver(Articles : String; DestStream : TStream); virtual;
procedure ListOverViewFmt(DestStream : TStream); virtual;
procedure ListMotd(DestStream : TStream); virtual; {HLX}
procedure Date; virtual;
procedure ModeReader; virtual;
procedure XHdr(DestStream : TStream;
Header : String;
Range : String); virtual;
procedure XPat(DestStream : TStream;
Header, Range, FindStr: String); virtual; {HLX}
procedure NewGroups(When : TDateTime;
GMTFLag : Boolean;
Distributions : String;
DestStream : TStream); virtual;
procedure NewNews(When : TDateTime;
GMTFLag : Boolean;
NewsGroupName : String;
Distributions : String;
DestStream : TStream); virtual;
protected
FWindowHandle : HWND;
{$IFDEF DUMP}
FDumpStream : TFileStream;
FDumpBuf : String;
{$ENDIF}
FHost : String;
FPort : String;
FState : TNntpState;
FWSocket : TWSocket;
FRequest : String;
FRequestType : TNntpRequest;
FRequestDoneFlag : Boolean;
FSentFlag : Boolean;
FStatusCode : Integer;
FSendCount : Integer; { Count sent bytes }
FRcvdCount : Integer; { Count received bytes }
FSendBuffer : array [0..NNTP_SND_BUF_SIZE - 1] of Char;
FLastResponse : String;
FLastCmdResponse : String;
FErrorMessage : String;
FArticleEstimated : Integer;
FArticleFirst : Integer;
FArticleLast : Integer;
FArticleNumber : Integer;
FArticleID : String;
FServerDate : TDateTime;
FDataStream : TStream;
FUserName : String;
FPassWord : String;
FLineLimit : Integer;
FNext : procedure of object;
FPostingPermited : Boolean;
FOnSessionConnected : TSessionConnected;
FOnSessionClosed : TSessionClosed;
FOnDataAvailable : TDataAvailable;
FOnRequestDone : TRequestDone;
FOnDisplay : TNntpDisplay;
FOnMessageBegin : TNotifyEvent;
FOnMessageEnd : TNotifyEvent;
FOnMessageLine : TNotifyEvent;
FOnXHdrBegin : TNotifyEvent;
FOnXHdrEnd : TNotifyEvent;
FOnXHdrLine : TNotifyEvent;
FOnStateChange : TNotifyEvent;
FOnSendData : TNotifyEvent;
FOnRcvdData : TNotifyEvent;
FGroupName : String;
procedure SetLineLimit(NewValue : Integer);
procedure WndProc(var MsgRec: TMessage); virtual;
procedure WMNntpRequestDone(var msg: TMessage); message WM_NNTP_REQUEST_DONE;
procedure WSocketDnsLookupDone(Sender: TObject; ErrCode: Word);
procedure WSocketSessionConnected(Sender: TObject; ErrCode: Word);
procedure WSocketDataAvailable(Sender: TObject; ErrCode: Word);
procedure WSocketSessionClosed(Sender: TObject; ErrCode: Word); virtual;
procedure WSocketDataSent(Sender: TObject; ErrCode: Word);
procedure DelayedRequestDone(ErrCode: Word); virtual;
procedure TriggerStateChange; virtual;
procedure TriggerRequestDone(Request: TNntpRequest; ErrCode: Word); virtual;
procedure StateChange(NewState : TNntpState); virtual;
procedure SendRequest; virtual;
procedure GroupNext; virtual;
procedure QuitNext; virtual;
procedure XHdrLineNext; virtual;
procedure GetArticleNext; virtual;
procedure GetArticleLineNext; virtual;
procedure GetArticleByNumber(RqType: TNntpRequest; Number : Integer; DestStream : TStream); virtual;
procedure GetArticleByID(RqType: TNntpRequest; ID : String; DestStream : TStream); virtual;
procedure GetArticle(RqType: TNntpRequest; ID : String; DestStream : TStream); virtual;
procedure PostNext; virtual;
procedure PostDone; virtual;
procedure PostBlock; virtual;
procedure PostSendNext; virtual;
procedure DateNext; virtual;
procedure ModeReaderNext; virtual;
procedure XHdrNext; virtual;
procedure AuthenticateNext1; virtual;
procedure AuthenticateNext2; virtual;
procedure TriggerSendData; virtual;
procedure TriggerRcvdData; virtual;
property Handle : HWND read FWindowHandle;
property SendCount : Integer read FSendCount
write FSendCount;
property RcvdCount : Integer read FRcvdCount
write FRcvdCount;
procedure TriggerSessionConnected(ErrCode: Word); virtual;
procedure TriggerMessageLine; virtual;
published
property CtrlSocket : TWSocket read FWSocket;
property State : TNntpState read FState;
property Host : String read FHost
write FHost;
property ErrorMessage : String read FErrorMessage;
property LastResponse : String read FLastResponse;
property StatusCode : Integer read FStatusCode;
property PostingPermited : Boolean read FPostingPermited;
property ArticleEstimated : Integer read FArticleEstimated;
property ArticleFirst : Integer read FArticleFirst;
property ArticleLast : Integer read FArticleLast;
property ArticleNumber : Integer read FArticleNumber;
property ArticleID : String read FArticleID;
property ServerDate : TDateTime read FServerDate;
property UserName : String read FUserName
write FUserName;
property PassWord : String read FPassWord
write FPassWord;
property Port : String read FPort
write FPort;
property LineLimit : Integer read FLineLimit
write SetLineLimit;
property GroupName : String read FGroupName;
property OnSessionConnected : TSessionConnected read FOnSessionConnected
write FOnSessionConnected;
property OnSessionClosed : TSessionClosed read FOnSessionClosed
write FOnSessionClosed;
property OnDataAvailable : TDataAvailable read FOnDataAvailable
write FOnDataAvailable;
property OnRequestDone : TRequestDone read FOnRequestDone
write FOnRequestDone;
property OnDisplay : TNntpDisplay read FOnDisplay
write FOnDisplay;
property OnMessageBegin : TNotifyEvent read FOnMessageBegin
write FOnMessageBegin;
property OnMessageEnd : TNotifyEvent read FOnMessageEnd
write FOnMessageEnd;
property OnMessageLine : TNotifyEvent read FOnMessageLine
write FOnMessageLine;
property OnXHdrBegin : TNotifyEvent read FOnXHdrBegin
write FOnXHdrBegin;
property OnXHdrEnd : TNotifyEvent read FOnXHdrEnd
write FOnXHdrEnd;
property OnXHdrLine : TNotifyEvent read FOnXHdrLine
write FOnXHdrLine;
property OnStateChange : TNotifyEvent read FOnStateChange
write FOnStateChange;
{ Event intended for progress bar update (send) }
property OnSendData : TNotifyEvent read FOnSendData
write FOnSendData;
{ Event intended for progress bar update (receive) }
property OnRcvdData : TNotifyEvent read FOnRcvdData
write FOnRcvdData;
end;
THtmlNntpCli = class(TNntpCli)
protected
FPlainText : TStrings;
FHtmlText : TStrings;
FAttachedFiles : TStrings; { File names for attachment }
FOutsideBoundary : String;
FInsideBoundary : String;
FMimeState : TNntpMimeState;
FHtmlCharSet : String;
FLineNumber : Integer;
FLineOffset : Integer;
FImageNumber : Integer;
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -