Mandar email con adjunto
 

Hola compañeros, podíais facilitarme el trozo de código que manda un email con un adjunto, lo tenia, pero un virus ataco a mi equipo y he perdido un montón de cosas

he probado con un montón de códigos y los mensajes de error son de lo mas diversos y no he logrado sacar ni un triste email y llevo horas y nada, asi que prefiero solicitar ayuda, antes de que me duela más la cabeza.

Lo que quiero hacer por si os vale de ayuda, es lo siguiente.

1º) se selecciona si quiero mandar un email (ok)
2º) si es así, crea del documento un archivo Pdf (oK)
3º) Paso los datos a un formulario para mandar el email, los datos son:
El email ,El asunto, la ruta del archivo, el nombre del archivo y el cuerpo del mensaje
Para llegar a este paso el cliente debe tener email (ok todo)
4) Pulso el botón mandar email, aquí lo primero que hace es comprobar si debemos mandar el texto de la ley de protección de datos (mediante un simple checkbox OK)
coge nuestros datos de la bd. configuración, Nombre de usuario, Email, Servidor en este caso 'smtp.gmail.com' y por último la contraseña (ok)
Y aquí es donde falla, salir el email

Como siempre siempre agradezco vuestra ayuda

Código Delphi [-]
IdMessage2.ClearBody;
IdMessage2.Recipients.EMailAddresses:='correo@correo.es';
IdMessage2.Subject:='Asunto';
IdMessage2.Priority:=MpNormal;
IdMessage2.From.Text:='micorreo@micorreo.es';
IdMessage2.Body.Text:='Cuerpo';
TIdAttachmentFile.create(IdMessage2.MessageParts,'C:\Adjunto.pdf');
try
IdSMTP2.Connect;
try
IdSMTP2.Send(IdMessage2);
Finally
IdSMTP2.Disconnect;
end;

Saludos.

ElDioni gracias, pero sigue sin funcionar, e incluso he probado con la configuración de mi correo en vez del Gmail y no hay manera.

Hola.

Te envío un trozo de código de lo que yo uso, usando SSL. Si algo no ves claro me preguntas.

Saludos

Código Delphi [-]
  IdEnviar := TIdMessage.Create(Self);
  TextoMensaje:=Texto+#13+#10+Firma+#13+#10+TablaDatos.FieldByname('TEXTOMAIL').Value;
  IdEnviar.Body.Text     := TextoMensaje;
  IdEnviar.From.Address  := CorreoPropio; { e-mail del que envía }
  IdEnviar.From.Name     := DlgPropiedades.NombreEmpresa; { El nombre del que envía }
  IdEnviar.Subject       := Subject;

  TIdAttachmentFile.Create(IdEnviar.MessageParts, GetTempDir+'\DOCUMENTO.PDF'); //Para adjuntar archivos al mensaje

  ListaDestinatarios:=CargaRegistro(Correo,';');

  for N := 0 to ListaDestinatarios.Count - 1 do begin
    ElDestinatario         := IdEnviar.Recipients.Add;
    ElDestinatario.Address := ListaDestinatarios[N]; { Primer destinatario }
  end;
//  ElDestinatario.Name    := 'Nombre del primer destinario';
  If Copia<>'' then begin
    ElDestinatario         := IdEnviar.Recipients.Add;
    ElDestinatario.Address := Copia; { Primer destinatario }
  end;
  Application.ProcessMessages ;
  IdSMTP1.Host       := Host;
  IdSMTP1.UserName   := UserId;
  IdSMTP1.Password   := Pass;

  if Puerto<>0 then IdSMTP1.Port:= Puerto;

  if(TablaDatos.FieldByName('TLSMAIL').AsString<>'') and (Copy(TablaDatos.FieldByName('TLSMAIL').AsString,1,1)<>'1') then begin
    idSMTP1.IOHandler := IdSSLIOHandlerSocketOpenSSL;
    if Copy(TablaDatos.FieldByname('TLSMAIL').AsString,1,1)='2' then begin
      idSMTP1.UseTLS := utUseExplicitTLS;
    end else if Copy(TablaDatos.FieldByname('TLSMAIL').AsString,1,1)='3' then begin
      idSMTP1.UseTLS := utUseImplicitTLS;
    end else if Copy(TablaDatos.FieldByname('TLSMAIL').AsString,1,1)='4' then begin
      idSMTP1.UseTLS := utUseRequireTLS;
    end else begin
      idSMTP1.UseTLS := utNoTLSSupport;
    end;
//    IdSSLIOHandlerSocketOpenSSL.Host :=TablaDatos.FieldByname('HOSTCO').AsString;
//    IdSSLIOHandlerSocketOpenSSL.Destination :=TablaDatos.FieldByname('HOSTCO').AsString+':'+IntToStr(IdSMTP1.Port);
  end;
  Bd.CierraTabla (TablaDatos);

  Try
    IdSMTP1.Connect;
    try
      IdSMTP1.Send(idEnviar);
    finally

    end;

  except
raise;
     ShowMessage('¡ATENCION! Problema de conexion');
     Close;
  end;
  IdSMTP1.Disconnect(true);

hola compañeros agradezco vuestra ayuda, pero no logro que tire, el error que más me sale es



e puesto un componente IdSSLIOHandlerSocketOpenSSL vinculado a mi IDSMTP y la propiedad UseTLS en sus diferentes modos y nada, la verdad es que me tiene totalmente parado ya que es una parte fundamental en el trabajo que estoy haciendo, así que os pido ayuda nuevamente

Así es como paso los datos



Y así es el form en diseño con los componentes que veis únicamente

siguiendo dando vueltas al tema, he vuelto a la función que se que me funciona, que es

Código Delphi [-]
procedure TForm1.Button1Click(Sender: TObject);
function EnviarEmail(aData, aHora : TDateTime; aHost, aLogin, aSenha,aListaEmail, aAssunto, aCorpo : String; Mifile:string) : Boolean;
var
  IdSMTP    : TIdSMTP;
  IdMessage : TIdMessage;
  Cabecalho: string;
begin
  Cabecalho:= '';
  Result:= False;
  IdSMTP    := TIdSMTP   .Create(nil);
  IdMessage := TIdMessage.Create(nil);
  try
    IdSMTP.Host:= aHost;
    IdSMTP.AuthType:= satDefault;
    IdSMTP.Username:= aLogin;
    IdSMTP.Password:= aSenha;
    IdSMTP.Connect;

    IdMessage.From.Address:= aLogin;
    IdMessage.Recipients.EMailAddresses:= aListaEmail;
    IdMessage.Subject:= aAssunto;
    IdMessage.Body.Text:='Data: '+DateToStr(aData)+#13#10+'Hora: '+TimeToStr(aHora)+#13#10+ aCorpo;
    IdMessage.MessageParts.Clear;
    if Mifile<>'' then TIdAttachmentFile.Create(IdMessage.MessageParts,Mifile);
    try
      IdSMTP.Send(IdMessage);
    except
      on E: Exception do
        begin
          MessageDlg('Error al intentar enviar este correo '+#13#10+e.Message,mtWarning,[mbok],0);
          Exit;
        end;
    end;
  finally
    IdSMTP   .Disconnect;
    IdSMTP   .Free;
    IdMessage.Free;
  end;
  Result:= True;
end;

begin                      //Servido Email     Correo Origen   //Clave Origen    Correo Destino          Asunto    Mensaje

//    EnviarEmail(Date,Time, 'smtp.eresmas.com','Desart@eresmas.com','xxx', 'info@jl68.es','Evido de email','Enviando email via programa��o utilizando os recursos da poderosa paleta indy',fichero);
    EnviarEmail(Date,Time, 'smtp.eresmas.com','Desart@eresmas.com','xxx', Edit1.text,Edit2.Text,Memo1.Lines.Text,fichero);
end;

a esta le he añadido para adjuntar ficheros en mifile con esta única linea

Código Delphi [-]
    if Mifile<>'' then TIdAttachmentFile.Create(IdMessage.MessageParts,Mifile);

y me sale el error



que como veis es totalmente diferente, en cambio si lo mando sin fichero, funciona perfectamente, siempre y cuando no lo mande desde una cuenta Gmail, en la que me da el error antes comentado.

Hola.

Eso tiene toda la pinta de ser un problema de que el fichero por algún motivo no lo localiza. ¿Estás seguro de que el fichero está ahí? o igual esa ruta con acentos, espacios, etc no le mola al componente. Puedes probar a hacer una prueba con un fichero en una carpeta de nombre sencillo. p.e. C:\TEMP\PRUEBA.JPG

Saludos

Hola Newtron, si el fichero es ese, lo cargo para estar seguro con un openDialog y e probado con un archivo simple en el raiz la ruta es c:\1.txt y ni así funciona

Club Delphi,

Revisa este código:

Código Delphi [-]
unit UfrmPrincipal;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls,

  IdIOHandler, IdIOHandlerSocket, IdSSLOpenSSL, IdMessage,
  IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
  IdMessageClient, IdSMTP;

type
  TfrmPrincipal = class(TForm)
    mCuerpoEmail: TMemo;
    edAsuntoEmail: TEdit;
    edServidorSmtp: TEdit;
    lbAsuntoEmail: TLabel;
    lbCuerpoEmail: TLabel;
    lbServidorSmtp: TLabel;
    edNombreUsuario: TEdit;
    btnEnviarEmail: TButton;
    lbNombreUsuario: TLabel;
    edEmailRemitente: TEdit;
    lbEmailRemitente: TLabel;
    edContrasenaUsuario: TEdit;
    edEmailDestinatario: TEdit;
    lbEmailDestinatario: TLabel;
    lbContrasenaUsuario: TLabel;
    IdSMTP: TIdSMTP;
    IdMessage: TIdMessage;
    IdSSLIOHandlerSocket: TIdSSLIOHandlerSocket;
    OpenDialog1: TOpenDialog;
    Button1: TButton;
    procedure btnEnviarEmailClick(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  end;

var
  frmPrincipal: TfrmPrincipal;
  Adjunto : String;

implementation

{$R *.dfm}

procedure TfrmPrincipal.btnEnviarEmailClick(Sender: TObject);
begin

  with IdMessage do
  begin

     Body.Clear();
     Recipients.Clear();
     Sender.Address := edEmailRemitente.Text;
     Recipients.EMailAddresses := edEmailDestinatario.Text;
     Subject := edAsuntoEmail.Text;
     Body.AddStrings(mCuerpoEmail.Lines);

     if FileExists(Adjunto) then
        with TIdAttachment.Create(MessageParts,Adjunto) do
        begin
           ContentType := 'binary';
        end

  end;

  with IdSMTP do
  begin

     IOHandler := IdSSLIOHandlerSocket;
     IdSSLIOHandlerSocket.SSLOptions.Method := sslvSSLv23; // sslv : SSLv2, SSLv3, TLSv1, SSLv23.
     IdSSLIOHandlerSocket.SSLOptions.Mode := sslmUnassigned;
     IdSSLIOHandlerSocket.SSLOptions.VerifyMode := [];
     IdSSLIOHandlerSocket.SSLOptions.VerifyDepth := 0;
     Port := 465;
     Host := edServidorSmtp.Text;
     AuthenticationType := atLogin;
     Username := edNombreUsuario.Text;
     Password := edContrasenaUsuario.Text;

     try
        Connect(5000);
     except
        raise Exception.Create('Error de Conexión');
     end;

     btnEnviarEmail.Enabled := false;
     try
        Send(IdMessage);
        ShowMessage('Correo enviado con éxito');
     finally
        btnEnviarEmail.Enabled := true;
     end;

     if Connected then
        Disconnect();

  end;

end;

procedure TfrmPrincipal.Button1Click(Sender: TObject);
begin
   if openDialog1.Execute then
      adjunto := openDialog1.Filename;
end;

end.

El código anterior envía un email con su adjunto vía Gmail con Delphi 7 bajo Windows 7 Professional x32, Indy 9.00.10 y la librería ssl indy_openssl096 (libeay32.dll y ssleay32.dll).

La librería indy_openssl096 esta disponible en : indy_openssl096.zip

Espero sea útil :)

Nelson.

hola buenos días y gracias por tu respuesta nlsgarcia (supongo que es Nelsón García) lo he seguido intentando, pero no hay manera en cuanto a las Dll, he bajado las siguientes

librery32dll y ssleay32.dll de la web http://indy.fulgan.com/SSL/, se supone que son para Windows 64 y mis indi son los 10.5.5, en cuanto a cargar las Dll, me he limitado a soltarlas en el directorio del programa y no he usado la tipica linea de código

para llamarlas, ya que no veo que se haga en ninguno de los ejemplos aportados, puede que hay ocurra mi error, pero si es asi, en que proceso las llamo y son las librerias correctas

Por si estuviera algo mal voy a poner como tengo configurado los componentes



y este es el código que estoy usando

Código Delphi [-]
   with IdMessage do
  begin

     Body.Clear();
     Recipients.Clear();
     Sender.Address := xxxxx@gmail.com';
     Recipients.EMailAddresses := xxx@xxx.es';
     Subject := edit2.Text;  El asunto
     Body.AddStrings(Memo1.Lines);
     Adjunto:=Edit3.Text+Edit4.Text;
     ShowMessage('['+Adjunto+']');

     if FileExists(Adjunto) then
      with TIdAttachmentFile.Create(MessageParts,Adjunto) do
      begin
           ContentType := 'binary';
      end

  end;

  with IdSMTP do
  begin

     IOHandler := IdSSLIOHandlerSocketOpenSSL1;
     IdSSLIOHandlerSocketOpenSSL1.SSLOptions.Method := sslvSSLv23; // sslv : SSLv2, SSLv3, TLSv1, SSLv23.
     IdSSLIOHandlerSocketOpenSSL1.SSLOptions.Mode := sslmUnassigned;
     IdSSLIOHandlerSocketOpenSSL1.SSLOptions.VerifyMode := [];
     IdSSLIOHandlerSocketOpenSSL1.SSLOptions.VerifyDepth := 0;
     Port := 465;
     Host := 'smtp.gmail.com';
     AuthType := satDefault;
     Username := 'xxxxxxx@gmail.com';
     Password := 'xxxxxxxx';

     try
        Connect;
     except
        raise Exception.Create('Error de Conexión');
     end;

//     btnEnviarEmail.Enabled := false;
//     try
//        Send(IdMessage);
//        ShowMessage('Correo enviado con éxito');
//     finally
//        btnEnviarEmail.Enabled := true;
//     end;

     if Connected then
        Disconnect();

  end;

Este me sigue pidiendo es las Ssl, se me olvido comentarlo antes

P.D. y ahora me hago un par de preguntas y cuando funcione, si en vez de mandarlo por Gmail, lo manda por una cuenta diferente, el código seguiría valiendo o habría que cambiarlo todo.


Como podéis ver no os he mentido, cuando digo que estoy verde en muchos aspectos e internet y sus comunicaciones es uno de mis puntos más débiles

José Luis Garcí,

Pregunto :

1- ¿Que versión de Windows utilizas?, ¿Es de 32 o 64 Bits?.

2- ¿En que versión de Delphi estas probando el código sugerido?.

Espero sea útil :)

Nelson.

Claro como no Windows 7 64 bits y delphi 2010

José Luis Garcí,

El código sugerido en el Msg #9 fue probado solamente en Delphi 7 bajo Windows 7 Professional x32.

Depende de las opciones de configuración de la otra cuenta de email, en general se debe hacer ajustes.

Revisa este código:

Código Delphi [-]
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, blcksock, smtpsend, pop3send, ssl_openssl, MIMEPart, MIMEMess;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  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 Login: ' + 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.Button1Click(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

   MsgText := TStringList.Create;
   
   MailFrom := 'username@gmail.com';  
   // MailFrom := 'username@hotmail.com';
   MailTo := 'anotherusername@gmail.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));

   // Configuración de Gmail
   SMTPHost := 'smtp.googlemail.com';
   SMTPPort := '465';
   Login := 'username';
   Password := '1234';
   SSL := True;
   TLS := False;

   // Configuración de Hotmail
   {
   SMTPHost := 'smtp.live.com';
   SMTPPort := '587';
   Login := 'username@hotmail.com';
   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.

El código anterior permite enviar un email y su attachment con Delphi 7 y Delphi 2010 bajo Windows 7 Professional x32 y la librería Synapse (2012-04-23 - Release no. 40). En todos los casos de prueba funciono correctamente con cuentas de Gmail y Hotmail sin requerir ninguna modificación la función de envío de email, es decir: La función sirve por igual para cuentas de tipo SSL, TLS y planas.

La librería Synapse esta disponible en : Synapse TCP/IP and Serial Library

Las características de la librería están detalladas en : Synapse's Features

Nota: La librería Synapse no funciona en Windows de 64 Bits, no requiere instalación de componentes y solo se debe hacer referencia a las unidades de la librería en el Library Path de Delphi 7 y Delphi 2010.

Pregunto : ¿Tienes la posibilidad de hacer el Desarrollo de la aplicación en Windows 7 de 32 Bits?.

Delphi 2010 compila los ejecutables en 32 Bits y si tienes la posibilidad de usar Windows 7 de 32 Bits podrías solventar el problema de los emails con el código sugerido anteriormente, de no ser así avísame y esta semana haré pruebas con Delphi 2010 y Indy bajo Windows 7 Professional x64.

Espero sea útil :)

Nelson.

Dentro de un rato lo pruebo, Nelson, si no me equivoco Delphi 2010, sólo compila en 32 bits, pero claro muchas veces tengo que poner librerias y otros de 64 bits, como el firebird, para evitar problemas con mi sistema, que luego funciona en otros a 32 bits.

Como comentaba, las pocas veces que he trabajado con una librería normalmente las tengo que llamar durante el programa, en todos los referentes al Gmail y te aseguro que he hecho pruebas y he mirado no he visto la llamada por ningún lado y me ha estrañado.

he intentado el tema de los certificados siguiendo los pasos de esta página para intentar el tema de los certificados, pero no ha habido manera de lograrlo y la verdad es bastante frustrante.

Esta es un parte fundamental del código que estoy desatollando, ya que el cliente quiere emitir el documento y mandarlo por mail según lo haga de una manera casi automatizada y preferiría hacerlo por código y no con un programa externo, que más adelante pueda darme problemas.

Te agradezco sinceramente el tiempo que me estas dedicando.

José Luis Garcí,

Es correcto ^\||/

La llamada a la librería ssl indy_openssl096 (libeay32.dll y ssleay32.dll) se hace internamente en Indy, no desde el código fuente, es por ello que el único requerimiento es garantizar que la ruta de la librería sea accesible a la aplicación.

Pregunto: ¿Para que requieres un certificado SSL para el envío de email por medio del protocolo SMTP?.

Revisa el código sugerido en el Msg #15, si te es posible hacer el desarrollo en Delphi 2010 bajo Windows 7 Professional x32 el mencionado código funcionara según lo esperado.

Espero sea útil :)

Nelson.

Mañana sin falto lo pruebo y gracias por dedicarme parte de tu tiempo, compañero.

Hola Nelson lo he intentado, pero no he podido, luego he cogido el codigo, y lo he vuelto a intentar, pero necesito, saber que componentes són necesarios, si puedes me mandas , el código con los fuentes y el ejecutable de todas maneras, a tu aclaración

Me preocupa, ya que no sólo puedo hacerlo desde esta plataforma (64 bits en el sistema)

José Luis Garcí,

La librería Synapse no utiliza componentes ni requiere instalación, solo se debe hacer referencia a las unidades de la librería en el Library Path de Delphi pero con la acotación de que no funciona en Win64.

Pregunto:

1- ¿Probastes el ejemplo sugerido en el Msg #15 en Win32?.

2- ¿Te es posible llevar tu proyecto a Win32?.

Espero sea útil :)

Nelson.

José Luis Garcí,

Revisa este código:

Código Delphi [-]
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Mapi;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function SendMailMAPI(const Subject, Body: String; Filenames: TStrings;
                      SenderName, SenderEMail, RecepientName, RecepientEMail: String): Integer;
type
   TAttachAccessArray = array [0..0] of TMapiFileDesc;
   PAttachAccessArray = ^TAttachAccessArray;

var
   MailMessage: TMapiMessage;
   lpSender, lpRecepient: TMapiRecipDesc;
   FileName: string;
   Attachments: PAttachAccessArray;
   SM: TFNMapiSendMail;
   MAPIModule: HModule;
   Counter: Byte;

   AuxStr : String;
   pAuxStr : Array[0..255] of AnsiChar;

   pSubject : Array[0..255] of AnsiChar;
   pBody : Array[0..9999] of AnsiChar;
   pSenderName : Array[0..255] of AnsiChar;
   pSenderEMail : Array[0..255] of AnsiChar;
   pRecepientName : Array[0..255] of AnsiChar;
   pRecepientEMail : Array[0..255] of AnsiChar;
   pFileName : Array[0..255] of AnsiChar;
   pFilePathName : Array[0..255] of AnsiChar;

begin

   StrPCopy(pSubject,Subject);
   StrPCopy(pBody,Body);
   StrPCopy(pSenderName,SenderName);
   StrPCopy(pSenderEMail,SenderEMail);
   StrPCopy(pRecepientName,RecepientName);
   StrPCopy(pRecepientEMail,RecepientEMail);

   FillChar(MailMessage, SizeOf(MailMessage), 0);

   with MailMessage do
   begin

      if (Subject <> '') then
         MailMessage.lpszSubject := @pSubject;

      if (Body <> '') then
         MailMessage.lpszNoteText := @pBody;

      if (SenderEMail <> '') then
      begin

         lpSender.ulRecipClass := MAPI_ORIG;

         if (SenderName = '') then
            lpSender.lpszName := @pSenderEMail
         else
            lpSender.lpszName := @pSenderName;

         AuxStr := 'SMTP:' + SenderEMail;
         StrPCopy(pAuxStr,AuxStr);

         lpSender.lpszAddress := @pAuxStr;
         lpSender.ulReserved := 0;
         lpSender.ulEIDSize := 0;
         lpSender.lpEntryID := nil;
         lpOriginator := @lpSender;

      end;

      if (RecepientEMail <> '') then
      begin
         lpRecepient.ulRecipClass := MAPI_TO;
         if (RecepientName = '') then
            lpRecepient.lpszName := @pRecepientEMail
         else
            lpRecepient.lpszName := @pRecepientName;

         AuxStr := 'SMTP:' + RecepientEMail;
         StrPCopy(pAuxStr,AuxStr);

         lpRecepient.lpszAddress := @pAuxStr;
         lpRecepient.ulReserved := 0;
         lpRecepient.ulEIDSize := 0;
         lpRecepient.lpEntryID := nil;
         nRecipCount := 1;
         lpRecips := @lpRecepient;
      end
      else
         lpRecips := nil;

      if Filenames.Count > 0 then
      begin

         nFileCount := Filenames.Count;

         GetMem(Attachments, SizeOf(TMapiFileDesc) * Filenames.Count);

         for Counter := 0 to Filenames.Count - 1 do
         begin
            FileName := Filenames[counter];
            Attachments[counter].ulReserved := 0;
            Attachments[counter].flFlags := 0;
            Attachments[counter].nPosition := ULONG($FFFFFFFF);

            StrPCopy(pFilePathName, Filename);
            Attachments[counter].lpszPathName := @pFilePathName;

            StrPCopy(pFileName, ExtractFileName(Filename));
            Attachments[counter].lpszFileName := @pFileName;

            Attachments[counter].lpFileType := nil;
         end;

         lpFiles := @Attachments^;

      end
      else
      begin
         nFileCount := 0;
         lpFiles := nil;
      end;

   end;

   MAPIModule := LoadLibrary(PChar(MAPIDLL));
   if MAPIModule = 0 then
      Result := -1
   else
   begin
      try
         @SM := GetProcAddress(MAPIModule, 'MAPISendMail');
         if @SM <> nil then
            Result := SM(0, Application.Handle, MailMessage, MAPI_DIALOG or MAPI_LOGON_UI, 0)
         else
            Result := 1
      finally
            FreeLibrary(MAPIModule);
      end;
   end;

end;

procedure TForm1.Button1Click(Sender: TObject);
var
   Subject, Body : String;
   MsgText : TStringList;
   Filenames : TStringList;
   SenderName, SenderEMail, RecepientName, RecepientEMail : String;
   i : Integer;

begin

   Subject := 'Prueba de Email con MAPI';

   MsgText := TStringList.Create;

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

   Body := MsgText.Text;

   Filenames := TStringList.Create;
   Filenames.Add(IncludeTrailingBackslash(ExtractFilePath(Application.ExeName)) + 'TestFile1.txt');
   Filenames.Add(IncludeTrailingBackslash(ExtractFilePath(Application.ExeName)) + 'TestFile2.txt');

   SenderName := 'UserName Surname';
   SenderEMail := 'userName@gmail.com';

   RecepientName := 'AnotherUserName AnotherSurname';
   RecepientEMail := 'anotheruserName@gmail.com';

   SendMailMAPI(Subject, Body, Filenames, SenderName, SenderEMail, RecepientName, RecepientEMail);

   Filenames.Free;
   MsgText.Free;

end;

end.

El código anterior permite el envío de emails con sus adjuntos por medio del cliente por default de email a través de MAPI en Delphi 2010 bajo Windows 7 Professional x32 y x64, funcionado correctamente con los clientes de email FireBird y OutLook 2010.

La solución anterior depende de un programa externo (Cliente de email por default), pero es una solución intermedia (Parte código, Parte Programa Externo) que puede ser viable dependiendo de los requerimientos funcionales del proceso a automatizar.

Espero sea útil :)

Nelson.

José Luis Garcí,

(Continuación del Msg #21)

Revisa este código:

Código Delphi [-]
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Mapi;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function SendMailMAPI(Subject, MsgText: String;
                      Filenames: TStrings;
                      SenderName, SenderEMail, RecepientName, RecepientEMail: String): Integer;
type
   TAttachAccessArray = array [0..0] of TMapiFileDesc;
   PAttachAccessArray = ^TAttachAccessArray;

var
   MailMessage: TMapiMessage;
   lpSender, lpRecepient: TMapiRecipDesc;
   FileName: string;
   Attachments: PAttachAccessArray;
   SM: TFNMapiSendMail;
   MAPIModule: HModule;
   Counter: Byte;

   AuxStr : String;
   pAuxStr : Array[0..255] of AnsiChar;

   pSubject : Array[0..255] of AnsiChar;
   pMsgText : Array[0..9999] of AnsiChar;
   pSenderName : Array[0..255] of AnsiChar;
   pSenderEMail : Array[0..255] of AnsiChar;
   pRecepientName : Array[0..255] of AnsiChar;
   pRecepientEMail : Array[0..255] of AnsiChar;
   pFileName : Array[0..255] of AnsiChar;
   pPathName : Array[0..255] of AnsiChar;

begin

   StrPCopy(pSubject,Subject);
   StrPCopy(pMsgText,MsgText);
   StrPCopy(pSenderName,SenderName);
   StrPCopy(pSenderEMail,SenderEMail);
   StrPCopy(pRecepientName,RecepientName);
   StrPCopy(pRecepientEMail,RecepientEMail);

   FillChar(MailMessage, SizeOf(MailMessage), 0);

   with MailMessage do
   begin

      if (Subject <> '') then
         MailMessage.lpszSubject := @pSubject;

      if (MsgText <> '') then
         MailMessage.lpszNoteText := @pMsgText;

      if (SenderEMail <> '') then
      begin

         lpSender.ulRecipClass := MAPI_ORIG;

         if (SenderName = '') then
            lpSender.lpszName := @pSenderEMail
         else
            lpSender.lpszName := @pSenderName;

         AuxStr := 'SMTP:' + SenderEMail;
         StrPCopy(pAuxStr,AuxStr);

         lpSender.lpszAddress := @pAuxStr;
         lpSender.ulReserved := 0;
         lpSender.ulEIDSize := 0;
         lpSender.lpEntryID := nil;
         lpOriginator := @lpSender;

      end;

      if (RecepientEMail <> '') then
      begin
         lpRecepient.ulRecipClass := MAPI_TO;
         if (RecepientName = '') then
            lpRecepient.lpszName := @pRecepientEMail
         else
            lpRecepient.lpszName := @pRecepientName;

         AuxStr := 'SMTP:' + RecepientEMail;
         StrPCopy(pAuxStr,AuxStr);

         lpRecepient.lpszAddress := @pAuxStr;
         lpRecepient.ulReserved := 0;
         lpRecepient.ulEIDSize := 0;
         lpRecepient.lpEntryID := nil;
         nRecipCount := 1;
         lpRecips := @lpRecepient;
      end
      else
         lpRecips := nil;

      if Filenames.Count > 0 then
      begin

         nFileCount := Filenames.Count;

         GetMem(Attachments, SizeOf(TMapiFileDesc) * Filenames.Count);

         for Counter := 0 to Filenames.Count - 1 do
         begin
            FileName := Filenames[counter];
            Attachments[counter].ulReserved := 0;
            Attachments[counter].flFlags := 0;
            Attachments[counter].nPosition := ULONG($FFFFFFFF);

            StrPCopy(pPathName, Filename);
            Attachments[counter].lpszPathName := StrNew(pPathName);

            StrPCopy(pFileName, ExtractFileName(Filename));
            Attachments[counter].lpszFileName := StrNew(pFileName);

            Attachments[counter].lpFileType := nil;
         end;

         lpFiles := @Attachments^;

      end
      else
      begin
         nFileCount := 0;
         lpFiles := nil;
      end;

   end;

   MAPIModule := LoadLibrary(PChar(MAPIDLL));
   if MAPIModule = 0 then
      Result := -1
   else
   begin
      try
         @SM := GetProcAddress(MAPIModule, 'MAPISendMail');
         if @SM <> nil then
            Result := SM(0, Application.Handle, MailMessage, MAPI_DIALOG or MAPI_LOGON_UI, 0)
         else
            Result := 1
      finally
            FreeLibrary(MAPIModule);
      end;
   end;

end;

procedure TForm1.Button1Click(Sender: TObject);
var
   Subject : String;
   MsgText : TStringList;
   FileName : String;
   Filenames : TStringList;
   SenderName, SenderEMail, RecepientName, RecepientEMail : String;
   i : Integer;

begin

   Subject := 'Prueba de Email con MAPI';

   MsgText := TStringList.Create;

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

   Filenames := TStringList.Create;

   FileName := IncludeTrailingBackslash(ExtractFilePath(Application.ExeName)) + 'TestFile1.txt';
   if FileExists(FileName) then
      Filenames.Add(FileName);

   FileName := IncludeTrailingBackslash(ExtractFilePath(Application.ExeName)) + 'TestFile2.txt';
   if FileExists(FileName) then
      Filenames.Add(FileName);

   FileName := IncludeTrailingBackslash(ExtractFilePath(Application.ExeName)) + 'TestFile3.txt';
   if FileExists(FileName) then
      Filenames.Add(FileName);

   SenderName := 'UserName Surname';
   SenderEMail := 'userName@gmail.com';

   RecepientName := 'AnotherUserName AnotherSurname';
   RecepientEMail := 'anotheruserName@gmail.com';

   SendMailMAPI(Subject, MsgText.Text, Filenames,
                SenderName, SenderEMail, RecepientName, RecepientEMail);

   Filenames.Free;
   MsgText.Free;

end;

end.

El código anterior es la Versión 2 del código del Msg #21 la cual incluye una corrección y una mejora en el proceso de Attachment de archivos vía MAPI, ambas necesarias para el buen funcionamiento de la aplicación.

Espero sea útil :)

Nelson.

Gracias Nelson, esta semana los mirare, pero no se cuando, ya que el jefe, me ha pedido una serie de cosas con urgencia, además tengo que terminar de preparar otras cosas antes de volver a la península, pero en cuanto lo pruebe te comento.

Repito, muchas gracias por tu ayuda.

Hola Nelson, me funciono bastante bien, he probado con las dos configuraciones, las dos funcionaron, pero es cierto que la segunda, si me manda archivos diferentes mientras que la primera se limitaba a mandarme dos veces el último archivo.

Pero no todo fue un camino de rosas, para llegar a ello, tuve que usar el Outlock, que nunca me he molestado en configurar y gracias al siguiente enlace http://office.microsoft.com/es-es/ou...001148898.aspx he podido solucionar el tema, te estoy muy agradecido sinceramente.

José Luis Garcí,

Te sugiero:

1- Si puedes instalar el cliente de correo Thunderbird te lo recomiendo ampliamente, es fácil de instalar, liviano, versátil, free y muy potente.

2- Revisa el código de los Msg #9 y #15, te serán útiles en desarrollos bajo Win32.

3- El código del Msg #9 se puede adaptar para que funcione bajo Win64.

4- El código del Msg #22 te sera útil en desarrollos bajo Win32 y Win64.

Espero sea útil :)

Nelson.

Si que me ha sido útil, gracias nuevamente Nelson

me un error
 

Mailfrom:Permanent Failure-Other or undefined security status.
como lo puedo arreglar?
uso windows 10, y delphi 10 Embarcadero RAD Studio

Hola, por favor, crea un hilo nuevo con tu duda, gracias.
Y no olvides echar un vistazo a nuestra guía de estilo. Saludos.

Ayudaaaaaaaa
 

Buenos dias!
Saludos soy de Cuba.
Ciertamente he probado el 99.9% de los ejemplos posteados aqui para enviar email y ninguno me funcioina, siempre me dan errores diferentes

Uso: Windows 10 64 bits.
Delphi 10 Embarcadero RAD Studio.
conexion a internet lenta pero me funciona.

Este es mi problema: Estoy trabajando en un software q me permita enviar email como notificacion, pero no encuentro
un ejemplo q me permita enviar email usando gmail, todos me dan un error diferente:
Connetion closed grace fully
usando el ejemplo de NLSGarcias q usa la libreria Synapse, despues corregir algunos errores me da el siguiente: Permanent Failure-Othres or Undefined security status.

Por favor si alguien puede Ayudarme con algo funcional, GRacias. Me URGEEEEE.

Y no olvides echar un vistazo a nuestra guía de estilo. Saludos.

Recuerda que para mandar emails por Gmail, debes quitarle opciones de seguridad en el gmail, por lo que no te lo recomiendo, mejor usa thunderbird de intermediario entre delphi y el gmail, es por lo que he optado yo. Sólo mando mensajes directos a mi gmail, de errores de forma oculta, cuando en una aplicación de la asociación se ha cometido un error