📄 pop3prot.pas
字号:
{*_* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
Author: Fran鏾is PIETTE
Object: TPop3Cli class implements the POP3 protocol
(RFC-1225, RFC-1939)
Creation: 03 october 1997
Version: 2.15
EMail: http://www.overbyte.be francois.piette@overbyte.be
http://www.rtfm.be/fpiette francois.piette@rtfm.be
francois.piette@pophost.eunet.be
Support: Use the mailing list twsocket@elists.org
Follow "support" link at http://www.overbyte.be for subscription.
Legal issues: Copyright (C) 1997-2002 by Fran鏾is PIETTE
Rue de Grady 24, 4053 Embourg, Belgium. Fax: +32-4-365.74.56
<francois.piette@overbyte.be> <francois.piette@pophost.eunet.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:
Sept 09, 1997 Modified TOP to be able to request 0 lines (bug reported by
damien@jetman.demon.co.uk)
Oct 10, 1997 V1.10. Published ProtocolState property, made TOP command
complies with RFC-1939 as suggested by damien@jetman.demon.co.uk
Implemented the UIDL command.
Oct 11, 1997 V1.11 Implemented the APOP command, but not tested because no
server available to test it.
Made internal error message look like POP3 error messages (-ERR)
Oct 28, 1997 V1.12 Modified TWSocket to handle line buffer overflow and
TPop3Client to handle that in GetMultiLine.
Jan 10, 1998 V1.13 Made FWSocket accessible with a read only property. This
eases DNSLookup without a supplementary TWSocket.
Added a Port property.
Apr 01, 1998 V1.14 Adapted for BCB V3
May 05, 1998 V1.15 Changed GetMultiLine to correctly handle double dots at
line start.
Jun 01, 1998 V1.16 Ben Robinson <zeppelin@wwa.com> found that Last did'nt
update MsgNum and MsgSize.
Aug 05, 1998 V2.00 New asynchronous version.
Sep 19, 1998 V2.01 Corrected WSocketDataAvailable to count for the added
nul byte at the end of buffer.
Nov 28, 1998 V2.02 Corrected exception triggered using highlevel function
when connection or DNS lookup failed (for example using Open).
Dec 03, 1998 V2.03 Added SetErrorMessage in WSocketSessionConnected.
Dec 22, 1998 V2.04 Handle exception when connecting (will be triggered when
an invalid port has been given).
Feb 27, 1999 V2.05 Adde State property.
Mar 07, 1999 V2.06 Made public property Connected.
Aug 20, 1999 V2.07 Revised conditional compilation, adapted for BCB4, set
compile options same as TWSocket.
Dec 26, 1999 V2.08 Makes OnRequestDone properly called after a QUIT command.
Special thanks to roger.morton@dial.pipex.com for his work
about that problem.
Jul 22, 2000 V2.09 Checked for buffer overflow in WSocketDataAvailable
as suggested by Jeroen Stolting <stolting.em@ilco.nl>
Nov 11, 2000 V2.10 Made ClearErrorMessage public. Cleared ErrorMessage when
connecting. Thanks to Jeroen Nijk <Nijk.em@ilco.nl> for pointing
to problem.
Nov 25, 2000 V2.11 Converted MD5 digest to lower case before sending to the
server. Thanks to Poessler Thomas <Thomas.Poessler@uta.at> who
found the problem and fix.
Jul 30, 2001 V2.12 Jake Traynham <jake@comm-unity.net> found a problem in
end of line logic in WSocketDataAvailable when random CR are
inside a message line. Changed logic to take only CRLF pair as
end of line.
Aug 18, 2001 V2.13 Angus Robertson <angus@magsys.co.uk> found a problem when
using the RetrSync and TopSync methods that it's not possible to
retrieve a body that takes longer than the timeout in
WaitUntilReady. Timeout has to be reevaluated in TriggerResponse.
Sep 09, 2001 V2.14 Beat Boegli <leeloo999@bluewin.ch> added LocalAddr property
for multihomed hosts.
Jul 06, 2002 V2.15 Added header decoding for RETR command. Added corresponding
properties such as HeaderFrom, HeaderTo, HeaderSubject,...
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
unit Pop3Prot;
interface
{$B-} { Enable partial boolean evaluation }
{$T-} { Untyped pointers }
{$X+} { Enable extended syntax }
{$IFNDEF VER80} { Not for Delphi 1 }
{$H+} { Use long strings }
{$J+} { Allow typed constant to be modified }
{$ENDIF}
{$IFDEF VER110} { C++ Builder V3.0 }
{$ObjExportAll On}
{$ENDIF}
{$IFDEF VER125} { C++ Builder V4.0 }
{$ObjExportAll On}
{$ENDIF}
uses
WinTypes, WinProcs, SysUtils, Messages, Classes, Graphics, Controls,
Forms, Dialogs, Menus, WSocket, WinSock, MD5;
const
Pop3CliVersion = 215;
CopyRight : String = ' POP3 component (c) 1997-2002 F. Piette V2.15 ';
{$IFDEF VER80}
{ Delphi 1 has a 255 characters string limitation }
POP3_RCV_BUF_SIZE = 255;
{$ELSE}
POP3_RCV_BUF_SIZE = 4096;
{$ENDIF}
WM_POP3_REQUEST_DONE = WM_USER + 1;
type
Pop3Exception = class(Exception);
TPop3Display = procedure(Sender: TObject; Msg : String) of object;
TPop3ProtocolState = (pop3Disconnected, pop3WaitingUser,
pop3WaitingPass, pop3Transaction);
TPop3State = (pop3Ready, pop3DnsLookup, pop3Connecting,
pop3Connected, pop3InternalReady,
pop3WaitingBanner, pop3WaitingResponse, pop3Abort);
TPop3Request = (pop3Connect, pop3User, pop3Pass, pop3RPop, pop3Quit,
pop3Stat, pop3List, pop3Retr, pop3Top, pop3Dele,
pop3Noop, pop3Last, pop3RSet, pop3Uidl, pop3APop,
pop3Open, pop3Custom);
TPop3Fct = (pop3FctNone, pop3FctConnect, pop3FctUser, pop3FctPass,
pop3FctRPop, pop3FctQuit, pop3FctAPop, pop3FctStat,
pop3FctList, pop3FctUidl, pop3FctRetr, pop3FctTop,
pop3FctDele, pop3FctNoop, pop3FctRSet, pop3FctLast);
TPop3FctSet = set of TPop3Fct;
TPop3NextProc = procedure of object;
TPop3RequestDone = procedure(Sender : TObject;
RqType : TPop3Request;
Error : Word) of object;
TPop3Method = function : boolean of object;
TCustomPop3Cli = class(TComponent)
private
FWSocket : TWSocket;
FWindowHandle : HWND;
FState : TPop3State;
FNextProtocolState : TPop3ProtocolState;
FProtocolState : TPop3ProtocolState;
FConnected : Boolean;
FRequestType : TPop3Request;
FRequestDoneFlag : Boolean;
FReceiveLen : Integer;
FRequestResult : Integer;
FStatusCode : Integer;
FReceiveBuffer : array [0..POP3_RCV_BUF_SIZE - 1] of char;
FNext : TPop3NextProc;
FWhenConnected : TPop3NextProc;
FFctSet : TPop3FctSet;
FFctPrv : TPop3Fct;
FHighLevelResult : Integer;
FHighLevelFlag : Boolean;
FNextRequest : TPop3NextProc;
FLastResponseSave : String;
FStatusCodeSave : Integer;
FRestartFlag : Boolean;
FDoneAsync : TPop3NextProc;
FMultiLineLine : TNotifyEvent;
FMultiLineEnd : TNotifyEvent;
FMultiLineProcess : TNotifyEvent;
FHost : String;
FLocalAddr : String; {bb}
FPort : String;
FUserName : String;
FPassWord : String;
FLastResponse : String;
FErrorMessage : String;
FTimeStamp : String;
FMsgCount : Integer;
FMsgSize : Integer;
FMsgNum : Integer;
FMsgUidl : String;
FMsgLines : Integer;
FTag : LongInt;
FWaitingOnQuit : Boolean;
FHeaderPart : Boolean;
FHeaderKeyword : String;
FHeaderData : String;
FHeaderFrom : String;
FHeaderTo : String;
FHeaderSubject : String;
FHeaderReplyTo : String;
FHeaderMessageId : String;
FHeaderDate : String;
FHeaderReturnPath : String;
FOnDisplay : TPop3Display;
FOnMessageBegin : TNotifyEvent;
FOnMessageEnd : TNotifyEvent;
FOnMessageLine : TNotifyEvent;
FOnListBegin : TNotifyEvent;
FOnListEnd : TNotifyEvent;
FOnListLine : TNotifyEvent;
FOnUidlBegin : TNotifyEvent;
FOnUidlEnd : TNotifyEvent;
FOnUidlLine : TNotifyEvent;
FOnStateChange : TNotifyEvent;
FOnRequestDone : TPop3RequestDone;
FOnResponse : TPop3Display;
FOnSessionConnected : TSessionConnected;
FOnSessionClosed : TSessionClosed;
FOnHeaderEnd : TNotifyEvent;
protected
procedure ExecAsync(RqType : TPop3Request;
Cmd : String;
NextState : TPop3ProtocolState;
DoneAsync : TPop3NextProc);
procedure NextExecAsync;
procedure StartTransaction(OpCode : String;
Params : String;
RqType : TPop3Request;
NextState : TPop3ProtocolState;
DoneTrans : TPop3NextProc);
procedure StartMultiLine(aOnBegin : TNotifyEvent;
aOnLine : TNotifyEvent;
aOnEnd : TNotifyEvent;
aProcess : TNotifyEvent);
procedure GetALine;
procedure StatDone;
procedure ListAllDone;
procedure ListSingleDone;
procedure UidlAllDone;
procedure UidlSingleDone;
procedure RetrDone;
procedure LastDone;
procedure WndProc(var MsgRec: TMessage); virtual;
procedure WMPop3RequestDone(var msg: TMessage);
message WM_POP3_REQUEST_DONE;
procedure WSocketDnsLookupDone(Sender: TObject; Error: Word);
procedure WSocketSessionConnected(Sender: TObject; Error: Word);
procedure WSocketDataAvailable(Sender: TObject; Error: Word);
procedure WSocketSessionClosed(Sender : TObject; Error : WORD);
procedure DisplayLastResponse;
procedure TriggerDisplay(Msg : String);
procedure TriggerSessionConnected(Error : Word); virtual;
procedure TriggerSessionClosed(Error : Word);
procedure TriggerResponse(Msg : String); virtual;
procedure TriggerStateChange; virtual;
procedure TriggerRequestDone(Error: Word); virtual;
function OkResponse : Boolean;
procedure StateChange(NewState : TPop3State);
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
procedure SetErrorMessage;
procedure Display(Msg : String);
procedure SendCommand(Cmd : String);
function ExtractNumbers(var N1 : Integer; var N2 : Integer) : Boolean;
function ExtractUidl(var N1 : Integer; var N2 : String) : Boolean;
procedure ProcessUidl(Sender : TObject);
procedure ProcessList(Sender : TObject);
procedure CheckReady;
procedure DoHighLevelAsync;
public
constructor Create(AOwner : TComponent); override;
destructor Destroy; override;
procedure Connect; virtual;
procedure Open; virtual;
procedure User; virtual;
procedure Pass; virtual;
procedure RPop; virtual;
procedure APop; virtual;
procedure Quit; virtual;
procedure Stat; virtual;
procedure List; virtual;
procedure Retr; virtual;
procedure Top; virtual;
procedure Dele; virtual;
procedure Noop; virtual;
procedure Last; virtual;
procedure RSet; virtual;
procedure Uidl; virtual;
procedure Abort; virtual;
procedure ClearErrorMessage;
procedure HighLevelAsync(RqType : TPop3Request; Fcts : TPop3FctSet);
property CtrlSocket : TWSocket read FWSocket;
property Host : String read FHost
write FHost;
property LocalAddr : String read FLocalAddr {bb}
write FLocalAddr; {bb}
property Port : String read FPort
write FPort;
property UserName : String read FUserName
write FUserName;
property PassWord : String read FPassWord
write FPassWord;
property ErrorMessage : String read FErrorMessage;
property LastResponse : String read FLastResponse;
property State : TPop3State read FState;
property Connected : Boolean read FConnected;
property ProtocolState : TPop3ProtocolState read FProtocolState;
{:Updated by the Stat method with the number of
messages in the maildrop }
property MsgCount : Integer read FMsgCount;
{:Updated by the Stat method with the total size
in byte for the messages in the maildrop }
property MsgSize : Integer read FMsgSize;
{:This is the number of lines to display in the TOP command
Set to zero if you wants the default value }
property MsgLines : Integer read FMsgLines
write FMsgLines;
{:This is the message number which must be returned by the Retr
method. It is also updated by the Last method }
property MsgNum : Integer read FMsgNum
write FMsgNum;
property MsgUidl : String read FMsgUidl;
{:The following properties are decoded by RETR command }
property HeaderKeyword : String read FHeaderKeyword;
property HeaderData : String read FHeaderData;
property HeaderFrom : String read FHeaderFrom;
property HeaderTo : String read FHeaderTo;
property HeaderSubject : String read FHeaderSubject;
property HeaderReplyTo : String read FHeaderReplyTo;
property HeaderMessageId : String read FHeaderMessageId;
property HeaderDate : String read FHeaderDate;
property HeaderReturnPath : String read FHeaderReturnPath;
{:General purpose property, not used by component }
property Tag : LongInt read FTag
write FTag;
property Handle : HWND read FWindowHandle;
property OnDisplay : TPop3Display 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 OnListBegin : TNotifyEvent read FOnListBegin
write FOnListBegin;
property OnListEnd : TNotifyEvent read FOnListEnd
write FOnListEnd;
property OnListLine : TNotifyEvent read FOnListLine
write FOnListLine;
property OnUidlBegin : TNotifyEvent read FOnUidlBegin
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -