Delphi实现的MIME邮件格式解析类库

研究了一下Pop3的邮件接收协议，然后随手写了一个Pop3的邮件接收控件！Pop3的邮件协议实际上是很简单的，知道那几个命令就行了，与服务器之间 的交互是一问一答得方式，控制起来也容易，相对而言邮件格式的解析倒是更加麻烦一点！于是也便顺带着将MIME邮件格式给熟悉了一下！总归说来，规律性比 较强，先获取最大的顶层框架，然后根据顶层框架来判断是否有还有子框架，依次根据给定的间隔符号迭代下来！看看类设计！首先一个MIME是要有一个邮件 头！所以这个类是必然的！

实现了邮件头类TDxMIMEHeader ，然后再看邮件格式，就是数据部分了，数据部分就涉及到前面说的框架问题，有Mulpart/mixed等这样的还有子框架的结构，也有单纯的text /plain这样的纯文本结构，具体的信息都在邮件格式的头部有说明 ，于是将数据Part设计成了一个继承模式，TDxMIMEPart作为数据Part的基类，然后Mulpart/mixed，text/plain等这 样的各个模块部分都从该类继承，Mulpart/mixed等是有内部数据模块的，所以这个另外继承一个多数据模块基类TDxMimeMulPart，然 后只要含有多个数据模块的模块都从这个类继承去实现，除此之外，还需要一个附件等流式数据的流模块的解析类TDxMIMEStreamPart，本类主要 是将附件等信息还原出来！大致信息如此，其实应该给模块类还要设置一个模块头的类的，因为只是研究也就直接写在里面了！大致代码块如下：

代码

(* **************************************************** *)
(*                 得闲工作室                           *)
(*               邮件格式解析单元                       *)
(*                                                      *)
(*               DxMIMEParser Unit                      *)
(*     String Operate Unit Version 1.x 2010/01/05       *)
(*     Copyright(c) 2010    不得闲                      *)
(*     email:appleak46@yahoo.com.cn     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)
   private
    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_Type( const  Value:  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 ;
   public
     constructor  Create; virtual ;
     destructor  Destroy; override ;
     property  TopType:  string   read  FTopType;
     function  GetFieldValue(Field:  string ):  string ;
     function  GetFieldParams(Field:  string ;ValueIndex: Integer; const  Splitstr:  string = ' ; ' ):  string ;
     procedure  SetFieldValue(Field:  string ;Value:  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;  
   end ;

  TDxMIMETextPart  =   class (TDxMIMEPart)
   private
    IsTop: Boolean; // 顶部
     function  GetTextInfo:  string ;
     procedure  SetTextInfo( const  Value:  string );
   protected
     procedure  ParserPart; override ;
   public
     constructor  Create; override ;
     property  Text:  string   read  GetTextInfo  write  SetTextInfo; // 纯文本信息
   end ;

  TDxMIMEHtmlPart  =   class (TDxMIMETextPart)
   public
     constructor  Create; override ;
   end ;

  TDxMIMEStreamPart  =   class (TDxMIMEPart)
   private
    stream: TMemoryStream;
    FFileName:  string ;
    FAttatchName:  string ;
     procedure  SetAttatchName( const  Value:  string );
     procedure  SetFileName( const  Value:  string );
     function  GetSize: Int64; // 内存流
   protected
     procedure  ParserPart; override ;
     procedure  DoParserContentInfo; virtual ; // 解析Content信息 
     procedure  Clear;
   public
     constructor  Create; override ;
     destructor  Destroy; override ;
     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;
   end ;

   // txt,Html都包含

  TDxMimeMulPart  =   class (TDxMIMEPart)
   private
    ObjList: TList;
     function  GetChildPartCount: Integer;
     function  GetChildPart(index: integer): TDxMIMEPart;
   protected
     procedure  ParserPart; override ;
     procedure  Clear;
   public
     constructor  Create; override ;
     destructor  Destroy; override ;
     property  ChildPartCount: Integer  read  GetChildPartCount;
     property  ChildPart[index: integer]: TDxMIMEPart  read  GetChildPart;
   end ;

  TDxMIMETxtHtmlPart  =   class (TDxMimeMulPart);

  TDxMIMEResPart  =   class (TDxMimeMulPart)
   protected
     procedure  ParserPart; override ;
   public
     constructor  Create; override ;
   end ;

   // multipart / Mixed附件方式
  TDxMIMEMulMixedPart  =   class (TDxMimeMulPart)
   public
     constructor  Create; override ;
   end ;

   // MIME解析类
  TDxMIMEParser  =   class
   private
    ParserList: TStringList;
    tmpList: TStringList;
    MimeHeader: TDxMIMEHeader;
    FMainMailPart: TDxMIMEPart;
     procedure  DoParser;
     function  GetTopTye:  string ;
   public
     constructor  Create;
     destructor  Destroy; override ;
     property  Header: TDxMIMEHeader  read  MimeHeader;
     procedure  LoadFromFile(FileName:  string );
     procedure  LoadFromStream(Stream: TStream);
     property  MainMailPart: TDxMIMEPart  read  FMainMailPart;
     property  TopType:  string   read  GetTopTye;
   end ;

  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                     *)
(*     String Operate Unit Version 1.x 2010/01/05       *)
(*     Copyright(c) 2010    不得闲                      *)
(*     email:appleak46@yahoo.com.cn     QQ:75492895     *)
(* **************************************************** *)
unit  DxEmailComponent;

interface
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)
   private
    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;
   public
     constructor  Create(AOwner: TComponent); override ;
     destructor  Destroy; 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;  
   end ;
implementation
end .

全部代码以及例子