unit uSendMail;
interface
uses
Vcl.ComCtrls, System.SysUtils, System.Classes, System.IOUtils, IdSmtp, IdMessage, IdAttachmentFile, IdText, IdExplicitTLSClientServerBase, IdSSLOpenSSL, IdBaseComponent, IdIOHandler,
IdIOHandlerSocket, IdIOHandlerStack, IdSSL;
type
TLoginType = (ltNone, ltLogin);
TMailPriority = (pHighest, pHigh, pNormal, pLow, pLowest);
TSendMail =
class
private
FLibeay32, FSSLeay32:
string;
FSmtp: TIdSMTP;
FIdSSLIOHandler: TIdSSLIOHandlerSocketOpenSSL;
FMsg: TIdMessage;
FAttachmentList: TStringList;
FiEMailSize: Integer;
FUseSSL: Boolean;
FTLSMode: Integer;
procedure SetLibeay32(
const aValue:
string);
procedure SetSSLeay32(
const aValue:
string);
procedure SetHost(
const aValue:
string);
procedure SetPort(
const aValue: Word);
procedure SetUserName(
const aValue:
string);
procedure SetPassword(
const aValue:
string);
procedure SetLoginType(
const aValue: TLoginType);
procedure SetMailAgent(
const aValue:
string);
procedure SetReceiver(
const aValue:
string);
procedure SetSender(
const aValue:
string);
procedure SetSubject(
const aValue:
string);
procedure SetPriority(
const aValue: TMailPriority);
procedure SetReturnReciept(
const aValue: Boolean);
procedure SetBody(aValue: TStrings);
procedure SetUseSSL(
const aValue: Boolean);
procedure SetTLSMode(
const aValue: Integer);
function GetLibeay32:
string;
function GetSSLeay32:
string;
function GetHost:
string;
function GetPort: Word;
function GetUserName:
string;
function GetPassword:
string;
function GetLoginType: TLoginType;
function GetMailAgent:
string;
function GetReceiver:
string;
function GetSender:
string;
function GetSubject:
string;
function GetPriority: TMailPriority;
function GetReturnReciept: Boolean;
function GetBody: TStrings;
function GetUseSSL: Boolean;
function GetTLSMode: Integer;
procedure setEmailSize(iEMailSize: Integer);
protected
//
public
constructor Create;
destructor Destroy;
override;
property Libeay32:
string read GetLibeay32
write SetLibeay32;
property SSLeay32:
string read GetSSLeay32
write SetSSLeay32;
property Host:
string read GetHost
write SetHost;
property Port: Word
read GetPort
write SetPort;
property Username:
string read GetUserName
write SetUserName;
property Password:
string read GetPassword
write SetPassword;
property LoginType: TLoginType
read GetLoginType
write SetLoginType;
property MailAgent:
string read GetMailAgent
write SetMailAgent;
property Receiver:
string read GetReceiver
write SetReceiver;
property Sender:
string read GetSender
write SetSender;
property Subject:
string read GetSubject
write SetSubject;
property Priority: TMailPriority
read GetPriority
write SetPriority;
property ReturnReciept: Boolean
read GetReturnReciept
write SetReturnReciept;
property Body: TStrings
read GetBody
write SetBody;
property Attachments: TStringList
read FAttachmentList;
property UseSSL: Boolean
read GetUseSSL
write SetUseSSL;
property TLSMode: Integer
read GetTLSMode
write SetTLSMode;
function SendMail: Boolean;
end;
implementation
function _MIMEConvert(
const s:
string):
string;
var
i: Integer;
begin
Result := '
';
for i := 1
to Length(s)
do
begin
if s[i] = '
€'
then
begin
Result := Result + '
?=ISO-8859-15?Q?=A4?='
end
else if Ord(s[i]) > $99
then
Result := Result + '
=?ISO-8859-1?Q?=' + Format('
%x', [Ord(s[i])]) + '
?='
else
Result := Result + s[i];
end;
end;
constructor TSendMail.Create;
begin
FSmtp := TIdSMTP.Create(
nil);
FIdSSLIOHandler := TIdSSLIOHandlerSocketOpenSSL.Create(
nil);
FMsg := TIdMessage.Create(
nil);
FAttachmentList := TStringList.Create;
end;
destructor TSendMail.Destroy;
begin
FreeAndNil(FSmtp);
FreeAndNil(FIdSSLIOHandler);
FreeAndNil(FMsg);
FreeAndNil(FAttachmentList);
inherited;
end;
function TSendMail.GetLoginType: TLoginType;
begin
if FSmtp.AuthType = satNone
then
Result := ltNone
else
Result := ltLogin;
end;
function TSendMail.GetHost:
string;
begin
Result := FSmtp.Host;
end;
function TSendMail.GetPort: Word;
begin
Result := FSmtp.Port;
end;
function TSendMail.GetPassword:
string;
begin
Result := FSmtp.Password;
end;
function TSendMail.GetUserName:
string;
begin
Result := FSmtp.Username;
end;
procedure TSendMail.SetLoginType(
const aValue: TLoginType);
begin
if aValue = ltNone
then
FSmtp.AuthType := satNone
else
FSmtp.AuthType := satDefault;
end;
procedure TSendMail.SetHost(
const aValue:
string);
begin
if aValue <> FSmtp.Host
then
FSmtp.Host := aValue;
end;
procedure TSendMail.SetPort(
const aValue: Word);
begin
if aValue <> FSmtp.Port
then
FSmtp.Port := aValue;
end;
procedure TSendMail.SetPassword(
const aValue:
string);
begin
if aValue <> FSmtp.Password
then
FSmtp.Password := aValue;
end;
procedure TSendMail.SetUserName(
const aValue:
string);
begin
if aValue <> FSmtp.Username
then
FSmtp.Username := aValue;
end;
function TSendMail.GetMailAgent:
string;
begin
Result := FSmtp.MailAgent;
end;
procedure TSendMail.SetMailAgent(
const aValue:
string);
begin
if aValue <> FSmtp.MailAgent
then
FSmtp.MailAgent := aValue;
end;
function TSendMail.GetBody: TStrings;
begin
Result := FMsg.Body;
end;
function TSendMail.GetUseSSL;
begin
Result := FUseSSL;
end;
function TSendMail.GetTLSMode;
begin
Result := FTLSMode;
end;
function TSendMail.GetPriority: TMailPriority;
var
iTmp: Byte;
begin
iTmp := Ord(FMsg.Priority);
Result := TMailPriority(iTmp);
end;
function TSendMail.GetReceiver:
string;
begin
Result := FMsg.Recipients.EMailAddresses;
end;
function TSendMail.GetReturnReciept: Boolean;
begin
Result := FMsg.ReceiptRecipient.Text <> '
';
end;
function TSendMail.GetSender:
string;
begin
Result := FMsg.From.Text;
end;
function TSendMail.GetSSLeay32:
string;
begin
Result := FSSLeay32;
end;
function TSendMail.GetLibeay32:
string;
begin
Result := FLibeay32;
end;
function TSendMail.GetSubject:
string;
begin
Result := FMsg.Subject;
end;
procedure TSendMail.SetBody(aValue: TStrings);
begin
FMsg.Body.Assign(aValue);
end;
procedure TSendMail.SetUseSSL(
const aValue: Boolean);
begin
FUseSSL := aValue;
end;
procedure TSendMail.SetTLSMode(
const aValue: Integer);
begin
FTLSMode := aValue;
end;
procedure TSendMail.SetPriority(
const aValue: TMailPriority);
var
iTmp: Byte;
begin
iTmp := Ord(aValue);
FMsg.Priority := TIdMessagePriority(iTmp);
end;
procedure TSendMail.SetReceiver(
const aValue:
string);
begin
FMsg.Recipients.EMailAddresses := aValue;
end;
procedure TSendMail.SetReturnReciept(
const aValue: Boolean);
begin
if aValue
then
FMsg.ReceiptRecipient.Text := FMsg.From.Text
else
FMsg.ReceiptRecipient.Text := '
';
end;
procedure TSendMail.SetSender(
const aValue:
string);
begin
FMsg.From.Text := aValue;
end;
procedure TSendMail.SetSSLeay32(
const aValue:
string);
begin
FSSLeay32 := aValue;
end;
procedure TSendMail.SetLibeay32(
const aValue:
string);
begin
FLibeay32 := aValue;
end;
procedure TSendMail.SetSubject(
const aValue:
string);
begin
FMsg.Subject := aValue;
end;
procedure TSendMail.setEmailSize(iEMailSize: Integer);
begin
FiEMailSize := iEMailSize;
end;
function TSendMail.SendMail: Boolean;
var
i: Integer;
begin
Result := False;
try
FMsg.Subject := _MIMEConvert(FMsg.Subject);
if FAttachmentList.Count > 0
then
begin
for i := 0
to FAttachmentList.Count - 1
do
begin
if TFile.Exists(FAttachmentList[i])
then
begin
TIdAttachmentFile.Create(FMsg.MessageParts, FAttachmentList[i]);
TIdText.Create(FMsg.MessageParts).ContentType := '
text/html';
TIdText.Create(FMsg.MessageParts).CharSet := '
ISO-8859-1';
if i = 0
then
TIdText.Create(FMsg.MessageParts).Body.Add(FMsg.Body.Text);
end;
end;
end
else
begin
FMsg.ContentType := '
text/html';
FMsg.CharSet := '
ISO-8859-1';
end;
setEmailSize(Length(FMsg.Body.Text));
FSmtp.ConnectTimeout := 10000;
if GetUseSSL
and TFile.Exists(FLibeay32)
and TFile.Exists(FSSLeay32)
then
begin
FSmtp.IOHandler := FIdSSLIOHandler;
// Not needed?
// fIdSSLIOHandler.SSLOptions.Mode := sslmUnassigned;
// fIdSSLIOHandler.SSLOptions.VerifyMode := [];
// fIdSSLIOHandler.SSLOptions.VerifyDepth := 0;
//
// fIdSSLIOHandler.Destination := getHost + ':' + IntToStr(getPort);
// fIdSSLIOHandler.Host := getHost;
// fIdSSLIOHandler.Port := getPort;
FSmtp.UseTLS := TIdUseTLS(GetTLSMode);
{*
0 utNoTLSSupport
1 utUseImplicitTLS
2 utUseRequireTLS
3 utUseExplicitTLS
*}
end;
try
FSmtp.Connect;
if FSmtp.Connected
then
begin
try
FSmtp.Send(FMsg);
Result := True;
finally
FSmtp.Disconnect;
end;
end;
except
Result := False;
end;
except
Result := False;
end;
end;
end.