Email SMTP Delphi 7

unit classSMTPMail;

interface
  uses Dialogs, SysUtils, Variants, dateutils, IdMessage, IdBaseComponent,
  IdComponent, IdTCPConnection, IdTCPClient, IdExplicitTLSClientServerBase,
  IdMessageClient, IdSMTPBase, IdSMTP, IdServerIOHandler, IdSSL, IdSSLOpenSSL,
  IdAttachment, IdMessageParts, IdEmailAddress, IdAttachmentFile, Forms;

type
  newMail = class
    messageRecipient:string;
    messageCC : String;
    messageSubject : String;
    messageFromAddress : String;
    messageBodyAdd : String;
    messageAttachment : String;
    function sendMail() : Boolean;
  end;

implementation

uses uDMPrincipal, Biblioteca, Variaveis;

function newMail.sendMail : Boolean;
var
SMTPCon : TIdSMTP;
SMTPMsg : TIdMessage;
SMTPIOHandler : TIdSSLIOHandlerSocketOpenSSL;
SMTPAttachment : TIdAttachment;
begin
    SMTPCon := TIdSMTP.Create();
    SMTPMsg := TIdMessage.Create();
    SMTPIOHandler := TIdSSLIOHandlerSocketOpenSSL.Create();
    DMPrincipal.db_SMTPMail.Open;
//    DMPrincipal.db_SMTPMail.Execute;
    SMTPCon.AuthType  := satDefault;
    SMTPCon.Host      := DMPrincipal.db_SMTPMailHOST.AsString;
    SMTPCon.Port      := DMPrincipal.db_SMTPMailPORT.AsInteger;
    SMTPCon.Username  := DMPrincipal.db_SMTPMailUSERNAME.AsString;
    SMTPCon.Password  := Decrypt(DMPrincipal.db_SMTPMailPASSWORD.Asstring, chave);
    SMTPCon.IOHandler := SMTPIOHandler;
    SMTPCon.UseTLS    := utUseExplicitTLS;
    with SMTPIOHandler do
        begin
            Destination            := DMPrincipal.db_SMTPMailHOST.AsString;
            Host                   := DMPrincipal.db_SMTPMailHOST.AsString;
            Port                   := DMPrincipal.db_SMTPMailPORT.AsInteger;
            SSLOptions.Method      := sslvSSLv3;
            SSLOptions.Mode        := sslmUnassigned;
            SSLOptions.VerifyMode  := [];
            SSLOptions.VerifyDepth := 0;
        end;
            //Preparar Mensagem...
            SMTPMsg.CharSet                   := 'utf-8';
            SMTPMsg.Encoding                  := meMIME;
            SMTPMsg.ContentType               := 'multipart/mixed';
            SMTPMsg.Priority                  := mpNormal;
            SMTPMsg.Date                      := Now;
            SMTPMsg.From.Name                 := 'Heitor Guarda Borges';
            SMTPMsg.Recipients.Add;
            SMTPMsg.Recipients.EMailAddresses := messageRecipient;   // Remetente
            SMTPMsg.From.Address              := messageFromAddress; // Destinatario
            if (messageCC <> '') then
            SMTPMsg.BccList.EMailAddresses    := messageCC;
            SMTPMsg.Subject                   := messageSubject; // Assunto
            SMTPMsg.Body.Add(messageBodyAdd); // Corpo

        if FileExists(messageAttachment) then
            SMTPAttachment := TIdAttachmentFile.Create(SMTPMsg.MessageParts, messageAttachment);

        try
            try
                SMTPCon.Connect();
                SMTPCon.Authenticate();
            except
              on E:Exception do
              begin
                MessageDlg('Erro ao conectar ao Serviço de Envio de Emails, se o problema persistir Contate o Administrador.'+#13+
                           'Falha na conexão e/ou autenticação: '+E.Message, mtWarning, [mbOK], 0);
                DMPrincipal.db_SMTPMail.Close;
                SMTPCon.Free;
                SMTPIOHandler.Free;
                Result := False;
                exit;
              end;
            end;
          SMTPCon.Send(SMTPMsg);
          SMTPCon.Disconnect();
          SMTPMsg.Clear;
          DMPrincipal.db_SMTPMail.Close;
        except
          on ex: exception do
          begin
            raise exception.Create('Falha no envio da mensagem.' + #13 + ex.Message);
            DMPrincipal.db_SMTPMail.Close;
            SMTPCon.Free;
            SMTPIOHandler.Free;
            Result := False;
            exit;
          end;
        end;
        Showmessage('Email enviado com sucesso para '+messageRecipient);
        DMPrincipal.db_SMTPMail.Close;        
        SMTPCon.Free;
        SMTPIOHandler.Free;
        Result := True;
end;

end.

unit uFrmEnviaEmail;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, Buttons, PngBitBtn, IdIOHandler, IdServerIOHandler,
  IdIOHandlerSocket, IdIOHandlerStack, IdSSL, IdSSLOpenSSL, IdAttachment,
  IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdMessageParts,
  IdExplicitTLSClientServerBase, IdMessageClient, IdSMTPBase, IdSMTP,
  IdMessage, IdEmailAddress, IdAttachmentFile, ComCtrls;

type
  TFrmEnviaEmail = class(TForm)
    Panel1: TPanel;
    PngBtnFechar: TPngBitBtn;
    PngSend: TPngBitBtn;
    Label1: TLabel;
    GroupBox1: TGroupBox;
    edtRemet: TEdit;
    edtDest: TEdit;
    edtAssunto: TEdit;
    GroupBox2: TGroupBox;
    GroupBox3: TGroupBox;
    memoMSG: TMemo;
    lbAnexos: TListBox;
    PngBtnAnexar: TPngBitBtn;
    Panel2: TPanel;
    statusBar: TStatusBar;
    OpenDialog1: TOpenDialog;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    procedure PngBtnFecharClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure PngSendClick(Sender: TObject);
    procedure PngBtnAnexarClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  FrmEnviaEmail: TFrmEnviaEmail;

implementation

uses classSMTPMail, uDMPrincipal, Biblioteca, Variaveis, UsuariosAcao;

{$R *.dfm}

procedure TFrmEnviaEmail.PngBtnFecharClick(Sender: TObject);
begin
  Close;
end;

procedure TFrmEnviaEmail.FormShow(Sender: TObject);
begin
  DMPrincipal.db_SMTPMail.Open;
  Label1.Caption := 'Servidor(es) Ativo(s): '+IntToStr(DMPrincipal.db_SMTPMail.RecordCount);
  AcaoUser[0] := 'Acessou o uso do módulo '+FrmEnviaEmail.Caption;
  LogUsuario(DMPrincipal.Ado_usuariolog, FrmEnviaEmail.Caption, AcaoUser[0]);
end;

procedure TFrmEnviaEmail.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  DMPrincipal.db_SMTPMail.Close;
  AcaoUser[0] := 'Finalizou o uso do módulo '+FrmEnviaEmail.Caption;
  LogUsuario(DMPrincipal.Ado_usuariolog, FrmEnviaEmail.Caption, AcaoUser[0]);
end;

procedure TFrmEnviaEmail.PngSendClick(Sender: TObject);
var
  xsendmail : newMail;
  i: integer;
begin
    PngSend.Enabled              := False;
    Screen.Cursor                := crHourglass;
    statusBar.Panels[0].Text     := 'Aguarde...';
    xsendmail                    := newMail.Create;
    xsendmail.messageRecipient   := edtRemet.Text; // Remetente
    xsendmail.messageFromAddress := edtDest.Text; // Destinatario
    xsendmail.messageSubject     := edtAssunto.Text; // Assunto

    // corpo
    xsendmail.messageBodyAdd := '<html>';
    xsendmail.messageBodyAdd := '    <body>';
    xsendmail.messageBodyAdd := '        <h4>Prezado(a)</h4>';
    xsendmail.messageBodyAdd := '        <font>';
    xsendmail.messageBodyAdd := '        Para eventuais esclarecimentos, estamos em plena disposição.';
    xsendmail.messageBodyAdd := '        <hr>';
    xsendmail.messageBodyAdd := '        <font>';
    xsendmail.messageBodyAdd := '        '+MemoMSG.Text;
    xsendmail.messageBodyAdd := '        </font>';
    xsendmail.messageBodyAdd := '        <b><font>';
    xsendmail.messageBodyAdd := '        <hr>';
    xsendmail.messageBodyAdd := '        ''Isoft - ''
';
    xsendmail.messageBodyAdd := '        <font>';
    xsendmail.messageBodyAdd := '        ''rua paraguai, 3118''
';
    xsendmail.messageBodyAdd := '        </font>';
    xsendmail.messageBodyAdd := '        </font></b>';
    xsendmail.messageBodyAdd := '    </body>';
    xsendmail.messageBodyAdd := '</html>';

    // anexa os arquivos
    if lbAnexos.Items.Count > 0 then
    begin
      for i := 0 to lbAnexos.Items.Count -1 do
        xsendmail.messageAttachment := lbAnexos.Items.Strings[i];
    end;
    try
       except
          On Exc:Exception do
          begin
              ShowMessage('Erro ao carregar o anexo. Verifique o item anexado e tente novamente!');
              abort;
          end;
    end;

    if (xsendmail.sendMail()) then
    begin
        xsendmail.Destroy;
        statusBar.Panels[0].Text := 'Concluído!!!';
        Screen.Cursor   := crDefault;
        PngSend.Enabled := True;
    end
    else
    begin
        xsendmail.Destroy;
        statusBar.Panels[0].Text := 'Falha no envio do email!!!';
        Screen.Cursor   := crDefault;
        PngSend.Enabled := True;
    end;
end;

procedure TFrmEnviaEmail.PngBtnAnexarClick(Sender: TObject);
var
  i: integer;
begin
  if OpenDialog1.Execute then
  begin
    for i:= 0 to OpenDialog1.Files.Count -1 do
    if (lbAnexos.Items.IndexOf(OpenDialog1.Files[i]) = -1) then
      lbAnexos.Items.Add(OpenDialog1.Files[i])
  end;
end;

end.