Mandar email con adjunto

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

[[José Luis Garcí]]

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.

[[nlsgarcia]]

José Luis Garcí,

Empezado por José Luis Garcí

...si no me equivoco Delphi 2010, sólo compila en 32 bits...

Es correcto

Empezado por José Luis Garcí

...una librería normalmente las tengo que llamar durante el programa...referentes al Gmail...no he visto la llamada por ningún lado...

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.

Empezado por José Luis Garcí

...he intentado el tema de los certificados...

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.

[[José Luis Garcí]]

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

[[José Luis Garcí]]

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

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.

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

[[nlsgarcia]]

José Luis Garcí,

...lo he intentado, pero no he podido...necesito, saber que componentes son necesarios...

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.

[[nlsgarcia]]

José Luis Garcí,

Empezado por José Luis Garcí

...el cliente quiere emitir el documento y mandarlo por email...y preferiría hacerlo por código y no con un programa externo...

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

   RecepientName := 'AnotherUserName AnotherSurname';
   RecepientEMail := '[email protected]';

   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.

[AzqLaaClub]

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

[Casimiro Noteví]

Empezado por AzqLaaClub

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.