Envió de Correo desde mi aplicación con Adjunto

ozsWizzard · #1 03-08-2014

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.

Efren2006 · #2 04-08-2014

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

Efren2006 · #3 04-08-2014

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;

JuanHC · #4 04-08-2014

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;

Efren2006 · #5 04-08-2014

Cita:

Empezado por JuanHC

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

JuanHC · #6 04-08-2014

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!

Efren2006 · #7 04-08-2014

Cita:

Empezado por JuanHC

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

Código:

application/octet-stream

...

AzqLaaClub · #8 18-04-2023

Código Delphi [-]<div style="margin:20px; margin-top:5px; ">
  <div class="smallfont" style="margin-bottom:2px">Cita:div>
  
  
    class="alt2" style="border:1px inset">
      
        <div>
          Empezado por ozsWizzard
          class="inlineimg" src="http://www.clubdelphi.com/foros/images/botones/viewpost.gif" border="0" alt="Ver Mensaje" />
        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_664151794eb7e" 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?

Neftali [Germán.Estévez] · #9 18-04-2023

Cita:

Empezado por AzqLaaClub

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.

Temas Similares
Tema	Autor	Foro	Respuestas	Último mensaje
Error en envío de mail con adjunto + Indy 10	agustibaldo	Internet	8	23-01-2015 21:23:31
Envío de mail con un archivo adjunto.	y_a_p	Varios	16	08-06-2013 23:40:46
Problema con envio de correos con fichero adjunto	apicito	OOP	5	09-02-2012 13:29:36
Como envío correo desde Excel sin que me pida confirmación?	luisdevis	Varios	3	11-10-2006 23:18:18
Envio de correo desde una ISAPI	anitra_cattivo	Internet	1	22-10-2003 23:12:42