Fórum Como enviar e-mail no Delphi #564717

unit uTesteSSL;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, IdTCPConnection, IdTCPClient, IdExplicitTLSClientServerBase,
  IdMessageClient,  IdBaseComponent, IdComponent, IdIOHandler,
  IdIOHandlerSocket, IdIOHandlerStack, IdSSL, IdSSLOpenSSL, StdCtrls, Buttons,
  ExtCtrls, IdMessage, IdSMTPBase, IdSMTP, WinInet , IniFiles;

type
  TForm1 = class(TForm)
    mLog: TMemo;
    Panel1: TPanel;
    edServidor: TEdit;
    edUsuario: TEdit;
    edPorta: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    edSenha: TEdit;
    Panel2: TPanel;
    btEnviar: TBitBtn;
    GroupBox1: TGroupBox;
    ckSSL: TCheckBox;
    Label5: TLabel;
    Label6: TLabel;
    cbMetodo: TComboBox;
    cbTLS: TComboBox;
    cnxSMTP: TIdSMTP;
    Label7: TLabel;
    cbModo: TComboBox;
    procedure FormShow(Sender: TObject);
    procedure IdSSLIOHandlerSocketOpenSSL1StatusInfo(const AMsg: string);
    procedure IdSSLIOHandlerSocketOpenSSL1Status(ASender: TObject;
      const AStatus: TIdStatus; const AStatusText: string);
    procedure btEnviarClick(Sender: TObject);
    procedure ckSSLClick(Sender: TObject);
    procedure cnxSMTPStatus(ASender: TObject; const AStatus: TIdStatus;
      const AStatusText: string);
    procedure cnxSMTPFailedRecipient(Sender: TObject; const AAddress, ACode,
      AText: string; var VContinue: Boolean);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    procedure AddLog(DsMsg: string);
    function IsConnected: Boolean;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.AddLog(DsMsg: string);
begin
   mLog.Lines.Add('['+DateTimeToStr(Now)+'] '+DsMsg);
   Application.ProcessMessages;
end;

function TForm1.IsConnected: Boolean;
const
  INTERNET_CONNECTION_MODEM = 1;
  INTERNET_CONNECTION_LAN = 2;
  INTERNET_CONNECTION_PROXY = 4;
  INTERNET_CONNECTION_MODEM_BUSY = 8;
var
  dwConnectionTypes : DWORD;
begin
  dwConnectionTypes := INTERNET_CONNECTION_MODEM + INTERNET_CONNECTION_LAN + INTERNET_CONNECTION_PROXY;
  If InternetGetConnectedState(@dwConnectionTypes,0) then
    Result := True
  else
    Result := False;
end;

procedure TForm1.btEnviarClick(Sender: TObject);
var Mensagem: TIdMessage;
    IdSSLIOHandlerSocketOpenSSL1: TIdSSLIOHandlerSocketOpenSSL;
begin
   mLog.Clear;
   IdSSLIOHandlerSocketOpenSSL1 := TIdSSLIOHandlerSocketOpenSSL.Create;
   try
      IdSSLIOHandlerSocketOpenSSL1.OnStatusInfo := IdSSLIOHandlerSocketOpenSSL1StatusInfo;
      IdSSLIOHandlerSocketOpenSSL1.OnStatus     := IdSSLIOHandlerSocketOpenSSL1Status;
      try
         AddLog('Entrou para envio de e-mail');
         //verifica se há conexão
         if not IsConnected then
         begin
            raise Exception.Create('Não existe conexão disponível para envio do e-mail.');
            Exit;
         end;

         AddLog('Cria os objetos');
         Mensagem := TIdMessage.Create(nil); // crio os componemtes em tempo de execução

         AddLog('Set de configurações');
         if ckSSL.Checked then
         begin
           cnxSMTP.IOHandler := IdSSLIOHandlerSocketOpenSSL1;
           IdSSLIOHandlerSocketOpenSSL1.SSLOptions.Method := TIdSSLVersion(cbMetodo.ItemIndex);
           IdSSLIOHandlerSocketOpenSSL1.SSLOptions.Mode   := sslmClient;
           IdSSLIOHandlerSocketOpenSSL1.SSLOptions.Method := TIdSSLVersion(cbMetodo.ItemIndex);
           IdSSLIOHandlerSocketOpenSSL1.SSLOptions.Mode   := TIdSSLMode(cbModo.ItemIndex);
           IdSSLIOHandlerSocketOpenSSL1.PassThrough       := True; //Office365

           cnxSMTP.AuthType := satDefault;
           cnxSMTP.UseTLS := TIdUseTLS(cbTLS.ItemIndex);
         end;

         Mensagem.From.Name := 'E-mail Teste SSL'; // Nome do Remetente
         Mensagem.From.Address := edUsuario.Text;
         Mensagem.Recipients.EMailAddresses := '@outlook.com.br';  // destinatario
         Mensagem.Priority := mpHighest;
         Mensagem.Subject := 'Envio pelo programa de testes';

         cnxSMTP.Host     := edServidor.Text;
         cnxSMTP.Username := edUsuario.Text;
         cnxSMTP.Password := edSenha.Text;
         cnxSMTP.AuthType := satDefault;
         cnxSMTP.Port     := StrToInt(edPorta.Text);

         AddLog('Monta o corpo do e-mail');

         Mensagem.ContentType := 'text/html; charset=iso-8859-1;';
         Mensagem.Body.Clear;
         Mensagem.Body.Add('Este email é um teste muito legal para ver se o e-mail é enviado.');

         AddLog(' ***** Conexão ***** ');
         cnxSMTP.Connect;
         AddLog(' ***** Envio ***** ');
         cnxSMTP.Send(Mensagem);
         AddLog(' ***** Email Enviado ***** ');
      except
         AddLog('ERRO: '+ (ExceptObject as Exception).Message);

      end;
   finally
      cnxSMTP.Disconnect;
      AddLog('Desconectado.');

      FreeAndNil(Mensagem); // destruo se não ha uso
      FreeAndNil(IdSSLIOHandlerSocketOpenSSL1);
   end;
end;

procedure TForm1.ckSSLClick(Sender: TObject);
begin
   cbMetodo.Enabled := ckSSL.Checked;
   cbTLS.Enabled    := ckSSL.Checked;
end;

procedure TForm1.cnxSMTPFailedRecipient(Sender: TObject; const AAddress, ACode,
  AText: string; var VContinue: Boolean);
begin
   AddLog('FAILED RECIPIENT SMTP: '+AText);
end;

procedure TForm1.cnxSMTPStatus(ASender: TObject; const AStatus: TIdStatus;
  const AStatusText: string);
begin
   AddLog('STATUS SMTP: '+AStatusText);
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
var
  vIniFile: TIniFile;
begin

  vIniFile := TIniFile.Create(ExtractFilePath(ParamStr(0)) + 'TesteSSL.ini');
  try
      //** Busca os Parâmetros do Gerenciador **//
      with TIniFile.Create(ExtractFilePath(ParamStr(0)) + 'TesteSSL.ini') do
      begin

        //** Sistema de Gerenciamento de Banco de Dados **//
        WriteString('ConfigTesteSSL', 'user', edUsuario.Text);
        WriteString('ConfigTesteSSL', 'password', edSenha.Text);
        WriteString('ConfigTesteSSL', 'smtp', edServidor.Text);
        WriteString('ConfigTesteSSL', 'porta', edPorta.Text);

        if ckSSL.Checked then
          WriteString('ConfigTesteSSL', 'SSL', 'Sim')
        else
          WriteString('ConfigTesteSSL', 'SSL', 'Não');

        WriteString('ConfigTesteSSL', 'modo', cbModo.Text);
        WriteString('ConfigTesteSSL', 'TLS', cbTLS.Text);
        WriteString('ConfigTesteSSL', 'metodo', cbMetodo.Text);


      end;


  finally
    FreeAndNil(vIniFile);
  end;
end;
procedure TForm1.FormCreate(Sender: TObject);
var
 vIniFile : TIniFile;
begin
 // Implementar Busca de    s
  vIniFile := TIniFile.Create(ExtractFilePath(ParamStr(0)) + 'TesteSSL.ini');
  try

    with TIniFile.Create(ExtractFilePath(ParamStr(0)) + 'TesteSSL.ini') do
    begin
      edServidor.Text := ReadString('ConfigTesteSSL', 'smtp', '');
      edUsuario.Text :=  ReadString('ConfigTesteSSL', 'user', '');
      edSenha.Text :=    ReadString('ConfigTesteSSL', 'password', '');
      edPorta.Text :=    ReadString('ConfigTesteSSL', 'porta', '');

      ckSSL.Checked := ReadString('ConfigTesteSSL', 'SSL', '') = 'Sim';

      if ckSSL.Checked then
      cbMetodo.ItemIndex := cbMetodo.Items.IndexOf(ReadString('ConfigTesteSSL', 'metodo', ''));
      cbTLS.ItemIndex := cbTLS.Items.IndexOf(ReadString('ConfigTesteSSL', 'TLS', ''));
      cbModo.ItemIndex := cbModo.Items.IndexOf(ReadString('ConfigTesteSSL', 'modo', ''));

    end;



  finally
    FreeAndNil(vIniFile);
  end;



end;

procedure TForm1.FormShow(Sender: TObject);
begin
   mLog.Clear;
   ckSSLClick(nil);
end;

procedure TForm1.IdSSLIOHandlerSocketOpenSSL1Status(ASender: TObject;
  const AStatus: TIdStatus; const AStatusText: string);
begin
   AddLog('STATUS SSL: '+AStatusText);
end;

procedure TForm1.IdSSLIOHandlerSocketOpenSSL1StatusInfo(const AMsg: string);
begin
   AddLog('STATUS SSL INFO: '+AMsg);
end;

end.