📄 smtpprot.pas
字号:
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 InitUUEncode(var hFile: File; sFile: string); virtual;
procedure DoUUEncode(var hFile: File; var sLine: string; var More: boolean); virtual;
procedure EndUUEncode(var hFile: File); virtual;
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 AuthNextLogin;
procedure AuthNextLoginNext;
procedure AuthNextCramMD5;
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 }
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);
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 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 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)
protected
FEmailBody : TStrings; { Message body text }
FEmailFiles : TStrings; { File names for attachment }
FCurrentFile : Integer; { Current file being sent }
FMimeBoundary : String; { Message parts boundary }
FFile : File;
FFileStarted : Boolean;
FBodyFlag : Boolean;
FBodyLine : Integer;
FOnAttachContentType : TSmtpAttachmentContentType;
FOnAttachHeader : TSmtpAttachHeader;
procedure TriggerAttachContentType(FileNumber : Integer;
var FileName : String;
var ContentType : String); virtual;
procedure TriggerAttachHeader(FileNumber : Integer;
FileName : String;
HdrLines : TStrings); virtual;
procedure TriggerGetData(LineNum : Integer;
MsgLine : PChar;
MaxLen : Integer;
var More : Boolean); override;
procedure TriggerHeaderLine(Line : PChar; Size : Integer); override;
procedure SetEMailFiles(newValue : TStrings);
procedure PrepareEMail;
public
constructor Create(AOwner : TComponent); override;
destructor Destroy; override;
procedure Data; override;
published
property Host;
property LocalAddr; {bb}
property Port;
property SignOn;
property Username;
property Password;
property AuthType;
property FromName;
property RcptName;
property MailMessage;
property HdrFrom;
property HdrTo;
property HdrCc;
property HdrReplyTo;
property HdrReturnPath;
property HdrSubject;
property HdrSender;
property State;
property CharSet;
property ContentType;
property ErrorMessage;
property LastResponse;
property Tag;
property OwnHeaders ; { Angus V2.21 }
property OnDisplay;
property OnCommand;
property OnResponse;
property OnGetData;
property OnHeaderLine;
property OnProcessHeader;
property OnRequestDone;
property OnSessionConnected;
property OnSessionClosed;
property EmailFiles : TStrings read FEmailFiles
write SetEmailFiles;
property OnAttachContentType : TSmtpAttachmentContentType
read FOnAttachContentType
write FOnAttachContentType;
property OnAttachHeader : TSmtpAttachHeader read FOnAttachHeader
write FOnAttachHeader;
end;
{ TSyncSmtpCli add synchronous functions. You should avoid using this }
{ component because synchronous function, apart from being easy, result }
{ in lower performance programs. }
TSyncSmtpCli = class(TSmtpCli)
protected
FTimeout : Integer; { Given in seconds }
FTimeStop : LongInt; { Milli-seconds }
FMultiThreaded : Boolean;
function WaitUntilReady : Boolean; virtual;
function Synchronize(Proc : TSmtpNextProc) : Boolean;
procedure TriggerGetData(LineNum : Integer;
MsgLine : PChar;
MaxLen : Integer;
var More : Boolean); override;
public
constructor Create(AOwner : TComponent); override;
function ConnectSync : Boolean; virtual;
function HeloSync : Boolean; virtual;
function EhloSync : Boolean; virtual;
function AuthSync : Boolean; virtual;
function VrfySync : Boolean; virtual;
function MailFromSync : Boolean; virtual;
function RcptToSync : Boolean; virtual;
function DataSync : Boolean; virtual;
function QuitSync : Boolean; virtual;
function RsetSync : Boolean; virtual;
function AbortSync : Boolean; virtual;
function OpenSync : Boolean; virtual;
function MailSync : Boolean; virtual;
published
property Timeout : Integer read FTimeout
write FTimeout;
property MultiThreaded : Boolean read FMultiThreaded
write FMultiThreaded;
end;
{ Function to convert a TDateTime to an RFC822 timestamp string }
function Rfc822DateTime(t : TDateTime) : String;
procedure Register;
implementation
{$B-} { Partial boolean evaluation }
type
TLookup = array [0..64] of Char;
TLookup2 = array[0..127] of Byte;
const
Base64Out: TLookup =
(
'A', 'B', 'C', 'D', 'E', 'F', 'G', 'H', 'I', 'J', 'K', 'L', 'M',
'N', 'O', 'P', 'Q', 'R', 'S', 'T', 'U', 'V', 'W', 'X', 'Y', 'Z',
'a', 'b', 'c', 'd', 'e', 'f', 'g', 'h', 'i', 'j', 'k', 'l', 'm',
'n', 'o', 'p', 'q', 'r', 's', 't', 'u', 'v', 'w', 'x', 'y', 'z',
'0', '1', '2', '3', '4', '5', '6', '7', '8', '9', '+', '/', '='
);
Base64In: TLookup2 =
(
255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255,
255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255,
255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255,
255, 255, 255, 255, 62, 255, 255, 255, 63, 52, 53, 54, 55,
56, 57, 58, 59, 60, 61, 255, 255, 255, 64, 255, 255, 255,
0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12,
13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25,
255, 255, 255, 255, 255, 255, 26, 27, 28, 29, 30, 31, 32,
33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45,
46, 47, 48, 49, 50, 51, 255, 255, 255, 255, 255
);
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{$IFDEF VER80}
procedure SetLength(var S: string; NewLength: Integer);
begin
S[0] := chr(NewLength);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function RTrim(Str : String) : String;
var
i : Integer;
begin
i := Length(Str);
while (i > 0) and (Str[i] = ' ') do
i := i - 1;
Result := Copy(Str, 1, i);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function LTrim(Str : String) : String;
var
i : Integer;
begin
if Str[1] <> ' ' then { Petite optimisation: pas d'espace }
Result := Str
else begin
i := 1;
while (i <= Length(Str)) and (Str[i] = ' ') do
i := i + 1;
Result := Copy(Str, i, Length(Str) - i + 1);
end;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function Trim(Str : String) : String;
begin
Result := LTrim(Rtrim(Str));
end;
{$ENDIF}
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function stpblk(PValue : PChar) : PChar;
begin
Result := PValue;
while Result^ in [' ', #9, #10, #13] do
Inc(Result);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -