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 <[email protected]>; 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指令查询即可找到目的地的地址。被查出来的目的地可能不止一个，有时这些目的地是有优先级别之分的，分别对应着邮件的优先级别，你可以根据邮件优先级的不同对应发送，也可以任意选择其中一个发送，本文的示例将选择反馈回来的第一个目的地发送，读者可根据实际需要进行改进。
{ 这个过程是用来得到邮件特快专递目的地服务器名称及优先级别数，参数AMXList是 用来接收结果值，AQName代表传递过来的域名 } procedure TForm1.GetMxList(AMxList: TStringList; AQName: string); var i: Integer; begin with IdDNSResolver do begin Host := '202.101.107.55'; { Host属性用来指定域名服务器的地址，此处为笔者所在地 的主域名服务器地址，你也可以指定任一可以快速访问到的Internet上域名服务器 地址，要知道自己所在地的域名服务器地址，win98下通过winipcfg命令,win2000下 通过ipconfig /all即可查出。} ReceiveTimeout := 10000; // 在指定的时间内得不到域名服务器的反馈，则视为失败。 ClearVars; // 清除前一次查询所反馈回来的资源记录
{ 构建此次查询的头部结构 } with DNSHeader do begin Qr := False; // False 代表查询 Opcode := 0; // 0代表标准域名查询 RD := True; //域名服务器可以进行递归查询 QDCount := 1; //查询的数量 end;
{ 构建要查询的问题 } DNSQDList.Clear; with DNSQDList.Add do begin QName := AQName; //要查询的域名 QType := cMX; //QTYPE指定要查询的资源记录的种类，值为cMX代表邮件交换记录 QClass := cIN; end;
ResolveDNS; //向域名服务器发出请求
{ 从域名服务器接收反馈的结果，将反馈回来的邮件服务器名称放在AMXList列表的Name部分， 邮件服务器的优先级别数放在Value部分。 } for i := 0 to DNSAnList.Count - 1 do AMxList.Add(DNSAnList[i].RData.MX.Exchange + '=' + IntToStr(DNSAnList[i].RData.MX.Preference)); end; end;
{ 单击"发送"按钮时发送专递邮件 } procedure TForm1.btnSendClick(Sender: TObject); var MxList: TStringList; i: Integer; QName, ThoughAddress: string; begin { 根据用户所填写的内容创建邮件 } with IdMsgSend do begin Body.Assign(mmContent.Lines); //邮件正文 From.Address := Trim(edtFrom.Text); //发件人地址 Recipients.EMailAddresses := Trim(edtTo.Text); //收件人地址 Subject := edtSubject.Text; //邮件主题 end;
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 <[email protected]>; 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指令查询即可找到目的地的地址。被查出来的目的地可能不止一个，有时这些目的地是有优先级别之分的，分别对应着邮件的优先级别，你可以根据邮件优先级的不同对应发送，也可以任意选择其中一个发送，本文的示例将选择反馈回来的第一个目的地发送，读者可根据实际需要进行改进。
{ 这个过程是用来得到邮件特快专递目的地服务器名称及优先级别数，参数AMXList是 用来接收结果值，AQName代表传递过来的域名 } procedure TForm1.GetMxList(AMxList: TStringList; AQName: string); var i: Integer; begin with IdDNSResolver do begin Host := '202.101.107.55'; { Host属性用来指定域名服务器的地址，此处为笔者所在地 的主域名服务器地址，你也可以指定任一可以快速访问到的Internet上域名服务器 地址，要知道自己所在地的域名服务器地址，win98下通过winipcfg命令,win2000下 通过ipconfig /all即可查出。} ReceiveTimeout := 10000; // 在指定的时间内得不到域名服务器的反馈，则视为失败。 ClearVars; // 清除前一次查询所反馈回来的资源记录
{ 构建此次查询的头部结构 } with DNSHeader do begin Qr := False; // False 代表查询 Opcode := 0; // 0代表标准域名查询 RD := True; //域名服务器可以进行递归查询 QDCount := 1; //查询的数量 end;
{ 构建要查询的问题 } DNSQDList.Clear; with DNSQDList.Add do begin QName := AQName; //要查询的域名 QType := cMX; //QTYPE指定要查询的资源记录的种类，值为cMX代表邮件交换记录 QClass := cIN; end;
ResolveDNS; //向域名服务器发出请求
{ 从域名服务器接收反馈的结果，将反馈回来的邮件服务器名称放在AMXList列表的Name部分， 邮件服务器的优先级别数放在Value部分。 } for i := 0 to DNSAnList.Count - 1 do AMxList.Add(DNSAnList[i].RData.MX.Exchange + '=' + IntToStr(DNSAnList[i].RData.MX.Preference)); end; end;
{ 单击"发送"按钮时发送专递邮件 } procedure TForm1.btnSendClick(Sender: TObject); var MxList: TStringList; i: Integer; QName, ThoughAddress: string; begin { 根据用户所填写的内容创建邮件 } with IdMsgSend do begin Body.Assign(mmContent.Lines); //邮件正文 From.Address := Trim(edtFrom.Text); //发件人地址 Recipients.EMailAddresses := Trim(edtTo.Text); //收件人地址 Subject := edtSubject.Text; //邮件主题 end;
“邮件特快专递”这个词现在已经是被广大的网民所熟知了，它就好比是网络上的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 <[email protected]>; 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 IdDNSResolver do
begin
Host := '202.101.107.55'; { Host属性用来指定域名服务器的地址，此处为笔者所在地
的主域名服务器地址，你也可以指定任一可以快速访问到的Internet上域名服务器
地址，要知道自己所在地的域名服务器地址，win98下通过winipcfg命令,win2000下
通过ipconfig /all即可查出。}
ReceiveTimeout := 10000; // 在指定的时间内得不到域名服务器的反馈，则视为失败。
ClearVars; // 清除前一次查询所反馈回来的资源记录
{ 构建此次查询的头部结构 }
with DNSHeader do
begin
Qr := False; // False 代表查询
Opcode := 0; // 0代表标准域名查询
RD := True; //域名服务器可以进行递归查询
QDCount := 1; //查询的数量
end;
{ 构建要查询的问题 }
DNSQDList.Clear;
with DNSQDList.Add do
begin
QName := AQName; //要查询的域名
QType := cMX; //QTYPE指定要查询的资源记录的种类，值为cMX代表邮件交换记录
QClass := cIN;
end;
ResolveDNS; //向域名服务器发出请求
{ 从域名服务器接收反馈的结果，将反馈回来的邮件服务器名称放在AMXList列表的Name部分，
邮件服务器的优先级别数放在Value部分。 }
for i := 0 to DNSAnList.Count - 1 do
AMxList.Add(DNSAnList[i].RData.MX.Exchange + '=' +
IntToStr(DNSAnList[i].RData.MX.Preference));
end;
end;
{ 单击"发送"按钮时发送专递邮件 }
procedure TForm1.btnSendClick(Sender: TObject);
var
MxList: TStringList;
i: Integer;
QName, ThoughAddress: string;
begin
{ 根据用户所填写的内容创建邮件 }
with IdMsgSend do
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 IdSMTP do
begin
Host := ThoughAddress; // 将Host赋值为目的地，这就是特快专递与普通邮件的区别
Port := 25; // smtp服务默认的端口为25
Connect; //连接到服务器
try
Send(IdMsgSend); //发送刚才创建的邮件
ShowMessage('发送完毕'); //发送完毕后提示
finally
Disconnect; //断开服务器连接
end;
end;
end;
end.
“邮件特快专递”这个词现在已经是被广大的网民所熟知了，它就好比是网络上的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 <[email protected]>; 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 IdDNSResolver do
begin
Host := '202.101.107.55'; { Host属性用来指定域名服务器的地址，此处为笔者所在地
的主域名服务器地址，你也可以指定任一可以快速访问到的Internet上域名服务器
地址，要知道自己所在地的域名服务器地址，win98下通过winipcfg命令,win2000下
通过ipconfig /all即可查出。}
ReceiveTimeout := 10000; // 在指定的时间内得不到域名服务器的反馈，则视为失败。
ClearVars; // 清除前一次查询所反馈回来的资源记录
{ 构建此次查询的头部结构 }
with DNSHeader do
begin
Qr := False; // False 代表查询
Opcode := 0; // 0代表标准域名查询
RD := True; //域名服务器可以进行递归查询
QDCount := 1; //查询的数量
end;
{ 构建要查询的问题 }
DNSQDList.Clear;
with DNSQDList.Add do
begin
QName := AQName; //要查询的域名
QType := cMX; //QTYPE指定要查询的资源记录的种类，值为cMX代表邮件交换记录
QClass := cIN;
end;
ResolveDNS; //向域名服务器发出请求
{ 从域名服务器接收反馈的结果，将反馈回来的邮件服务器名称放在AMXList列表的Name部分，
邮件服务器的优先级别数放在Value部分。 }
for i := 0 to DNSAnList.Count - 1 do
AMxList.Add(DNSAnList[i].RData.MX.Exchange + '=' +
IntToStr(DNSAnList[i].RData.MX.Preference));
end;
end;
{ 单击"发送"按钮时发送专递邮件 }
procedure TForm1.btnSendClick(Sender: TObject);
var
MxList: TStringList;
i: Integer;
QName, ThoughAddress: string;
begin
{ 根据用户所填写的内容创建邮件 }
with IdMsgSend do
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 IdSMTP do
begin
Host := ThoughAddress; // 将Host赋值为目的地，这就是特快专递与普通邮件的区别
Port := 25; // smtp服务默认的端口为25
Connect; //连接到服务器
try
Send(IdMsgSend); //发送刚才创建的邮件
ShowMessage('发送完毕'); //发送完毕后提示
finally
Disconnect; //断开服务器连接
end;
end;
end;
end.
unit Unit1;interfaceuses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ComCtrls, Psock, NMsmtp, StdCtrls;type
TForm1 = class(TForm)
NMSMTP: TNMSMTP;
StatusBar: TStatusBar;
ToAddress: TEdit;
Subject: TEdit;
ToCarbonCopy: TEdit;
ToBlindCarbonCopy: TEdit;
FromAddress: TEdit;
FromName: TEdit;
UserID: TEdit;
Host: TEdit;
Attachment: TEdit;
Body: TMemo;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
Label7: TLabel;
Label8: TLabel;
Label9: TLabel;
SendButton: TButton;
NewButton: TButton;
ClearButton: TButton;
AttachButton: TButton;
CloseButton: TButton;
OpenDialog: TOpenDialog;
procedure SendButtonClick(Sender: TObject);
procedure NewButtonClick(Sender: TObject);
procedure ClearButtonClick(Sender: TObject);
procedure AttachButtonClick(Sender: TObject);
procedure CloseButtonClick(Sender: TObject);
procedure NMSMTPAuthenticationFailed(var Handled: Boolean);
procedure NMSMTPSuccess(Sender: TObject);
procedure NMSMTPFailure(Sender: TObject);
procedure NMSMTPHeaderIncomplete(var handled: Boolean;
hiType: Integer);
private
{ Private declarations }
public
{ Public declarations }
end;var
Form1: TForm1;implementation{$R *.DFM}procedure TForm1.SendButtonClick(Sender: TObject);
begin
Form1.Cursor :=crHourGlass;
SendButton.Enabled :=False;
NewButton.Enabled :=False;
ClearButton.Enabled :=False;
AttachButton.Enabled :=False;
StatusBar.SimpleText :='正在连接服务器，请稍候...';
NMSMTP.PostMessage.ToAddress.Text :=ToAddress.Text ;
NMSMTP.PostMessage.ToCarbonCopy.Text :=ToCarbonCopy.Text ;
NMSMTP.PostMessage.ToBlindCarbonCopy.Text :=ToBlindCarbonCopy.Text ;
NMSMTP.PostMessage.FromAddress :=FromAddress.Text ;
NMSMTP.PostMessage.FromName :=FromName.Text ;
NMSMTP.PostMessage.Attachments.Text :=Attachment.Text ;
NMSMTP.PostMessage.Body.Text :=Body.Text ;
NMSMTP.PostMessage.Date :=DateToStr(Now);
NMSMTP.PostMessage.ReplyTo :=FromAddress.Text ;
NMSMTP.Host :=Host.Text ;
NMSMTP.UserID :=UserID.Text ;
NMSMTP.Connect ;
NMSMTP.SendMail ;
NMSMTP.Disconnect ;
end;procedure TForm1.NewButtonClick(Sender: TObject);
begin
ToAddress.Clear ;
Subject.Clear ;
ToCarbonCopy.Clear ;
ToBlindCarbonCopy.Clear ;
Attachment.Clear ;
Body.Clear ;end;procedure TForm1.ClearButtonClick(Sender: TObject);
begin
ToAddress.Clear ;
Subject.Clear ;
ToCarbonCopy.Clear ;
ToBlindCarbonCopy.Clear ;
Attachment.Clear ;
Body.Clear ;
FromAddress.Clear ;
FromName.Clear ;
Host.Clear ;
UserID.Clear ;
end;procedure TForm1.AttachButtonClick(Sender: TObject);
begin
if OpenDialog.Execute then
Attachment.Text :=(OpenDialog.FileName);
end;procedure TForm1.CloseButtonClick(Sender: TObject);
begin
close;
end;procedure TForm1.NMSMTPAuthenticationFailed(var Handled: Boolean);
var
S:String;
begin
{再输入一次}
S:= NMSMTP.UserID ;
if InputQuery('身份验证失败','请重新输入用户名:',S) then
begin
NMSMTP.UserID :=S;
Handled :=True;
end;
end;procedure TForm1.NMSMTPSuccess(Sender: TObject);
begin
MessageDlg('邮件已成功发送！',mtInformation,[mbYes],0);
SendButton.Enabled :=True;
NewButton.Enabled :=True;
ClearButton.Enabled :=True;
AttachButton.Enabled :=True;
form1.Cursor :=crDefault;
StatusBar.SimpleText :='已成功发送邮件！';end;procedure TForm1.NMSMTPFailure(Sender: TObject);
begin
MessageDlg('邮件发送失败！',mtInformation,[mbYes],0);
SendButton.Enabled :=True;
NewButton.Enabled :=True;
ClearButton.Enabled :=True;
AttachButton.Enabled :=True;
form1.Cursor :=crDefault;
StatusBar.SimpleText :='发送邮件失败！';
end;procedure TForm1.NMSMTPHeaderIncomplete(var handled: Boolean;
hiType: Integer);
var
Str: String;
begin
{当所需信息不完整时，给予一次重新输入机会}
case hiType of
hiFromAddress:
if InputQuery('发件人地址没有填写','请输入发件人地址;',Str) then
begin
NMSMTP.PostMessage.FromAddress :=sTR;
Handled :=True;
end;
hiToAddress:
if InputQuery('收件人地址没有填写','请输入收件人地址;',Str) then
begin
NMSMTP.PostMessage.FromAddress :=sTR;
Handled :=True;
end;
end;
end;end.
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ComCtrls, Psock, NMsmtp, StdCtrls;type
TForm1 = class(TForm)
NMSMTP: TNMSMTP;
StatusBar: TStatusBar;
ToAddress: TEdit;
Subject: TEdit;
ToCarbonCopy: TEdit;
ToBlindCarbonCopy: TEdit;
FromAddress: TEdit;
FromName: TEdit;
UserID: TEdit;
Host: TEdit;
Attachment: TEdit;
Body: TMemo;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
Label7: TLabel;
Label8: TLabel;
Label9: TLabel;
SendButton: TButton;
NewButton: TButton;
ClearButton: TButton;
AttachButton: TButton;
CloseButton: TButton;
OpenDialog: TOpenDialog;
procedure SendButtonClick(Sender: TObject);
procedure NewButtonClick(Sender: TObject);
procedure ClearButtonClick(Sender: TObject);
procedure AttachButtonClick(Sender: TObject);
procedure CloseButtonClick(Sender: TObject);
procedure NMSMTPAuthenticationFailed(var Handled: Boolean);
procedure NMSMTPSuccess(Sender: TObject);
procedure NMSMTPFailure(Sender: TObject);
procedure NMSMTPHeaderIncomplete(var handled: Boolean;
hiType: Integer);
private
{ Private declarations }
public
{ Public declarations }
end;var
Form1: TForm1;implementation{$R *.DFM}procedure TForm1.SendButtonClick(Sender: TObject);
begin
Form1.Cursor :=crHourGlass;
SendButton.Enabled :=False;
NewButton.Enabled :=False;
ClearButton.Enabled :=False;
AttachButton.Enabled :=False;
StatusBar.SimpleText :='正在连接服务器，请稍候...';
NMSMTP.PostMessage.ToAddress.Text :=ToAddress.Text ;
NMSMTP.PostMessage.ToCarbonCopy.Text :=ToCarbonCopy.Text ;
NMSMTP.PostMessage.ToBlindCarbonCopy.Text :=ToBlindCarbonCopy.Text ;
NMSMTP.PostMessage.FromAddress :=FromAddress.Text ;
NMSMTP.PostMessage.FromName :=FromName.Text ;
NMSMTP.PostMessage.Attachments.Text :=Attachment.Text ;
NMSMTP.PostMessage.Body.Text :=Body.Text ;
NMSMTP.PostMessage.Date :=DateToStr(Now);
NMSMTP.PostMessage.ReplyTo :=FromAddress.Text ;
NMSMTP.Host :=Host.Text ;
NMSMTP.UserID :=UserID.Text ;
NMSMTP.Connect ;
NMSMTP.SendMail ;
NMSMTP.Disconnect ;
end;procedure TForm1.NewButtonClick(Sender: TObject);
begin
ToAddress.Clear ;
Subject.Clear ;
ToCarbonCopy.Clear ;
ToBlindCarbonCopy.Clear ;
Attachment.Clear ;
Body.Clear ;end;procedure TForm1.ClearButtonClick(Sender: TObject);
begin
ToAddress.Clear ;
Subject.Clear ;
ToCarbonCopy.Clear ;
ToBlindCarbonCopy.Clear ;
Attachment.Clear ;
Body.Clear ;
FromAddress.Clear ;
FromName.Clear ;
Host.Clear ;
UserID.Clear ;
end;procedure TForm1.AttachButtonClick(Sender: TObject);
begin
if OpenDialog.Execute then
Attachment.Text :=(OpenDialog.FileName);
end;procedure TForm1.CloseButtonClick(Sender: TObject);
begin
close;
end;procedure TForm1.NMSMTPAuthenticationFailed(var Handled: Boolean);
var
S:String;
begin
{再输入一次}
S:= NMSMTP.UserID ;
if InputQuery('身份验证失败','请重新输入用户名:',S) then
begin
NMSMTP.UserID :=S;
Handled :=True;
end;
end;procedure TForm1.NMSMTPSuccess(Sender: TObject);
begin
MessageDlg('邮件已成功发送！',mtInformation,[mbYes],0);
SendButton.Enabled :=True;
NewButton.Enabled :=True;
ClearButton.Enabled :=True;
AttachButton.Enabled :=True;
form1.Cursor :=crDefault;
StatusBar.SimpleText :='已成功发送邮件！';end;procedure TForm1.NMSMTPFailure(Sender: TObject);
begin
MessageDlg('邮件发送失败！',mtInformation,[mbYes],0);
SendButton.Enabled :=True;
NewButton.Enabled :=True;
ClearButton.Enabled :=True;
AttachButton.Enabled :=True;
form1.Cursor :=crDefault;
StatusBar.SimpleText :='发送邮件失败！';
end;procedure TForm1.NMSMTPHeaderIncomplete(var handled: Boolean;
hiType: Integer);
var
Str: String;
begin
{当所需信息不完整时，给予一次重新输入机会}
case hiType of
hiFromAddress:
if InputQuery('发件人地址没有填写','请输入发件人地址;',Str) then
begin
NMSMTP.PostMessage.FromAddress :=sTR;
Handled :=True;
end;
hiToAddress:
if InputQuery('收件人地址没有填写','请输入收件人地址;',Str) then
begin
NMSMTP.PostMessage.FromAddress :=sTR;
Handled :=True;
end;
end;
end;end.
tks
可是delphi，没有这个选项,怎么办啊？
[email protected]