INDY发送html邮件带附件邮件内容不能正确显示的问题

有个项目里面需要发送html邮件，按平时的发送代码没问题，可是加入附件后邮件内容显示为源码，从网上找到达人是这样处理的：
原贴

1. HTML

实验表明如果只有邮件内容而没有附件,使用HTML格式很简单:
      with IdMessage do
        begin
        ContentType := FieldByName('ContentType').AsString;
        Body.Text := FieldByName('Body').AsString;
        //...
        end;
但是一旦加上附件就不灵了.

看Indy的官方网站提供的DEMO,是这样添加邮件内容:
procedure TfrmMessageEditor.btnTextClick(Sender: TObject);
begin
   if Length(Edit1.Text) = 0 then
      begin
         MessageDlg('Indicate ContentType first', mtError, [mbOk], 0);
      end
   else
      begin
         with TIdText.Create(IdMsgSend.MessageParts, Memo1.Lines) do
            begin
               ContentType := Edit1.Text;
            end;
         Memo1.Clear;
         ResetAttachmentListView;
      end;
end;
主要就是这几行:
         with TIdText.Create(IdMsgSend.MessageParts, Memo1.Lines) do
            begin
               ContentType := Edit1.Text;
            end;
把Edit1.Text换成: 'text/html';
最后把邮件发出去以后用Foxmail收下来看邮件源码,结果仍然是Content-Type: text/plain;

试了很多次都是这样的结果.想来想去看来只有从Indy的代码上去分析了.

通过跟踪,问题应该就在IdMessageClient.pas里:
      if AMsg.MessageParts.TextPartCount > 1 then
      begin
        WriteLn('Content-Type: multipart/alternative; '); {do not localize}
        WriteLn('        boundary="' + IndyMultiPartAlternativeBoundary + '"'); {do not localize}
        WriteLn('');
        for i := 0 to AMsg.MessageParts.Count - 1 do
        begin
          if AMsg.MessageParts.Items[i] is TIdText then
          begin
            WriteLn('--' + IndyMultiPartAlternativeBoundary);
            DoStatus(hsStatusText,  [RSMsgClientEncodingText]);
            WriteTextPart(AMsg.MessageParts.Items[i] as TIdText);
            WriteLn('');
          end;
        end;
        WriteLn('--' + IndyMultiPartAlternativeBoundary + '--');
      end
      else begin
        if LMIMEAttachments then
        begin
          WriteLn('Content-Type: text/plain'); {do not localize}
          WriteLn('Content-Transfer-Encoding: 7bit'); {do not localize}
          WriteLn('');
          WriteBodyText(AMsg);
        end;
      end;
从这里可以看出,文本部分必须为2个或以上才会用设定的ContentType,否则自动设置为text/plain.

不想改控件,所以在使用上再添加一个MessageParts.Item,不用添加Body就可以解决:
        MailBody := TStringList.Create;
        MailBody.Text := FieldByName('Body').AsString;
        with TIdText.Create(MessageParts, MailBody) do
          ContentType := FieldByName('ContentType').AsString;
        MailBody.Free;
        with TIdText.Create(MessageParts, MailBody) do
          ContentType := FieldByName('ContentType').AsString;

不知道这算不算Indy的一个BUG,反正我是感觉很别扭.


2.显示发邮件进程

用惯了Foxmail,对它发邮件时显示的那个进度条很有印象,也想做一个.
Indy的Demo没有提供这样的演示,我拦这个事件:
procedure TfrmMain.IdSMTPWorkBegin(Sender: TObject; AWorkMode: TWorkMode;
  const AWorkCountMax: Integer);
begin
  //Gauge.MaxValue := AWorkCountMax;
end;
抓到的值一直是0,看来又是一个我搞不懂的问题.

倒是这个事件返回的值可以用:
procedure TfrmMain.IdSMTPWork(Sender: TObject; AWorkMode: TWorkMode;
  const AWorkCount: Integer);
begin
  Gauge.Progress := AWorkCount;
end;
这样时度就有着落了,但是总的长度呢?

发现IdMessage有一个SaveToStream的方法,这倒可以试一试!
我想:所有要发的东西都放在这个IdMessage里,把它Save到一个流里,然后取这个流的SIZE就可以 吧.
最后是这样解决的:
  TempStream := TMemoryStream.Create;
  IdMessage.SaveToStream(TempStream);
  Gauge.MaxValue := TempStream.Size;
  TempStream.Free;