技术笔记：Indy控件发送邮件
工作中有个需求需要发送邮件，因为使用的delphi6，所以自然就选择了indy组件，想想这事挺简单的。实现的过程倒是简单，看着Indy的demo很快就完了，毕竟也不是很复杂的功能。
功能要求：
1、压缩日志文件并作为邮件的附件
2、邮件正文带上一些客户端信息
组件介绍
TIdSmtp：与服务器的连接及数据发送，基于smtp协议
TIdMessage：自然就是报文的信息了，包含收件人、发件人、主题、正文，以及附件。
代码展示：
function TfrmMailSend.SendMail: Boolean; var objMailBody: TStrings; begin Result := False; IdSMTP1.Username := FMailSetting.Username; IdSMTP1.Password := FMailSetting.Password; IdSMTP1.Host := FMailSetting.Host; IdSMTP1.Port := FMailSetting.Port; IdSMTP1.AuthenticationType := atLogin; IdMessage1.Priority := mpNormal; IdMessage1.From.Text := FMailSetting.FromAddress; IdMessage1.Recipients.EMailAddresses := edtToAddress.Text; IdMessage1.Subject := '日志：'+FormatDateTime('YYYY-MM-DD', dtpLogDate.Date) + '['+hsGetOperatorNo+']'; objMailBody := TStringList.Create; try objMailBody.Add('<table>'); objMailBody.Add('<tr><td><b>ClientID:</b></td><td>'+ hsGetClientID + '</td></tr>'); objMailBody.Add('<tr><td><b>CompanyName:</b></td><td>'+ AnsiToUtf8('中文革') + '</td></tr>'); objMailBody.Add('<tr><td><b>Server DateTime:</b></td><td>'+ DateTimeToStr(GetServerDateTime) + '</td></tr>'); objMailBody.Add('</table>'); //可能是Indy的bug，需要创建两次TIdText才能成功发送内容 with TIdText.Create(IdMessage1.MessageParts, objMailBody) do begin ContentType:='text/html;charset=utf-8'; ContentTransfer := 'quoted-printable'; //不能用base64，indy控件没实现 end; with TIdText.Create(IdMessage1.MessageParts, objMailBody) do begin ContentType := 'text/html;charset=utf-8'; ContentTransfer := 'quoted-printable'; //不能用base64，indy控件没实现 end; finally FreeAndNil(objMailBody); end; try IdSMTP1.Connect; try IdSMTP1.Send(IdMessage1); Result := True; finally if IdSMTP1.Connected then IdSMTP1.Disconnect; end; except on e: Exception do Console('[发送异常]'+e.Message); end; end;
代码流程主要是先准备好smtp主机信息，用户名与密码。然后组织好邮件内容，然后连接并发送。
关于附件
附件添加比较简单，Indy封装了一个专门的消息类TIdAttachment，只要将文件用TIdAttachment附加即可：
TIdAttachment.Create(IdMessage1.MessageParts, AFileName);
这样就可以将附件添加到邮件人内容中了。
解决中文乱码问题
写这个小程序最头痛的就是中文乱码问题，由于对这个组件不熟悉，找了半天也没找到办法解决。因为delphi早期版本一直都是基于ansi字符集，所以对于中文需要支持时就得专门处理。对email的协议也不太熟悉，只知道是编码问题，但找了老半天也没找到相着的解决方法。设置了IdMessage的CharSet也没有效果。
于是没办法就只要查看foxmail，QQ邮箱之类的邮件原文来看看差别。发现主要是三个点：
Content-Type: text/html;
charset="GB2312"
Content-Transfer-Encoding: quoted-printable
对于前两个好理解，和html协议类似。但Content-Transfer-Encoding没怎么接触过。
Content-Transfer-Encoding主要值：
7bit：用于不编码的数据。数据为 7 位 US-ASCII 字符，总行长不超过 1000 个字符。
base64：不用解释了。这个通常用于字节流，比较附件就用这个格式。
quoted-printable：将由 US-ASCII 字符集中可打印的字符组成的数据编码。
之所以是中文乱码，原因是添加邮件正文时的字符集与接收邮件客户端的字符集对上。比如Delphi默认发送的时候文本是Ansi的，结果Foxmail却是不支持。只有GB2312、UTF-8之类的。查看邮件正文：
Content-Type: text/html;
charset="UTF-8"
Content-Transfer-Encoding: quoted-printable
这样一来肯定就显示乱码了，因为发的时候他中文并不是UTF-8的格式。解决这个问题办法也简单，那就把字符串转正特定的编码再发吧。
还好delphi里有个函数直接就用：
AnsiToUtf8('中文革')
这样发过去的内容中文就可以显示了。
发送Html
直接在TIdMessage的body内容发送其实是text/plain，这种明格式的话就不太容易做样式，不太好看。所以就要支持Html格式。看了看网上的资料，就是使用另一个Indy类可以实现TIdText。
with TIdText.Create(IdMessage1.MessageParts, objMailBody) do begin ContentType:='text/html;charset=utf-8'; ContentTransfer := 'quoted-printable'; //不能用base64，indy控件没实现 end;
和附件的使用方法类似，只是要设定一下格式。只不过让人失望了，发过去没有效果啊。。没有效果啊。。接收到的邮件正文是空白的，查看原文：
--=_NextPart_2rfkindysadvnqw3nerasdf Content-Type: text/plain Content-Transfer-Encoding: 7bit --=_NextPart_2rfkindysadvnqw3nerasdf Content-Type: application/octet-stream; name="Logs_2016-01-10[60001].7z"
这是QQ邮箱中收到的正文，发现在附件与正文之间的内容是空白，没有收到啊。再看看Foxmail(微软exchage)
------=_002_NextPart335103774317_=----
Content-Type: text/html;
charset="GB2312"
Content-Transfer-Encoding: quoted-printable<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2//EN">
<HTML>
<HEAD>
<META HTTP-EQUIV=3D"Content-Type" CONTENT=3D"text/html; charset=3Dgb2312">
<META NAME=3D"Generator" CONTENT=3D"MS Exchange Server version 14.01.0421.=
002">
<TITLE>=C8=D5=D6=BE=A3=BA2016-01-10[60001]</TITLE>
</HEAD>
<BODY>
<!-- Converted from text/plain format --></BODY>
</HTML>
------=_002_NextPart335103774317_=------------=_001_NextPart645231448141_=----
Content-Type: application/octet-stream;
name="Logs_2016-01-10[60001].7z"
这倒是有一段html内容，只是body部分显示的是空白。。后来在网上看到一篇文章才发现是indy的一个bug。链接
TIdSMTP是最终发送邮件的类，发送的代码主要是在它父类TIdMessageClient中实现。SendBody方法，看看代码片段：
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
TextPartCount > 1才会去写入TIdText的内容，我的天，这玩意有点坑人啊。。于是我也学着别人的方法再添加一次，本文最初那段代码已经知道用法了：
//可能是Indy的bug，需要创建两次TIdText才能成功发送内容 with TIdText.Create(IdMessage1.MessageParts, objMailBody) do begin ContentType:='text/html;charset=utf-8'; ContentTransfer := 'quoted-printable'; //不能用base64，indy控件没实现 end; with TIdText.Create(IdMessage1.MessageParts, objMailBody) do begin ContentType := 'text/html;charset=utf-8'; ContentTransfer := 'quoted-printable'; //不能用base64，indy控件没实现 end;
再说乱码问题
前面在解决乱码问题时提到了Content-Transfer-Encoding，看别家邮件发送的内容可以是Base64，那么我想这应该是比较好的一种方法，于是就设置了一下，呵呵哒。跪了。然后只能继续查看组件的源代码，还是TIdMessageClient的SendBody方法，其中有个子函数：WriteTextPart。
procedure WriteTextPart(ATextPart: TIdText); var Data: string; i: Integer; begin if Length(ATextPart.ContentType) = 0 then ATextPart.ContentType := 'text/plain'; {do not localize} if Length(ATextPart.ContentTransfer) = 0 then ATextPart.ContentTransfer := 'quoted-printable'; {do not localize} WriteLn('Content-Type: ' + ATextPart.ContentType); {do not localize} WriteLn('Content-Transfer-Encoding: ' + ATextPart.ContentTransfer); {do not localize} WriteStrings(ATextPart.ExtraHeaders); WriteLn(''); // TODO: Provide B64 encoding later // if AnsiSameText(ATextPart.ContentTransfer, 'base64') then begin // LEncoder := TIdEncoder3to4.Create(nil); if AnsiSameText(ATextPart.ContentTransfer, 'quoted-printable') then begin for i := 0 to ATextPart.Body.Count - 1 do begin if Copy(ATextPart.Body[i], 1, 1) = '.' then begin ATextPart.Body[i] := '.' + ATextPart.Body[i]; end; Data := TIdEncoderQuotedPrintable.EncodeString(ATextPart.Body[i] + EOL); if TransferEncoding = iso2022jp then Write(Encode2022JP(Data)) else Write(Data); end; end else begin WriteStrings(ATextPart.Body); end; WriteLn(''); end;
看到注释我已经跪了。。T_T，原来base64还是TODO的功能，不知道后续的Indy版本有没有实现。。
发送邮件进度
由于发送邮件包括了附件，内容比较大必须给用户显示个进度条。看着TIdSMTP有个OnWorkBegin和OnWork事件，而且OnWorkBegin有个AWorkCountMax参数，喜出望外，这样就知道发送的总大小了，弄个进度条这不是分分钟就OK了嘛。。结果一试发现然并卵。于是只能自己想办法了。
发现OnWork有AWorkCount参数，发现这个参数是有用的，它会在被调用时返回当前已经发送的大小。那么就想这个大小会是什么大小呢？
测试了发下发现和附件的总大小是一样的。这样就只要解决附件总大小就可以了，方法也简单，在添加附件的时候计算一下文件长度然后保存在一个变量中即可。在OnWorkBegin的时候设置为进度条最大值就好了。
procedure TfrmMailSend.IdSMTP1Work(Sender: TObject; AWorkMode: TWorkMode; const AWorkCount: Integer); begin self.ProgressBar1.Position := AWorkCount; Console('正在发送日志......'); Application.ProcessMessages; end; procedure TfrmMailSend.IdSMTP1WorkBegin(Sender: TObject; AWorkMode: TWorkMode; const AWorkCountMax: Integer); begin ProgressBar1.Position := 0; if FAttaSize >= 0 then ProgressBar1.Max := FAttaSize else ProgressBar1.Max := 0; Console('开始发送日志......'); end; procedure TfrmMailSend.IdSMTP1WorkEnd(Sender: TObject; AWorkMode: TWorkMode); begin Application.ProcessMessages; FAttaSize := 0; Console('发送完成'); end;
效果还是挺好。
