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

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:[e-mail]     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:[e-mail]     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.

全部代码以及例子

 

作者：不得闲

本文版权归作者和博客园共有，欢迎转载，但未经作者同意必须保留此段声明，且在文章页面明显位置给出原
文连接，否则保留追究法律责任的权利。

 

 

 

 

posted on 2010-01-07 00:39  不得闲