Envió de Correo desde mi aplicación con Adjunto

[AzqLaaClub]

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);
//    procedure IdSSLIOHandlerSocketOpenSSL1GetPassword(var Password: AnsiString);
  private
    { Private declarations }
  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;  // Gmail
   if TLS then Smtp.AutoTLS := True;  // Hotmail

   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
   // Configuración de Gmail
   SMTPHost := 'smtp.gmail.com';
   SMTPPort := '465';
   Login := '[email protected]';
   Password := edit1.Text;
   SSL := True;
   TLS := False;

  MsgText := TStringList.Create;

   MailFrom := '[email protected]';
   // MailFrom := '[email protected]';
   MailTo := '[email protected]';
   Subject := 'Test de Email con Synapse: ' + DateTimeToStr(Now);

   for i := 1 to 10 do
      MsgText.Add('Línea de Texto de email ' + IntToStr(i));

   // Configuración de Hotmail
   {
   SMTPHost := 'smtp.live.com';
   SMTPPort := '587';
   Login := '[email protected]';
   Password := '1234';
   SSL := False;
   TLS := True;
   }

   //FileOnDisk := 'TestFile.txt';

  // FileName := IncludeTrailingBackslash(ExtractFilePath(Application.ExeName)) + FileOnDisk;

   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!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!