📄 smtpprot.pas
字号:
TSmtpState = (smtpReady, smtpDnsLookup,
smtpConnecting, smtpConnected,
smtpInternalReady, smtpWaitingBanner,
smtpWaitingResponse, smtpAbort);
TSmtpMimeState = (smtpMimeIntro, smtpMimePlainText,
smtpMimeHtmlText, smtpMimeImages, smtpMimeDone);
TSmtpRequest = (smtpConnect, smtpHelo, smtpMailFrom,
smtpVrfy, smtpRcptTo, smtpData,
smtpQuit, smtpRset, smtpOpen,
smtpMail, smtpEhlo, smtpAuth,
smtpCustom);
TSmtpFct = (smtpFctNone, smtpFctHelo, smtpFctConnect,
smtpFctMailFrom, smtpFctRcptTo, smtpFctData,
smtpFctVrfy, smtpFctQuit, smtpFctRset,
smtpFctEhlo, smtpFctAuth);
TSmtpFctSet = set of TSmtpFct;
TSmtpContentType = (smtpHtml, smtpPlainText);
TSmtpAuthType = (smtpAuthNone, smtpAuthPlain, smtpAuthLogin,
smtpAuthCramMD5, smtpAuthCramSha1,
smtpAuthAutoSelect);
TSmtpShareMode = (smtpShareCompat, smtpShareExclusive,
smtpShareDenyWrite, smtpShareDenyRead,
smtpShareDenyNone);
TSmtpPriority = (smtpPriorityNone, smtpPriorityHighest,
smtpPriorityHigh, smtpPriorityNormal,
smtpPriorityLow, smtpPriorityLowest);
{A.G. start}
{ Do YOU know shorter & readable designations ?? }
TSmtpBeforeOpenFileAction = (smtpBeforeOpenFileNone, smtpBeforeOpenFileNext,
smtpBeforeOpenFileAbort);
TSmtpAfterOpenFileAction = (smtpAfterOpenFileNone, smtpAfterOpenFileNext,
smtpAfterOpenFileRetry, smtpAfterOpenFileAbort);
TSmtpBeforeFileOpenEvent = procedure(Sender : TObject;
Idx : Integer;
FileName : String;
var Action : TSmtpBeforeOpenFileAction)
of object;
TSmtpAfterFileOpenEvent = procedure(Sender : TObject;
Idx : Integer;
FileName : String;
E : Exception;
var Action : TSmtpAfterOpenFileAction)
of object;
{A.G. end}
TSmtpDisplay = procedure(Sender : TObject;
Msg : String) of object;
TSmtpHeaderLineEvent = procedure(Sender : TObject;
Msg : Pointer;
Size : Integer) of object;
TSmtpProcessHeaderEvent = procedure(Sender : TObject;
HdrLines : TStrings) of object;
TSmtpGetDataEvent = procedure(Sender : TObject;
LineNum : Integer;
MsgLine : Pointer;
MaxLen : Integer;
var More: Boolean) of object;
TSmtpRequestDone = procedure(Sender : TObject;
RqType : TSmtpRequest;
ErrorCode : Word) of object;
TSmtpAttachmentContentType = procedure(Sender : TObject;
FileNumber : Integer;
var FileName : String;
var ContentType : String) of object;
TSmtpAttachHeader = procedure(Sender : TObject;
FileNumber : Integer;
FileName : String;
HdrLines : TStrings) of object;
TSmtpNextProc = procedure of object;
{ Base component, implementing the transport, without MIME support }
TCustomSmtpClient = class(TComponent)
protected
FWSocket : TWSocket; { Underlaying socket }
FHost : String; { SMTP server hostname or IP }
FLocalAddr : String; {bb} { Local Address for mulithome }
FPort : String; { Should be 'smtp' }
FSignOn : String; { Used for the 'HELO' command }
FUsername : String; { Used with the 'AUTH' command }
FPassword : String; { Used with the 'AUTH' command }
FAuthType : TSmtpAuthType;{ Used with the 'AUTH' command }
FAuthTypesSupported : TStrings; { AuthTypes supported by server}
FFromName : String; { Sender's EMail }
FRcptName : TStrings; { Recepients EMails list }
FMailMessage : TStrings;
FHdrFrom : String;
FHdrTo : String;
FHdrCc : String;
FHdrReplyTo : String;
FHdrReturnPath : String;
FHdrSubject : String;
FHdrSender : String; { Mail Sender's Email }
FHdrPriority : TSmtpPriority;
FState : TSmtpState;
FCharSet : String;
FContentType : TSmtpContentType;
FContentTypeStr : String;
FLastResponse : String;
FErrorMessage : String;
FTag : LongInt;
FConnected : Boolean;
FESmtpSupported : Boolean;
FRequestType : TSmtpRequest;
FRequestDoneFlag : Boolean;
FReceiveLen : Integer;
FRequestResult : Integer;
FStatusCode : Integer;
FReceiveBuffer : array [0..SMTP_RCV_BUF_SIZE - 1] of char;
FNext : TSmtpNextProc;
FWhenConnected : TSmtpNextProc;
FFctSet : TSmtpFctSet;
FFctPrv : TSmtpFct;
FHighLevelResult : Integer;
FHighLevelFlag : Boolean;
FNextRequest : TSmtpNextProc;
FLastResponseSave : String;
FStatusCodeSave : Integer;
FRestartFlag : Boolean;
FOkResponses : array [0..15] of Integer;
FDoneAsync : TSmtpNextProc;
FWindowHandle : HWND;
FItemCount : LongInt;
FHdrLines : TStrings;
FLineNum : Integer;
FMoreLines : Boolean;
FOwnHeaders : Boolean ; { Angus V2.21 }
FOnDisplay : TSmtpDisplay;
FOnCommand : TSmtpDisplay;
FOnResponse : TSmtpDisplay;
FOnGetData : TSmtpGetDataEvent;
FOnHeaderLine : TSmtpHeaderLineEvent;
FOnProcessHeader : TSmtpProcessHeaderEvent;
FOnRequestDone : TSmtpRequestDone;
FOnStateChange : TNotifyEvent;
FOnSessionConnected : TSessionConnected;
FOnSessionClosed : TSessionClosed;
FStream : TStream;
FShareMode : Word;
function SmtpClientAllocateHWnd(Method: TWndMethod): HWND;
procedure AuthGetType; { parse Ehlo response for AuthTypes }
procedure SetShareMode(newValue: TSmtpShareMode);
function GetShareMode: TSmtpShareMode;
procedure SmtpClientDeallocateHWnd(WHandle: HWND);
procedure TriggerDisplay(Msg : String); virtual;
procedure TriggerCommand(Msg : String); virtual;
procedure TriggerResponse(Msg : String); virtual;
procedure TriggerRequestDone(ErrorCode : Word); virtual;
procedure TriggerStateChange; virtual;
procedure TriggerGetData(LineNum : Integer;
MsgLine : Pointer;
MaxLen : Integer;
var More : Boolean); virtual;
procedure TriggerHeaderLine(Line : Pointer; Size : Integer); virtual;
procedure TriggerProcessHeader(HdrLines : TStrings); virtual;
procedure TriggerSessionConnected(ErrorCode : Word); virtual;
procedure TriggerSessionClosed(ErrorCode : Word); virtual;
procedure ClearErrorMessage;
procedure SetErrorMessage;
procedure StateChange(NewState : TSmtpState);
procedure SendCommand(Cmd : String); virtual;
procedure SetRcptName(newValue : TStrings);
procedure SetMailMessage(newValue : TStrings);
procedure CheckReady;
procedure WSocketDnsLookupDone(Sender: TObject; ErrorCode: Word);
procedure WSocketSessionConnected(Sender: TObject; ErrorCode: Word);
procedure WSocketDataAvailable(Sender: TObject; ErrorCode: Word);
procedure WSocketDataSent(Sender : TObject; ErrorCode : Word);
procedure WSocketSessionClosed(Sender : TObject; ErrorCode : WORD);
procedure DisplayLastResponse;
procedure DoHighLevelAsync;
procedure ExecAsync(RqType : TSmtpRequest;
Cmd : String;
OkResponses : array of Word;
DoneAsync : TSmtpNextProc);
procedure NextExecAsync;
procedure EhloNext;
procedure DoAuthPlain;
procedure AuthNextPlain;
procedure AuthNextLogin;
procedure AuthNextLoginNext;
procedure AuthNextCramMD5;
{$IFDEF DELPHI3_UP}
procedure AuthNextCramSHA1; {HLX}
{$ENDIF}
procedure RcptToNext;
procedure RcptToDone;
procedure DataNext;
procedure WndProc(var MsgRec: TMessage); virtual;
procedure WMSmtpRequestDone(var msg: TMessage);
message WM_SMTP_REQUEST_DONE;
public
constructor Create(AOwner : TComponent); override;
destructor Destroy; override;
procedure Connect; virtual; { Connect to the mail server }
procedure Helo; virtual; { Send the HELO command }
procedure Ehlo; virtual; { Send the EHLO command }
procedure Auth; virtual; { Send the AUTH command }
procedure Vrfy; virtual; { Send the VRFY command }
procedure MailFrom; virtual; { Send the MAILFROM command }
procedure RcptTo; virtual; { Send RECPTTO command }
procedure Data; virtual; { Send DATA command }
procedure Quit; virtual; { Send QUITE command, close }
procedure Rset; virtual; { Send RSET command }
procedure Abort; virtual; { Abort opertaion, close }
procedure Open; virtual; { Connect, Helo/Ehlo, Auth }
procedure Mail; virtual; { MailFrom, RcptTo, Data }
{$IFNDEF VER80}
procedure ThreadAttach;
procedure ThreadDetach;
{$ENDIF}
property ShareMode : TSmtpShareMode read GetShareMode
write SetShareMode;
property CtrlSocket : TWSocket read FWSocket;
property Handle : HWND read FWindowHandle;
property Connected : Boolean read FConnected;
procedure HighLevelAsync(RqType : TSmtpRequest; Fcts : TSmtpFctSet);
procedure SetContentType(newValue : TSmtpContentType); virtual;
procedure RcptNameAdd(const ToList : String;
const CcList : String;
const BccList : String);
protected
property Host : String read FHost
write FHost;
property LocalAddr : String read FLocalAddr {bb}
write FLocalAddr; {bb}
property Port : String read FPort
write FPort;
property SignOn : String read FSignOn
write FSignOn;
property Username : String read FUsername
write FUsername;
property Password : String read FPassword
write FPassword;
property AuthType : TSmtpAuthType read FAuthType
write FAuthType;
property AuthTypesSupported : TStrings read FAuthTypesSupported;
property FromName : String read FFromName
write FFromName;
property RcptName : TStrings read FRcptName
write SetRcptName;
property MailMessage : TStrings read FMailMessage
write SetMailMessage;
property HdrFrom : String read FHdrFrom
write FHdrFrom;
property HdrTo : String read FHdrTo
write FHdrTo;
property HdrCc : String read FHdrCc
write FHdrCc;
property HdrReplyTo : String read FHdrReplyTo
write FHdrReplyTo;
property HdrReturnPath : String read FHdrReturnPath
write FHdrReturnPath;
property HdrSubject : String read FHdrSubject
write FHdrSubject;
property HdrSender: String read FHdrSender
write FHdrSender;
property HdrPriority : TSmtpPriority read FHdrPriority
write FHdrPriority;
property CharSet : String read FCharSet
write FCharSet;
property ContentType : TSmtpContentType read FContentType
write SetContentType;
property ErrorMessage : String read FErrorMessage;
property LastResponse : String read FLastResponse;
property State : TSmtpState read FState;
property Tag : LongInt read FTag
write FTag;
property OwnHeaders : Boolean read FOwnHeaders
{ Angus V2.21 } write FOwnHeaders;
property OnDisplay : TSmtpDisplay read FOnDisplay
write FOnDisplay;
property OnCommand: TSmtpDisplay read FOnCommand
write FOnCommand;
property OnResponse: TSmtpDisplay read FOnResponse
write FOnResponse;
property OnGetData : TSmtpGetDataEvent read FOnGetData
write FOnGetData;
property OnHeaderLine : TSmtpHeaderLineEvent read FOnHeaderLine
write FOnHeaderLine;
property OnProcessHeader : TSmtpProcessHeaderEvent
read FOnProcessHeader
write FOnProcessHeader;
property OnRequestDone : TSmtpRequestDone read FOnRequestDone
write FOnRequestDone;
property OnStateChange : TNotifyEvent read FOnStateChange
write FOnStateChange;
property OnSessionConnected : TSessionConnected
read FOnSessionConnected
write FOnSessionConnected;
property OnSessionClosed : TSessionClosed
read FOnSessionClosed
write FOnSessionClosed;
end;
{ Descending component adding MIME (file attach) support }
TSmtpCli = class(TCustomSmtpClient)
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -