Alguém Poderia Analisar este código

Delphi

18/10/2013

Alguém poderia me dizer o que tem de errado nesse código ?

Na linha idSMTP.Send(lMensagem) está dando o Seguinte Erro. Idsmtp reply error must issue a starttls command first

function TFormRecuperarSenha.EnviaEmail(destino : String; Assunto : String; Mensagem : TStrings) : Boolean;
var
   IdSMTP : TIdSMTP;
   lMensagem : TIdMessage;
   i,x : Integer;
   Linha : String;
begin
   Result := False;
   if destino = EmptyStr then
      begin
          MessageBox(Handle,'Destinatario Não informado.','Erro',MB_ICONERROR + MB_OK);
          Exit;
      end;
   try
      IdSMTP := TIdSMTP.Create(Application);
      try
          lMensagem := TIdMessage.Create(Application);
          idSMTP.Username := 'laboratorioifpr600@gmail.com'; 
          idSMTP.Password :=  '' ; // senha do usuario
          idSMTP.Host := 'smtp.gmail.com'; 
          idSMTP.Port := 587 ; //porta email
          try
              idSMTP.Connect;
              try
                 with lMensagem do
                    begin
                       ContentType := 'text/html';
                       Subject := Assunto;
                       From.Name := 'Laboratório IFPR Londrina';
                       From.Address := 'laboratorioifpr600@gmail.com';
                       Recipients.EmailAddresses := destino; // email de destino
                       Body.Add('<html>');
                       for i := 0 to Mensagem.Count-1 do
                           begin
                              Linha := EmptyStr;
                              for x := 1 to Length(Mensagem.Strings[i]) do if MidStr(Mensagem.Strings[i],x,1) = #32 then Linha := Linha+' ' // ' '
                                  else Linha := Linha+MidStr(Mensagem.Strings[i],x,1);
                              Body.Add(Linha+'<BR>');
                           end;
                       Body.Add('</html>');
                       try
                          idSMTP.Send(lMensagem); // Aqui Está Dando Erro ...
                          Result:=True;
                       except
                          on e : Exception do
                             begin
                                MessageBox(Handle,'Falha no envio do e-mail. Tente mais tarde.','Erro',MB_ICONERROR + MB_OK);
                                Messagebox(Handle,PAnsiChar(e.ClassName+' erro gerado, com mensagem : '+e.Message),'Erro',MB_ICONERROR + MB_OK);
                                Result:=False;
                             end;
                       end;
                    end;
              finally
                 idSMTP.Disconnect;
              end;
          Except
             MessageBox(Handle,'Falha na conexão com internet. Tente mais tarde.','Erro',MB_ICONERROR + MB_OK);
          End;
      finally
          lMensagem.Free;
      end;
   finally
      IdSMTP.Free;
   end;
end;
Flávio Henr4ique

Flávio Henr4ique

Curtidas 0

Respostas

Marcos Iwazaki

Marcos Iwazaki

18/10/2013

veja se isso resolve
https://www.devmedia.com.br/enviando-email-com-encriptacao-ssl-usando-conta-do-gmail/9219

GOSTEI 0
Manoel Jr

Manoel Jr

18/10/2013

o erro é em tempo de execução ou de compilação?
GOSTEI 0
Flávio Henr4ique

Flávio Henr4ique

18/10/2013

O Erro é em tempo de execução. No Depurador foi dado o erro na linha que eu indiquei, a 42.
GOSTEI 0
Vanderson Freitas

Vanderson Freitas

18/10/2013

Brother, não sei se vai te ajudar mas dá uma olhada neste sistema ai do link:

http://www.4shared.com/rar/SS79ky2m/controle_de_negocios.html

É um sistema de gestão empresarial que estou desenvolvendo e disponibilizando os fontes pro pessoal,
já vai ter uma nova atualização neste proximo mês. Nele eu tenho um form para envio de emails para clientes,
e chamo uma trhed para enviar os emails que estão em uma treeview neste form. Esta funcionando legal !

No seu caso ai acho que não está funcionando por questão da parte de seguranca (socket, ssl) !
Se não quiser baixar o sistema e dar uma olhada, Segue o codigo da minha thread !

** Código da Thread: **

unit Thr_EmailCli;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, IdIOHandler, IdIOHandlerSocket, IdIOHandlerStack, IdSSL, IdAttachment,
IdSSLOpenSSL, IdMessage, IdBaseComponent, IdComponent, IdTCPConnection, IdAttachmentFile,
IdTCPClient, IdExplicitTLSClientServerBase, IdMessageClient, IdSMTPBase,
IdSMTP, SUIButton, StdCtrls, ComCtrls, IdAntiFreezeBase, IdAntiFreeze, IdText;

type
TEmailCli = class(TThread)
private
MSG: TIdMessage;
SMTP: TIdSMTP;
SSLSocket: TIdSSLIOHandlerSocketOpenSSL;
IdAnexo: TIdAttachmentFile;
{ Private declarations }
protected
procedure Execute; override;
procedure Atualizar(Status: Boolean; Index: Integer; Email: String);
end;

implementation

uses Unt_EmailCli;

{ Important: Methods and properties of objects in visual components can only be
used in a method called using Synchronize, for example,

Synchronize(UpdateCaption);

and UpdateCaption could look like,

procedure TEmailCli.UpdateCaption;
begin
Form1.Caption := 'Updated in a thread';
end; }

{ TEmailCli }

procedure TEmailCli.Atualizar(Status: Boolean; Index: Integer; Email: String);
begin
if (Status = True) then
begin
Frm_EmailCli.Trv_Email.Items.Item[Index].ImageIndex := 1;
Frm_EmailCli.Trv_Email.Items.Item[Index].SelectedIndex := 1;
Frm_EmailCli.Trv_Email.Items.Item[Index].StateIndex := 1;
end
else
begin
Frm_EmailCli.Trv_Email.Items.Item[Index].ImageIndex := 2;
Frm_EmailCli.Trv_Email.Items.Item[Index].SelectedIndex := 2;
Frm_EmailCli.Trv_Email.Items.Item[Index].StateIndex := 2;
end;

Frm_EmailCli.Pgb_Progresso.Position := Frm_EmailCli.Pgb_Progresso.Position + 1;
Frm_EmailCli.Stsbar.SimpleText := ' Enviando: ' + Email;
end;

procedure TEmailCli.Execute;
var
I, X: Integer;
Sts_Ok: Boolean;
begin
{ Place thread code here }

FreeOnTerminate := True;

Frm_EmailCli.Pgb_Progresso.Min := 0;
Frm_EmailCli.Pgb_Progresso.Max := Frm_EmailCli.v_Qtd;
try
try
SSLSocket := TIdSSLIOHandlerSocketOpenSSL.Create(Nil);
SSLSocket.SSLOptions.Method := sslvSSLv3; //sslvSSLv3
SSLSocket.SSLOptions.Mode := sslmClient; //sslmClient sslmUnassigned
SSLSocket.Port := 587;
SSLSocket.Destination := Frm_EmailCli.v_Smtp+ ':' +IntToStr(Frm_EmailCli.v_Porta);

SMTP := TIdSMTP.Create(Nil);
SMTP.IOHandler := SSLSocket;
SMTP.AuthType := atDefault;
SMTP.Host := Frm_EmailCli.v_Smtp;
SMTP.Port := Frm_EmailCli.v_Porta;
SMTP.UserName := Frm_EmailCli.v_Email;
SMTP.Password := Frm_EmailCli.v_Senha;
SMTP.ConnectTimeout := 10000;
SMTP.ReadTimeout := 10000;
SMTP.UseTLS := utUseExplicitTLS;//utUseExplicitTLS porta 587 pra esse cara/ utUseImplicitTLS(465)
// SMTP.SendCmd('STARTTLS',220);
SMTP.AuthType := atDefault;

MSG := TIdMessage.Create(Nil);
MSG.Clear;
MSG.from.Name := Frm_EmailCli.Edt_De.Text;
MSG.subject := Frm_EmailCli.Edt_Assunto.Text;
MSG.Body.Assign(Frm_EmailCli.Rch_Email.Lines);

MSG.MessageParts.Clear;
if (Frm_EmailCli.ListBoxAnexos.Items.Count > 0) then
begin
for X := 0 to Frm_EmailCli.ListBoxAnexos.Items.Count - 1 do
begin
IdAnexo := TIdAttachmentFile.Create(MSG.MessageParts, Frm_EmailCli.ListBoxAnexos.Items[X]);
IdAnexo.ContentType := 'text/plain'+'; '+'name='+ExtractFileName(Frm_EmailCli.ListBoxAnexos.Items[X]);
end;
end;

except
On E:Exception do
begin
Application.MessageBox(pansichar('Erro Ao Criar Componentes do E-Mail'+#13+E.Message),
' Atenção', MB_OK + MB_ICONHAND);
Exit;
end;
end;

for I := 0 to Frm_EmailCli.Trv_Email.Items.Count -1 do
begin
if (Frm_EmailCli.Trv_Email.Items.Item[I].Level <> 0) then
begin
MSG.recipients.EmailAddresses := Frm_EmailCli.Trv_Email.Items.Item[I].Text;

try
SMTP.Connect;
SMTP.Authenticate;
SMTP.Send(MSG);
SMTP.Disconnect;
Sts_Ok := True;
//Atualizar(Sts_Ok, I, Frm_EmailCli.Trv_Email.Items.Item[I + 1].Text);
Atualizar(Sts_Ok, I, Frm_EmailCli.Trv_Email.Items.Item[I].Text);
except
On E:Exception do
begin
Application.MessageBox(pansichar('Erro Ao Conectar Possiveis Causas:'+#13+#10+
'Verifique a Conexão com a Internet.'+#13+#10+
'Verifique as Configurações do E-Mail,'+#13+#10+
'em Cadastro de Parametros.'+#13+#10+
'Se Estiver Anexando Arquivo,'+#13+#10+
'Verifique se o seu Provedor Suporta o Tamanho do Arquivo.'+#13+#10+
'Se Tiver Duvida em Relação as Configurações do E-mail,'+#13+#10+
'Como Porta, Smtp, Etc. Contate o seu Provedor,'+#13+#10+
'que ele te fornecerá essas informações.'+#13+#10+
'Segue o Erro Encontrado:'+#13+#10+ E.Message), ' Atenção', MB_OK + MB_ICONHAND);

Sts_Ok := False;
// Atualizar(Sts_Ok, I, Frm_EmailCli.Trv_Email.Items.Item[I + 1].Text);
Atualizar(Sts_Ok, I, Frm_EmailCli.Trv_Email.Items.Item[I].Text);
Exit;
end;
end;
end;
end;
finally
FreeAndNil(SMTP);
FreeAndNil(MSG);
FreeAndNil(SSLSocket);

if Assigned(IdAnexo)then
FreeAndNil(IdAnexo);
end;
end;

end.

Fim ** Código da Thread: **

Ah referente ao sistema, nesta proxima versão ja vai está usando os recursos de voz,vale apena dar uma olhada.
GOSTEI 0
Itamar Souza

Itamar Souza

18/10/2013

Alguém poderia me dizer o que tem de errado nesse código ?

Na linha idSMTP.Send(lMensagem) está dando o Seguinte Erro. Idsmtp reply error must issue a starttls command first

function TFormRecuperarSenha.EnviaEmail(destino : String; Assunto : String; Mensagem : TStrings) : Boolean;
var
   IdSMTP : TIdSMTP;
   lMensagem : TIdMessage;
   i,x : Integer;
   Linha : String;
begin
   Result := False;
   if destino = EmptyStr then
      begin
          MessageBox(Handle,'Destinatario Não informado.','Erro',MB_ICONERROR + MB_OK);
          Exit;
      end;
   try
      IdSMTP := TIdSMTP.Create(Application);
      try
          lMensagem := TIdMessage.Create(Application);
          idSMTP.Username := 'laboratorioifpr600@gmail.com'; 
          idSMTP.Password :=  '' ; // senha do usuario
          idSMTP.Host := 'smtp.gmail.com'; 
          idSMTP.Port := 587 ; //porta email
          try
              idSMTP.Connect;
              try
                 with lMensagem do
                    begin
                       ContentType := 'text/html';
                       Subject := Assunto;
                       From.Name := 'Laboratório IFPR Londrina';
                       From.Address := 'laboratorioifpr600@gmail.com';
                       Recipients.EmailAddresses := destino; // email de destino
                       Body.Add('<html>');
                       for i := 0 to Mensagem.Count-1 do
                           begin
                              Linha := EmptyStr;
                              for x := 1 to Length(Mensagem.Strings[i]) do if MidStr(Mensagem.Strings[i],x,1) = #32 then Linha := Linha+' ' // ' '
                                  else Linha := Linha+MidStr(Mensagem.Strings[i],x,1);
                              Body.Add(Linha+'<BR>');
                           end;
                       Body.Add('</html>');
                       try
                          idSMTP.Send(lMensagem); // Aqui Está Dando Erro ...
                          Result:=True;
                       except
                          on e : Exception do
                             begin
                                MessageBox(Handle,'Falha no envio do e-mail. Tente mais tarde.','Erro',MB_ICONERROR + MB_OK);
                                Messagebox(Handle,PAnsiChar(e.ClassName+' erro gerado, com mensagem : '+e.Message),'Erro',MB_ICONERROR + MB_OK);
                                Result:=False;
                             end;
                       end;
                    end;
              finally
                 idSMTP.Disconnect;
              end;
          Except
             MessageBox(Handle,'Falha na conexão com internet. Tente mais tarde.','Erro',MB_ICONERROR + MB_OK);
          End;
      finally
          lMensagem.Free;
      end;
   finally
      IdSMTP.Free;
   end;
end;


Amigo,

Você não falou qual a versão do delphi mais se for 7: pode fazer isso que vai funcionar.

att


procedure TForm1.EnviarEmailComAnexo;
var
xAnexo : Integer;
Email: TIdMessage;
begin

//indica quem está enviando a mensagem
IdMessage1.Subject := 'Titulo ' + ' em ' + FormatDateTime('dd/mm/yyyy hh:mm', Now);
IdMessage1.Sender.Name := 'Nome da Empresa';
IdMessage1.Sender.Address := 'sistemas@daempresa.com.br';
IdMessage1.From.Name := 'Nome da Empresa';


IdMessage1.Recipients.EMailAddresses := 'teste@hotmail.com';

if comCopia.Text <> '' then
begin
IdMessage1.CCList.EMailAddresses := 'teste@hotmail.com';
end;

if comCopiaOculta.Text <> '' then
begin
IdMessage1.BccList.EMailAddresses := 'teste@hotmail.com';
end;


//Trata a Prioridade da mensagem
case cbxPrioridade.ItemIndex of
0 : IdMessage1.Priority := mpHigh;
1 : IdMessage1.Priority := mpNormal;
2 : IdMessage1.Priority := mpLow;
end;

// IdMessage1.ContentType := 'text/html';
IdMessage1.ContentType := 'html';
IdMessage1.CharSet := 'ISO-8859-1';
IdMessage1.Body.Add('Conteúdo da mensagem');


//Tratando os arquivos anexos
for xAnexo := 0 to ListBoxAnexo.Items.Count-1 do
TIdAttachment.Create(IdMessage1.MessageParts, TFileName(ListBoxAnexo.Items.Strings[xAnexo]));


IdSMTP1.Disconnect;
IdSMTP1.Host := '';
IdSMTP1.UserName := '';
IdSMTP1.Password := '';
IdSMTP1.Port := 0;
// IdSMTP1.AuthenticationType := false;

try
IdSMTP1.Connect;
IdSMTP1.Send(IdMessage1);
lbInformacoes.Caption :='Enviado com sucesso!!';
ListBoxAnexo.Clear;
IdMessage1.MessageParts.Clear;
IdMessage1.Body.Clear;
except
lbInformacoes.Caption :='Erro ao enviar o e-mail.';
end;
IdSMTP1.Disconnect;

end;
GOSTEI 0
POSTAR