Usando el ejemplo de Envio de correo con Synapse pude enviar correo pude enviar.
Uso Win 10 64 bits
Delphi 10 32bits EMBARCADERO RAD Studio.
La solucion es q en la cuenta gmail q vas a usar debes dale permiso al programa q vas a
usar como gestor.
Aqui les dejo un enlace de como se hace la configuracion de la cuenta gmail.
https://www.ovalsoft.es/configura-gm...s-de-terceros/
En concreto el codigo completo.
Código Delphi
[-]unit main;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs,IdHTTP, StdCtrls, IdBaseComponent, IdComponent, IdTCPConnection,
IdTCPClient, ShellApi, IdMessage, IdExplicitTLSClientServerBase,
IdMessageClient, IdSMTPBase, IdSMTP, IdIOHandler, IdIOHandlerSocket,
IdIOHandlerStack, Mapi,IdSSL, IdSSLOpenSSL, IdServerIOHandler,
blcksock, smtpsend, pop3send, ssl_openssl, MIMEPart, MIMEMess, IdEmailAddress;
type
TForm1 = class(TForm)
Button1: TButton;
sen: TIdHTTP;
Edit1: TEdit;
Memo1: TMemo;
Button2: TButton;
Button3: TButton;
IdSMTP1: TIdSMTP;
IdMessage1: TIdMessage;
Button4: TButton;
IdServerIOHandlerSSLOpenSSL1: TIdServerIOHandlerSSLOpenSSL;
IdSSLIOHandlerSocketOpenSSL1: TIdSSLIOHandlerSocketOpenSSL;
Button5: TButton;
Edit2: TEdit;
Button6: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
private
public
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
function SendMail(const MailFrom, MailTo, Subject : String;
MsgText : TStrings;
SMTPHost, SMTPPort : String;
Login, Password : String;
FileName : String;
SSL : Boolean;
TLS : Boolean
) : Boolean;
var
Msg : TMimeMess;
MimePart : TMimepart;
Smtp: TSMTPSend;
MsgErr : String;
begin
if MailFrom = EmptyStr then
begin
MsgErr := 'MailFrom No Puede Estar en Blanco';
MessageDlg(MsgErr,mtError,[mbOK],0);
Result := False;
Exit;
end;
if MailTo = EmptyStr then
begin
MsgErr := 'MailTo No Puede Estar en Blanco';
MessageDlg(MsgErr,mtError,[mbOK],0);
Result := False;
Exit;
end;
if Subject = EmptyStr then
begin
MsgErr := 'Subject No Puede Estar en Blanco';
MessageDlg(MsgErr,mtError,[mbOK],0);
Result := False;
Exit;
end;
if MsgText.Count = 0 then
begin
MsgErr := 'MsgText No Puede Estar en Blanco';
MessageDlg(MsgErr,mtError,[mbOK],0);
Result := False;
Exit;
end;
if SMTPHost = EmptyStr then
begin
MsgErr := 'SMTPHost No Puede Estar en Blanco';
MessageDlg(MsgErr,mtError,[mbOK],0);
Result := False;
Exit;
end;
if SMTPPort = EmptyStr then
begin
MsgErr := 'SMTPPort No Puede Estar en Blanco';
MessageDlg(MsgErr,mtError,[mbOK],0);
Result := False;
Exit;
end;
if Login = EmptyStr then
begin
MsgErr := 'Login No Puede Estar en Blanco';
MessageDlg(MsgErr,mtError,[mbOK],0);
Result := False;
Exit;
end;
if Password = EmptyStr then
begin
MsgErr := 'Password No Puede Estar en Blanco';
MessageDlg(MsgErr,mtError,[mbOK],0);
Result := False;
Exit;
end;
Msg := TMimeMess.Create;
Smtp := TSMTPSend.Create;
Msg.Header.Date := Now;
Msg.Header.From := MailFrom;
Msg.Header.ToList.Clear;
Msg.Header.ToList.add(MailTo);
Msg.Header.CcList.Clear;
Msg.Header.Subject := Subject;
MIMEPart := Msg.AddPartMultipart('mixed', nil);
Msg.AddPartText(MsgText, MIMEPart);
if (FileName <> EmptyStr) and FileExists(FileName) then
Msg.AddPartBinaryFromFile(FileName, MIMEPart);
Msg.EncodeMessage;
Smtp.UserName := Login;
Smtp.Password := Password;
Smtp.TargetHost := SmtpHost;
Smtp.TargetPort := SmtpPort;
if SSL then Smtp.FullSSL := True; if TLS then Smtp.AutoTLS := True;
if not smtp.Login() then
begin
MsgErr := 'Error Logineee: ' + smtp.EnhCodeString;
MessageDlg(MsgErr,mtError,[mbOK],0);
Result := False;
Exit;
end;
if not smtp.MailFrom(MailFrom, Length(MailFrom)) then
begin
MsgErr := 'Error MailFrom: ' + smtp.EnhCodeString;
MessageDlg(MsgErr,mtError,[mbOK],0);
Result := False;
Exit;
end;
if not smtp.MailTo(MailTo) then
begin
MsgErr := 'Error MailTo: ' + smtp.EnhCodeString;
MessageDlg(MsgErr,mtError,[mbOK],0);
Result := False;
Exit;
end;
if not smtp.MailData(Msg.Lines) then
begin
MsgErr := 'Error MailData: ' + smtp.EnhCodeString;
MessageDlg(MsgErr,mtError,[mbOK],0);
Result := False;
Exit;
end;
if not smtp.Logout() then
begin
MsgErr := 'Error Logout: ' + smtp.EnhCodeString;
MessageDlg(MsgErr,mtError,[mbOK],0);
Result := False;
Exit;
end;
Msg.Free;
Smtp.Free;
Result := True;
end;
procedure TForm1.Button4Click(Sender: TObject);
var
MailFrom, MailTo, Subject : String;
MsgText : TStrings;
SMTPHost, SMTPPort : String;
Login, Password : String;
FileName : String;
FileOnDisk : String;
SSL, TLS : Boolean;
i : Integer;
begin
SMTPHost := 'smtp.gmail.com';
SMTPPort := '465';
Login := 'micuentadegmail@gmail.com';
Password := edit1.Text;
SSL := True;
TLS := False;
MsgText := TStringList.Create;
MailFrom := 'micuentadegmail@gmail.com';
MailTo := 'xxxxxxx@xxxx.com';
Subject := 'Test de Email con Synapse: ' + DateTimeToStr(Now);
for i := 1 to 10 do
MsgText.Add('Línea de Texto de email ' + IntToStr(i));
if SendMail(MailFrom, MailTo, Subject, MsgText, SMTPHost, SMTPPort, Login,
Password, FileName, SSL, TLS)
then
MessageDlg('Email Enviado Satisfactoriamente', mtInformation, [mbOK], 0)
else
MessageDlg('Error en Envío de Email', mtError, [mbOK], 0);
MsgText.Free;
end;
end.
Gracias a todos por sus aportes.
El codigo es tomado de este sitio!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!