Club Delphi  
    FTP   CCD     Buscar   Trucos   Trabajo   Foros

Retroceder   Foros Club Delphi > Principal > Internet
Registrarse FAQ Miembros Calendario Guía de estilo Buscar Temas de Hoy Marcar Foros Como Leídos

Grupo de Teaming del ClubDelphi

Respuesta
 
Herramientas Buscar en Tema Desplegado
  #1  
Antiguo 22-08-2011
Avatar de newtron
[newtron] newtron is offline
Membrillo Premium
 
Registrado: abr 2007
Ubicación: Motril, Granada
Posts: 3.457
Poder: 20
newtron Va camino a la fama
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
__________________
Be water my friend.
Responder Con Cita
  #2  
Antiguo 22-08-2011
Avatar de dec
dec dec is offline
Moderador
 
Registrado: dic 2004
Ubicación: Alcobendas, Madrid, España
Posts: 13.107
Poder: 34
dec Tiene un aura espectaculardec Tiene un aura espectacular
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".

Última edición por dec fecha: 22-08-2011 a las 14:40:13.
Responder Con Cita
  #3  
Antiguo 22-08-2011
Avatar de Casimiro Notevi
Casimiro Notevi Casimiro Notevi is offline
Moderador
 
Registrado: sep 2004
Ubicación: En algún lugar.
Posts: 32.021
Poder: 10
Casimiro Notevi Tiene un aura espectacularCasimiro Notevi Tiene un aura espectacular
"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
Responder Con Cita
  #4  
Antiguo 22-08-2011
Avatar de gluglu
[gluglu] gluglu is offline
Miembro Premium
 
Registrado: sep 2004
Ubicación: Málaga - España
Posts: 1.455
Poder: 21
gluglu Va por buen camino
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.
__________________
Piensa siempre en positivo !
Responder Con Cita
  #5  
Antiguo 22-08-2011
Avatar de Chris
[Chris] Chris is offline
Miembro Premium
 
Registrado: abr 2007
Ubicación: Jinotepe, Nicaragua
Posts: 1.678
Poder: 18
Chris Va por buen camino
Cita:
Empezado por Casimiro Notevi Ver Mensaje
"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
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
__________________
Perfil Github - @chrramirez - Delphi Blog - Blog Web
Responder Con Cita
  #6  
Antiguo 22-08-2011
Avatar de gluglu
[gluglu] gluglu is offline
Miembro Premium
 
Registrado: sep 2004
Ubicación: Málaga - España
Posts: 1.455
Poder: 21
gluglu Va por buen camino
Uuuy !! Me acabo de dar cuenta que el enlace dentro del otro hilo ya no funciona !
__________________
Piensa siempre en positivo !
Responder Con Cita
  #7  
Antiguo 22-08-2011
Avatar de Casimiro Notevi
Casimiro Notevi Casimiro Notevi is offline
Moderador
 
Registrado: sep 2004
Ubicación: En algún lugar.
Posts: 32.021
Poder: 10
Casimiro Notevi Tiene un aura espectacularCasimiro Notevi Tiene un aura espectacular
Cita:
Empezado por gluglu Ver Mensaje
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
Responder Con Cita
  #8  
Antiguo 22-08-2011
Avatar de gluglu
[gluglu] gluglu is offline
Miembro Premium
 
Registrado: sep 2004
Ubicación: Málaga - España
Posts: 1.455
Poder: 21
gluglu Va por buen camino
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
__________________
Piensa siempre en positivo !

Última edición por gluglu fecha: 22-08-2011 a las 17:25:09.
Responder Con Cita
  #9  
Antiguo 22-08-2011
Avatar de gluglu
[gluglu] gluglu is offline
Miembro Premium
 
Registrado: sep 2004
Ubicación: Málaga - España
Posts: 1.455
Poder: 21
gluglu Va por buen camino
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 !

__________________
Piensa siempre en positivo !
Responder Con Cita
  #10  
Antiguo 22-08-2011
Avatar de dec
dec dec is offline
Moderador
 
Registrado: dic 2004
Ubicación: Alcobendas, Madrid, España
Posts: 13.107
Poder: 34
dec Tiene un aura espectaculardec Tiene un aura espectacular
Hola,

Cita:
Empezado por Chris Ver Mensaje
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.
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.
Responder Con Cita
  #11  
Antiguo 22-08-2011
Avatar de Casimiro Notevi
Casimiro Notevi Casimiro Notevi is offline
Moderador
 
Registrado: sep 2004
Ubicación: En algún lugar.
Posts: 32.021
Poder: 10
Casimiro Notevi Tiene un aura espectacularCasimiro Notevi Tiene un aura espectacular
Cita:
Empezado por gluglu Ver Mensaje
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
Responder Con Cita
  #12  
Antiguo 22-08-2011
Avatar de newtron
[newtron] newtron is offline
Membrillo Premium
 
Registrado: abr 2007
Ubicación: Motril, Granada
Posts: 3.457
Poder: 20
newtron Va camino a la fama
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
__________________
Be water my friend.
Responder Con Cita
  #13  
Antiguo 23-08-2011
Avatar de newtron
[newtron] newtron is offline
Membrillo Premium
 
Registrado: abr 2007
Ubicación: Motril, Granada
Posts: 3.457
Poder: 20
newtron Va camino a la fama
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.
__________________
Be water my friend.

Última edición por newtron fecha: 23-08-2011 a las 11:46:48.
Responder Con Cita
  #14  
Antiguo 23-08-2011
Avatar de gluglu
[gluglu] gluglu is offline
Miembro Premium
 
Registrado: sep 2004
Ubicación: Málaga - España
Posts: 1.455
Poder: 21
gluglu Va por buen camino
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
__________________
Piensa siempre en positivo !
Responder Con Cita
  #15  
Antiguo 23-08-2011
Avatar de newtron
[newtron] newtron is offline
Membrillo Premium
 
Registrado: abr 2007
Ubicación: Motril, Granada
Posts: 3.457
Poder: 20
newtron Va camino a la fama
¡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
__________________
Be water my friend.
Responder Con Cita
  #16  
Antiguo 23-08-2011
Avatar de gluglu
[gluglu] gluglu is offline
Miembro Premium
 
Registrado: sep 2004
Ubicación: Málaga - España
Posts: 1.455
Poder: 21
gluglu Va por buen camino
... hecho !
__________________
Piensa siempre en positivo !
Responder Con Cita
  #17  
Antiguo 23-08-2011
Avatar de Casimiro Notevi
Casimiro Notevi Casimiro Notevi is offline
Moderador
 
Registrado: sep 2004
Ubicación: En algún lugar.
Posts: 32.021
Poder: 10
Casimiro Notevi Tiene un aura espectacularCasimiro Notevi Tiene un aura espectacular
Cita:
Empezado por newtron Ver Mensaje
¡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


Responder Con Cita
  #18  
Antiguo 05-08-2016
Neeruu Neeruu is offline
Miembro
 
Registrado: oct 2007
Posts: 484
Poder: 17
Neeruu Va por buen camino
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;
__________________
Saluda Atte Neeruu!!! :)
Responder Con Cita
  #19  
Antiguo 05-08-2016
Avatar de newtron
[newtron] newtron is offline
Membrillo Premium
 
Registrado: abr 2007
Ubicación: Motril, Granada
Posts: 3.457
Poder: 20
newtron Va camino a la fama
Gracias Neeruu.
__________________
Be water my friend.
Responder Con Cita
  #20  
Antiguo 05-08-2016
Avatar de dec
dec dec is offline
Moderador
 
Registrado: dic 2004
Ubicación: Alcobendas, Madrid, España
Posts: 13.107
Poder: 34
dec Tiene un aura espectaculardec Tiene un aura espectacular
Cita:
Empezado por newtron Ver Mensaje
Gracias Neeruu.
+123456789
__________________
David Esperalta
www.decsoftutils.com
Responder Con Cita
Respuesta


Herramientas Buscar en Tema
Buscar en Tema:

Búsqueda Avanzada
Desplegado

Normas de Publicación
no Puedes crear nuevos temas
no Puedes responder a temas
no Puedes adjuntar archivos
no Puedes editar tus mensajes

El código vB está habilitado
Las caritas están habilitado
Código [IMG] está habilitado
Código HTML está deshabilitado
Saltar a Foro

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


La franja horaria es GMT +2. Ahora son las 21:30:22.


Powered by vBulletin® Version 3.6.8
Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Traducción al castellano por el equipo de moderadores del Club Delphi
Copyright 1996-2007 Club Delphi