|
@@ -0,0 +1,238 @@
|
|
|
|
+{ ***************************************************************************
|
|
|
|
+
|
|
|
|
+ Copyright (c) 2016-2017 Kike Pérez
|
|
|
|
+
|
|
|
|
+ Unit : Quick.SMTP
|
|
|
|
+ Description : Send Emails
|
|
|
|
+ Author : Kike Pérez
|
|
|
|
+ Version : 1.1
|
|
|
|
+ Created : 12/10/2017
|
|
|
|
+ Modified : 11/11/2017
|
|
|
|
+
|
|
|
|
+ This file is part of QuickLib: https://github.com/exilon/QuickLib
|
|
|
|
+
|
|
|
|
+ ***************************************************************************
|
|
|
|
+
|
|
|
|
+ Licensed under the Apache License, Version 2.0 (the "License");
|
|
|
|
+ you may not use this file except in compliance with the License.
|
|
|
|
+ You may obtain a copy of the License at
|
|
|
|
+
|
|
|
|
+ http://www.apache.org/licenses/LICENSE-2.0
|
|
|
|
+
|
|
|
|
+ Unless required by applicable law or agreed to in writing, software
|
|
|
|
+ distributed under the License is distributed on an "AS IS" BASIS,
|
|
|
|
+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
|
|
|
+ See the License for the specific language governing permissions and
|
|
|
|
+ limitations under the License.
|
|
|
|
+
|
|
|
|
+ *************************************************************************** }
|
|
|
|
+
|
|
|
|
+unit Quick.SMTP;
|
|
|
|
+
|
|
|
|
+interface
|
|
|
|
+
|
|
|
|
+uses
|
|
|
|
+ Classes,
|
|
|
|
+ System.SysUtils,
|
|
|
|
+ IdGlobal,
|
|
|
|
+ IdSMTP,
|
|
|
|
+ IdMessage,
|
|
|
|
+ IdReplySMTP,
|
|
|
|
+ IdSSLOpenSSL,
|
|
|
|
+ IdText,
|
|
|
|
+ IdAttachment,
|
|
|
|
+ IdAttachmentFile,
|
|
|
|
+ IdExplicitTLSClientServerBase,
|
|
|
|
+ IdHTTP;
|
|
|
|
+
|
|
|
|
+type
|
|
|
|
+
|
|
|
|
+ TMailMessage = class
|
|
|
|
+ private
|
|
|
|
+ fSenderName : string;
|
|
|
|
+ fFrom : string;
|
|
|
|
+ fRecipient : string;
|
|
|
|
+ fSubject : string;
|
|
|
|
+ fBody : string;
|
|
|
|
+ fCC : string;
|
|
|
|
+ fBCC : string;
|
|
|
|
+ fBodyFromFile : Boolean;
|
|
|
|
+ fAttachments : TStringList;
|
|
|
|
+ procedure SetBody(aValue : string);
|
|
|
|
+ public
|
|
|
|
+ constructor Create;
|
|
|
|
+ destructor Destroy; override;
|
|
|
|
+ property SenderName : string read fSenderName write fSenderName;
|
|
|
|
+ property From : string read fFrom write fFrom;
|
|
|
|
+ property Recipient : string read fRecipient write fRecipient;
|
|
|
|
+ property Subject : string read fSubject write fSubject;
|
|
|
|
+ property Body : string read fBody write SetBody;
|
|
|
|
+ property CC : string read fCC write fCC;
|
|
|
|
+ property BCC : string read fBCC write fBCC;
|
|
|
|
+ property Attachments : TStringList read fAttachments write fAttachments;
|
|
|
|
+ procedure AddBodyFromFile(const cFileName : string);
|
|
|
|
+ end;
|
|
|
|
+
|
|
|
|
+ TSMTP = class(TIdSMTP)
|
|
|
|
+ private
|
|
|
|
+ fServerAuth : Boolean;
|
|
|
|
+ fUseSSL : Boolean;
|
|
|
|
+ fMail : TMailMessage;
|
|
|
|
+ public
|
|
|
|
+ constructor Create; overload;
|
|
|
|
+ constructor Create(const cHost : string; cPort : Integer; cUseSSL : Boolean = False); overload;
|
|
|
|
+ destructor Destroy; override;
|
|
|
|
+ property ServerAuth : Boolean read fServerAuth write fServerAuth;
|
|
|
|
+ property UseSSL: Boolean read fUseSSL write fUseSSL;
|
|
|
|
+ property Mail : TMailMessage read fMail write fMail;
|
|
|
|
+ function SendMail: Boolean; overload;
|
|
|
|
+ function SendEmail(const cFrom,cSubject,cTo,cBody : string) : Boolean; overload;
|
|
|
|
+ end;
|
|
|
|
+
|
|
|
|
+implementation
|
|
|
|
+
|
|
|
|
+
|
|
|
|
+{ TMailMessage }
|
|
|
|
+
|
|
|
|
+constructor TMailMessage.Create;
|
|
|
|
+begin
|
|
|
|
+ fCC := '';
|
|
|
|
+ fBCC := '';
|
|
|
|
+ fBody := '';
|
|
|
|
+ fAttachments := TStringList.Create;
|
|
|
|
+end;
|
|
|
|
+
|
|
|
|
+destructor TMailMessage.Destroy;
|
|
|
|
+begin
|
|
|
|
+ if Assigned(fAttachments) then fAttachments.Free;
|
|
|
|
+ inherited;
|
|
|
|
+end;
|
|
|
|
+
|
|
|
|
+procedure TMailMessage.AddBodyFromFile(const cFileName: string);
|
|
|
|
+begin
|
|
|
|
+ fBodyFromFile := True;
|
|
|
|
+ fBody := cFileName;
|
|
|
|
+end;
|
|
|
|
+
|
|
|
|
+procedure TMailMessage.SetBody(aValue: string);
|
|
|
|
+begin
|
|
|
|
+ fBodyFromFile := False;
|
|
|
|
+ fBody := aValue;
|
|
|
|
+end;
|
|
|
|
+
|
|
|
|
+{ TSMTP }
|
|
|
|
+
|
|
|
|
+constructor TSMTP.Create;
|
|
|
|
+begin
|
|
|
|
+ inherited;
|
|
|
|
+ fMail := TMailMessage.Create;
|
|
|
|
+ Port := 25;
|
|
|
|
+ UseTLS := TIdUseTLS.utNoTLSSupport;
|
|
|
|
+ fUseSSL := False;
|
|
|
|
+end;
|
|
|
|
+
|
|
|
|
+constructor TSMTP.Create(const cHost : string; cPort : Integer; cUseSSL : Boolean = False);
|
|
|
|
+begin
|
|
|
|
+ inherited Create;
|
|
|
|
+ Host := cHost;
|
|
|
|
+ Port := cPort;
|
|
|
|
+ fUseSSL := cUseSSL;
|
|
|
|
+end;
|
|
|
|
+
|
|
|
|
+destructor TSMTP.Destroy;
|
|
|
|
+begin
|
|
|
|
+ if Assigned(fMail) then fMail.Free;
|
|
|
|
+ inherited;
|
|
|
|
+end;
|
|
|
|
+
|
|
|
|
+function TSMTP.SendEmail(const cFrom,cSubject,cTo,cBody : string) : Boolean;
|
|
|
|
+begin
|
|
|
|
+ fMail.From := cFrom;
|
|
|
|
+ fMail.Subject := cSubject;
|
|
|
|
+ fMail.Body := cBody;
|
|
|
|
+ fMail.Recipient := cTo;
|
|
|
|
+ fMail.CC := '';
|
|
|
|
+ fMail.BCC := '';
|
|
|
|
+ Result := Self.SendMail;
|
|
|
|
+end;
|
|
|
|
+
|
|
|
|
+function TSMTP.SendMail: Boolean;
|
|
|
|
+var
|
|
|
|
+ msg : TIdMessage;
|
|
|
|
+ SSLHandler : TIdSSLIOHandlerSocketOpenSSL;
|
|
|
|
+ email : string;
|
|
|
|
+ filename : string;
|
|
|
|
+ mBody : TIdText;
|
|
|
|
+begin
|
|
|
|
+ Result := False;
|
|
|
|
+ SSLHandler := TIdSSLIOHandlerSocketOpenSSL.Create(nil);
|
|
|
|
+ try
|
|
|
|
+ msg := TIdMessage.Create(nil);
|
|
|
|
+ try
|
|
|
|
+ //create mail msg
|
|
|
|
+ msg.From.Address := fMail.From;
|
|
|
|
+ if fMail.SenderName <> '' then msg.From.Name := fMail.SenderName;
|
|
|
|
+ msg.Subject := fMail.Subject;
|
|
|
|
+ for email in fMail.Recipient.Split([',']) do msg.Recipients.Add.Address := email;
|
|
|
|
+ for email in fMail.CC.Split([',']) do msg.CCList.Add.Address := email;
|
|
|
|
+ for email in fMail.BCC.Split([',']) do msg.BCCList.Add.Address := email;
|
|
|
|
+ if fMail.fBodyFromFile then
|
|
|
|
+ begin
|
|
|
|
+ msg.Body.LoadFromFile(fMail.Body);
|
|
|
|
+ end
|
|
|
|
+ else
|
|
|
|
+ begin
|
|
|
|
+ mBody := TIdText.Create(msg.MessageParts);
|
|
|
|
+ mBody.ContentType := 'text/html';
|
|
|
|
+ mBody.Body.Add(fMail.Body);
|
|
|
|
+ end;
|
|
|
|
+ //add attachements if exists
|
|
|
|
+ if fMail.Attachments.Count > 0 then
|
|
|
|
+ begin
|
|
|
|
+ for filename in fMail.Attachments do
|
|
|
|
+ begin
|
|
|
|
+ TIdAttachmentFile.Create(msg.MessageParts,filename);
|
|
|
|
+ end;
|
|
|
|
+ end;
|
|
|
|
+
|
|
|
|
+ //configure smtp SSL
|
|
|
|
+ try
|
|
|
|
+ if fUseSSL then
|
|
|
|
+ begin
|
|
|
|
+ Self.IOHandler := SSLHandler;
|
|
|
|
+ SSLHandler.MaxLineAction := maException;
|
|
|
|
+ SSLHandler.SSLOptions.Method := sslvTLSv1_2;
|
|
|
|
+ SSLHandler.SSLOptions.Mode := sslmUnassigned;
|
|
|
|
+ SSLHandler.SSLOptions.VerifyMode := [];
|
|
|
|
+ SSLHandler.SSLOptions.VerifyDepth := 0;
|
|
|
|
+ //Self.UseTLS := utUseExplicitTLS;
|
|
|
|
+ end;
|
|
|
|
+ //server auth
|
|
|
|
+ if ServerAuth then Self.AuthType := TIdSMTPAuthenticationType.satDefault;
|
|
|
|
+ Self.Port := fPort;
|
|
|
|
+ except
|
|
|
|
+ on E : Exception do raise Exception.Create(Format('[%s] : %s',[Self.ClassName,e.Message]));
|
|
|
|
+ end;
|
|
|
|
+
|
|
|
|
+ //send email
|
|
|
|
+ try
|
|
|
|
+ Self.Connect;
|
|
|
|
+ if Self.Connected then
|
|
|
|
+ begin
|
|
|
|
+ Self.Send(msg);
|
|
|
|
+ Self.Disconnect(False);
|
|
|
|
+ Result := True;
|
|
|
|
+ end;
|
|
|
|
+ except
|
|
|
|
+ on E : Exception do raise Exception.Create(Format('[%s] : %s',[Self.ClassName,e.Message]));
|
|
|
|
+ end;
|
|
|
|
+ finally
|
|
|
|
+ msg.Free;
|
|
|
|
+ end;
|
|
|
|
+ finally
|
|
|
|
+ if Assigned(SSLHandler) then SSLHandler.Free;
|
|
|
|
+ end;
|
|
|
|
+end;
|
|
|
|
+
|
|
|
|
+
|
|
|
|
+end.
|