Ver Mensaje Individual
  #13  
Antiguo 23-08-2011
Avatar de newtron
[newtron] newtron is offline
Membrillo Premium
 
Registrado: abr 2007
Ubicación: Motril, Granada
Posts: 3.462
Reputación: 21
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 10:46:48.
Responder Con Cita