研究了一下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 .
(* 得闲工作室 *)
(* 邮件格式解析单元 *)
(* *)
(* 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 .
(* 得闲工作室 *)
(* 邮件收发控件单元 *)
(* *)
(* 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 .
本文转自 不得闲 博客园博客，原文链接：http://www.cnblogs.com/DxSoft/archive/2010/01/07/1640854.html ，如需转载请自行联系原作者
