有个项目里面需要发送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;
