Advertisement
filhotecmail

SenMail

Aug 17th, 2017
2,299
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Delphi 12.83 KB | None | 0 0
  1. unit SendMailClass;
  2.  
  3. interface
  4.  
  5. uses Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, ComCtrls,
  6.   ACBrMail, types, ACBrBase, ExtCtrls,
  7.   Vcl.Imaging.pngimage, System.Zip, CompressaoArquivos, FireDAC.Phys.FBDef,
  8.   FireDAC.UI.Intf, FireDAC.VCLUI.Wait, FireDAC.Comp.UI,
  9.   FireDAC.Stan.Intf, FireDAC.Phys, FireDAC.Phys.IBBase, FireDAC.Phys.FB,
  10.   FireDAC.Stan.Option, FireDAC.Stan.Param,StrUtils,
  11.   FireDAC.Stan.Error, FireDAC.DatS, FireDAC.Phys.Intf, FireDAC.DApt.Intf,
  12.   FireDAC.Stan.Async, FireDAC.DApt, AcbrUtil,FuncoesLibraryClass,
  13.   FireDAC.Stan.Def, FireDAC.Stan.Pool, Data.DB, FireDAC.Comp.Client,
  14.   FireDAC.Comp.DataSet, Tipos, Winapi.Messages, DateUtils,
  15.   System.Variants, typinfo, AcbrSatClassFactory, AcbrSat;
  16.  
  17. type
  18.   ISendMailInterface = Interface
  19.     ['{466A2F03-20B5-426E-B099-98ADF109573F}']
  20.  
  21.     procedure AfterOpen(DataSet: TDataset);
  22.     procedure AfterClose(DataSet: TDataset);
  23.     Procedure AfterMailSend(Sender: TObject);
  24.     procedure ContabilizaMovimentofiscal;
  25.     function GetFileList(const Path: string): TStringList;
  26.  
  27.   End;
  28.  
  29. type
  30.   TDadosEmpresa = Record
  31.     Fantasia, Razao, Cnpj, Ie: String;
  32.   End;
  33.  
  34. type
  35.   TSendMailList = class(TInterfacedObject, ISendMailInterface)
  36.   private
  37.  
  38.     FIdSMTPPort: string;
  39.     FIdSMTPPassword: string;
  40.     FIdSMTPHost: string;
  41.     FIdSMTPUsername: string;
  42.     FMailObj: TAcbrMail;
  43.     FFromName: string;
  44.     FFromEmail: string;
  45.     FchkTLS: TCheckBox;
  46.     FchkSSL: TCheckBox;
  47.     FPgrBar: TProgressBar;
  48.     FTCompressao: TCompressao;
  49.     FArquivo: String;
  50.     FArquivoFromEmail: string;
  51.     FTDadosEmpresa: TDadosEmpresa;
  52.     FAssunto: String;
  53.     FTDAvatar: String;
  54.     Ffiscal: TStringList;
  55.     FCopia: String;
  56.     FmailSend: string;
  57.     FMsgString: String;
  58.     Fwait: Tform;
  59.     function getCarregaParametros: TObject;
  60.     procedure setFAssunto(const Value: string);
  61.  
  62.     { Private declaration }
  63.   protected
  64.     { Protected declaration }
  65.   public
  66.     { Public declaration declaration }
  67.  
  68.     property MailObj: TAcbrMail read FMailObj write FMailObj;
  69.     /// <summary> Propriedade Nome do Remetente do email do Tipos String </summary>
  70.     property FromName: string read FFromName write FFromName;
  71.     /// <summary> Propriedade Nome do Remetente do email do Tipos String </summary>
  72.     property FromEmail: string read FFromEmail write FFromEmail;
  73.     property IdSMTPPort: string read FIdSMTPPort write FIdSMTPPort;
  74.     property IdSMTPHost: string read FIdSMTPHost write FIdSMTPHost;
  75.     property IdSMTPUsername: string read FIdSMTPUsername write FIdSMTPUsername;
  76.     property IdSMTPPassword: string read FIdSMTPPassword write FIdSMTPPassword;
  77.     property chkTLS: TCheckBox read FchkTLS write FchkTLS;
  78.     property chkSSL: TCheckBox read FchkSSL write FchkSSL;
  79.     property Assunto: String read FAssunto write setFAssunto;
  80.     /// <summary> Classe TCompressao</summary>
  81.     property Compressao: TCompressao read FTCompressao write FTCompressao;
  82.     property Arquivo: String read FArquivo write FArquivo;
  83.     /// <summary> Carrega os Parametros do Email Fiscal</summary>
  84.     property CarregaParametros: TObject read getCarregaParametros;
  85.     property TDAvatar: String read FTDAvatar write FTDAvatar;
  86.     /// <summary> StringList alimentado na procedure Contabiliza Movimento Fiscal</summary>
  87.     property StringListFiscal: TStringList read Ffiscal write Ffiscal;
  88.     property MailCopia: String read FCopia write FCopia;
  89.     property MailSendDestinatario: string read FmailSend write FmailSend;
  90.     property MsgWait: String read FMsgString write FMsgString;
  91.     property ArquivoFromEmail: string read FArquivoFromEmail
  92.       write FArquivoFromEmail;
  93.     property Wait: Tform read Fwait write Fwait;
  94.     property DadosEmpresa: TDadosEmpresa read FTDadosEmpresa
  95.       write FTDadosEmpresa;
  96.     procedure AfterOpen(DataSet: TDataset);
  97.     procedure AfterClose(DataSet: TDataset);
  98.     Procedure BeforeDestruction; override;
  99.     Procedure AfterMailSend(Sender: TObject);
  100.     /// <summary> Implementa o ACBrSat para leitura dos arquivos fiscais e alimenta o StringList FFiscal </summary>
  101.     procedure ContabilizaMovimentofiscal;
  102.     destructor Destroy; override;
  103.     function GetFileList(const Path: string): TStringList;
  104.     constructor Create(aNomearquivoZip, aValueArquivo: String;
  105.       aPgrBar: TProgressBar; aDTAvatar: string); (* Metodos do Constructor *)
  106.  
  107.   published
  108.     { Protected declaration }
  109.   end;
  110.  
  111. implementation
  112.  
  113. uses DtmConexao;
  114.  
  115. procedure TSendMailList.AfterClose(DataSet: TDataset);
  116. begin
  117.   DataSet.DisposeOf;
  118. end;
  119.  
  120. procedure TSendMailList.AfterMailSend(Sender: TObject);
  121. begin
  122.   MailObj.DisposeOf;
  123. end;
  124.  
  125. procedure TSendMailList.AfterOpen(DataSet: TDataset);
  126. begin
  127.   DataSet.FieldByName('ID').Required := False;
  128.  
  129.   self.FFromName := DataSet.FieldByName('NOMETITULAR').AsString;
  130.   self.FFromEmail := DataSet.FieldByName('EMAILDACONTA').AsString;
  131.   self.FIdSMTPHost := DataSet.FieldByName('HOSTSMTP').AsString;
  132.   self.FIdSMTPUsername := DataSet.FieldByName('USERNAME').AsString;
  133.   self.FIdSMTPPassword := DataSet.FieldByName('PASSWORD').AsString;
  134.   self.FIdSMTPPort := DataSet.FieldByName('SMTPPORT').AsString;
  135.   FCopia := DataSet.FieldByName('MAIL_COPIA1').AsString;
  136.   FmailSend := DataSet.FieldByName('ENVIARPARA').AsString;
  137.   FTDadosEmpresa.Fantasia := AcbrSatClassFactory.TAcbrSatClassFactory.
  138.     SatModelEquipdata.aSatModelData.EMIT_FANTASIA;
  139.   FTDadosEmpresa.Cnpj := AcbrSatClassFactory.TAcbrSatClassFactory.
  140.     SatModelEquipdata.aSatModelData.EMIT_CNPJ;
  141.   FTDadosEmpresa.Ie := AcbrSatClassFactory.TAcbrSatClassFactory.
  142.     SatModelEquipdata.aSatModelData.EMIT_IE;
  143.   FTDadosEmpresa.Razao := AcbrSatClassFactory.TAcbrSatClassFactory.
  144.     SatModelEquipdata.aSatModelData.EMIT_RAZAO;
  145.   DataSet.Close;
  146.   DataSet.AfterClose := AfterClose;
  147.  
  148.   FchkTLS.Checked := True;
  149.   FchkSSL.Checked := True;
  150.   MailObj.FromName := FFromName;
  151.   MailObj.From := FFromEmail;
  152.   MailObj.Host := FIdSMTPHost;
  153.   MailObj.Username := FIdSMTPUsername;
  154.   MailObj.Password := FIdSMTPPassword;
  155.   MailObj.Port := FIdSMTPPort;
  156.   MailObj.SetTLS := True;
  157.   MailObj.SetSSL := True;
  158.   MailObj.DefaultCharset := TMailCharset(0);
  159.   MailObj.IDECharset := TMailCharset(0);
  160.   FMailObj.UseThread := False;
  161.  
  162.   FMailObj.AddAddress(self.FmailSend);
  163.   if FCopia <> '' then begin
  164.      FMailObj.AddCC(self.FCopia);
  165.   end;
  166.   // FMailObj.AddReplyTo('um_email');
  167.   // FMailObj.AddBCC('um_email');
  168.   FMailObj.Subject := 'Arquivos CFE ' + copy(ArquivoFromEmail, 27, 31) +
  169.     ' do caixa ' + inttostr(AcbrSatClassFactory.TAcbrSatClassFactory.
  170.     SatModelEquipdata.aSatModelData.PDV_NCAIXA) + ' ' + FTDadosEmpresa.Fantasia;
  171.   FMailObj.IsHTML := False;
  172.   FMailObj.Body.Text := 'Arquivos CFE do SatFiscal da empresa: ' +
  173.     FTDadosEmpresa.Fantasia + ' ' + FTDadosEmpresa.Cnpj + '' +
  174.     FTDadosEmpresa.Ie;
  175.   FMailObj.AltBody.Text := FAssunto;
  176.   FMailObj.AddAttachment(FArquivoFromEmail, 'Arquivo do Sat');
  177.   FMailObj.Send;
  178.   FMailObj.OnAfterMailProcess := AfterMailSend;
  179.   DataSet.DisposeOf;
  180. end;
  181.  
  182. procedure TSendMailList.BeforeDestruction;
  183. begin
  184.   inherited BeforeDestruction;
  185.  
  186. end;
  187.  
  188. procedure TSendMailList.ContabilizaMovimentofiscal;
  189. var
  190.   Sat: TACBrSat;
  191.   SR: TSearchRec;
  192.   i: Integer;
  193.   Total, TVlProd, TvlPis, TvlCofins, TvlPisST, TvlCofinsST, TvlDescontos,
  194.     TotalAcrescimos, TotalIcmsst, TVlIcms: Currency;
  195.   FirstDate: Tdate;
  196. begin
  197.   try
  198.     Sat := TACBrSat.Create(nil);
  199.     i := FindFirst(concat('C:\Leopard\Pdv\Bin\Vendas\',
  200.       TAcbrSatClassFactory.SatModelEquipdata.aSatModelData.EMIT_CNPJ, '\',
  201.       FTDAvatar, '\*.xml*'), faAnyFile, SR);
  202.     Total := 0;
  203.     TVlProd := 0;
  204.     TvlPis := 0;
  205.     TvlCofins := 0;
  206.     TvlPisST := 0;
  207.     TvlCofinsST := 0;
  208.     TvlDescontos := 0;
  209.     TVlIcms := 0;
  210.     TotalAcrescimos := 0;
  211.     TotalIcmsst := 0;
  212.  
  213.     while i = 0 do
  214.     begin
  215.       Sat.CFe.LoadFromFile(concat('C:\Leopard\Pdv\Bin\Vendas\',
  216.         TAcbrSatClassFactory.SatModelEquipdata.aSatModelData.EMIT_CNPJ, '\',
  217.         FTDAvatar, '\', SR.Name));
  218.       // ImprimirLinha(concat(inttostr(TAcbrSatClassFactory.SatModelEquipdata.AcbrSat1.CFe.ide.nCFe), '-', TAcbrSatClassFactory.SatModelEquipdata.AcbrSat1.CFe.infCFe.ID, ' R$',
  219.       // FormatCurr('###,##0.00', TAcbrSatClassFactory.SatModelEquipdata.AcbrSat1.CFe.Total.vCFe)));
  220.       Total := Total + Sat.CFe.Total.vCFe;
  221.       TVlProd := TVlProd + Sat.CFe.Total.ICMSTot.vProd;
  222.       TvlPis := TvlPis + Sat.CFe.Total.ICMSTot.vPIS;
  223.       TvlCofins := TvlCofins + Sat.CFe.Total.ICMSTot.vCOFINS;
  224.       TvlPisST := TvlPisST + Sat.CFe.Total.ICMSTot.vPISST;
  225.       TvlCofinsST := TvlCofinsST + Sat.CFe.Total.ICMSTot.vCOFINSST;
  226.       TvlDescontos := TvlDescontos + Sat.CFe.Total.ICMSTot.vDesc;
  227.       TVlIcms := TVlIcms + Sat.CFe.Total.ICMSTot.vICMS;
  228.       TotalAcrescimos := TotalAcrescimos +
  229.         Sat.CFe.Total.DescAcrEntr.vAcresSubtot;
  230.       i := FindNext(SR);
  231.     end;
  232.     Ffiscal := TStringList.Create;
  233.     Ffiscal.Add(' ');
  234.     Ffiscal.Add
  235.       (' **** Totalizadores Fiscais do CFE referente ao movimento****');
  236.     Ffiscal.Add(StringOfChar('-',180));
  237.     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$ ');
  238.     Ffiscal.Add(StringOfChar('-',180));
  239.     FFiscal.Add( FormatCurr('###,##0.00',TVlIcms) + '              | ' + FormatCurr('###,##0.00', TvlPis) + '         | '
  240.     + FormatCurr('###,##0.00',TvlCofins) + '       |       ' + FormatCurr('###,##0.00',TvlPisST) + '       |       ' +
  241.      FormatCurr('###,##0.00',TvlCofinsST)+ '          |       '+FormatCurr('###,##0.00',TVlProd)+ '             |          '+ FormatCurr('###,##0.00',TvlDescontos)
  242.      + '          |       '+ FormatCurr('###,##0.00',TotalAcrescimos));
  243.     Ffiscal.Add(StringOfChar('-',180));
  244.     Ffiscal.Add('TOTAL          R$ ' + FormatCurr('###,##0.00', Total));
  245.     Ffiscal.Add
  246.       ('* Empresas do simples nacional nao destacam imposto no campo proprio, no sat são '
  247.       + ' apurados com a csosn 102 para Tributados, e 0500 para produtos sujeitos a ST.');
  248.   finally
  249.     Sat.DisposeOf;
  250.   end;
  251.  
  252. end;
  253.  
  254. constructor TSendMailList.Create(aNomearquivoZip, aValueArquivo: String;
  255.   aPgrBar: TProgressBar; aDTAvatar: string);
  256.  
  257. begin
  258.   inherited Create;
  259.   try
  260.     FMsgString := 'Aguarde Iniciando Processo de leitura dos arquivos xml';
  261.     Wait := OnWait(FMsgString, 600, 55, 'Segoe Ui Light', 14);
  262.     wait.Update;
  263.     Wait.Free;
  264.  
  265.     FTDAvatar := aDTAvatar;
  266.     ContabilizaMovimentofiscal;
  267.     FAssunto :=
  268.       'Ola, segue anexo os arquivos CFE(Cupom Fiscal Eletronico) do SAT Numero'
  269.       + AcbrSatClassFactory.TAcbrSatClassFactory.SatModelEquipdata.
  270.       aSatModelData.aTSatModelEquipdata.EQUIP_SN + ' ' +
  271.       ' pertencentes ao PDV numero ' +
  272.       inttostr(AcbrSatClassFactory.TAcbrSatClassFactory.SatModelEquipdata.
  273.       aSatModelData.PDV_NCAIXA) + ' ' + ' referente ao periodo : ' +
  274.       aNomearquivoZip + ' , ' + ' da empresa ' +
  275.       AcbrSatClassFactory.TAcbrSatClassFactory.SatModelEquipdata.aSatModelData.
  276.       EMIT_RAZAO + ' ' + ' do CNPJ  Nº : ' +
  277.       AcbrSatClassFactory.TAcbrSatClassFactory.SatModelEquipdata.aSatModelData.
  278.       EMIT_CNPJ + ' ' + Ffiscal.Text;
  279.  
  280.     aPgrBar.Position := 1;
  281.  
  282.     FMsgString := 'Aguarde Iniciando Processo de compressão dos arquivos';
  283.     Wait := OnWait(FMsgString, 600, 55, 'Segoe Ui Light', 14);
  284.     wait.Update;
  285.  
  286.     FTCompressao := TCompressao.Create('c:\Leopard\TMP\' + aNomearquivoZip +
  287.       '.zip', aValueArquivo, aPgrBar);
  288.     FArquivoFromEmail := ('c:\Leopard\TMP\' + aNomearquivoZip + '.zip');
  289.     FMailObj := TAcbrMail.Create(Nil);
  290.     FchkTLS := TCheckBox.Create(Nil);
  291.     FchkSSL := TCheckBox.Create(Nil);
  292.  
  293.     Wait.Free;
  294.     FMsgString := 'Aguarde iniciando processo de envio do email';
  295.     Wait := OnWait(FMsgString, 600, 55, 'Segoe Ui Light', 14);
  296.     wait.Update;
  297.     getCarregaParametros;
  298.   finally
  299.     Wait.Free;
  300.     FTCompressao.Free;
  301.   end;
  302.  
  303. end;
  304.  
  305. destructor TSendMailList.Destroy;
  306. begin
  307.  
  308.   inherited Destroy;
  309.   Ffiscal.DisposeOf;
  310. end;
  311.  
  312. function TSendMailList.getCarregaParametros: TObject;
  313. var
  314.   FDconta: TFDquery;
  315. begin
  316.  
  317.   FDconta := TFDquery.Create(nil);
  318.   FDconta.AfterOpen := AfterOpen;
  319.   FDconta.AfterClose := AfterClose;
  320.   FDconta.Connection := DtmConexao.TDtmConexao.FDMasterPdv;
  321.   FDconta.SQL.Clear;
  322.   FDconta.SQL.Text :=
  323.     'Select ID, NOMETITULAR, EMAILDACONTA, HOSTSMTP, USERNAME, "PASSWORD", SMTPPORT,MAIL_COPIA1,ENVIARPARA '
  324.     + ' from CONTAS_EMAIL where ID = 1  ';
  325.   FDconta.Open();
  326. end;
  327.  
  328. function TSendMailList.GetFileList(const Path: string): TStringList;
  329. var
  330.   i: Integer;
  331.   SearchRec: TSearchRec;
  332. begin
  333.   Result := TStringList.Create;
  334.   try
  335.     i := FindFirst(Path, 0, SearchRec);
  336.     while i = 0 do
  337.     begin
  338.       Result.Add(SearchRec.Name);
  339.       i := FindNext(SearchRec);
  340.     end;
  341.   except
  342.     Result.Free;
  343.     raise;
  344.   end;
  345. end;
  346.  
  347. procedure TSendMailList.setFAssunto(const Value: string);
  348. begin
  349.   FAssunto := Value;
  350. end;
  351.  
  352. end.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement