Fórum EMAIL ENVIA MAS NAO CHEGA #594473
25/05/2018
0
Olá amigos,
Meu problema é o seguinte, meu cliente tem um host contratado e não consigo enviar via idSMTP de jeito nenhum. Para todos os clientes servem, até mesmo nós aqui da empresa usamos o programa, mas para as configurações deste cliente não vai nem a pau. O sistema envia, não dá mensagem de erro, porém não chega.
Utilizo Delphi XE7
Segue código:
function EnviaMail( Email, Conta, Senha, Autentica, Smtp,
Nom_exibe, Porta_smtp, Corpo, Destinatario,
Assunto: string; Anexo, ArquivosAnexados : TStringList; UsaSSL, Auth_TSL: Boolean) : String;
var
Texto :TIdText;
html :TIdText;
Attacha: TIdAttachment;
i: Integer;
IdSSLIOHandlerSocket : TIdSSLIOHandlerSocketOpenSSL;
begin
Result := '';
try
//Limpa IDMEssage
IdMessage.Clear;
//Muda Charset
IdMessage.CharSet:='iso-8859-1';
// Assunto do E-mail
IdMessage.Subject := Assunto;
// E-mail do Remetente = email valido...
IdMessage.From.Address := Email;
// Nome do Remetente
IdMessage.From.Name := Nom_exibe;
// destinatario
IdMessage.Recipients.EMailAddresses := Destinatario;
IdMessage.ContentType := 'multipart/related';
IdMessage.ContentDisposition := 'inline';
IdMessage.Encoding := meMIME;
IdMessage.Priority := mpHighest;
Texto := TIdText.Create(IdMessage.MessageParts);
Texto.ContentType := 'text/html';
Texto.Body.Add(Corpo);
//anexa as imagens que vao no email
Texto := TIdText.Create(IdMessage.MessageParts);
Texto.ContentType := 'text/plain';
for i:= 0 to Anexo.Count -1 do
begin
Attacha := TIdAttachmentFile.Create(IdMessage.MessageParts, Anexo[i]);
Attacha.ExtraHeaders.Values['content-ID'] := ExtraiNomeArquivoDoEndereco(Anexo[i]);
end;
//anexa os anexos que vao no email
Texto := TIdText.Create(IdMessage.MessageParts);
Texto.ContentType := 'text/plain';
for i:= 0 to ArquivosAnexados.Count -1 do
begin
Attacha := TIdAttachmentFile.Create(IdMessage.MessageParts, ArquivosAnexados[i]);
Attacha.ExtraHeaders.Values['content-ID'] := ExtraiNomeArquivoDoEndereco(ArquivosAnexados[i]);
end;
IdSMTP.Host := Smtp;
IdSMTP.Username := Conta;
IdSMTP.Password := Senha;
IdSMTP.AuthType := satDefault;
if Trim(Porta_smtp) = '' then
begin
IdSMTP.Port := 25
end
else
begin
IdSMTP.Port := StrToInt(Porta_smtp);
end;
IdSMTP.UseEhlo := true;
IdSMTP.UseVerp := false;
// IdSMTP.ReadTimeout := 10000;
//Muda Status
lblStatusEnvio.Caption := 'Status do envio: Verificando SSL e STL';
prbStatusEnvio.Position := 50;
prbStatusEnvio.Update;
Application.ProcessMessages;
sleep(3000);
// Configuração do protocolo SSL (TIdSSLIOHandlerSocketOpenSSL)
IdSSLIOHandlerSocket := TIdSSLIOHandlerSocketOpenSSL.Create(Self);
IdSSLIOHandlerSocket.SSLOptions.Method := sslvSSLv23;
IdSSLIOHandlerSocket.SSLOptions.Mode := sslmClient;
IdSMTP.IOHandler := IdSSLIOHandlerSocket;
if Auth_TSL then
begin
IdSSLIOHandlerSocketOpenSSL.SSLOptions.Method := sslvSSLv3;
IdSSLIOHandlerSocketOpenSSL.SSLOptions.Mode := sslmClient;
IdSSLIOHandlerSocketOpenSSL.Port := StrToInt(Porta_smtp);
IdSMTP.AuthType := satDefault;
if StrToInt(Porta_smtp) = 587 then
begin
IdSMTP.UseTLS := utUseExplicitTLS;
end
else
begin
IdSMTP.UseTLS := utUseImplicitTLS;
end;
end
else
begin
IdSMTP.AuthType := satNone;
IdSMTP.UseTLS := utNoTLSSupport ;
end;
//Caso seja obrigado a usar TSL(hotmail)
if UsaSSL then
begin
IdSMTP.UseTLS := utUseRequireTLS;
end;
//servidor requer autentificacao
if Autentica = 'S' then
begin
IdSMTP.AuthType := satDefault;
end
else
begin
IdSMTP.AuthType := satNone;
end;
//Muda Status
lblStatusEnvio.Caption := 'Status do envio: Aguardando resposta do Servidor';
prbStatusEnvio.Position := 70;
prbStatusEnvio.Update;
Application.ProcessMessages;
sleep(8000);
IdSMTP.Connect;
sleep(1000);
Try
if IdSMTP.Connected then
begin
//Muda Status
lblStatusEnvio.Caption := 'Status do envio: Autenticando';
prbStatusEnvio.Position := 80;
prbStatusEnvio.Update;
Application.ProcessMessages;
sleep(1000);
IdSMTP.Authenticate;
sleep(1000);
//Muda Status
lblStatusEnvio.Caption := 'Status do envio: Enviando Mensagem';
prbStatusEnvio.Position := 90;
prbStatusEnvio.Update;
Application.ProcessMessages;
sleep(2000);
IdSMTP.Send(IdMessage);
//Muda Status
lblStatusEnvio.Caption := 'Status do envio: E-Mail enviado';
prbStatusEnvio.Position := 100;
prbStatusEnvio.Update;
Application.ProcessMessages;
btnEnviar.Enabled:= True;
end
else
begin
//Muda Status
lblStatusEnvio.Caption:= 'Status do envio: Mensagem não pode ser enviada';
//Inicializa Barra
prbStatusEnvio.Position := 100;
Application.ProcessMessages;
Result := 'Mensagem não pode ser enviada.';
btnEnviar.Enabled:= True;
exit;
end;
except
IdSMTP.Disconnect;
IdSMTP.Host := Smtp; // smtp
IdSMTP.AuthType := satNone;
IdSMTP.Connect;
try
IdSMTP.Send(IdMessage);
except
begin
//Muda Status
lblStatusEnvio.Caption:= 'Status do envio: Mensagem não pode ser enviada';
//Inicializa Barra
prbStatusEnvio.Position := 100;
Result := 'Não pode enviar o email para ' + Destinatario + '. Verifique as configurações da conta!';
Application.ProcessMessages;
btnEnviar.Enabled:= True;
end;
end;
IdSMTP.Disconnect;
end;
IdSMTP.Disconnect;
finally
end;
if Result = '' then
begin
Result := 'E-Mail enviado para ' + Destinatario;
btnEnviar.Enabled:= True;
end;
end;
Agradeço desde já.
Meu problema é o seguinte, meu cliente tem um host contratado e não consigo enviar via idSMTP de jeito nenhum. Para todos os clientes servem, até mesmo nós aqui da empresa usamos o programa, mas para as configurações deste cliente não vai nem a pau. O sistema envia, não dá mensagem de erro, porém não chega.
Utilizo Delphi XE7
Segue código:
function EnviaMail( Email, Conta, Senha, Autentica, Smtp,
Nom_exibe, Porta_smtp, Corpo, Destinatario,
Assunto: string; Anexo, ArquivosAnexados : TStringList; UsaSSL, Auth_TSL: Boolean) : String;
var
Texto :TIdText;
html :TIdText;
Attacha: TIdAttachment;
i: Integer;
IdSSLIOHandlerSocket : TIdSSLIOHandlerSocketOpenSSL;
begin
Result := '';
try
//Limpa IDMEssage
IdMessage.Clear;
//Muda Charset
IdMessage.CharSet:='iso-8859-1';
// Assunto do E-mail
IdMessage.Subject := Assunto;
// E-mail do Remetente = email valido...
IdMessage.From.Address := Email;
// Nome do Remetente
IdMessage.From.Name := Nom_exibe;
// destinatario
IdMessage.Recipients.EMailAddresses := Destinatario;
IdMessage.ContentType := 'multipart/related';
IdMessage.ContentDisposition := 'inline';
IdMessage.Encoding := meMIME;
IdMessage.Priority := mpHighest;
Texto := TIdText.Create(IdMessage.MessageParts);
Texto.ContentType := 'text/html';
Texto.Body.Add(Corpo);
//anexa as imagens que vao no email
Texto := TIdText.Create(IdMessage.MessageParts);
Texto.ContentType := 'text/plain';
for i:= 0 to Anexo.Count -1 do
begin
Attacha := TIdAttachmentFile.Create(IdMessage.MessageParts, Anexo[i]);
Attacha.ExtraHeaders.Values['content-ID'] := ExtraiNomeArquivoDoEndereco(Anexo[i]);
end;
//anexa os anexos que vao no email
Texto := TIdText.Create(IdMessage.MessageParts);
Texto.ContentType := 'text/plain';
for i:= 0 to ArquivosAnexados.Count -1 do
begin
Attacha := TIdAttachmentFile.Create(IdMessage.MessageParts, ArquivosAnexados[i]);
Attacha.ExtraHeaders.Values['content-ID'] := ExtraiNomeArquivoDoEndereco(ArquivosAnexados[i]);
end;
IdSMTP.Host := Smtp;
IdSMTP.Username := Conta;
IdSMTP.Password := Senha;
IdSMTP.AuthType := satDefault;
if Trim(Porta_smtp) = '' then
begin
IdSMTP.Port := 25
end
else
begin
IdSMTP.Port := StrToInt(Porta_smtp);
end;
IdSMTP.UseEhlo := true;
IdSMTP.UseVerp := false;
// IdSMTP.ReadTimeout := 10000;
//Muda Status
lblStatusEnvio.Caption := 'Status do envio: Verificando SSL e STL';
prbStatusEnvio.Position := 50;
prbStatusEnvio.Update;
Application.ProcessMessages;
sleep(3000);
// Configuração do protocolo SSL (TIdSSLIOHandlerSocketOpenSSL)
IdSSLIOHandlerSocket := TIdSSLIOHandlerSocketOpenSSL.Create(Self);
IdSSLIOHandlerSocket.SSLOptions.Method := sslvSSLv23;
IdSSLIOHandlerSocket.SSLOptions.Mode := sslmClient;
IdSMTP.IOHandler := IdSSLIOHandlerSocket;
if Auth_TSL then
begin
IdSSLIOHandlerSocketOpenSSL.SSLOptions.Method := sslvSSLv3;
IdSSLIOHandlerSocketOpenSSL.SSLOptions.Mode := sslmClient;
IdSSLIOHandlerSocketOpenSSL.Port := StrToInt(Porta_smtp);
IdSMTP.AuthType := satDefault;
if StrToInt(Porta_smtp) = 587 then
begin
IdSMTP.UseTLS := utUseExplicitTLS;
end
else
begin
IdSMTP.UseTLS := utUseImplicitTLS;
end;
end
else
begin
IdSMTP.AuthType := satNone;
IdSMTP.UseTLS := utNoTLSSupport ;
end;
//Caso seja obrigado a usar TSL(hotmail)
if UsaSSL then
begin
IdSMTP.UseTLS := utUseRequireTLS;
end;
//servidor requer autentificacao
if Autentica = 'S' then
begin
IdSMTP.AuthType := satDefault;
end
else
begin
IdSMTP.AuthType := satNone;
end;
//Muda Status
lblStatusEnvio.Caption := 'Status do envio: Aguardando resposta do Servidor';
prbStatusEnvio.Position := 70;
prbStatusEnvio.Update;
Application.ProcessMessages;
sleep(8000);
IdSMTP.Connect;
sleep(1000);
Try
if IdSMTP.Connected then
begin
//Muda Status
lblStatusEnvio.Caption := 'Status do envio: Autenticando';
prbStatusEnvio.Position := 80;
prbStatusEnvio.Update;
Application.ProcessMessages;
sleep(1000);
IdSMTP.Authenticate;
sleep(1000);
//Muda Status
lblStatusEnvio.Caption := 'Status do envio: Enviando Mensagem';
prbStatusEnvio.Position := 90;
prbStatusEnvio.Update;
Application.ProcessMessages;
sleep(2000);
IdSMTP.Send(IdMessage);
//Muda Status
lblStatusEnvio.Caption := 'Status do envio: E-Mail enviado';
prbStatusEnvio.Position := 100;
prbStatusEnvio.Update;
Application.ProcessMessages;
btnEnviar.Enabled:= True;
end
else
begin
//Muda Status
lblStatusEnvio.Caption:= 'Status do envio: Mensagem não pode ser enviada';
//Inicializa Barra
prbStatusEnvio.Position := 100;
Application.ProcessMessages;
Result := 'Mensagem não pode ser enviada.';
btnEnviar.Enabled:= True;
exit;
end;
except
IdSMTP.Disconnect;
IdSMTP.Host := Smtp; // smtp
IdSMTP.AuthType := satNone;
IdSMTP.Connect;
try
IdSMTP.Send(IdMessage);
except
begin
//Muda Status
lblStatusEnvio.Caption:= 'Status do envio: Mensagem não pode ser enviada';
//Inicializa Barra
prbStatusEnvio.Position := 100;
Result := 'Não pode enviar o email para ' + Destinatario + '. Verifique as configurações da conta!';
Application.ProcessMessages;
btnEnviar.Enabled:= True;
end;
end;
IdSMTP.Disconnect;
end;
IdSMTP.Disconnect;
finally
end;
if Result = '' then
begin
Result := 'E-Mail enviado para ' + Destinatario;
btnEnviar.Enabled:= True;
end;
end;
Agradeço desde já.
Marcelo Letteri
Curtir tópico
+ 0
Responder
Clique aqui para fazer login e interagir na Comunidade :)