Enviar correo html con imagen incrustada

[gluglu] · #1 22-08-2011

Uuuy !! Me acabo de dar cuenta que el enlace dentro del otro hilo ya no funciona !

Casimiro Notevi · #2 22-08-2011

Cita:

Empezado por gluglu

Uuuy !! Me acabo de dar cuenta que el enlace dentro del otro hilo ya no funciona !

A mí sí me funciona

Edito: ya veo que te refieres al enlace del enlace, no va, no :s

[gluglu] · #3 22-08-2011

A lo mejor me excedo un poco, con la cantidad de código, o incluso podría haber adjuntado un ZIP, pero te pongo el código que yo utilizo para enviar un correo a través de Indy, directamente desde el programa Delphi, y además dentro de un Thread.

Los correos que yo envío, pueden contener una imagen en la cabecera del correo, y otra en el pie del mensaje. Supongo que lo mismo se puede aplicar a cualquier imagen en cualquier parte del texto.

Tienes que fijarte especialmente en los diferentes 'tipos' que se pueden definir.

Además de las imágenes de principio y final, se puede añadir cualquier otro fichero adjunto, diferente de las imágenes.

Espero te sirva :

Código Delphi [-]procedure TEMailsSend.Send_EMail;
var
  m : TMemoryStream;
  f : TFileStream;
  g : TStream;
  i : Integer;
  filename     : string;
  img_t_align  : Integer;
  img_b_align  : Integer;
  int_no       : Int64;
  tempFileName : String;
  messagetype  : Integer;
  Top_Image    : Boolean;
  Bot_Image    : Boolean;
begin
 
  with pDataSet2 do begin
    SelectSQL.Clear;
    SelectSQL.Add('Select * from EMAIL_CONFIG');
    SelectSQL.Add('where BUILDINGNO = :Txt1');
    ParamByName('Txt1').Value := pDataSet1.FieldByName('BUILDINGNO').Value;
    Prepare;
    Open;
  end;
 
  if (pDataSet2.Eof) or
     (pDataSet2.FieldByName('SMTP_HOST').AsString     = '') or
     (pDataSet2.FieldByName('SMTP_PORT').AsInteger    = 0)  then begin
    Error_Str := 'Configuracion e-Correo para Dpto. '+pDataSet2.FieldByName('DEPARTMENT').AsString+' incorrecta';
    Synchronize(ErrorMainForm);
    Exit;
  end;
 
  if pDataSet2.FieldByName('SMTP_SSL').AsInteger = 1 then begin
    IdIOHandler := TIdSSLIOHandlerSocketOpenSSL.Create(nil);
    IdIOHandler.RecvBufferSize         := 65000;
    IdIOHandler.SendBufferSize         := 65000;
    IdIOHandler.SSLOptions.Method      := sslvSSLv3;
    IdIOHandler.SSLOptions.Mode        := sslmUnassigned;
    IdIOHandler.SSLOptions.VerifyDepth := 0;
    IdIOHandler.SSLOptions.VerifyMode  := [];
    IdIOHandler.UseNagle               := False;
    IdIOHandler.Port                   := pDataSet2.FieldByName('SMTP_PORT').AsInteger;
    IdIOHandler.Destination            := pDataSet2.FieldByName('SMTP_HOST').AsString + ':' + pDataSet2.FieldByName('SMTP_PORT').AsString;
    IdIOHandler.Host                   := pDataSet2.FieldByName('SMTP_HOST').Value;
  end;
 
  IdSMTP1             := TIdSMTP.Create(nil);
  IdSMTP1.OnWork      := IdSMTP1Work;
  IdSMTP1.Host        := pDataSet2.FieldByName('SMTP_HOST').Value;
  IdSMTP1.Port        := pDataSet2.FieldByName('SMTP_PORT').Value;

  if pDataSet2.FieldByName('SMTP_SSL').AsInteger = 1 then begin
    IdSMTP1.IOHandler := IdIOHandler;
    IdSMTP1.UseTLS    := utUseImplicitTLS;
  end;
 
  img_t_align  := pDataSet2.FieldByName('IMAGE_T_ALIGN').AsInteger;
  img_b_align  := pDataSet2.FieldByName('IMAGE_B_ALIGN').AsInteger;

  with pDataSet2 do begin
    SelectSQL.Clear;
    SelectSQL.Add('Select * from EMAIL_CONFIG_DEPARTMENTS');
    SelectSQL.Add('where BUILDINGNO = :Txt1');
    SelectSQL.Add('and INTERNALNO   = :Txt2');
    ParamByName('Txt1').Value := pDataSet1.FieldByName('BUILDINGNO').Value;
    ParamByName('Txt2').Value := pDataSet1.FieldByName('FROM_DEPARTMENT').Value;
    Prepare;
    Open;
  end;
 
  if (pDataSet2.Eof) or
     (pDataSet2.FieldByName('SMTP_USERNAME').AsString = '') or
     (pDataSet2.FieldByName('SMTP_PASSWORD').AsString = '') then begin
    IdSMTP1.Free;
    Error_Str := 'Configuracion e-Correo para Dpto. '+pDataSet2.FieldByName('DEPARTMENT').AsString+' incorrecta';
    Synchronize(ErrorMainForm);
    Exit;
  end;
 
  IdSMTP1.Username := pDataSet2.FieldByName('SMTP_USERNAME').Value;
  IdSMTP1.Password := pDataSet2.FieldByName('SMTP_PASSWORD').Value;
 
  IdMessage1 := TIdMessage.Create(nil);
  if not pDataSet2.FieldByName('SMTP_FROM_ADDR').IsNull then
    IdMessage1.From.Address           := pDataSet2.FieldByName('SMTP_FROM_ADDR').Value;
  if not pDataSet2.FieldByName('SMTP_FROM_NAME').IsNull then
    IdMessage1.From.Name              := pDataSet2.FieldByName('SMTP_FROM_NAME').Value;
  if not pDataSet2.FieldByName('SMTP_REPLYTO').IsNull then
    IdMessage1.ReplyTo.EMailAddresses := pDataSet2.FieldByName('SMTP_REPLYTO').Value;
  IdMessage1.Charset                  := 'iso-8859-1';
  if pDataSet1.FieldByName('ASKFORRECEIPT').AsInteger = 1 then
    if not pDataSet2.FieldByName('SMTP_FROM_ADDR').IsNull then
      IdMessage1.ReceiptRecipient.Address := pDataSet2.FieldByName('SMTP_FROM_ADDR').Value;
 
  // To List
  with pDataSet2 do begin
    SelectSQL.Clear;
    SelectSQL.Add('Select * from BOOKINGS_EMAIL_TO');
    SelectSQL.Add('where INTERNALNO   = :Txt1');
    SelectSQL.Add('and TYPE_TO_CC_CCO = 1');
    ParamByName('Txt1').Value := pDataSet1.FieldByName('INTERNALNO').Value;
    Prepare;
    Open;
    First;
    while not Eof do begin
      with IdMessage1.Recipients.Add do begin
        Name    := pDataSet2.FieldByName('EMAILNAME').AsString;
        Address := pDataSet2.FieldByName('EMAILADDRESS').AsString;
      end;
      Next;
    end;
  end;
 
  // CC List
  with pDataSet2 do begin
    SelectSQL.Clear;
    SelectSQL.Add('Select * from BOOKINGS_EMAIL_TO');
    SelectSQL.Add('where INTERNALNO   = :Txt1');
    SelectSQL.Add('and TYPE_TO_CC_CCO = 2');
    ParamByName('Txt1').Value := pDataSet1.FieldByName('INTERNALNO').Value;
    Prepare;
    Open;
    First;
    while not Eof do begin
      with IdMessage1.CCList.Add do begin
        Name    := pDataSet2.FieldByName('EMAILNAME').AsString;
        Address := pDataSet2.FieldByName('EMAILADDRESS').AsString;
      end;
      Next;
    end;
  end;
 
  // CCO List
  with pDataSet2 do begin
    SelectSQL.Clear;
    SelectSQL.Add('Select * from BOOKINGS_EMAIL_TO');
    SelectSQL.Add('where INTERNALNO   = :Txt1');
    SelectSQL.Add('and TYPE_TO_CC_CCO = 3');
    ParamByName('Txt1').Value := pDataSet1.FieldByName('INTERNALNO').Value;
    Prepare;
    Open;
    First;
    while not Eof do begin
      with IdMessage1.BCCList.Add do begin
        Name    := pDataSet2.FieldByName('EMAILNAME').AsString;
        Address := pDataSet2.FieldByName('EMAILADDRESS').AsString;
      end;
      Next;
    end;
  end;
 
  IdMessage1.Subject := pDataSet1.FieldByName('SUBJECT').AsString;
 
  Mail_Str   := '';
  Mail_Size  := 0;
  Mail_BSize := 0;
  Mail_BSent := 0;
  Top_Image  := False;
  Bot_Image  := False;
  Synchronize(UpdateMainForm);

  html.Clear;
  html.Add(':html: :head: :/head:'+
           ':body text=#000000 bgcolor=#FFFFFF link=#FF0000'+
           'alink=#FF0000 vlink=#FF0000:'+#13#10);
  html.Add(':html::body:');
 
  if pDataSet1.FieldByName('TOP_IMAGE').AsInteger = 1 then begin
 
    with pDataSet2 do begin
      SelectSQL.Clear;
      SelectSQL.Add('Select * from EMAIL_CONFIG_IMAGES');
      SelectSQL.Add('where BUILDINGNO = :Txt1');
      SelectSQL.Add('and TOP_BOTTOM   = 1');
      ParamByName('Txt1').Value := pDataSet1.FieldByName('BUILDINGNO').Value;
      Prepare;
      Open;
    end;
 
    if not pDataSet2.IsEmpty then begin
      Mail_Str  := 'Añadiendo Imagen Cabecera';
      Synchronize(UpdateMainForm);
      if not DirectoryExists('DocTemp') then
        CreateDir(ExtractFilePath(Application.ExeName)+'DocTemp');
      tempFileName := ExtractFilePath(Application.ExeName)+'DocTemp\'+'AT0001.JPG';
      if not FileExists(tempFileName) then begin
        f := TFileStream.Create(tempFileName,fmCreate);
        g := pDataSet2.CreateBlobStream(pDataSet2.FieldByName('IMAGE'), bmRead);
        f.seek(0,soFromBeginning);
        f.CopyFrom(g, 0);
        Mail_Size  := Mail_Size + f.size;
        g.free;
        f.Free;
      end;
      case img_t_align of
        0,1 : html.Add(':img src="cid:0001":');
          2 : html.Add('IV align=center::IMG src="cid:0001" align=center::/DIV:');
          3 : html.Add('IV align=right::IMG src="cid:0001" align=right::/DIV:');
      end;
      Top_Image := True;
    end;
 
  end;

  with pDataSet2 do begin
    SelectSQL.Clear;
    SelectSQL.Add('Select * from BOOKINGS_EMAIL_BLOB');
    SelectSQL.Add('where INTERNALNO = :Txt1');
    ParamByName('Txt1').Value := pDataSet1.FieldByName('INTERNALNO').Value;
    Prepare;
    Open;
  end;
 
  MainFormMailSend2 := TMainFormMailSend2.Create(nil);
  if not pDataSet2.IsEmpty then begin
    m := TMemoryStream.Create;
    (pDataSet2.FieldByName('BODY_TEXT') as TBlobField).SaveToStream(m);
    m.Seek(0,soFromBeginning);
    MainFormMailSend2.Editor.Lines.LoadFromStream(m);
    Mail_Size := Mail_Size + m.size;
    m.Free;
  end
  else MainFormMailSend2.Editor.Text := '';
 
  Mail_Str  := 'Convirtiendo Texto a HTML';
  Synchronize(UpdateMainForm);
 
  if pDataSet1.FieldByName('TEXT_FORMAT').AsInteger = 1 then html.Add(RTFToHTMLSimple(MainFormMailSend2.Editor));
  if pDataSet1.FieldByName('TEXT_FORMAT').AsInteger = 2 then html.Add(RTFToHTMLWords(MainFormMailSend2.Editor));
  if pDataSet1.FieldByName('TEXT_FORMAT').AsInteger = 3 then html.Add(RTFToHTMLDetailed(MainFormMailSend2.Editor));
 
  if pDataSet1.FieldByName('FINAL_TEXT').AsInteger = 1 then begin
    with pDataSet2 do begin
      SelectSQL.Clear;
      SelectSQL.Add('Select * from EMAIL_CONFIG_FINALTEXT');
      SelectSQL.Add('where BUILDINGNO     = :Txt1');
      SelectSQL.Add('and DEPARTMENT_INTNO = :Txt2');
      ParamByName('Txt1').Value := pDataSet1.FieldByName('BUILDINGNO').Value;
      ParamByName('Txt2').Value := pDataSet1.FieldByName('FROM_DEPARTMENT').Value;
      Prepare;
      Open;
    end;
 
    if not pDataSet2.IsEmpty then begin
      Mail_BSent := 0;
      Mail_Str   := 'Añadiendo Texto Final';
      Synchronize(UpdateMainForm);
      m := TMemoryStream.Create;
      (pDataSet2.FieldByName('COMMENTS') as TBlobField).SaveToStream(m);
      m.Seek(0,soFromBeginning);
      MainFormMailSend2.Editor.Lines.LoadFromStream(m);
      Mail_Size := Mail_Size + m.size;
      m.Free;
      Mail_Str  := 'Convirtiendo Texto Final';
      Synchronize(UpdateMainForm);
      html.Add(':div: :/div:');
      html.Add(RTFToHTMLDetailed(MainFormMailSend2.Editor));
    end;
 
  end;
  MainFormMailSend2.Free;
 
  if pDataSet1.FieldByName('BOTTOM_IMAGE').AsInteger = 1 then begin
    html.Add(':div: :/div:');
    with pDataSet2 do begin
      SelectSQL.Clear;
      SelectSQL.Add('Select * from EMAIL_CONFIG_IMAGES');
      SelectSQL.Add('where BUILDINGNO = :Txt1');
      SelectSQL.Add('and TOP_BOTTOM   = 2');
      ParamByName('Txt1').Value := pDataSet1.FieldByName('BUILDINGNO').Value;
      Prepare;
      Open;
    end;
    if not pDataSet2.IsEmpty then begin
      Mail_BSent := 0;
      Mail_Str   := 'Añadiendo Imagen Pie de Página';
      Synchronize(UpdateMainForm);
      if not DirectoryExists('DocTemp') then
        CreateDir(ExtractFilePath(Application.ExeName)+'DocTemp');
      tempFileName := ExtractFilePath(Application.ExeName)+'DocTemp\'+'AT0002.JPG';
      if not FileExists(tempFileName) then begin
        f := TFileStream.Create(tempFileName,fmCreate);
        g := pDataSet2.CreateBlobStream(pDataSet2.FieldByName('IMAGE'), bmRead);
        f.seek(0,soFromBeginning);
        f.CopyFrom(g, 0);
        Mail_Size  := Mail_Size + f.size;
        g.free;
        f.Free;
      end;
      case img_b_align of
        0,1 : html.Add(':img src="cid:0002":');
          2 : html.Add('IV align=center::IMG src="cid:0002" align=center::/DIV:');
          3 : html.Add('IV align=right::IMG src="cid:0002" align=right::/DIV:');
      end;
      Bot_Image := True;
    end;
  end;
 
  html.Add(':/body::/html:');
 
  with pDataSet2 do begin
    SelectSQL.Clear;
    SelectSQL.Add('Select * from BOOKINGS_EMAIL_ATTACH');
    SelectSQL.Add('where INTERNALNO = :Txt1');
    SelectSQL.Add('order by INTERNALNO2');
    ParamByName('Txt1').Value := pDataSet1.FieldByName('INTERNALNO').Value;
    Prepare;
    Open;
  end;
 
  if (pDataSet2.IsEmpty) and (not Top_Image) and (not Bot_Image) then begin
    // Just HTML Text, No Attachments, No Embedded Images
    MessageType := 1;
    IdMessage1.ContentType := 'multipart/alternative';
  end;

  if (not pDataSet2.IsEmpty) and (not Top_Image) and (not Bot_Image) then begin
    // HTML Text + Attachments, No Embedded Images
    MessageType := 2;
    IdMessage1.ContentType := 'multipart/mixed';
  end;

  if (not pDataSet2.IsEmpty) and ((Top_Image) or (Bot_Image)) then begin
    // HTML Text + Attachments + Embedded Images
    MessageType := 3;
    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;
  end;

  if (pDataSet2.IsEmpty) and ((Top_Image) or (Bot_Image)) then begin
    // HTML Text + Embedded Images, No Attachments
    MessageType := 4;
    IdMessage1.ContentType := 'multipart/related; type="text/html"';
  end;
 
  // MessageType
  // 1 = Only Text HTML
  // 2 = Text + File Attachments
  // 3 = Text + File Attachments + Embedded Images
  // 4 = Text + Embedded Images
 
  with TIdText.Create(IdMessage1.MessageParts, nil) do begin
    Body.Assign(html);
    ContentType := 'text/html';
    if MessageType = 3 then ParentPart := 1;
    CharSet     := 'iso-8859-1';
  end;
 
  if Top_Image then begin
    tempFileName := ExtractFilePath(Application.ExeName)+'DocTemp\'+'AT0001.JPG';
    with TIdAttachmentFile.Create(IdMessage1.MessageParts, tempFileName) do begin
      ContentID   := '0001';
      ContentType := 'image/jpeg';
      FileName    := 'AT0001.JPG';
      if MessageType = 3 then ParentPart := 0;
    end;
  end;

  if Bot_Image then begin
    tempFileName := ExtractFilePath(Application.ExeName)+'DocTemp\'+'AT0002.JPG';
    with TIdAttachmentFile.Create(IdMessage1.MessageParts, tempFileName) do begin
      ContentID   := '0002';
      ContentType := 'image/jpeg';
      FileName    := 'AT0002.JPG';
      if MessageType = 3 then ParentPart := 0;
    end;
  end;
 
  //Files Attachments
  if not pDataSet2.IsEmpty then begin
 
    Mail_BSent := 0;
    Mail_Str   := 'Adjuntando Archivos al Mensaje';
    Synchronize(UpdateMainForm);
 
    pDataSet2.First;
    while not pDataSet2.Eof do begin
      if not DirectoryExists('DocTemp') then
        CreateDir(ExtractFilePath(Application.ExeName)+'DocTemp');
      tempFileName := ExtractFilePath(Application.ExeName)+'DocTemp\'+Trim(pDataSet2.FieldByName('FILENAME').Value);
      with pDataSet3 do begin
        SelectSQL.Clear;
        SelectSQL.Add('Select * from BOOKINGS_EMAIL_ATTACH_BLOB');
        SelectSQL.Add('where INTERNALNO = :Txt1');
        SelectSQL.Add('and INTERNALNO2  = :Txt2');
        ParamByName('Txt1').Value := pDataSet2.FieldByName('INTERNALNO').Value;
        ParamByName('Txt2').Value := pDataSet2.FieldByName('INTERNALNO2').Value;
        Prepare;
        Open;
      end;
      f := TFileStream.Create(tempFileName,fmCreate);
      g := pDataSet3.CreateBlobStream(pDataSet3.FieldByName('DOCUMENT'), bmRead);
      f.seek(0,soFromBeginning);
      f.CopyFrom(g, 0);
      Mail_Size  := Mail_Size + f.size;
      g.free;
      f.Free;
      with TIdAttachmentFile.Create(IdMessage1.MessageParts, tempFileName) do begin
        ContentType        := 'application/'+pDataSet2.FieldByName('FILEEXTENSION').AsString;
        FileName           := tempFileName;
      end;
      pDataSet2.Next;
    end;
  end;
 
  pDataSet2.Close;
 
  if Act_Status <> 'ABORT' then begin
    try
      Mail_Size  := Mail_Size + ((Mail_Size*36) div 100);
      Mail_BSent := 0;
      Mail_Str   := 'Conectando con Servidor de Correo';
      Synchronize(UpdateMainForm);
      IdSMTP1.Connect;
      if Tot_Mails > 1 then
        Mail_Str  := 'Enviando '+IntToStr(Num_Mail)+' de '+IntToStr(Tot_Mails)+' e-Correos al Servidor de Correo'
      else
        Mail_Str  := 'Enviando e-Correo al Servidor de Correo';
      Synchronize(UpdateMainForm);
      Act_Status := 'SENDING';
      IdSMTP1.Send(IdMessage1);
      Mail_Str  := 'Desconectando del Servidor de Correo';
      Synchronize(UpdateMainForm);
      IdSMTP1.Disconnect;
      Act_Status := 'OK';
    except
      on E: Exception do begin
        Act_Status := 'ABORT';
      end;
    end;
  end;
 
  IdSMTP1.Free;
  IdMessage1.Free;
 
  if Top_Image then begin
    tempFileName := ExtractFilePath(Application.ExeName)+'DocTemp\'+'AT0001.JPG';
    DeleteFile(tempFileName);
  end;

  if Bot_Image then begin
    tempFileName := ExtractFilePath(Application.ExeName)+'DocTemp\'+'AT0002.JPG';
    DeleteFile(tempFileName);
  end;
 
  with pDataSet2 do begin
    Open;
    if not IsEmpty then begin
      First;
      while not Eof do begin
        tempFileName := ExtractFilePath(Application.ExeName)+'DocTemp\'+Trim(pDataSet2.FieldByName('FILENAME').Value);
        if FileExists(tempFileName) then DeleteFile(tempFileName);
        Next;
      end;
    end;
    Close;
  end;
 
  pDataSet1.Edit;

  if Act_Status = 'OK' then pDataSet1.FieldByName('DATE_SENT_RECEIV').Value := Now;
  pDataSet1.FieldByName('CURRENTLY_SENDING').Value := 0;
  pDataSet1.Post;
  pTransact.CommitRetaining;
 
end;

Edito : He tenido que reemplazar algunos 'tags HTML' por ':' en vez de '<' y '>' porque se veían mal en el hilo

[gluglu] · #4 22-08-2011

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/b...8_17_a.en.aspx

También he encontrado esto :

http://www.indyproject.org/sockets/b...080116.EN.aspx

Saludos !

Casimiro Notevi · #5 22-08-2011

Cita:

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] · #6 22-08-2011

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] · #7 23-08-2011

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] · #8 23-08-2011

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

Código:

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

Temas Similares
Tema	Autor	Foro	Respuestas	Último mensaje
Enviar un correo desde delphi HTML	flystar	Varios	0	25-05-2010 19:12:45
ENVIAR CORREO mi cuenta de correo es GMAIL	ASAPLTDA	PHP	1	16-11-2006 00:54:03
Problemas al Enviar Correo con Ciertas Dir. de Correo	AGAG4	Internet	2	01-02-2006 20:37:42
Como enviar un correo en formato HTML	TDworD	Internet	0	20-11-2004 20:01:13
Como enviar correo HTML?	JDNA	Internet	3	15-05-2004 07:21:03