Mandar email con adjunto

[[nlsgarcia]]

Club Delphi,

Empezado por José Luis Garcí

...podéis facilitarme el trozo de código que manda un email con un adjunto...

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.

[[José Luis Garcí]]

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

stdcall; external 'xxx.dll';

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

[[José Luis Garcí]]

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 := [email protected]';
     Recipients.EMailAddresses := [email protected]';
     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 := '[email protected]';
     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;

[[José Luis Garcí]]

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

[[nlsgarcia]]

José Luis Garcí,

Empezado por José Luis Garcí

...lo he seguido intentando, pero no hay manera...

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.

[[José Luis Garcí]]

Empezado por nlsgarcia

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

[[nlsgarcia]]

José Luis Garcí,

Empezado por José Luis Garcí

...Windows 7 64 bits y Delphi 2010...

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

Empezado por José Luis Garcí

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

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 := '[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 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 := '[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.

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.