X
xucm
Unregistered / Unconfirmed
GUEST, unregistred user!
谁有内置SMTP服务器的邮件delphi源代码,我愿出1000分相送
I
intcom
Unregistered / Unconfirmed
GUEST, unregistred user!
用Delphi编写邮件特快专递程序（附源程序）
陈旭波
01-12-4 下午 02:31:23
--------------------------------------------------------------------------------
“邮件特快专递”这个词现在已经是被广大的网民所熟知了，它就好比是网络上的EMS，能
够直接把邮件送到对方的邮箱中，邮件发送完毕后，对方就可以立刻收到。Foxmail在其
最新的4.0版本中也特别新增了该功能，作为一名编程爱好者，你是不是也想知道如何编程
实现该功能呢？那就随本文一起揭开“邮件特快专递”的神秘面纱：
一、实现原理
在Outlook Express中，可通过查看邮件的属性得到该邮件的头部资料。我们拿一封不是特快专递的普通邮件来进行剖析，下面是笔者一封邮件的头部资料：
Received: from sm1.163.com([202.108.44.203]) by peoplemail.com.cn(JetMail 2.5.3.0)
with SMTP id jm1ac3c063eec;
Thu, 29 Nov 2001 07:20:25 -0000
Received: from xubo (unknown [61.154.94.146])
by sm1.163.com (Postfix) with ESMTP id 99CF11C461061
for <cxubo@peoplemail.com.cn>;
Thu, 29 Nov 2001 15:12:49 +0800 (CST)
……
从该头部资料可以看出，邮件传递的路线是由xubo→sm1.163.com→peoplemail.com.cn，其
中xubo是本人所在机器，邮件是经由sm1.163.com这个中转站才送到目的地的，而我们平常
所说的邮件特快专递，就是把邮件直接送到目的地而不需要中转站。
如何才能知道目的地的地址呢？我们知道电子邮件的地址由用户名(username)和邮箱域
名（address.com）两部分构成的，给域名服务器发送针对“address.com”的MX指令查询
即可找到目的地的地址。被查出来的目的地可能不止一个，有时这些目的地是有优先级别
之分的，分别对应着邮件的优先级别，你可以根据邮件优先级的不同对应发送，也可以任
意选择其中一个发送，本文的示例将选择反馈回来的第一个目的地发送，读者可根据实际
需要进行改进。
二、用到的核心组件
本文将采用Indy控件集进行域名查询、邮件发送部分的编程。INDY的全名是Internet
Direct（也叫Winshoes），是一套开放源代码、跨平台、优秀的Internet控件集，它支持
大部分流行的Internet协议。Delphi 6已经包含了该控件集，如果你使用的是Delphi 6以
前的版本，请先到Indy主页http://www.nevrona.com/Indy/Download.html下载并安装该
控件集。
三、窗口设计
向窗体上放置三个TEdit组件，一个TMemo组件，四个Tlabel组件，用到的Indy组件为
TIdDNSResolver、TIdAntiFreeze、TIdSMTP、TIdMessage。其中TIdDNSResolver是用来向
域名服务器发出查询请求并得到结果，TIdMessage用来构建邮件，TIdSMTP用来发送邮件，
TidAntiFreeze可以确保Indy在工作时程序能响应来自外界的消息(注：Indy是以同步的方
式进行工作的，在读或写操作完成之前，其它代码无法执行，加入TidAntiFreeze可以在
每隔一段时间通过呼叫Application.ProcessMessage方法响应来自外界的消息。)
程序的界面如下图所示(箭头所指向的文字标识了该组件的名字)：
四、程序代码(代码中包含了详细的说明)
……(前面一部分省略)
type
TForm1 = class(TForm)
IdDNSResolver: TIdDNSResolver;
IdAntiFreeze1: TIdAntiFreeze;
btnSend: TButton;
IdSMTP: TIdSMTP;
IdMsgSend: TIdMessage;
mmContent: TMemo;
Label1: TLabel;
edtTo: TEdit;
Label4: TLabel;
Label5: TLabel;
edtFrom: TEdit;
Label6: TLabel;
edtSubject: TEdit;
procedure btnSendClick(Sender: TObject);
private
{ Private declarations }
procedure GetMxList(AMxList: TStringList;
AQName: string);
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
{ TForm1 }
{ 这个过程是用来得到邮件特快专递目的地服务器名称及优先级别数，参数AMXList是
用来接收结果值，AQName代表传递过来的域名 }
procedure TForm1.GetMxList(AMxList: TStringList;
AQName: string);
var
i: Integer;
begin
with IdDNSResolverdo
begin
Host := '202.101.107.55';
{ Host属性用来指定域名服务器的地址，此处为笔者所在地
的主域名服务器地址，你也可以指定任一可以快速访问到的Internet上域名服务器
地址，要知道自己所在地的域名服务器地址，win98下通过winipcfg命令,win2000下
通过ipconfig /all即可查出。}
ReceiveTimeout := 10000;
// 在指定的时间内得不到域名服务器的反馈，则视为失败。
ClearVars;
// 清除前一次查询所反馈回来的资源记录
{ 构建此次查询的头部结构 }
with DNSHeaderdo
begin
Qr := False;
// False 代表查询
Opcode := 0;
// 0代表标准域名查询
RD := True;
//域名服务器可以进行递归查询
QDCount := 1;
//查询的数量
end;
{ 构建要查询的问题 }
DNSQDList.Clear;
with DNSQDList.Adddo
begin
QName := AQName;
//要查询的域名
QType := cMX;
//QTYPE指定要查询的资源记录的种类，值为cMX代表邮件交换记录
QClass := cIN;
end;
ResolveDNS;
//向域名服务器发出请求
{ 从域名服务器接收反馈的结果，将反馈回来的邮件服务器名称放在AMXList列表的Name
部分，
邮件服务器的优先级别数放在Value部分。 }
for i := 0 to DNSAnList.Count - 1do
AMxList.Add(DNSAnList.RData.MX.Exchange + '=' +
IntToStr(DNSAnList.RData.MX.Preference));
end;
end;
{ 单击"发送"按钮时发送专递邮件 }
procedure TForm1.btnSendClick(Sender: TObject);
var
MxList: TStringList;
i: Integer;
QName, ThoughAddress: string;
begin
{ 根据用户所填写的内容创建邮件 }
with IdMsgSenddo
begin
Body.Assign(mmContent.Lines);
//邮件正文
From.Address := Trim(edtFrom.Text);
//发件人地址
Recipients.EMailAddresses := Trim(edtTo.Text);
//收件人地址
Subject := edtSubject.Text;
//邮件主题
end;
{ 从输入的收件人地址中取出邮箱域名，利用前面的GetMxList过程得到目的地地址 }
QName := TrimRight(copy(edtTo.Text, Pos('@', edtTo.Text) + 1, Length(edtTo.Text)));
MxList := TStringList.Create;
try
GetMxList(MxList, QName);
ThoughAddress := MxList.Names[0];
{取反馈回来的第一个服务器为目的地，读者可
根据实际需要改进，比如说考虑到信件的优先级或当你选择的服务器因繁忙而暂时
不能处理你的信件时，换用其它服务器试试 }
finally
MxList.Free;
end;
{ 发送邮件 }
with IdSMTPdo
begin
Host := ThoughAddress;
// 将Host赋值为目的地，这就是特快专递与普通邮件的区别
Port := 25;
// smtp服务默认的端口为25
Connect;
//连接到服务器
try
Send(IdMsgSend);
//发送刚才创建的邮件
ShowMessage('发送完毕');
//发送完毕后提示
finally
Disconnect;
//断开服务器连接
end;
end;
end;
end.
陈旭波
01-12-4 下午 02:31:23
--------------------------------------------------------------------------------
“邮件特快专递”这个词现在已经是被广大的网民所熟知了，它就好比是网络上的EMS，能
够直接把邮件送到对方的邮箱中，邮件发送完毕后，对方就可以立刻收到。Foxmail在其
最新的4.0版本中也特别新增了该功能，作为一名编程爱好者，你是不是也想知道如何编程
实现该功能呢？那就随本文一起揭开“邮件特快专递”的神秘面纱：
一、实现原理
在Outlook Express中，可通过查看邮件的属性得到该邮件的头部资料。我们拿一封不是特快专递的普通邮件来进行剖析，下面是笔者一封邮件的头部资料：
Received: from sm1.163.com([202.108.44.203]) by peoplemail.com.cn(JetMail 2.5.3.0)
with SMTP id jm1ac3c063eec;
Thu, 29 Nov 2001 07:20:25 -0000
Received: from xubo (unknown [61.154.94.146])
by sm1.163.com (Postfix) with ESMTP id 99CF11C461061
for <cxubo@peoplemail.com.cn>;
Thu, 29 Nov 2001 15:12:49 +0800 (CST)
……
从该头部资料可以看出，邮件传递的路线是由xubo→sm1.163.com→peoplemail.com.cn，其
中xubo是本人所在机器，邮件是经由sm1.163.com这个中转站才送到目的地的，而我们平常
所说的邮件特快专递，就是把邮件直接送到目的地而不需要中转站。
如何才能知道目的地的地址呢？我们知道电子邮件的地址由用户名(username)和邮箱域
名（address.com）两部分构成的，给域名服务器发送针对“address.com”的MX指令查询
即可找到目的地的地址。被查出来的目的地可能不止一个，有时这些目的地是有优先级别
之分的，分别对应着邮件的优先级别，你可以根据邮件优先级的不同对应发送，也可以任
意选择其中一个发送，本文的示例将选择反馈回来的第一个目的地发送，读者可根据实际
需要进行改进。
二、用到的核心组件
本文将采用Indy控件集进行域名查询、邮件发送部分的编程。INDY的全名是Internet
Direct（也叫Winshoes），是一套开放源代码、跨平台、优秀的Internet控件集，它支持
大部分流行的Internet协议。Delphi 6已经包含了该控件集，如果你使用的是Delphi 6以
前的版本，请先到Indy主页http://www.nevrona.com/Indy/Download.html下载并安装该
控件集。
三、窗口设计
向窗体上放置三个TEdit组件，一个TMemo组件，四个Tlabel组件，用到的Indy组件为
TIdDNSResolver、TIdAntiFreeze、TIdSMTP、TIdMessage。其中TIdDNSResolver是用来向
域名服务器发出查询请求并得到结果，TIdMessage用来构建邮件，TIdSMTP用来发送邮件，
TidAntiFreeze可以确保Indy在工作时程序能响应来自外界的消息(注：Indy是以同步的方
式进行工作的，在读或写操作完成之前，其它代码无法执行，加入TidAntiFreeze可以在
每隔一段时间通过呼叫Application.ProcessMessage方法响应来自外界的消息。)
程序的界面如下图所示(箭头所指向的文字标识了该组件的名字)：
四、程序代码(代码中包含了详细的说明)
……(前面一部分省略)
type
TForm1 = class(TForm)
IdDNSResolver: TIdDNSResolver;
IdAntiFreeze1: TIdAntiFreeze;
btnSend: TButton;
IdSMTP: TIdSMTP;
IdMsgSend: TIdMessage;
mmContent: TMemo;
Label1: TLabel;
edtTo: TEdit;
Label4: TLabel;
Label5: TLabel;
edtFrom: TEdit;
Label6: TLabel;
edtSubject: TEdit;
procedure btnSendClick(Sender: TObject);
private
{ Private declarations }
procedure GetMxList(AMxList: TStringList;
AQName: string);
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
{ TForm1 }
{ 这个过程是用来得到邮件特快专递目的地服务器名称及优先级别数，参数AMXList是
用来接收结果值，AQName代表传递过来的域名 }
procedure TForm1.GetMxList(AMxList: TStringList;
AQName: string);
var
i: Integer;
begin
with IdDNSResolverdo
begin
Host := '202.101.107.55';
{ Host属性用来指定域名服务器的地址，此处为笔者所在地
的主域名服务器地址，你也可以指定任一可以快速访问到的Internet上域名服务器
地址，要知道自己所在地的域名服务器地址，win98下通过winipcfg命令,win2000下
通过ipconfig /all即可查出。}
ReceiveTimeout := 10000;
// 在指定的时间内得不到域名服务器的反馈，则视为失败。
ClearVars;
// 清除前一次查询所反馈回来的资源记录
{ 构建此次查询的头部结构 }
with DNSHeaderdo
begin
Qr := False;
// False 代表查询
Opcode := 0;
// 0代表标准域名查询
RD := True;
//域名服务器可以进行递归查询
QDCount := 1;
//查询的数量
end;
{ 构建要查询的问题 }
DNSQDList.Clear;
with DNSQDList.Adddo
begin
QName := AQName;
//要查询的域名
QType := cMX;
//QTYPE指定要查询的资源记录的种类，值为cMX代表邮件交换记录
QClass := cIN;
end;
ResolveDNS;
//向域名服务器发出请求
{ 从域名服务器接收反馈的结果，将反馈回来的邮件服务器名称放在AMXList列表的Name
部分，
邮件服务器的优先级别数放在Value部分。 }
for i := 0 to DNSAnList.Count - 1do
AMxList.Add(DNSAnList.RData.MX.Exchange + '=' +
IntToStr(DNSAnList.RData.MX.Preference));
end;
end;
{ 单击"发送"按钮时发送专递邮件 }
procedure TForm1.btnSendClick(Sender: TObject);
var
MxList: TStringList;
i: Integer;
QName, ThoughAddress: string;
begin
{ 根据用户所填写的内容创建邮件 }
with IdMsgSenddo
begin
Body.Assign(mmContent.Lines);
//邮件正文
From.Address := Trim(edtFrom.Text);
//发件人地址
Recipients.EMailAddresses := Trim(edtTo.Text);
//收件人地址
Subject := edtSubject.Text;
//邮件主题
end;
{ 从输入的收件人地址中取出邮箱域名，利用前面的GetMxList过程得到目的地地址 }
QName := TrimRight(copy(edtTo.Text, Pos('@', edtTo.Text) + 1, Length(edtTo.Text)));
MxList := TStringList.Create;
try
GetMxList(MxList, QName);
ThoughAddress := MxList.Names[0];
{取反馈回来的第一个服务器为目的地，读者可
根据实际需要改进，比如说考虑到信件的优先级或当你选择的服务器因繁忙而暂时
不能处理你的信件时，换用其它服务器试试 }
finally
MxList.Free;
end;
{ 发送邮件 }
with IdSMTPdo
begin
Host := ThoughAddress;
// 将Host赋值为目的地，这就是特快专递与普通邮件的区别
Port := 25;
// smtp服务默认的端口为25
Connect;
//连接到服务器
try
Send(IdMsgSend);
//发送刚才创建的邮件
ShowMessage('发送完毕');
//发送完毕后提示
finally
Disconnect;
//断开服务器连接
end;
end;
end;
end.
L
LGS
Unregistered / Unconfirmed
GUEST, unregistred user!
Email 服务器的简单实现
--------------------------------------------------------------------------------
我们知道从Delphi 3 开始，它自带的控件中有基于Internet开发的控件。如果我们充分利用这些控件开发Internet程序则可以简化编程工作，提高效率。鉴于目前POP3客户端的软件的种类繁多，（如Outlook Express,Foxmail 以及Web 方式下的各免费邮局）,而服务器端（除Unix Email系统）很少公开原代码,下面我就向大家着重介绍一下利用 Delphi 4中Internet控件组的TClientSocket 和TServerSocket 控件来实现 Email POP3服务器端。如果您理解了Email POP3服务器的构造，相信也可以依葫芦画瓢写出Email SMTP服务器程序。在此基础上加入多线程技术使服务器能同时处理多个客户的连接请求，您就可以轻松地实现一个简单的Email服务器了。
---- 一． 设计思路
---- Email 系统采用C/S 结构。当用户想发送邮件时或收取邮件时在客户机上运行任意一个客户端程序，如Foxmail。在菜单’工具->选项’的邮件服务器里填上运行我们服务器程序的主机名。服务器主机24小时一直运行我们的服务器端程序，SMTP和POP3服务器程序分别在25端口和110端口侦听连接请求。当用户发信时，首先客户端会与服务器端建立Socket连接。然后开始一应一答的Client/Server间的通信。发信和收信时建立连接后服务器端分别要发送一个’250 OK’ 和’+OK pop3 server is ready ’的应答。客户端收到此应答后开始发送SMTP或POP3命令。POP3通信时一般最开始的命令是’user ‘和’pass’或’ apop’用以进行身份验证。注意由于POP3会话有3个状态，某些命令只在某特定状态下有效。当用户进行完所有的操作后发送一个’quit’命令。服务器端收到此命令即终止此次socket连接并继续侦听其他的连接请求。注意：POP3通信时客户端在Transaction状态下’quit’则进入update状态。如果从Authorization状态下’quit’则终止通信，而不进入Update状态。如果客户端不通过’quit’命令终止连接，POP3会话不会进入Update状态。而只有在Update状态下收到’quit’命令后服务器才会在断连前把标志为已删的邮件进行物理删除。
---- 二． 代码实现(以POP3为例)
---- 自定义TPOP类的描述：
SessionState = ( Init,Authorization, Transaction,Update);
TPop=class (TComponent)
public
UserName:string;//Email帐户名
PassWord:string;
//Email口令
ReceText
char;
//server端收到的字符串
PopState:SessionState;
//pop状态：
init or authorization or transaction or update
MsgCount:integer;
//邮件总数
SizeCount:integer;
//邮件总大小
ReplyString:string;//服务器端发送的应答信息
DeleIndex:byte;//用户要删的邮件序号
ListIndex:byte;//list方法 的参数：
用户要列出的序号为listindex的邮件信息
RetrIndex:byte;//retr方法的参数：
用户要取序号为retrindex的邮件
TopIndex:byte;
//top方法的参数
QuitFlag:boolean;//用户如果通过quit命断连则此变量为true;
反之（此时要把f_dele都置回0）
OldMsgCount:integer;//旧邮件数：Last 命令返回
//邮件头的各个域
HMsgId:string;
HReplyTo:string;
HDate:string;
HFrom:string;
HTo:string;
HSubject:string;
HMIME_Ver:real;
HContent_Type:string;
HContent_Transfer_Encoding:string;
HText:string;
//所有POP3服务器必须支持的命令
procedure user;
function pass:boolean;
procedure stat;
procedure dele;
procedure list;
procedure retr;
procedure noop;
procedure rset;
procedure aquit;
procedure tquit;
//扩展的可选择实现的POP3 命令
procedure top;
procedure last;
procedure apop;
procedure uidl;
end;
---- 1. 建立连接
---- 我们可以看到利用了Tclientsocket后客户端请求建立连接只需下面的代码。
with ClientSocketdo
begin
Host := Server;
Active := True;
end;
---- 服务器端利用TserverSocket,一直在侦听110端口，若客户端有连接请求，则ServerSocketAccept事件会被激活，建立起连接。
procedure TMyForm.ServerSocketAccept(Sender: TObject;
Socket: TCustomWinSocket);
begin
Statusbar1.Panels[0].Text :=
'连接到 ' + Socket.RemoteAddress;
//pop对象初始化
pop:=TPop.Create(nil);
pop.PopState:=init;
pop.LoginResult:=false;
pop.QuitFlag:=false;
ServerSocket.Socket.Connections[0]
.sendtext('+OK ibonc pop3 server is ready'+crlf);
end;
---- 2. 通信
---- 服务器端收到客户端发来的信息，则会激活ServerSocketClientRead事件，通过ServerSocket的Socket.ReceiveText可以得到信息的内容。
procedure TMyForm.ServerSocketClientRead(Sender: TObject;
Socket: TCustomWinSocket);
var temp_command :string;
//存放接收到的命令行，并做去crlf的处理
begin
temp_command:=Socket.ReceiveText;
//to remove the crlf in command line
temp_command:=trim(copy(temp_command,1,
pos(crlf,temp_command)-1));
pop.ReceText:=pchar(temp_command);
if pop.popstate=init then
if strLIComp(pop.ReceText,'user ',5)=0 then
pop.user
else
ServerSocket.Socket.Connections[0]
.sendtext('-ERR user name please')
else
if pop.popstate=authorization then
begin
if strLIComp(pop.ReceText,'pass ',5)=0 then
pop.pass
else
if strIComp(pop.ReceText,'quit')=0 then
pop.aquit
else
ServerSocket.Socket.Connections[0]
.sendtext('-ERR pass word please');
end
else
if pop.popstate=transaction then
begin
if strIComp(pop.ReceText,'stat')=0 then
pop.stat
else
if strLIComp(pop.ReceText,'dele ',5)=0 then
pop.dele
else
if strLIComp(pop.ReceText,'list',4)=0 then
pop.list
else
if strLIComp(pop.ReceText,'retr ',5)=0 then
pop.retr
else
if strIComp(pop.ReceText,'noop')=0 then
pop.noop
else
if strIComp(pop.ReceText,'rset')=0 then
pop.rset
else
if strIComp(pop.ReceText,'quit')=0 then
pop.tquit
else
if strIComp(pop.ReceText,'last')=0 then
pop.last
else
if strLIComp(pop.ReceText, 'apop ',5)=0 then
pop.apop
else
if strLIComp(pop.ReceText, 'uidl ',5)=0 then
pop.uidl
else
ServerSocket.socket.connections[0]
.sendtext('-ERR no such command yet'+crlf);
end
end;
---- 3. 关闭连接
procedure TMyForm.ServerSocket
ClientDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
begin
ServerSocket.Active := False;
//如果client端没有通过quit 命令断连，
则在断连时要把那些f_dele置为0
if pop.QuitFlag=False then
begin
MyForm.query11.Close;
MyForm.query11.Params[0].Asstring:=pop.UserName;
MyForm.query11.prepare;
MyForm.query11.execsql;
end;
end;
---- 三． 结语
---- 由于Email系统与数据库表结构的紧密联系,笔者没有写出各POP3命令的具体实现。相信读者在认真阅读了RFC1939之后不难写出实现函数。现在就动手为你的公司写一个自己的Email服务器吧！
--------------------------------------------------------------------------------
--------------------------------------------------------------------------------
我们知道从Delphi 3 开始，它自带的控件中有基于Internet开发的控件。如果我们充分利用这些控件开发Internet程序则可以简化编程工作，提高效率。鉴于目前POP3客户端的软件的种类繁多，（如Outlook Express,Foxmail 以及Web 方式下的各免费邮局）,而服务器端（除Unix Email系统）很少公开原代码,下面我就向大家着重介绍一下利用 Delphi 4中Internet控件组的TClientSocket 和TServerSocket 控件来实现 Email POP3服务器端。如果您理解了Email POP3服务器的构造，相信也可以依葫芦画瓢写出Email SMTP服务器程序。在此基础上加入多线程技术使服务器能同时处理多个客户的连接请求，您就可以轻松地实现一个简单的Email服务器了。
---- 一． 设计思路
---- Email 系统采用C/S 结构。当用户想发送邮件时或收取邮件时在客户机上运行任意一个客户端程序，如Foxmail。在菜单’工具->选项’的邮件服务器里填上运行我们服务器程序的主机名。服务器主机24小时一直运行我们的服务器端程序，SMTP和POP3服务器程序分别在25端口和110端口侦听连接请求。当用户发信时，首先客户端会与服务器端建立Socket连接。然后开始一应一答的Client/Server间的通信。发信和收信时建立连接后服务器端分别要发送一个’250 OK’ 和’+OK pop3 server is ready ’的应答。客户端收到此应答后开始发送SMTP或POP3命令。POP3通信时一般最开始的命令是’user ‘和’pass’或’ apop’用以进行身份验证。注意由于POP3会话有3个状态，某些命令只在某特定状态下有效。当用户进行完所有的操作后发送一个’quit’命令。服务器端收到此命令即终止此次socket连接并继续侦听其他的连接请求。注意：POP3通信时客户端在Transaction状态下’quit’则进入update状态。如果从Authorization状态下’quit’则终止通信，而不进入Update状态。如果客户端不通过’quit’命令终止连接，POP3会话不会进入Update状态。而只有在Update状态下收到’quit’命令后服务器才会在断连前把标志为已删的邮件进行物理删除。
---- 二． 代码实现(以POP3为例)
---- 自定义TPOP类的描述：
SessionState = ( Init,Authorization, Transaction,Update);
TPop=class (TComponent)
public
UserName:string;//Email帐户名
PassWord:string;
//Email口令
ReceText
char;//server端收到的字符串
PopState:SessionState;
//pop状态：
init or authorization or transaction or update
MsgCount:integer;
//邮件总数
SizeCount:integer;
//邮件总大小
ReplyString:string;//服务器端发送的应答信息
DeleIndex:byte;//用户要删的邮件序号
ListIndex:byte;//list方法 的参数：
用户要列出的序号为listindex的邮件信息
RetrIndex:byte;//retr方法的参数：
用户要取序号为retrindex的邮件
TopIndex:byte;
//top方法的参数
QuitFlag:boolean;//用户如果通过quit命断连则此变量为true;
反之（此时要把f_dele都置回0）
OldMsgCount:integer;//旧邮件数：Last 命令返回
//邮件头的各个域
HMsgId:string;
HReplyTo:string;
HDate:string;
HFrom:string;
HTo:string;
HSubject:string;
HMIME_Ver:real;
HContent_Type:string;
HContent_Transfer_Encoding:string;
HText:string;
//所有POP3服务器必须支持的命令
procedure user;
function pass:boolean;
procedure stat;
procedure dele;
procedure list;
procedure retr;
procedure noop;
procedure rset;
procedure aquit;
procedure tquit;
//扩展的可选择实现的POP3 命令
procedure top;
procedure last;
procedure apop;
procedure uidl;
end;
---- 1. 建立连接
---- 我们可以看到利用了Tclientsocket后客户端请求建立连接只需下面的代码。
with ClientSocketdo
begin
Host := Server;
Active := True;
end;
---- 服务器端利用TserverSocket,一直在侦听110端口，若客户端有连接请求，则ServerSocketAccept事件会被激活，建立起连接。
procedure TMyForm.ServerSocketAccept(Sender: TObject;
Socket: TCustomWinSocket);
begin
Statusbar1.Panels[0].Text :=
'连接到 ' + Socket.RemoteAddress;
//pop对象初始化
pop:=TPop.Create(nil);
pop.PopState:=init;
pop.LoginResult:=false;
pop.QuitFlag:=false;
ServerSocket.Socket.Connections[0]
.sendtext('+OK ibonc pop3 server is ready'+crlf);
end;
---- 2. 通信
---- 服务器端收到客户端发来的信息，则会激活ServerSocketClientRead事件，通过ServerSocket的Socket.ReceiveText可以得到信息的内容。
procedure TMyForm.ServerSocketClientRead(Sender: TObject;
Socket: TCustomWinSocket);
var temp_command :string;
//存放接收到的命令行，并做去crlf的处理
begin
temp_command:=Socket.ReceiveText;
//to remove the crlf in command line
temp_command:=trim(copy(temp_command,1,
pos(crlf,temp_command)-1));
pop.ReceText:=pchar(temp_command);
if pop.popstate=init then
if strLIComp(pop.ReceText,'user ',5)=0 then
pop.user
else
ServerSocket.Socket.Connections[0]
.sendtext('-ERR user name please')
else
if pop.popstate=authorization then
begin
if strLIComp(pop.ReceText,'pass ',5)=0 then
pop.pass
else
if strIComp(pop.ReceText,'quit')=0 then
pop.aquit
else
ServerSocket.Socket.Connections[0]
.sendtext('-ERR pass word please');
end
else
if pop.popstate=transaction then
begin
if strIComp(pop.ReceText,'stat')=0 then
pop.stat
else
if strLIComp(pop.ReceText,'dele ',5)=0 then
pop.dele
else
if strLIComp(pop.ReceText,'list',4)=0 then
pop.list
else
if strLIComp(pop.ReceText,'retr ',5)=0 then
pop.retr
else
if strIComp(pop.ReceText,'noop')=0 then
pop.noop
else
if strIComp(pop.ReceText,'rset')=0 then
pop.rset
else
if strIComp(pop.ReceText,'quit')=0 then
pop.tquit
else
if strIComp(pop.ReceText,'last')=0 then
pop.last
else
if strLIComp(pop.ReceText, 'apop ',5)=0 then
pop.apop
else
if strLIComp(pop.ReceText, 'uidl ',5)=0 then
pop.uidl
else
ServerSocket.socket.connections[0]
.sendtext('-ERR no such command yet'+crlf);
end
end;
---- 3. 关闭连接
procedure TMyForm.ServerSocket
ClientDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
begin
ServerSocket.Active := False;
//如果client端没有通过quit 命令断连，
则在断连时要把那些f_dele置为0
if pop.QuitFlag=False then
begin
MyForm.query11.Close;
MyForm.query11.Params[0].Asstring:=pop.UserName;
MyForm.query11.prepare;
MyForm.query11.execsql;
end;
end;
---- 三． 结语
---- 由于Email系统与数据库表结构的紧密联系,笔者没有写出各POP3命令的具体实现。相信读者在认真阅读了RFC1939之后不难写出实现函数。现在就动手为你的公司写一个自己的Email服务器吧！
--------------------------------------------------------------------------------