unit utils_email;
interface
{ Sample:
with TUtilsEMailSender.Create do
begin
Host := 'localhost';
Port := 587;
Username := 'me@domain.com';
Password := 'secret';
From := 'me@domain.com';
Recipients.Add('johdoe@domain.com');
CC.Text:='cc1@domain.com'+sLineBreak+'cc2@domain.com';
BCC.Text:='bcc1@domain.com'+sLineBreak+'bcc2@domain.com';
Subject := edtSubject.Text;
Body := edtBody.Text;
//Attachments.Text := 'attach1.ods' + sLineBreak + 'attach2.html';
Attachments.Add('attach1.ods');
Attachments.Add('attach2.html');
Result := Send;
if Result = '' then
ShowMessage('SUCESS')
else
ShowMessage('FAIL');
Free;
end;
}
uses
Classes, SysUtils;
type
TUtilsEMailSender = class
private
FHost: string;
FPort: Integer;
FUsername: string;
FPassword: string;
FFrom: string;
FRecipients: TStrings;
FCC: TStrings;
FBCC: TStrings;
FSubject: string;
FBody: string;
FAttachments: TStringList;
public
constructor Create;
destructor Destroy; override;
function Send: String;
property Host: string read FHost write FHost;
property Port: Integer read FPort write FPort;
property Username: string read FUsername write FUsername;
property Password: string read FPassword write FPassword;
property From: string read FFrom write FFrom;
property Recipients: TStrings read FRecipients write FRecipients;
property CC: TStrings read FCC write FCC;
property BCC: TStrings read FBCC write FBCC;
property Subject: string read FSubject write FSubject;
property Body: string read FBody write FBody;
property Attachments: TStringList read FAttachments write FAttachments;
end;
implementation
uses
smtpsend, mimemess, mimepart;
{ TUtilsEMailSender }
constructor TUtilsEMailSender.Create;
begin
FRecipients := TStringList.Create;
FCC := TStringList.Create;
FBCC := TStringList.Create;
FAttachments := TStringList.Create;
end;
destructor TUtilsEMailSender.Destroy;
begin
FRecipients.Free;
FCC.Free;
FBCC.Free;
FAttachments.Free;
inherited;
end;
function TUtilsEMailSender.Send: String;
var
vSMTP: TSMTPSend;
vMimeMsg: TMimeMess;
vMimePart: TMimePart;
vTextPart: TStrings;
vFileStream: TFileStream;
i: Integer;
begin
Result := '';
vSMTP := TSMTPSend.Create;
vMimeMsg := TMimeMess.Create;
if (Pos('@', FFrom)<=0) then
Result:='Você não informou o remetente.';
if (Result='') and (Pos('@', FRecipients.Text)<=0) then
Result:='Você não informou o destinatario.';
if (Result='') and (Trim(FSubject)='') then
Result:='Você não informou o assunto.';
if (Result='') and (Trim(FBody)='') then
Result:='Você não informou o conteudo da mensagem.';
try
if Result='' then
begin
try
// Configuração do servidor SMTP
vSMTP.TargetHost := FHost;
vSMTP.TargetPort := IntToStr(FPort);
vSMTP.Username := FUsername;
vSMTP.Password := FPassword;
// Configuração do e-mail
vMimeMsg.Header.From := FFrom;
for i := 0 to FRecipients.Count - 1 do
vMimeMsg.Header.ToList.Add(FRecipients[i]);
for i := 0 to FCC.Count - 1 do
vMimeMsg.Header.CCList.Add(FCC[i]);
vMimeMsg.Header.Subject := FSubject;
// Criação da parte mista (para separar corpo e anexos)
vMimePart := vMimeMsg.AddPartMultipart('mixed', nil);
// Adicionar corpo do e-mail como texto
vTextPart := TStringList.Create;
try
vTextPart.Text := FBody;
vMimeMsg.AddPartText(vTextPart, vMimePart);
finally
vTextPart.Free;
end;
// Adicionar anexos
for i := 0 to FAttachments.Count - 1 do
begin
vFileStream := TFileStream.Create(FAttachments[i], fmOpenRead or fmShareDenyWrite);
try
vMimeMsg.AddPartBinary(vFileStream, ExtractFileName(FAttachments[i]), vMimePart);
finally
vFileStream.Free;
end;
end;
// Conectar ao servidor SMTP e enviar o e-mail
if vSMTP.Login then
begin
vSMTP.MailFrom(FFrom, Length(FBody));
for i := 0 to FRecipients.Count - 1 do
vSMTP.MailTo(FRecipients[i]);
for i := 0 to FCC.Count - 1 do
vSMTP.MailTo(FCC[i]);
// Adicionar destinatários BCC (não incluídos no cabeçalho do e-mail)
for i := 0 to FBCC.Count - 1 do
vSMTP.MailTo(FBCC[i]);
vMimeMsg.EncodeMessage; //glad
vSMTP.MailData(vMimeMsg.Lines);
vSMTP.Logout;
end;
except
on e:exception do
Result:=
'Erro "'+e.message+'": '+sLineBreak+
'Unidade: '+{$I %FILE%}+sLineBreak+
'Linha: '+{$INCLUDE %LINE%}+sLineBreak+
'Método: '+{$I %CURRENTROUTINE%};
end;
end;
finally
vSMTP.Free;
vMimeMsg.Free;
end;
end;
end.
Recent
