Delphi實作的MIME郵件格式解析類庫

研究了一下Pop3的郵件接收協定，然後随手寫了一個Pop3的郵件接收控件！Pop3的郵件協定實際上是很簡單的，知道那幾個指令就行了，與伺服器之間的互動是一問一答得方式，控制起來也容易，相對而言郵件格式的解析倒是更加麻煩一點！于是也便順帶着将MIME郵件格式給熟悉了一下！總歸說來，規律性比較強，先擷取最大的頂層架構，然後根據頂層架構來判斷是否有還有子架構，依次根據給定的間隔符号疊代下來！看看類設計！首先一個MIME是要有一個郵件頭！是以這個類是必然的！

實作了郵件頭類TDxMIMEHeader ，然後再看郵件格式，就是資料部分了，資料部分就涉及到前面說的架構問題，有Mulpart/mixed等這樣的還有子架構的結構，也有單純的text/plain這樣的純文字結構，具體的資訊都在郵件格式的頭部有說明 ，于是将資料Part設計成了一個繼承模式，TDxMIMEPart作為資料Part的基類，然後Mulpart/mixed，text/plain等這樣的各個子產品部分都從該類繼承，Mulpart/mixed等是有内部資料子產品的，是以這個另外繼承一個多資料子產品基類TDxMimeMulPart，然後隻要含有多個資料子產品的子產品都從這個類繼承去實作，除此之外，還需要一個附件等流式資料的流子產品的解析類TDxMIMEStreamPart，本類主要是将附件等資訊還原出來！大緻資訊如此，其實應該給子產品類還要設定一個子產品頭的類的，因為隻是研究也就直接寫在裡面了！大緻代碼塊如下：

<a></a>

代碼

(******************************************************)

(*                得閑工作室                          *)

(*              郵件格式解析單元                      *)

(*                                                    *)

(*              DxMIMEParser Unit                     *)

(*    String Operate Unit Version 1.x 2010/01/05      *)

(*    Copyright(c) 2010    不得閑                     *)

(*    email:[email protected]     QQ:75492895    *)

unit DxMIMEParser;

interface

uses Windows,Classes,SysUtils,DxEmailCommon,synacode,Registry;

type

  //編碼

  TContent_Transfer_Encoding = (TE_Base64, TE_Quoted_printable, TE_7bit, TE_8bit,TE_Binary);

  //MIME郵件頭定義

  TDxMIMEHeader = class(TPersistent)

  private

    HeaderList: TStringList;

    function GetHeaderString: string;

    procedure SetFrom(const Value: string);

    function GetFrom: string;

    function GetContent_Type: string;

    procedure SetContent_Type(const Value: string);

    procedure SetToPerson(const Value: string);

    function GetToPerson: string;

    function GetMessage_ID: string;

    procedure SetMessage_ID(const Value: string);

    function GetMimeVer: string;

    procedure SetMimeVer(const Value: string);

    function GetSubject: string;

    procedure SetSubject(const Value: string);

    function GetDateTime: TDateTime;

    procedure SetDateTime(const Value: TDateTime);

  public

    constructor Create;

    destructor Destroy;override;

    function GetFieldValue(Field: string): string;

    procedure SetFieldValue(Field: string;Value: string);

    property From: string read GetFrom write SetFrom;//來自誰

    property Content_Type: string read GetContent_Type write SetContent_Type;

    property ToPerson: string read GetToPerson write SetToPerson;//發送給誰

    property Message_ID: string read GetMessage_ID write SetMessage_ID;

    property Mime_Ver: string read GetMimeVer write SetMimeVer;//版本

    property Subject: string read GetSubject write SetSubject;//題目

    property DateTime: TDateTime read GetDateTime write SetDateTime; //發送時間

    property HeaderString: string read GetHeaderString;

  end;

  //MIME段

  TDxMIMEPart = class(TPersistent)

    PartList: TStringList;

    SplitStr: string;

    FContent_Transfer_Encoding: TContent_Transfer_Encoding;

    FTopType: string;

    FContent_Type: string;

    FContent_Disposition: string;

    FContent_ID: string;

    FContent_Base: string;

    FContent_Location: string;

    procedure SetContent_Disposition(const Value: string);

    procedure SetContent_ID(const Value: string);

    procedure SetContent_Base(const Value: string);

    procedure SetContent_Location(const Value: string);

  protected

    procedure ParserPart;virtual;

    constructor Create;virtual;

    property TopType: string read FTopType;

    function GetFieldParams(Field: string;ValueIndex: Integer;const Splitstr: string=';'): string;

    property Content_Type: string read FContent_Type write SetContent_Type;

    property Content_Disposition: string read FContent_Disposition write SetContent_Disposition;

    property Content_ID: string read FContent_ID write SetContent_ID;

    property Content_Location: string read FContent_Location write SetContent_Location;

    property Content_Base: string read FContent_Base write SetContent_Base;

    property Content_Transfer_Encoding: TContent_Transfer_Encoding read FContent_Transfer_Encoding write FContent_Transfer_Encoding;  

  TDxMIMETextPart = class(TDxMIMEPart)

    IsTop: Boolean;//頂部

    function GetTextInfo: string;

    procedure SetTextInfo(const Value: string);

    procedure ParserPart;override;

    constructor Create;override;

    property Text: string read GetTextInfo write SetTextInfo;//純文字資訊

  TDxMIMEHtmlPart = class(TDxMIMETextPart)

  TDxMIMEStreamPart = class(TDxMIMEPart)

    stream: TMemoryStream;

    FFileName: string;

    FAttatchName: string;

    procedure SetAttatchName(const Value: string);

    procedure SetFileName(const Value: string);

    function GetSize: Int64;//記憶體流

    procedure DoParserContentInfo;virtual;//解析Content資訊 

    procedure Clear;

    procedure SaveToFile(FileName: string);

    procedure SaveToStream(AStream: TStream);

    property AttatchName: string read FAttatchName write SetAttatchName;

    property FileName: string read FFileName write SetFileName;

    property Size: Int64 read GetSize;

  //txt,Html都包含

  TDxMimeMulPart = class(TDxMIMEPart)

    ObjList: TList;

    function GetChildPartCount: Integer;

    function GetChildPart(index: integer): TDxMIMEPart;

    property ChildPartCount: Integer read GetChildPartCount;

    property ChildPart[index: integer]: TDxMIMEPart read GetChildPart;

  TDxMIMETxtHtmlPart = class(TDxMimeMulPart);

  TDxMIMEResPart = class(TDxMimeMulPart)

  //multipart/Mixed附件方式

  TDxMIMEMulMixedPart = class(TDxMimeMulPart)

  //MIME解析類

  TDxMIMEParser = class

    ParserList: TStringList;

    tmpList: TStringList;

    MimeHeader: TDxMIMEHeader;

    FMainMailPart: TDxMIMEPart;

    procedure DoParser;

    function GetTopTye: string;

    property Header: TDxMIMEHeader read MimeHeader;

    procedure LoadFromFile(FileName: string);

    procedure LoadFromStream(Stream: TStream);

    property MainMailPart: TDxMIMEPart read FMainMailPart;

    property TopType: string read GetTopTye;

  TDxPartClass = class of TDxMIMEPart;

const

  ContentTypes: array[0..5]of string=('text/plain','text/html','multipart/mixed','multipart/related','multipart/alternative','application/octet-stream');

implementation

//完整代碼，請下載下傳附件

end.

Bug肯定還是會存在的，因為代碼都僅僅是一個雛形！沒做任何嚴謹的邏輯與測試的考驗，不過我測試過的郵件格式，基本上是都能夠解析出來的！包括裡面的資料與附件，都能解析出來！

同時，我也給出郵件接收的控件TDxPop3，代碼尚未完整實作，目前隻實作了一個非阻塞模型的，存在着bug，不曉得是啥原因，通過List指令傳回的郵件大小總比我接收的郵件大小要小！于是當我根據傳回的郵件的大小去判斷是否已經将郵件完整下載下傳的時候，有時候就在郵件沒有下完整的時候，我就跳出去了，具體原因沒有深入追究！接收的資料貌似也沒什麼問題，但是就是接收的資料大小要比List傳回的郵件的大小要大，導緻了郵件中途退出！大緻代碼：

(*              郵件收發控件單元                      *)

(*           DxEmailComponent Unit                    *)

unit DxEmailComponent;

uses Windows,SysUtils,Classes,ScktComp,Forms,frxMD5,DxEmailCommon,DxMIMEParser;

type           //無狀态   連接配接   檢查使用者      檢查密碼   STAT指令  List指令   下載下傳郵件                   操作成功                        失敗

  TEmailState = (Es_None,ES_Con,ES_CheckUser,ES_CheckPwd,ES_STATCMD,ES_LISTCMD,ES_DownLoadEmail,ES_Hello, ES_OperateOk,ES_QUIT,ES_TimeOut,ES_Error);

  TReciveSimpleDataEvent = procedure(Sender: TObject;State: TEmailState;ReciveData: string) of object;

  TDownLoadEmailEvent = procedure(Sender: TObject;EmailStreamParser: TDxMIMEParser) of object;

  TProgressEvent = procedure(Sender: TObject;Progress: Single) of object;

  TErrorEvent = procedure(Sender: TObject;ErrMsg: string) of object;

  //郵件接收控件

  TDxPop3 = class(TComponent)

    EmailList: TStringList;//郵件資訊清單

    FMIMEParser: TDxMIMEParser;

    Pop3Socket: TClientSocket;

    FUserName: string;

    FPassword: string;

    EmailState: TEmailState;

    FAutoAPOP: Boolean;

    CurEmailStream: TMemoryStream;

    beginDownLoad: Boolean;//開始下載下傳

    UserLogedIn: Boolean;//使用者登入進來

    Md5TimeSeed: string;//計算密碼加密資訊的時間種子

    StateMsg: string;

    CurDownLoadEmailSize: Int64;//目前下載下傳的Email檔案大小

    IsOpering: Boolean;//正在執行某個操作

    FTimeOutInterValue: DWORD;

    FOnReciveSimpleData: TReciveSimpleDataEvent;

    FOnDownLoadEmail: TDownLoadEmailEvent;

    FOnUserLogedIn: TNotifyEvent;//狀态資訊

    inlineMsg: Boolean;

    UserQuit: Boolean;//使用者退出

    FOnProgress: TProgressEvent;

    FOnError: TErrorEvent;    

    FOnBeginDownLoadEmail: TNotifyEvent;//内部消息

    procedure SetSocketType(const Value: TClientType);

    function GetSocketType: TClientType;

    procedure SetFPop3Host(const Value: string);

    function GetPop3Host: string;

    function GetPop3Port: Integer;

    procedure SetPop3Port(const Value: Integer);

    procedure SendCmdLine(CmdLine: string);//發送消息

    procedure DoSockRead(Sender: TObject; Socket: TCustomWinSocket);

    procedure WaitLastCmdOk;

    procedure SayHello;

    procedure SetTimeOutInterValue(const Value: DWORD);

    function GetMainMailCount: Integer;

    constructor Create(AOwner: TComponent);override;

    function Login: Boolean;

    procedure Quit;//退出

    procedure Stat;//Stat指令

    procedure DeleteMail(MailId: Integer=-1); //删除指定的郵件

    procedure UnDeleteMail(MailId: Integer = -1);//取消删除郵件

    procedure List(MsgNum: Integer=-1);//List指令

    procedure GetMainListInfo;

    procedure DownLoadEmail(MsgId: Integer);//下載下傳郵件

    property Active: Boolean read UserLogedIn;//使用者活動

    property MainMailCount: Integer read GetMainMailCount;

    property MailInfoList: TStringList read EmailList;

  published  

    property SocketType: TClientType read GetSocketType write SetSocketType;

    property TimeOutInterValue: DWORD read FTimeOutInterValue write SetTimeOutInterValue default 60;//1分鐘

    property UserName: string read FUserName write FUserName;

    property Password: string read FPassword write FPassword;

    property Pop3Host: string read GetPop3Host write SetFPop3Host;

    property Pop3Port: Integer read GetPop3Port write SetPop3Port;

    property AutoAPOP: Boolean read FAutoAPOP write FAutoAPOP default True;//自動檢查是否使用APOP

    property OnReciveSimpleData: TReciveSimpleDataEvent read FOnReciveSimpleData write FOnReciveSimpleData;

    property OnDownLoadEmail: TDownLoadEmailEvent read FOnDownLoadEmail write FOnDownLoadEmail;

    property OnProgress: TProgressEvent read FOnProgress write FOnProgress;

    property OnError: TErrorEvent read FOnError Write FOnError;  

    property OnUserLogedIn: TNotifyEvent read FOnUserLogedIn write FOnUserLogedIn;

    property OnBeginDownLoadEmail: TNotifyEvent read FOnBeginDownLoadEmail write FOnBeginDownLoadEmail;  

<a target="_blank" href="http://files.cnblogs.com/DxSoft/%E9%82%AE%E4%BB%B6%E6%8E%A5%E6%94%B6%E4%B8%8E%E6%A0%BC%E5%BC%8F%E8%A7%A3%E6%9E%90.rar">全部代碼以及例子</a>

本文轉自 不得閑 部落格園部落格，原文連結：http://www.cnblogs.com/DxSoft/archive/2010/01/07/1640854.html   ，如需轉載請自行聯系原作者