Enviar correo html con imagen incrustada

[elguille]

Este codigo no me funcionaba. Despues de muchas vueltas he editado en WORD lo que queria enviar, lo he grabado con formato "pagina web filtrada" el cual graba un fichero htm y un directorio "nombre"_archivos donde estan las imagenes .
La función de envio

Código Delphi [-]
procedure emailhtml(host: string; nombre: string; password: string; port: integer; desde: string; hasta: string; asunto: string; cuerpo: string; adjunto: string; bcc: string);
var
  IDSMTP1: TIDSMTP;
  email: TIdMessage;
  htmpart, txtpart: TIdText;
  html: TStrings;
  mfic, mfichero: string;
  bmppart: TIdAttachmentfile;
begin
  screen.cursor := crhourglass;
  IDSMTP1 := TIDSMTP.Create(nil);
  IDSMTP1.UserNAME := nombre;
  IDSMTP1.password := password;
  IDSMTP1.host := host;
  IDSMTP1.port := port;

  html := TStringList.Create();
  html.Add(cuerpo);
  email := TIdMessage.Create(nil);
  with email do
  begin
    From.Text := desde;
    Recipients.EMailAddresses := hasta;
    Subject := asunto;
    CCList.EMailAddresses := '';
    BccList.EMailAddresses := bcc;
    ContentType := 'multipart/related; type="text/html"';
    txtpart := TIdText.Create(email.MessageParts);
    txtpart.ContentType := 'multipart/related; type="multipart/alternative"';

    txtpart := TIdText.Create(email.MessageParts);
    txtpart.ContentType := 'multipart/alternative';

    txtpart := TIdText.Create(email.MessageParts);
    txtpart.ContentType := 'text/plain';
    txtpart.ParentPart := 1;

    htmpart := TIdText.Create(email.MessageParts, html);
    htmpart.ContentType := 'text/html';
    htmpart.ParentPart := 1;

    if adjunto <> '' THEN
    begin
      mfichero := adjunto;
      if pos(';', mfichero) > 0 then
      begin
        while pos(';', mfichero) > 0 do
        begin
          mfic := copy(mfichero, 1, pos(';', mfichero) - 1);
          bmppart := TIdAttachmentfile.Create(email.MessageParts, mfic);
          bmppart.ContentType := 'image/jpg';
          bmppart.FileIsTempFile := true;
          bmppart.ContentDisposition := 'inline';
          bmppart.ContentID := '<' + extractfilename(mfic) + '>';
          bmppart.FileName := mfic;
          mfichero := copy(mfichero, pos(';', mfichero) + 1, 1000);
        end;
      end
      else
        TIdAttachmentfile.Create(email.MessageParts, mfichero);
    end;
  end;
  with IDSMTP1 do
  begin
    try
      if Connected then
        Disconnect;
      Connect;
    except
      raise Exception.Create('Error al conectar con el servidor.');
    end;
    if Connected then
    begin
      try
        Send(email);
      except
        on E: Exception do
        begin
          raise Exception.Create(E.classname + ' ' + E.message);
        end;
      end;
      try
        Disconnect;
      except
        raise Exception.Create('Error al desconectar del servidor.');
      end;
    end;
  end;
  html.Free;
  IDSMTP1.Free;
  email.Free;
  screen.cursor := crdefault;
end;

Con la llamada para el fichero email.htm

Código Delphi [-]
      TS2 := tstringlist.Create;
      TS2.LoadFromFile(extractfilepath(application.ExeName) + 'email.htm');
      TS2.Text := strreplace(TS2.Text, 'email_archivos/', 'cid:');
      mrut := extractfilepath(application.ExeName) + 'email_archivos\';
      if FindFirst(mrut + '*.*', faAnyFile, SearchRec) = 0 then
      begin
        REPEAT
          IF (SearchRec.Name <> '.') AND (SearchRec.Name <> '..') THEN
            mfic := mfic + mrut + SearchRec.Name + ';';
        UNTIL FindNext(SearchRec) <> 0;
        FINDCLOSE(SearchRec);
      end;
      emailhtml(ts[1], ts[2], ts[3], strtointdef(ts[4], 0), ts[5], ts[6], ts[7], TS2.Text, mfic,'');
      TS2.Free;

El email ahora se ve igual tanto en Outlook como yahoo y gmail. (Era uno de los problemas del codigo anterior)