Banco de dados por email

unit uEnviarEmail;

interface

uses SysUtils, Types, Windows, smtpsend, ssl_openssl, mimemess,
     IniFiles, mimepart, Graphics, Contnrs, Classes;

const
  Codes64 = '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz+/';

type
  TSendMailThread = class(TThread)
  private
    FException : Exception;
    procedure DoHandleException;
    function RetornaDadosProvedor(AChave, AValue : string) : string;
  public

    Terminado: Boolean;
    smtp : TSMTPSend;
    AFonteDados : string;
    sFrom : String;
    sTo : String;
    sSmtpHost, sSmtpPort, sSmtpUser, sSmtpPasswd : string;
    sCC : TStrings;
    slmsg_Lines : TStrings;
    constructor Create( AOwner : TComponent);
    Destructor Destroy; override ;

    function EnviarEmail(const sSmtpHost, sSmtpPort, sSmtpUser,
     sSmtpPasswd, sFrom, sTo, sAssunto: String; sMensagem : TStrings; SSL : Boolean;
     sCC: TStrings = nil; Anexos : TStrings = nil; PedeConfirma: Boolean = False;
     AguardarEnvio: Boolean = False; NomeRemetente: String = ''; TLS : Boolean = True) : boolean;

  protected
    procedure Execute; override;
    procedure HandleException;
  end;

implementation

Uses Forms, StrUtils, dateutils;

function Desincriptar(S: string): string;
var
  i: integer;
  a: integer;
  X: integer;
  b: integer;
begin
  Result := '';
  a := 0;
  b := 0;
  for i := 1 to Length(S) do
  begin
    X := Pos(S[i], Codes64) - 1;
    if X >= 0 then
    begin
      b := b * 64 + X;
      a := a + 6;
      if a >= 8 then
      begin
        a := a - 8;
        X := b shr a;
        b := b mod (1 shl a);
        X := X mod 256;
        Result := Result + chr(X);
      end;
    end
    else
      Exit;
  end;
end;

function TSendMailThread.RetornaDadosProvedor(AChave, AValue : string) : string;
var
  cPath : string;
begin
  cPath := AFonteDados;

  with TIniFile.Create(cPath) do
    begin
      try
        Result := ReadString(AChave, AValue, '');
      finally
        Destroy;
      end;
    end;
end;

constructor TSendMailThread.Create( AOwner : TComponent );
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
     Terminado := False;

     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);

     finally
       try
         smtp.Sock.CloseSocket;
       except
       end ;
       Terminado := True;
     end;
   except
     Terminado := True;
     HandleException;
   end;
end;

procedure TSendMailThread.DoHandleException;
begin
   if FException is Exception then
      Application.ShowException(FException)
   else
      SysUtils.ShowException(FException, nil);
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;

function TSendMailThread.EnviarEmail(const sSmtpHost, sSmtpPort, sSmtpUser,
  sSmtpPasswd, sFrom, sTo, sAssunto: String; sMensagem : TStrings; SSL : Boolean;
  sCC: TStrings = nil; Anexos : TStrings = nil; PedeConfirma: Boolean = False;
  AguardarEnvio: Boolean = False; NomeRemetente: String = ''; TLS : Boolean = True) : boolean;
var
  ThreadSMTP : TSendMailThread;
  m : TMimemess;
  p : TMimepart;
  StreamNFe : TStringStream;
  I : Integer;
begin
  Result := False;

  m := TMimemess.create;

  ThreadSMTP := TSendMailThread.Create(Application);  // Não Libera, pois usa FreeOnTerminate := True ;
  StreamNFe  := TStringStream.Create('');
  try
    p := m.AddPartMultipart('mixed', nil);
    if sMensagem <> nil then
       m.AddPartText(sMensagem, p);

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

    m.header.tolist.add(sTo);

    if Trim(NomeRemetente) <> '' then
       m.header.From := Format('%s<%s>', [NomeRemetente, sFrom])
    else
       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;
    if Trim(sSmtpPort)<>'' then     // Usa default
       ThreadSMTP.smtp.TargetPort := sSmtpPort;

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

    try
      ThreadSMTP.Resume; // inicia a thread

      if AguardarEnvio then
        begin
          repeat
            Sleep(1000);
            Application.ProcessMessages;
          until ThreadSMTP.Terminado;
        end;

      Result := True;
    except
      Result := False;
    end;

  finally
    m.free;
    StreamNFe.Free;
  end;
end;


end.