Envió de Correo desde mi aplicación con Adjunto

[Efren2006]

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]

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]

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]

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]

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

application/octet-stream

...