[firebase-br] enviar email para todos clientes

[Hugo Jose de Sousa]

unit UEmailBoleto;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, jpeg, ExtCtrls, PDJRotoLabel,
  smtpsend, ssl_openssl, mimemess, mimepart, ComCtrls, Gauges;
{ Units para envio de email : smtpsend ssl_openssl mimemess mimepart,}

type
  TFEmailBoleto = class(TForm)
    btnEnviarEmail: TBitBtn;
    ProLabel1: TPDJRotoLabel;
    TmTempo: TTimer;
    img1: TImage;
    GaugeEmail: TGauge;
    lb1: TLabel;
    procedure btnEnviarEmailClick(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word; Shift:
TShiftState);
    procedure TmTempoTimer(Sender: TObject);
    procedure FormShow(Sender: TObject);

  private
    { Private declarations }

  public
    { Public declarations }
  end;
  TSendMailThread = class(TThread)
  private
    FException: Exception;
    procedure DoHandleException;
  public
    smtp: TSMTPSend;
    sFrom: string;
    sTo: string;
    sCC: TStrings;
    slmsg_Lines: TStrings;
    constructor Create;
    destructor Destroy; override;
  protected
    procedure Execute; override;
    procedure HandleException;
  end;
procedure EnviarEmail(const sSmtpHost,
  sSmtpPort,
  sSmtpUser,
  sSmtpPasswd,
  sFrom,
  sTo,
  sAssunto: string;
  boletoPdf: string;
  sMensagem: TStrings;
  SSL: Boolean;
  EnviaPDF: Boolean = true;
  sCC: TStrings = nil;
  Anexos: TStrings = nil;
  PedeConfirma: Boolean = False);
var
  FEmailBoleto: TFEmailBoleto;

implementation

uses
  UImpDoc, UdmImpCS, FuncoesGeral, UdmPrincipal, StrUtils;

{$R *.dfm}

{ TSendMailThread }

procedure TSendMailThread.DoHandleException;
begin
  Sysutils.ShowException(FException, nil);
end;

constructor TSendMailThread.Create;
begin
  smtp := TSMTPSend.Create;
  slmsg_Lines := TStringList.Create;
  sCC := TStringList.Create;

  sFrom := '';
  sTo := '';

  FreeOnTerminate := True;

  inherited Create(True);
end;

destructor TSendMailThread.Destroy;
begin
  slmsg_Lines.Free;
  sCC.Free;
  smtp.Free;

  inherited;
end;

procedure TSendMailThread.Execute;
var
  i: integer;
begin
  inherited;
  try
    if not smtp.Login() then
      raise Exception.Create('SMTP ERROR: Login:' + smtp.EnhCodeString +
        sLineBreak + smtp.FullResult.Text);

    if not smtp.MailFrom(sFrom, Length(sFrom)) then
      raise Exception.Create('SMTP ERROR: MailFrom:' + smtp.EnhCodeString +
        sLineBreak + smtp.FullResult.Text);

    if not smtp.MailTo(sTo) then
      raise Exception.Create('SMTP ERROR: MailTo:' <'> + smtp.EnhCodeString
+
        sLineBreak + smtp.FullResult.Text);

    if (sCC <> nil) then
    begin
      for I := 0 to sCC.Count - 1 do
      begin
        if not smtp.MailTo(sCC.Strings[i]) then
          raise Exception.Create('SMTP ERROR: MailTo:' <'> +
smtp.EnhCodeString +
            sLineBreak + smtp.FullResult.Text);
      end;
    end;
    if not smtp.MailData(slmsg_Lines) then
      raise Exception.Create('SMTP ERROR: MailData:' + smtp.EnhCodeString +
        sLineBreak + smtp.FullResult.Text);
    if not smtp.Logout() then
      raise Exception.Create('SMTP ERROR: Logout:' + smtp.EnhCodeString +
        sLineBreak + smtp.FullResult.Text);
  except
    try
      smtp.Sock.CloseSocket;
    except
    end;
    HandleException;
  end;
end;

procedure TSendMailThread.HandleException;
begin
  FException := Exception(ExceptObject);
  try
    {Não mostra mensagens de EAbort}
    if not (FException is EAbort) then
      Synchronize(DoHandleException);
  finally
    FException := nil;
  end;
end;

procedure EnviarEmail(const sSmtpHost,
  sSmtpPort,
  sSmtpUser,
  sSmtpPasswd,
  sFrom,
  sTo,
  sAssunto: string;
  boletoPdf: string;
  sMensagem: TStrings;
  SSL: Boolean;
  EnviaPDF: Boolean = true;
  sCC: TStrings = nil;
  Anexos: TStrings = nil;
  PedeConfirma: Boolean = False);
var
  ThreadSMTP: TSendMailThread;
  m: TMimemess;
  p: TMimepart;
  StreamBoleto: TStringStream;

  i: Integer;
begin
  m := TMimemess.create;
  ThreadSMTP := TSendMailThread.Create;
  { Não Libera, pois usa FreeOnTerminate := True}
  StreamBoleto := TStringStream.Create('');
  try
    p := m.AddPartMultipart('mixed', nil);
    if sMensagem <> nil then
      m.AddPartText(sMensagem, p);

    if (EnviaPDF) then
    begin
      m.AddPartBinaryFromFile(boletoPdf, p);
    end;

    if assigned(Anexos) then
      for i := 0 to Anexos.Count - 1 do
      begin
        m.AddPartBinaryFromFile(Anexos[i], p);
      end;

    m.header.tolist.add(sTo);
    m.header.From := sFrom;
    m.header.subject := sAssunto;
    m.Header.ReplyTo := sFrom;
    if PedeConfirma then
      m.Header.CustomHeaders.Add('Disposition-Notification-To: ' + sFrom);
    m.EncodeMessage;

    ThreadSMTP.sFrom := sFrom;
    ThreadSMTP.sTo := sTo;

    if sCC <> nil then
      ThreadSMTP.sCC.AddStrings(sCC);
    ThreadSMTP.slmsg_Lines.AddStrings(m.Lines);

    ThreadSMTP.smtp.UserName := sSmtpUser;
    ThreadSMTP.smtp.Password := sSmtpPasswd;

    ThreadSMTP.smtp.TargetHost := sSmtpHost;
    ThreadSMTP.smtp.TargetPort := sSmtpPort;

    ThreadSMTP.smtp.FullSSL := SSL;
    ThreadSMTP.smtp.AutoTLS := True;

    ThreadSMTP.Resume; { inicia a thread }

  finally
    m.free;
    StreamBoleto.Free;
  end;
end;