📄 pop3prot.pas
字号:
{*_* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
Author: Fran鏾is PIETTE
Object: TPop3Cli class implements the POP3 protocol
(RFC-1225, RFC-1939)
EMail: francois.piette@pophost.eunet.be francois.piette@rtfm.be
http://www.rtfm.be/fpiette
Creation: 03 october 1997
Version: 2.06
Support: Use the mailing list twsocket@rtfm.be See website for details.
Legal issues: Copyright (C) 1997, 1998, 1999 by Fran鏾is PIETTE
Rue de Grady 24, 4053 Embourg, Belgium. Fax: +32-4-365.74.56
<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.
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
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 = 207;
CopyRight : String = ' POP3 component (c) 97-98 F. Piette V2.07 ';
{$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;
FPort : String;
FUserName : String;
FPassWord : String;
FLastResponse : String;
FErrorMessage : String;
FTimeStamp : String;
FMsgCount : Integer;
FMsgSize : Integer;
FMsgNum : Integer;
FMsgUidl : String;
FMsgLines : Integer;
FTag : LongInt;
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;
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 ClearErrorMessage;
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 HighLevelAsync(RqType : TPop3Request; Fcts : TPop3FctSet);
property WSocket : TWSocket read FWSocket;
property Host : String read FHost
write FHost;
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;
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
write FOnUidlBegin;
property OnUidlEnd : TNotifyEvent read FOnUidlEnd
write FOnUidlEnd;
property OnUidlLine : TNotifyEvent read FOnUidlLine
write FOnUidlLine;
property OnStateChange : TNotifyEvent read FOnStateChange
write FOnStateChange;
property OnRequestDone : TPop3RequestDone read FOnRequestDone
write FOnRequestDone;
property OnResponse: TPop3Display read FOnResponse
write FOnResponse;
property OnSessionConnected : TSessionConnected
read FOnSessionConnected
write FOnSessionConnected;
property OnSessionClosed : TSessionClosed
read FOnSessionClosed
write FOnSessionClosed;
end;
TPop3Cli = class(TCustomPop3Cli)
published
property Host;
property Port;
property UserName;
property PassWord;
property ErrorMessage;
property LastResponse;
property ProtocolState;
property MsgCount;
property MsgSize;
property MsgLines;
property MsgNum;
property MsgUidl;
property Tag;
property OnDisplay;
property OnMessageBegin;
property OnMessageEnd;
property OnMessageLine;
property OnListBegin;
property OnListEnd;
property OnListLine;
property OnUidlBegin;
property OnUidlEnd;
property OnUidlLine;
property OnStateChange;
property OnRequestDone;
property OnResponse;
property OnSessionConnected;
property OnSessionClosed;
end;
{ TSyncPop3Cli add synchronous functions. You should avoid using this }
{ component because synchronous function, apart from being easy, result }
{ in lower performance programs. }
TSyncPop3Cli = class(TPop3Cli)
protected
FTimeout : Integer; { Given in seconds }
FTimeStop : LongInt; { Milli-seconds }
FMultiThreaded : Boolean;
function WaitUntilReady : Boolean; virtual;
function Synchronize(Proc : TPop3NextProc) : Boolean;
public
constructor Create(AOwner : TComponent); override;
function ConnectSync : Boolean; virtual;
function OpenSync : Boolean; virtual;
function UserSync : Boolean; virtual;
function PassSync : Boolean; virtual;
function RPopSync : Boolean; virtual;
function APopSync : Boolean; virtual;
function QuitSync : Boolean; virtual;
function StatSync : Boolean; virtual;
function ListSync : Boolean; virtual;
function RetrSync : Boolean; virtual;
function TopSync : Boolean; virtual;
function DeleSync : Boolean; virtual;
function NoopSync : Boolean; virtual;
function LastSync : Boolean; virtual;
function RSetSync : Boolean; virtual;
function UidlSync : Boolean; virtual;
function AbortSync : Boolean; virtual;
published
property Timeout : Integer read FTimeout
write FTimeout;
property MultiThreaded : Boolean read FMultiThreaded
write FMultiThreaded;
end;
procedure Register;
implementation
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{$IFDEF VER80}
procedure SetLength(var S: string; NewLength: Integer);
begin
S[0] := chr(NewLength);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function RTrim(Str : String) : String;
var
i : Integer;
begin
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -