Create a new version of paste:

unit SendMailClass;

interface

uses Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, ComCtrls,
  ACBrMail, types, ACBrBase, ExtCtrls,
  Vcl.Imaging.pngimage, System.Zip, CompressaoArquivos, FireDAC.Phys.FBDef,
  FireDAC.UI.Intf, FireDAC.VCLUI.Wait, FireDAC.Comp.UI,
  FireDAC.Stan.Intf, FireDAC.Phys, FireDAC.Phys.IBBase, FireDAC.Phys.FB,
  FireDAC.Stan.Option, FireDAC.Stan.Param,StrUtils,
  FireDAC.Stan.Error, FireDAC.DatS, FireDAC.Phys.Intf, FireDAC.DApt.Intf,
  FireDAC.Stan.Async, FireDAC.DApt, AcbrUtil,FuncoesLibraryClass,
  FireDAC.Stan.Def, FireDAC.Stan.Pool, Data.DB, FireDAC.Comp.Client,
  FireDAC.Comp.DataSet, Tipos, Winapi.Messages, DateUtils,
  System.Variants, typinfo, AcbrSatClassFactory, AcbrSat;

type
  ISendMailInterface = Interface
    ['{466A2F03-20B5-426E-B099-98ADF109573F}']

    procedure AfterOpen(DataSet: TDataset);
    procedure AfterClose(DataSet: TDataset);
    Procedure AfterMailSend(Sender: TObject);
    procedure ContabilizaMovimentofiscal;
    function GetFileList(const Path: string): TStringList;

  End;

type
  TDadosEmpresa = Record
    Fantasia, Razao, Cnpj, Ie: String;
  End;

type
  TSendMailList = class(TInterfacedObject, ISendMailInterface)
  private

    FIdSMTPPort: string;
    FIdSMTPPassword: string;
    FIdSMTPHost: string;
    FIdSMTPUsername: string;
    FMailObj: TAcbrMail;
    FFromName: string;
    FFromEmail: string;
    FchkTLS: TCheckBox;
    FchkSSL: TCheckBox;
    FPgrBar: TProgressBar;
    FTCompressao: TCompressao;
    FArquivo: String;
    FArquivoFromEmail: string;
    FTDadosEmpresa: TDadosEmpresa;
    FAssunto: String;
    FTDAvatar: String;
    Ffiscal: TStringList;
    FCopia: String;
    FmailSend: string;
    FMsgString: String;
    Fwait: Tform;
    function getCarregaParametros: TObject;
    procedure setFAssunto(const Value: string);

    { Private declaration }
  protected
    { Protected declaration }
  public
    { Public declaration declaration }

    property MailObj: TAcbrMail read FMailObj write FMailObj;
    /// <summary> Propriedade Nome do Remetente do email do Tipos String </summary>
    property FromName: string read FFromName write FFromName;
    /// <summary> Propriedade Nome do Remetente do email do Tipos String </summary>
    property FromEmail: string read FFromEmail write FFromEmail;
    property IdSMTPPort: string read FIdSMTPPort write FIdSMTPPort;
    property IdSMTPHost: string read FIdSMTPHost write FIdSMTPHost;
    property IdSMTPUsername: string read FIdSMTPUsername write FIdSMTPUsername;
    property IdSMTPPassword: string read FIdSMTPPassword write FIdSMTPPassword;
    property chkTLS: TCheckBox read FchkTLS write FchkTLS;
    property chkSSL: TCheckBox read FchkSSL write FchkSSL;
    property Assunto: String read FAssunto write setFAssunto;
    /// <summary> Classe TCompressao</summary>
    property Compressao: TCompressao read FTCompressao write FTCompressao;
    property Arquivo: String read FArquivo write FArquivo;
    /// <summary> Carrega os Parametros do Email Fiscal</summary>
    property CarregaParametros: TObject read getCarregaParametros;
    property TDAvatar: String read FTDAvatar write FTDAvatar;
    /// <summary> StringList alimentado na procedure Contabiliza Movimento Fiscal</summary>
    property StringListFiscal: TStringList read Ffiscal write Ffiscal;
    property MailCopia: String read FCopia write FCopia;
    property MailSendDestinatario: string read FmailSend write FmailSend;
    property MsgWait: String read FMsgString write FMsgString;
    property ArquivoFromEmail: string read FArquivoFromEmail
      write FArquivoFromEmail;
    property Wait: Tform read Fwait write Fwait;
    property DadosEmpresa: TDadosEmpresa read FTDadosEmpresa
      write FTDadosEmpresa;
    procedure AfterOpen(DataSet: TDataset);
    procedure AfterClose(DataSet: TDataset);
    Procedure BeforeDestruction; override;
    Procedure AfterMailSend(Sender: TObject);
    /// <summary> Implementa o ACBrSat para leitura dos arquivos fiscais e alimenta o StringList FFiscal </summary>
    procedure ContabilizaMovimentofiscal;
    destructor Destroy; override;
    function GetFileList(const Path: string): TStringList;
    constructor Create(aNomearquivoZip, aValueArquivo: String;
      aPgrBar: TProgressBar; aDTAvatar: string); (* Metodos do Constructor *)

  published
    { Protected declaration }
  end;

implementation

uses DtmConexao;

procedure TSendMailList.AfterClose(DataSet: TDataset);
begin
  DataSet.DisposeOf;
end;

procedure TSendMailList.AfterMailSend(Sender: TObject);
begin
  MailObj.DisposeOf;
end;

procedure TSendMailList.AfterOpen(DataSet: TDataset);
begin
  DataSet.FieldByName('ID').Required := False;

  self.FFromName := DataSet.FieldByName('NOMETITULAR').AsString;
  self.FFromEmail := DataSet.FieldByName('EMAILDACONTA').AsString;
  self.FIdSMTPHost := DataSet.FieldByName('HOSTSMTP').AsString;
  self.FIdSMTPUsername := DataSet.FieldByName('USERNAME').AsString;
  self.FIdSMTPPassword := DataSet.FieldByName('PASSWORD').AsString;
  self.FIdSMTPPort := DataSet.FieldByName('SMTPPORT').AsString;
  FCopia := DataSet.FieldByName('MAIL_COPIA1').AsString;
  FmailSend := DataSet.FieldByName('ENVIARPARA').AsString;
  FTDadosEmpresa.Fantasia := AcbrSatClassFactory.TAcbrSatClassFactory.
    SatModelEquipdata.aSatModelData.EMIT_FANTASIA;
  FTDadosEmpresa.Cnpj := AcbrSatClassFactory.TAcbrSatClassFactory.
    SatModelEquipdata.aSatModelData.EMIT_CNPJ;
  FTDadosEmpresa.Ie := AcbrSatClassFactory.TAcbrSatClassFactory.
    SatModelEquipdata.aSatModelData.EMIT_IE;
  FTDadosEmpresa.Razao := AcbrSatClassFactory.TAcbrSatClassFactory.
    SatModelEquipdata.aSatModelData.EMIT_RAZAO;
  DataSet.Close;
  DataSet.AfterClose := AfterClose;

  FchkTLS.Checked := True;
  FchkSSL.Checked := True;
  MailObj.FromName := FFromName;
  MailObj.From := FFromEmail;
  MailObj.Host := FIdSMTPHost;
  MailObj.Username := FIdSMTPUsername;
  MailObj.Password := FIdSMTPPassword;
  MailObj.Port := FIdSMTPPort;
  MailObj.SetTLS := True;
  MailObj.SetSSL := True;
  MailObj.DefaultCharset := TMailCharset(0);
  MailObj.IDECharset := TMailCharset(0);
  FMailObj.UseThread := False;

  FMailObj.AddAddress(self.FmailSend);
  if FCopia <> '' then begin
     FMailObj.AddCC(self.FCopia);
  end;
  // FMailObj.AddReplyTo('um_email');
  // FMailObj.AddBCC('um_email');
  FMailObj.Subject := 'Arquivos CFE ' + copy(ArquivoFromEmail, 27, 31) +
    ' do caixa ' + inttostr(AcbrSatClassFactory.TAcbrSatClassFactory.
    SatModelEquipdata.aSatModelData.PDV_NCAIXA) + ' ' + FTDadosEmpresa.Fantasia;
  FMailObj.IsHTML := False;
  FMailObj.Body.Text := 'Arquivos CFE do SatFiscal da empresa: ' +
    FTDadosEmpresa.Fantasia + ' ' + FTDadosEmpresa.Cnpj + '' +
    FTDadosEmpresa.Ie;
  FMailObj.AltBody.Text := FAssunto;
  FMailObj.AddAttachment(FArquivoFromEmail, 'Arquivo do Sat');
  FMailObj.Send;
  FMailObj.OnAfterMailProcess := AfterMailSend;
  DataSet.DisposeOf;
end;

procedure TSendMailList.BeforeDestruction;
begin
  inherited BeforeDestruction;

end;

procedure TSendMailList.ContabilizaMovimentofiscal;
var
  Sat: TACBrSat;
  SR: TSearchRec;
  i: Integer;
  Total, TVlProd, TvlPis, TvlCofins, TvlPisST, TvlCofinsST, TvlDescontos,
    TotalAcrescimos, TotalIcmsst, TVlIcms: Currency;
  FirstDate: Tdate;
begin
  try
    Sat := TACBrSat.Create(nil);
    i := FindFirst(concat('C:\Leopard\Pdv\Bin\Vendas\',
      TAcbrSatClassFactory.SatModelEquipdata.aSatModelData.EMIT_CNPJ, '\',
      FTDAvatar, '\*.xml*'), faAnyFile, SR);
    Total := 0;
    TVlProd := 0;
    TvlPis := 0;
    TvlCofins := 0;
    TvlPisST := 0;
    TvlCofinsST := 0;
    TvlDescontos := 0;
    TVlIcms := 0;
    TotalAcrescimos := 0;
    TotalIcmsst := 0;

    while i = 0 do
    begin
      Sat.CFe.LoadFromFile(concat('C:\Leopard\Pdv\Bin\Vendas\',
        TAcbrSatClassFactory.SatModelEquipdata.aSatModelData.EMIT_CNPJ, '\',
        FTDAvatar, '\', SR.Name));
      // ImprimirLinha(concat(inttostr(TAcbrSatClassFactory.SatModelEquipdata.AcbrSat1.CFe.ide.nCFe), '-', TAcbrSatClassFactory.SatModelEquipdata.AcbrSat1.CFe.infCFe.ID, ' R$',
      // FormatCurr('###,##0.00', TAcbrSatClassFactory.SatModelEquipdata.AcbrSat1.CFe.Total.vCFe)));
      Total := Total + Sat.CFe.Total.vCFe;
      TVlProd := TVlProd + Sat.CFe.Total.ICMSTot.vProd;
      TvlPis := TvlPis + Sat.CFe.Total.ICMSTot.vPIS;
      TvlCofins := TvlCofins + Sat.CFe.Total.ICMSTot.vCOFINS;
      TvlPisST := TvlPisST + Sat.CFe.Total.ICMSTot.vPISST;
      TvlCofinsST := TvlCofinsST + Sat.CFe.Total.ICMSTot.vCOFINSST;
      TvlDescontos := TvlDescontos + Sat.CFe.Total.ICMSTot.vDesc;
      TVlIcms := TVlIcms + Sat.CFe.Total.ICMSTot.vICMS;
      TotalAcrescimos := TotalAcrescimos +
        Sat.CFe.Total.DescAcrEntr.vAcresSubtot;
      i := FindNext(SR);
    end;
    Ffiscal := TStringList.Create;
    Ffiscal.Add(' ');
    Ffiscal.Add
      (' **** Totalizadores Fiscais do CFE referente ao movimento****');
    Ffiscal.Add(StringOfChar('-',180));
    Ffiscal.Add('T. Icms R$ | T. Pis R$  | T. Cofins R$ | T. PisST R$ | T. CofinsST R$ | T. Produtos | T. Descontos R$ | T. Acrescimos R$ ');
    Ffiscal.Add(StringOfChar('-',180));
    FFiscal.Add( FormatCurr('###,##0.00',TVlIcms) + '              | ' + FormatCurr('###,##0.00', TvlPis) + '         | '
    + FormatCurr('###,##0.00',TvlCofins) + '       |       ' + FormatCurr('###,##0.00',TvlPisST) + '       |       ' +
     FormatCurr('###,##0.00',TvlCofinsST)+ '          |       '+FormatCurr('###,##0.00',TVlProd)+ '             |          '+ FormatCurr('###,##0.00',TvlDescontos)
     + '          |       '+ FormatCurr('###,##0.00',TotalAcrescimos));
    Ffiscal.Add(StringOfChar('-',180));
    Ffiscal.Add('TOTAL          R$ ' + FormatCurr('###,##0.00', Total));
    Ffiscal.Add
      ('* Empresas do simples nacional nao destacam imposto no campo proprio, no sat são '
      + ' apurados com a csosn 102 para Tributados, e 0500 para produtos sujeitos a ST.');
  finally
    Sat.DisposeOf;
  end;

end;

constructor TSendMailList.Create(aNomearquivoZip, aValueArquivo: String;
  aPgrBar: TProgressBar; aDTAvatar: string);

begin
  inherited Create;
  try
    FMsgString := 'Aguarde Iniciando Processo de leitura dos arquivos xml';
    Wait := OnWait(FMsgString, 600, 55, 'Segoe Ui Light', 14);
    wait.Update;
    Wait.Free;

    FTDAvatar := aDTAvatar;
    ContabilizaMovimentofiscal;
    FAssunto :=
      'Ola, segue anexo os arquivos CFE(Cupom Fiscal Eletronico) do SAT Numero'
      + AcbrSatClassFactory.TAcbrSatClassFactory.SatModelEquipdata.
      aSatModelData.aTSatModelEquipdata.EQUIP_SN + ' ' +
      ' pertencentes ao PDV numero ' +
      inttostr(AcbrSatClassFactory.TAcbrSatClassFactory.SatModelEquipdata.
      aSatModelData.PDV_NCAIXA) + ' ' + ' referente ao periodo : ' +
      aNomearquivoZip + ' , ' + ' da empresa ' +
      AcbrSatClassFactory.TAcbrSatClassFactory.SatModelEquipdata.aSatModelData.
      EMIT_RAZAO + ' ' + ' do CNPJ  Nº : ' +
      AcbrSatClassFactory.TAcbrSatClassFactory.SatModelEquipdata.aSatModelData.
      EMIT_CNPJ + ' ' + Ffiscal.Text;

    aPgrBar.Position := 1;

    FMsgString := 'Aguarde Iniciando Processo de compressão dos arquivos';
    Wait := OnWait(FMsgString, 600, 55, 'Segoe Ui Light', 14);
    wait.Update;

    FTCompressao := TCompressao.Create('c:\Leopard\TMP\' + aNomearquivoZip +
      '.zip', aValueArquivo, aPgrBar);
    FArquivoFromEmail := ('c:\Leopard\TMP\' + aNomearquivoZip + '.zip');
    FMailObj := TAcbrMail.Create(Nil);
    FchkTLS := TCheckBox.Create(Nil);
    FchkSSL := TCheckBox.Create(Nil);

    Wait.Free;
    FMsgString := 'Aguarde iniciando processo de envio do email';
    Wait := OnWait(FMsgString, 600, 55, 'Segoe Ui Light', 14);
    wait.Update;
    getCarregaParametros;
  finally
    Wait.Free;
    FTCompressao.Free;
  end;

end;

destructor TSendMailList.Destroy;
begin

  inherited Destroy;
  Ffiscal.DisposeOf;
end;

function TSendMailList.getCarregaParametros: TObject;
var
  FDconta: TFDquery;
begin

  FDconta := TFDquery.Create(nil);
  FDconta.AfterOpen := AfterOpen;
  FDconta.AfterClose := AfterClose;
  FDconta.Connection := DtmConexao.TDtmConexao.FDMasterPdv;
  FDconta.SQL.Clear;
  FDconta.SQL.Text :=
    'Select ID, NOMETITULAR, EMAILDACONTA, HOSTSMTP, USERNAME, "PASSWORD", SMTPPORT,MAIL_COPIA1,ENVIARPARA '
    + ' from CONTAS_EMAIL where ID = 1  ';
  FDconta.Open();
end;

function TSendMailList.GetFileList(const Path: string): TStringList;
var
  i: Integer;
  SearchRec: TSearchRec;
begin
  Result := TStringList.Create;
  try
    i := FindFirst(Path, 0, SearchRec);
    while i = 0 do
    begin
      Result.Add(SearchRec.Name);
      i := FindNext(SearchRec);
    end;
  except
    Result.Free;
    raise;
  end;
end;

procedure TSendMailList.setFAssunto(const Value: string);
begin
  FAssunto := Value;
end;

end.