Enviar correo html con imagen incrustada

[Casimiro Noteví]

Empezado por gluglu

El artículo al que hacía referencia en el otro hilo del cual incluí el enlace, creo que es este : http://www.indyproject.org/sockets/blogs/rlebeau/2005_08_17_a.en.aspx

Con tu permiso , he editado el otro post poniendo este enlace, así no queda huérfano

[[newtron]]

Gracias a todos.

Le echaré un vistazo al código de gluglu y cuando acabe dentro de un par de meses os diré como ha ido.

Saludos

[[newtron]]

Hola de nuevo.

He modificado un programa de ejemplo que pillé por internet en función al código de gluglu y ya casi lo tengo, el único problema es que la imagen me aparece dos veces, una insertada en el mensaje y otra como archivo adjunto. Os pongo el código a ver si alguien ve donde está el problema.

Código Delphi [-]
Function TForm1.EnviaCorreoHtml: String;
var
  LIdmMensaje: TIdMessage;
  LIdmGraf: TIdAttachmentFile;
  LStlMensaje: TStringList;
  LsGIdImage: String;
begin
  Try
    LStlMensaje := TStringList.Create;
    LStlMensaje.Add(':HTML::HEAD::TITLE:Prueba de imágenes:/TITLE::/HEAD::BODY::BODY::STYLE:Table{FONT-FAMILY: Century Gothic, Arial;}:/STYLE:');
    LStlMensaje.Add(':b:La siguiente imagen ha sido incluida en el correo para efectos de prueba:/b:');
    LStlMensaje.Add(':table border="0" cellpadding="0" cellspacing="0" width="800":');
    LStlMensaje.Add('  :tr:');
    LStlMensaje.Add('    :td colspan="3"::img border="0" src="cid: IMG001" :');
    LStlMensaje.Add('      : :/td:');
    LStlMensaje.Add('  :/tr:');
    LStlMensaje.Add(':/table:');
    LIdmMensaje := TIdMessage.Create(Nil);
    LIdmMensaje.From.Name := EdtNomb.Text;
    LIdmMensaje.From.Address := EdtEmail.Text;
    with LIdmMensaje.Recipients.Add do
       begin
         Name := Edit2.Text;
         Address := Edit2.Text;
       end;
    LIdmMensaje.Subject := 'Prueba de envio de correo con imágenes';
  //        LIdmMensaje.Body.Text := LStlMensaje.Text;
    TIdText.Create(LIdmMensaje.MessageParts, nil);
    with TIdText.Create(LIdmMensaje.MessageParts) do
      begin
        ContentType := 'text/html';
        ContentTransfer := '7bit';
        Body := TStringList.Create;
        Body.Text := LStlMensaje.Text;
      End;
    LIdmGraf := TIdAttachmentFile.Create(LIdmMensaje.MessageParts,EdtImagen.Text);
    LIdmGraf.ContentType := 'image/jpg';
    LIdmGraf.ContentID   := 'IMG001';
    LIdmGraf.Filename    := 'image001.jpg';
    LIdmMensaje.Priority := mpNormal;
    Result := EnviaCorreo(LIdmMensaje);
    LStlMensaje.Free;
    LIdmGraf.Free;
    LIdmMensaje.Free;
  Except
    on Err : Exception do
      Result := 'Ocurrió un problema al procesar la estructura del mensaje de correo. Error "' + Err.Message + '"';
  End;
End;

Gracias y un saludo

P.D.: igual que gluglu he cambiado los tags del html por : para que se vea algo decente.

[[gluglu]]

Tienes que definir también el 'Type' del TIdMessage.

// Just HTML Text, No Attachments, No Embedded Images
IdMessage1.ContentType := 'multipart/alternative';

// HTML Text + Attachments, No Embedded Images
IdMessage1.ContentType := 'multipart/mixed';

// HTML Text + Attachments + Embedded Images
IdMessage1.ContentType := 'multipart/mixed';
with TIdText.Create(IdMessage1.MessageParts, nil) do begin
  ContentType := 'multipart/related; type="multipart/alternative"';
end;
with TIdText.Create(IdMessage1.MessageParts, nil) do begin
   ContentType := 'multipart/alternative';
   ParentPart := 0;
end;

// HTML Text + Embedded Images, No Attachments
IdMessage1.ContentType := 'multipart/related; type="text/html"';

En tu caso particular, añade :

Código Delphi [-]
LIdmMensaje := TIdMessage.Create(Nil);
LIdmMensaje.ContentType := 'multipart/related; type="text/html"';

Saludos

[[newtron]]

¡Solucionado!

Gracias gluglu, recuerdame que te invite a un par de pajaretes en la casa guardia (a casimiro no que no bebe )

Gracias y un saludo

[[gluglu]]

... hecho !

[Casimiro Noteví]

Empezado por newtron

¡Solucionado!
Gracias gluglu, recuerdame que te invite a un par de pajaretes en la casa guardia (a casimiro no que no bebe )
Gracias y un saludo

Acaso allí no venden zumos de frutas

[Neeruu]

Una actualización....

Para que la imagen incrustada se vea bien en gmail hay que agregar lo siguiente:

LIdmGraf.ContentID := '<IMG001>'; //El contentID va entre <>...
LIdmGraf.ContentDisposition := 'inline'; //Esta linea hay que agregarla....

Código Delphi [-]
Function TForm1.EnviaCorreoHtml: String;
var
  LIdmMensaje: TIdMessage;
  LIdmGraf: TIdAttachmentFile;
  LStlMensaje: TStringList;
  LsGIdImage: String;
begin
  Try
    LStlMensaje := TStringList.Create;
    LStlMensaje.Add(':HTML::HEAD::TITLE:Prueba de imágenes:/TITLE::/HEAD::BODY::BODY::STYLE:Table{FONT-FAMILY: Century Gothic, Arial;}:/STYLE:');
    LStlMensaje.Add(':b:La siguiente imagen ha sido incluida en el correo para efectos de prueba:/b:');
    LStlMensaje.Add(':table border="0" cellpadding="0" cellspacing="0" width="800":');
    LStlMensaje.Add('  :tr:');
    LStlMensaje.Add('    :td colspan="3"::img border="0" src="cid: IMG001" :');
    LStlMensaje.Add('      : :/td:');
    LStlMensaje.Add('  :/tr:');
    LStlMensaje.Add(':/table:');
    LIdmMensaje := TIdMessage.Create(Nil);
    LIdmMensaje.From.Name := EdtNomb.Text;
    LIdmMensaje.From.Address := EdtEmail.Text;
    with LIdmMensaje.Recipients.Add do
       begin
         Name := Edit2.Text;
         Address := Edit2.Text;
       end;
    LIdmMensaje.Subject := 'Prueba de envio de correo con imágenes';
  //        LIdmMensaje.Body.Text := LStlMensaje.Text;
    TIdText.Create(LIdmMensaje.MessageParts, nil);
    with TIdText.Create(LIdmMensaje.MessageParts) do
      begin
        ContentType := 'text/html';
        ContentTransfer := '7bit';
        Body := TStringList.Create;
        Body.Text := LStlMensaje.Text;
      End;
    LIdmGraf := TIdAttachmentFile.Create(LIdmMensaje.MessageParts,EdtImagen.Text);
    LIdmGraf.ContentType := 'image/jpg';
    LIdmGraf.ContentID   := ''; //El contentID va entre <>...
    LIdmGraf.Filename    := 'image001.jpg';
    LIdmGraf.ContentDisposition := 'inline'; //Esta linea hay que agregarla....
    LIdmMensaje.Priority := mpNormal;
    Result := EnviaCorreo(LIdmMensaje);
    LStlMensaje.Free;
    LIdmGraf.Free;
    LIdmMensaje.Free;
  Except
    on Err : Exception do
      Result := 'Ocurrió un problema al procesar la estructura del mensaje de correo. Error "' + Err.Message + '"';
  End;
End;