Enviar correo html con imagen incrustada
 

Hola.

Tengo un pequeño problema a ver si a alguien se le enciende la luz.

Estoy haciendo un pequeño proceso para enviar correos con formato html incrustando imágenes. El fichero html se crea desde word y lo que hago es crear un stringlist e incluirlo en el "body" del mensaje para incluir luego el archivo de la imagen.

El problema es que el que recibe el mensaje ve el recuadro donde debería de ir la imagen en blanco y al final se ve la imagen como archivo adjunto. Es como si no se enterara de que esa imagen en vez de ir como archivo adjunto va incrustada en una posición determinada del texto html.

El tema está en que word cuando insertas imagenes en un fichero html crea una carpeta con el nombre del archivo html seguido de "_archivos" donde ubica la imagen y creo que los tiros van por ahí pero no sé qué hacer para que me la enlace correctamente en el correo.

Pongo una parte del código que genera el correo.

Código Delphi [-]
  with TIdText.Create(email.MessageParts, nil) do begin
    Body.Assign(TextoHtml); // StringList con el fichero html
    ContentType := 'text/html';
  end;
  with TIdAttachmentFile.Create(email.MessageParts, sRuta+'image001.JPG') do begin
    ContentID   := '0001';
    ContentType := 'image/jpeg';
    FileName    := 'image001.jpg';
    ExtraHeaders.Values['content-id'] := 'image001.jpg';
  end;

Gracias y un saludo

Hola,

Es muy posible que me equivoque, puesto que, parecería lógico poder enviar correos en formato HTML que mostrase imágenes "incrustadas". Sin embargo, quien recibe el correo ve la imagen como un archivo adjunto,... porque es un archivo adjunto.

A mí me parece que el problema, por decirlo así, está en el código HTML, concretamente, en la etiqueta IMG, y más concretamente, en el atribute SRC ("source") de dicha etiqueta. Porque, ¿dónde se supone que apunta dicho atributo? En efecto, ha de contener la ruta del archivo de imagen.

Ahora bien, casi apostaría algo a que dicha "ruta" no existe más que en el archivo HTML cuando tú lo ves en tu sistema. Si quieres añadir la imagen en el correo, deberás subir dicha imagen a un servidor en internet, de manera que la ruta de la imagen sea una URL que lleve a la imagen en cuestión.

De este modo, cualquier lector de correos que soporte HTML, podrá localizar sin problemas la imagen y por lo tanto podrá mostrarla. La otra solución que se me ocurre, pasa por utilizar en el atributo SRC de la etiqueta IMG, un "esquema de datos en la URI". Esto consigue, verdaderamente, incrustar la imagen en el propio HTML, como puedes ver en el enlaze anterior, convirtiendo la imagen en una secuencia de caracteres en "Base 64".

Esta última solución tiene el inconveniente de que la imagen quedará tal cual la insertes en el HTML del correo (en este caso), mientras que, si utilizas una URL como ruta de la imagen, podrás hacer cambios en la imagen, actualizarla en el servidor, y, quien vea el correo encontrará la imagen siempre actualizada, al menos en teoría, puesto que el cliente de correo puede guardar la imagen "en caché".

Por lo demás, dicho todo lo anterior, quiero imaginar (y hasta recordar) que existe una forma de adjuntar imágenes en los correos, refiriéndose a ellas con rutas "relativas", es decir, incrustando de alguna forma las imágenes en el correo, pero, no como archivos adjuntos, o, como algún tipo especial de archivos adjuntos. Tal vez aquí mismo encuentres algún ejemplo de esto último.

No obstante, si esta última solución no existiese o fuese farragosa, lo de asegurarte de ofrecer una URL de la imagen o incrustarla mediante "Base 64" "debe funcionar".

"Estoy" con dec, la imagen debes ponerla en un lugar público para que el remitente del email pueda acceder a ella.
La otra opción es "incrustarla" en el propio email, como ha explicado también dec.
O sea, todo lo explicado por dec, más claro... imposible :)

Echale un vistazo al siguiente enlace :

http://www.clubdelphi.com/foros/show...highlight=html

Hace ya cierto tiempo que me peleé con ello. Aun así, si necesitas información adicional ... aquí estamos para ver si lo podemos resolver.

Decirte que en su momento me costó muchas pruebas para finalmente llegar a un resultado satisfactorio.

El problema con esto es que los clientes de correos siempre te bloquerán la imagen y el usuario explícitamente tendrá que indicarle que descargue las imágenes y las muestre (hablando técnicamente). Esto no es bueno si lo que vas hacer es propaganda o te preocupas demasiado por tu destinatario que sabes que necesita ver esas imágenes, pero no quieres que incurra en más operaciones para ver las imágenes.

Con respecto a la técnica de base64 y el URI que comenta dec sería la solución más estupenda, lamentablemente, Outlook no la soporta :-/

Por último, a cómo vas newtron es cómo lo puedes conseguir. Lo que te falta es que tienes que cambiar la referencia de la imagen para que no apunte a un archivo en el sistema de ficheros, sino que apunte al ID del archivo adjunto. Puedes probar con Thunderbird haciendo un correo de prueba y analiza el código fuente del correo que genera para que aprendas más sobre esta técnica. Funciona con Thunderbird y Outlook perfectamente.

Saludos,
Chris

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

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(':DIV align=center::IMG src="cid:0001" align=center::/DIV:');
          3 : html.Add(':DIV 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(':DIV align=center::IMG src="cid:0002" align=center::/DIV:');
          3 : html.Add(':DIV 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

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 !

:cool: :cool: :cool:

Hola,

Esta es la técnica sobre la que yo había oído campanas. O sea, que, es posible enlazar a los archivos adjuntos desde el HTML. Pues esta puede ser la solución o al menos una de ellas.

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

Gracias a todos. :)

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

Saludos

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('      :p: :/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.

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

En tu caso particular, añade :

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

Saludos :cool:

¡Solucionado!

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

Gracias y un saludo

:D :D ;) ... hecho !

Acaso allí no venden zumos de frutas :(


:D

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;

Gracias Neeruu.

+123456789