Envió de Correo desde mi aplicación con Adjunto
 

Saludos

Amigos Necesito enviar desde mi Aplicación Correos electrónicos de mis reportes, es decir con adjunto, ya he buscado en el FORO todas los Link y ejemplos que colocaron, y la verdad NINGUNO me ha servidor, Todos me dan algún tipo de error, he probado con varios tipos de cuenta (Gmail, Hotmail),, pero nada.. Sera este teme algo muy complicado ??? Existe algún ejemplo por allí que funcione del cual yo pueda revisar como ejemplo... y adaptarlo....

Nota: Uso Delphi 2009

Pleases

Ejemplo Gmail (Está escrito casi de cabeza mirando un programa mío, creo que está bien y debería funcionar:

Código Delphi [-]
procedure Enviar;
var
   SMTP: TIdSMTP;
   Mensaje: TIdMessage;
   i: Integer;
   lMens: String;
   gmailssl: TIdSSLIOHandlerSocketOpenSSL;
   Para: TIdEmailAddressList;
begin
   gmailIssl := TIdSSLIOHandlerSocketOpenSSL.Create(nil);
   
   SMTP := nil;
   SMTP := TIdSMTP.Create(nil);
   try   
      gmailssl.Destination = 'smtp.gmail.com:587';
      gmailssl.Host = 'smtp.gmail.com';
      gmailssl.Port = 587;

      SMTP.Username  := 'usuario@gmail.com';
      SMTP.Password  := 'Clave';
      SMTP.Host      := 'smtp.gmail.com';
      SMTP.Port      := '587'; //'465 si es con SSL. Aunque esto no lo tengo claro del todo.
      SMTP.IOHandler := gmailSSL;
      SMTP.UseTLS    := utUseExplicitTLS;
      
      Mensaje := TIdMessage.Create(nil);
      Para := TIdEmailAddressList.Create(nil);
      Cuerpo := TStringList.Create;
      try
         Mensaje.Clear;
         
         Mensaje.From.Name    := Desde;
         Mensaje.From.Address := Login;
         
         Para.Add.Address = 'correo@correo.com'. //Es una lista
         Mensaje.Recipients := Para; 
         Mensaje.Subject    := 'Asunto';
         Correo.Cuerpo.Add('Cuerpo'); //Es una lista
         Mensaje.Body.Text  := Cuerpo.Text;
         
        //Aquí es donde va lo de los adjuntos 
        TIdAttachmentFile.Create(Mensaje.MessageParts, 'direccionFichero'); //Es una lista         
         
         Mensaje.Priority := mpHighest;
            try
               lMens := 'Error al conectar con el servidor:';
               SMTP.Connect;
               // Si ha conectado enviamos el mensaje y desconectamos
               if SMTP.Connected then
               begin
                  lMens := 'Error al enviar el mensaje:';
                  SMTP.Send(Mensaje);

                  lMens := 'Error al desconectar del servidor:';
                  SMTP.Disconnect;
               end;
               //Sacar mensaje de correcto
            except
               on E:Exception do
               begin
                  lMens := lMens + ' ' + E.Message;
                  //Sacar mensaje de error
               end;
            end;

         finally
            //Este error no debería de darse, se crear un count más de los que hay
            //cuando falla el envío
            try
               for i := 0 to Mensaje.MessageParts.Count - 1 do
                  TIdAttachmentFile(Mensaje.MessageParts[i]).Free;
            except
            end;
            Mensaje.Free;
            Para.Free;
            Cuerpo.Free;
      end;
   finally
      if Assigned(SMTP)       then SMTP.Free;
      if Assigned(gmailIssl)  then SMTP.Free;
   end;

Donde pone "//Es una lista" es que puedes poner esa línea dentro de un bucle y rellenar varios datos.

¿El error no será que no tienes conexión a internet?

Gracias por tan pronta Respuesta..

Efectivamente ya logre con esta Rutina Enviar el correo, por cierto con el puerto 465.. El problema que tengo es que cuando reviso el correo NO me muestra el Adjunto,,, OJO cuando veo el correo a modo lista dice que tiene adjunto, pero al abrirlo NO lo muestra,,, Hice la prueba de Reenviando el correo y me muestra un Archivo ATT00001 y no deja abrirlo (este caso es enviando el correo a una Cuenta Hotmail) Tambien hice la prueba con un correo Gmail y si lo muestra pero el nombre me dice NONAME y no reconoce automáticamente el tipo de archivo que estoy enviando..

En mi Caso necesito enviar un correo con un Archivo PDF adjunto..

Saludos

Adjunto Mi Programa:

Código Delphi [-]
procedure TDataImpresion.EnvioCorreo(Sender: TObject);
Var
  ArcAdjunto,NomArchivo:string;
  Adjunto:TIdAttachmentFile;
begin
   with SMTP do
   begin
     AuthType := satDefault;
     Port := StrToInt(BioPuerto.Text);
     Host := BioHost.Text;
     Username := BioNomUsuario.Text;
     Password := BioNomClave.Text;
     UseTLS := utUseImplicitTLS;
     IOHandler:=Socket;
   end;
   with Socket do
   begin
     DefaultPort:=0;
     Host:=BioHost.Text;
     Destination:=BioHost.Text+':'+BioPuerto.Text;
     Port:=StrToInt(BioPuerto.Text);
     SSLOptions.Method:=sslvSSLv3;
     SSLOptions.Mode:=sslmUnassigned;
     SSLOptions.VerifyDepth:=0;
   end;
   Mensaje.Clear;
   with Mensaje do
   begin
     Recipients.Clear;
     Recipients.Add;
     Recipients[0].Name := 'EFREN AGUILAR';
     Recipients[0].Address := BioPara.Text;
     From.Name := Global.Cia.Nombre;
     From.Address := BioNomUsuario.Text;
     Subject := BioAsunto.Text;
     Body.Clear;
     Body.Text :=BioTexto.Lines.Text;
     IsEncoded :=False;
     ContentType := 'multipart/mixed';
     MessageParts.Clear;
     Priority := mpHighest;
   end;
   // adjuntamos el archivo
   ArcAdjunto:=ArchivoAdjunto;
   if (ArcAdjunto<>'') and (FileExists(ArcAdjunto)) then
      begin
      NomArchivo:=ExtractFileName(ArcAdjunto);
      Adjunto:=TIdAttachmentFile.Create(Mensaje.MessageParts, ArcAdjunto);
      Adjunto.ContentType:='application/pdf';
      Adjunto. FileName:=NomArchivo;
      Adjunto.ContentID:=NomArchivo;
      Adjunto.DisplayName:=NomArchivo;
      end
    else
      begin
      Adjunto := nil;
      end;
   try
     Smtp.Connect;
     try
        smtp.Send(Mensaje);
        ShowMessage('El Correo Fue Enviado Satisfactoriamente...');
     except
        on E: Exception do ShowMessage(E.Message);
     end;
   finally
     if smtp.Connected then
        smtp.Disconnect;
     if Adjunto <> nil then
        FreeAndNil( Adjunto );
   end;
end;

Hola,

Por si os sirve de algo. Adjunto el codigo que yo utilizo y funciona bien enviando adjuntos.

Me pasaba algo parecido, si el mail no tenia adjuntos, se veia bien, pero si tenia adjunto, lo indicaba pero no se veia.
El cambio que hice fue:

NO tiene adjunto: compMensaje.ContentType := 'text/html' ;
SI tiene adjunto: compMensaje.ContentType := 'multipart/mixed' ;

y me funciona bien.



function TFmails.enviarEmail(servidor : string; usuario : string; contrasena : string;
puerto : integer; asunto : string; mensaje : TStringList; conAutenticacion : boolean;
emisor : string; nombreEmisor : string; destinatario : string; cc : string) : boolean;
var
compMensaje : TIdMessage;
envioCorrecto : boolean;
var Linea: string ;
var b, FlagAdjuntos: Integer;
begin
if conAutenticacion then
begin
compEnvioEmail.AuthType := satDefault;
compEnvioEmail.Username := usuario;
compEnvioEmail.Password := contrasena;
end
else
compEnvioEmail.AuthType := satNone;

compMensaje := TIdMessage.Create (nil);
compMensaje.From.Address := emisor;
compMensaje.From.Name := nombreEmisor;
compMensaje.Recipients.Add.Address := destinatario;
if Trim(cc) <> '' then compMensaje.CCList.Add.Address := cc;
compMensaje.ContentType := 'text/html' ;
compMensaje.CharSet := 'iso-8859-1' ;
compMensaje.Subject := asunto;
compMensaje.ReplyTo.Add.Address := emisor;


FlagAdjuntos := 0 ;
ListaAdjuntos := Trim(ListaAdjuntos) + ';';
if Length(ListaAdjuntos) > 1 then
begin
i := 1 ;
while ( i <= 10 ) do
begin
nFicheros[i] := '' ;
ListaAdjuntos := Trim(ListaAdjuntos);
Largo := Length(ListaAdjuntos) ;
Posicion := Pos(';', ListaAdjuntos);

if Posicion > 0 then
begin
FlagAdjuntos := 1 ;
nFicheros[i] := Copy(ListaAdjuntos, 1,Posicion-1);
ListaAdjuntos := Copy(ListaAdjuntos, Posicion+1, Largo+Posicion) ;
TIdAttachmentFile.Create(compMensaje.MessageParts, Trim(nFicheros[i]));
end;
i := i + 1;
end;
end;

if FlagAdjuntos = 1 then compMensaje.ContentType := 'multipart/mixed' ;

for b:=0 to mensaje.count -1 do
begin
if FlagAdjuntos = 1 then Linea := mensaje[b] else Linea := mensaje[b] + '<BR>';
compMensaje.Body.Add(Linea);
end;


envioCorrecto := true;
try
compEnvioEmail.Send(compMensaje);
except
envioCorrecto := false;
end;

TIdAttachment.NewInstance.Free ;
compMensaje.Free;
enviarEmail := envioCorrecto;
end;

Amigo Juan Gracias por tu respuesta, pero como veras en el post anterior (Programa Fuente) ya coloque el Valor de la Propiedad:

Código Delphi [-]
ContentType := 'multipart/mixed'

.. y sigo con el mismo problema.

Saludos

No sera que cuando adjuntas el archivo cambias el valor y pones esto?
Adjunto.ContentType:='application/pdf';

ya por probar, podrias quitar esta linea a ver que pasa.

suerte!

Descubrí que de esta forma si envió al correo a un GMAIL por lo menos me reconoce que el archivo es PDF... pero sigue sin aparecer el nombre,, en una Cuenta HOTMAIL, nada de Nada...

He probado también como me indicas y NADA cuando veo el script del correo en los navegadores me lo reconoce como ...

NAda
 

Código Delphi [-]
<div style="margin:20px; margin-top:5px; ">
  <div class="smallfont" style="margin-bottom:2px">Cita:div>
  

  

    
class="alt2">
      

      
        <div>
          Empezado por ozsWizzard
          (Mensaje 479647)
        div>
        <div style="font-style:italic">Ejemplo Gmail (Está escrito casi de cabeza mirando un programa mío, creo que está bien y debería funcionar:

class='delphi'><div class="frame_codigo_delphi">Código Delphi [-]<div id="delphi_div_66523607570bf" class="texto_codigo_delphi">
class='keyword'>procedure Enviar;
class='keyword'>var
   SMTP: TIdSMTP;
   Mensaje: TIdMessage;
   i: Integer;
   lMens: class='keyword'>String;
   gmailssl: TIdSSLIOHandlerSocketOpenSSL;
   Para: TIdEmailAddressList;
class='keyword'>begin
   gmailIssl := TIdSSLIOHandlerSocketOpenSSL.Create(class='keyword'>nil);
   
   SMTP := class='keyword'>nil;
   SMTP := TIdSMTP.Create(class='keyword'>nil);
   class='keyword'>try   
      gmailssl.Destination = class='quote'>'smtp.gmail.com:587';
      gmailssl.Host = class='quote'>'smtp.gmail.com';
      gmailssl.Port = 587;

      SMTP.Username  := class='quote'>'usuario@gmail.com';
      SMTP.Password  := class='quote'>'Clave';
      SMTP.Host      := class='quote'>'smtp.gmail.com';
      SMTP.Port      := class='quote'>'587'; class='comment'>//'465 si es con SSL. Aunque esto no lo tengo claro del todo.
      SMTP.IOHandler := gmailSSL;
      SMTP.UseTLS    := utUseExplicitTLS;
      
      Mensaje := TIdMessage.Create(class='keyword'>nil);
      Para := TIdEmailAddressList.Create(class='keyword'>nil);
      Cuerpo := TStringList.Create;
      class='keyword'>try
         Mensaje.Clear;
         
         Mensaje.From.Name    := Desde;
         Mensaje.From.Address := Login;
         
         Para.Add.Address = class='quote'>'correo@correo.com'. class='comment'>//Es una lista
         Mensaje.Recipients := Para; 
         Mensaje.Subject    := class='quote'>'Asunto';
         Correo.Cuerpo.Add(class='quote'>'Cuerpo'); class='comment'>//Es una lista
         Mensaje.Body.Text  := Cuerpo.Text;
         
        class='comment'>//Aquí es donde va lo de los adjuntos 
        TIdAttachmentFile.Create(Mensaje.MessageParts, class='quote'>'direccionFichero'); class='comment'>//Es una lista         
         
         Mensaje.Priority := mpHighest;
            class='keyword'>try
               lMens := class='quote'>'Error al conectar con el servidor:';
               SMTP.Connect;
               class='comment'>// Si ha conectado enviamos el mensaje y desconectamos
               class='keyword'>if SMTP.Connected class='keyword'>then
               class='keyword'>begin
                  lMens := class='quote'>'Error al enviar el mensaje:';
                  SMTP.Send(Mensaje);

                  lMens := class='quote'>'Error al desconectar del servidor:';
                  SMTP.Disconnect;
               class='keyword'>end;
               class='comment'>//Sacar mensaje de correcto
            class='keyword'>except
               class='keyword'>on E:Exception class='keyword'>do
               class='keyword'>begin
                  lMens := lMens + class='quote'>' ' + E.class='keyword'>Message;
                  class='comment'>//Sacar mensaje de error
               class='keyword'>end;
            class='keyword'>end;

         class='keyword'>finally
            class='comment'>//Este error no debería de darse, se crear un count más de los que hay
            class='comment'>//cuando falla el envío
            class='keyword'>try
               class='keyword'>for i := 0 class='keyword'>to Mensaje.MessageParts.Count - 1 class='keyword'>do
                  TIdAttachmentFile(Mensaje.MessageParts[i]).Free;
            class='keyword'>except
            class='keyword'>end;
            Mensaje.Free;
            Para.Free;
            Cuerpo.Free;
      class='keyword'>end;
   class='keyword'>finally
      class='keyword'>if Assigned(SMTP)       class='keyword'>then SMTP.Free;
      class='keyword'>if Assigned(gmailIssl)  class='keyword'>then SMTP.Free;
   class='keyword'>end;
div>div>
Donde pone "//Es una lista" es que puedes poner esa línea dentro de un bucle y rellenar varios datos.
      
      

    
  
  
div>

Este ejemplo, me da este error: Invalid Pointer Operation. Como lo puedo corregir?

Estás poniendo mensajes sobre los mismo en distintos foros. Si lo haces pueden acabar borrados y tú baneado.

Revisa la guia de estilo de los foros.



Crea un nuevo hilo y explica bien tu problema.
También puedes editar el mensaje anterior y corregirlo.

Solucionado - Solucion
 

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 := 'micuentadegmail@gmail.com';
   Password := edit1.Text;
   SSL := True;
   TLS := False;

  MsgText := TStringList.Create;

   MailFrom := 'micuentadegmail@gmail.com';
   // MailFrom := 'username@hotmail.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));

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

Gracias a todos por sus aportes.

qP:-)El codigo es tomado de este sitio!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

16. Si alguien te remite a la guía de estilo, no te molestes en leerla. Tú tienes cosas más importantes que hacer y a fin de cuentas, nadie la lee.

Gracias por publicar la solución. ^\||/^\||/
Te recuerdo que cuando tengas un momento revises La guía de estilo y coloques tags cuando añadas código al mensaje.
He editado tu mensaje para ajustar el link y añadir los tags.