Delphi用Indy10实现smtp发送邮件支持附件

chinajobs

于 2016-05-26 14:11:46 发布

阅读量5.8k

点赞数

分类专栏： Delphi 文章标签： idsmtp

Delphi 专栏收录该内容

150 篇文章

订阅专栏

原先使用了第三方插件EASendMail SMTP Component来实现发送邮件，谁知道授权过期了，无奈只好求助于Indy，Google上翻阅了相关资料一番，发现现成的代码并不能满足我的需求，就在原基础上加以修改，添加了HTML格式化和添加附件接口。

//revise by bccsafe //add property edFormatHTML, edAttachmentList //support indy10 and above version! interface uses IdMessage, Classes, IdSMTP, IdMessageBuilder;
const
SMTP_PORT_EXPLICIT_TLS = 587;

type
TSSLEmail = class(TObject)
private
IdMessage: TIdMessage;
SMTP: TIdSMTP;
FedBody: TStrings;
FedSMTPPort: Integer;
FedToEmail: string;
FedSubject: string;
FedSMTPServer: string;
FedCCEmail: string;
FedPassword: string;
FedBCCEmail: string;
FedSenderName: string;
FedUserName: string;
FedPriority: TIdMessagePriority;
FedSenderEmail: string;
FedSSLConnection: Boolean;
FedAttachmentList: TStrings;
FedFormatHTML: Boolean;
// Getter / Setter procedure SetBody(const Value: TStrings);
procedure Init;
procedure InitMailMessage;
procedure InitSASL;
procedure AddSSLHandler;
procedure SetedAttachmentList(const Value: TStrings);
procedure SetedFormatHTML(const Value: Boolean);
public
constructor Create; overload;
constructor Create(const ASMTPServer: string; const ASMTPPort: Integer; const AUserName, APassword: string); overload;
destructor Destroy; override;
procedure SendEmail;
// Properties property edBCCEmail: string read FedBCCEmail write FedBCCEmail;
property edBody: TStrings read FedBody write SetBody;
property edCCEmail: string read FedCCEmail write FedCCEmail;
property edPassword: string read FedPassword write FedPassword;
property edPriority: TIdMessagePriority read FedPriority write FedPriority;
property edSenderEmail: string read FedSenderEmail write FedSenderEmail;
property edSenderName: string read FedSenderName write FedSenderName;
property edSMTPServer: string read FedSMTPServer write FedSMTPServer;
property edSMTPPort: Integer read FedSMTPPort write FedSMTPPort;
property edSSLConnection: Boolean read FedSSLConnection write FedSSLConnection;
property edToEmail: string read FedToEmail write FedToEmail;
property edUserName: string read FedUserName write FedUserName;
property edSubject: string read FedSubject write FedSubject;
property edFormatHTML: Boolean read FedFormatHTML write SetedFormatHTML;
property edAttachmentList: TStrings read FedAttachmentList write SetedAttachmentList;
end;

implementation

uses
IdComponent, IdTCPConnection, IdTCPClient, IdExplicitTLSClientServerBase,
IdMessageClient, IdSMTPBase, IdBaseComponent, IdIOHandler, IdIOHandlerSocket,
IdIOHandlerStack, IdSSL, IdSSLOpenSSL, IdSASLLogin, IdSASL_CRAM_SHA1, IdSASL,
IdSASLUserPass, IdSASL_CRAMBase, IdSASL_CRAM_MD5, IdSASLSKey, IdSASLPlain,
IdSASLOTP, IdSASLExternal, IdSASLDigest, IdSASLAnonymous, IdUserPassProvider;

constructor TSSLEmail.Create;
begin
inherited;
Init;
FedBody := TStringList.Create;
edAttachmentList := TStringList.Create;
end;

procedure TSSLEmail.Init;
begin
edSSLConnection := True;
edPriority := TIdMessagePriority.mpNormal;
end;

constructor TSSLEmail.Create(const ASMTPServer: string; const ASMTPPort: Integer; const AUserName, APassword: string);
begin
Create;
edSMTPServer := ASMTPServer;
edSMTPPort := ASMTPPort;
edUserName := AUserName;
edPassword := APassword;
end;

destructor TSSLEmail.Destroy;
begin
edBody.Free;
edAttachmentList.Free;
inherited;
end;
// Setter / Getter -----------------------------------------------------------

procedure TSSLEmail.SetBody(const Value: TStrings);
begin
FedBody.Assign(Value);
end;

procedure TSSLEmail.SetedAttachmentList(const Value: TStrings);
begin
FedAttachmentList := Value;
end;

procedure TSSLEmail.SetedFormatHTML(const Value: Boolean);
begin
FedFormatHTML := Value;
end;
// Send the mail -------------------------------------------------------------

procedure TSSLEmail.SendEmail;
begin
IdMessage := TIdMessage.Create;
try
InitMailMessage;
SMTP := TIdSMTP.Create;
try
if edSSLConnection then
begin
AddSSLHandler;
if edSMTPPort = SMTP_PORT_EXPLICIT_TLS then
SMTP.UseTLS := utUseExplicitTLS
else
SMTP.UseTLS := utUseImplicitTLS;
end;
if (edUserName <> '') or (edPassword <> '') then
begin
SMTP.AuthType := satSASL;
InitSASL;
end
else
begin
SMTP.AuthType := satNone;
end;
SMTP.Host := edSMTPServer;
SMTP.Port := edSMTPPort;
SMTP.ConnectTimeout := 30000;
SMTP.UseEHLO := True;
SMTP.Connect;
try
SMTP.Send(IdMessage);
finally
SMTP.Disconnect;
end;
finally
SMTP.Free;
end;
finally
IdMessage.Free;
end;
end;
// Prepare the mail ----------------------------------------------------------

procedure TSSLEmail.InitMailMessage;
var
Index: Integer;
begin
with TIdMessageBuilderHtml.Create do
try
HtmlCharSet := 'UTF-8';
if edFormatHTML then
Html.Text := FedBody.Text
else
PlainText.Text := FedBody.Text;
for Index := 0 to FedAttachmentList.Count - 1 do
Attachments.Add(edAttachmentList[Index]);
FillMessage(IdMessage);
finally
Free;
end;
IdMessage.Charset := 'UTF-8';
IdMessage.Body := edBody;
IdMessage.Sender.Text := edSenderEmail;
IdMessage.From.Name := edSenderName;
IdMessage.From.Address := edSenderEmail;
IdMessage.ReplyTo.EMailAddresses := edSenderEmail;
IdMessage.Recipients.EMailAddresses := edToEmail;
IdMessage.Subject := edSubject;
IdMessage.Priority := edPriority;
IdMessage.CCList.EMailAddresses := edCCEmail;
IdMessage.ReceiptRecipient.Text := '';
IdMessage.BccList.EMailAddresses := edBCCEmail;
end;

procedure TSSLEmail.AddSSLHandler;
var
SSLHandler: TIdSSLIOHandlerSocketOpenSSL;
begin
SSLHandler := TIdSSLIOHandlerSocketOpenSSL.Create(SMTP);
// SSL/TLS handshake determines the highest available SSL/TLS version dynamically SSLHandler.SSLOptions.Method := sslvSSLv23;
SSLHandler.SSLOptions.Mode := sslmClient;
SSLHandler.SSLOptions.VerifyMode := [];
SSLHandler.SSLOptions.VerifyDepth := 0;
SMTP.IOHandler := SSLHandler;
end;

procedure TSSLEmail.InitSASL;
var
IdUserPassProvider: TIdUserPassProvider;
IdSASLCRAMMD5: TIdSASLCRAMMD5;
IdSASLCRAMSHA1: TIdSASLCRAMSHA1;
IdSASLPlain: TIdSASLPlain;
IdSASLLogin: TIdSASLLogin;
IdSASLSKey: TIdSASLSKey;
IdSASLOTP: TIdSASLOTP;
IdSASLAnonymous: TIdSASLAnonymous;
IdSASLExternal: TIdSASLExternal;
begin
IdUserPassProvider := TIdUserPassProvider.Create(SMTP);
IdUserPassProvider.Username := edUserName;
IdUserPassProvider.Password := edPassword;
IdSASLCRAMSHA1 := TIdSASLCRAMSHA1.Create(SMTP);
IdSASLCRAMSHA1.UserPassProvider := IdUserPassProvider;
IdSASLCRAMMD5 := TIdSASLCRAMMD5.Create(SMTP);
IdSASLCRAMMD5.UserPassProvider := IdUserPassProvider;
IdSASLSKey := TIdSASLSKey.Create(SMTP);
IdSASLSKey.UserPassProvider := IdUserPassProvider;
IdSASLOTP := TIdSASLOTP.Create(SMTP);
IdSASLOTP.UserPassProvider := IdUserPassProvider;
IdSASLAnonymous := TIdSASLAnonymous.Create(SMTP);
IdSASLExternal := TIdSASLExternal.Create(SMTP);
IdSASLLogin := TIdSASLLogin.Create(SMTP);
IdSASLLogin.UserPassProvider := IdUserPassProvider;
IdSASLPlain := TIdSASLPlain.Create(SMTP);
IdSASLPlain.UserPassProvider := IdUserPassProvider;
SMTP.SASLMechanisms.Add.SASL := IdSASLCRAMSHA1;
SMTP.SASLMechanisms.Add.SASL := IdSASLCRAMMD5;
SMTP.SASLMechanisms.Add.SASL := IdSASLSKey;
SMTP.SASLMechanisms.Add.SASL := IdSASLOTP;
SMTP.SASLMechanisms.Add.SASL := IdSASLAnonymous;
SMTP.SASLMechanisms.Add.SASL := IdSASLExternal;
SMTP.SASLMechanisms.Add.SASL := IdSASLLogin;
SMTP.SASLMechanisms.Add.SASL := IdSASLPlain;
end;