程序師世界是廣大編程愛好者互助、分享、學習的平台,程序師世界有你更精彩!
首頁
編程語言
C語言|JAVA編程
Python編程
網頁編程
ASP編程|PHP編程
JSP編程
數據庫知識
MYSQL數據庫|SqlServer數據庫
Oracle數據庫|DB2數據庫
 程式師世界 >> 編程語言 >> 更多編程語言 >> Delphi >> 技術筆記:Indy控件發送郵件,indy控件

技術筆記:Indy控件發送郵件,indy控件

編輯:Delphi

技術筆記:Indy控件發送郵件,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;

效果還是挺好。

 

  1. 上一頁:
  2. 下一頁:
Copyright © 程式師世界 All Rights Reserved