编程实现邮件地址有效性检测

这个VB6COM组件提供了一项即时邮件查询的功能。它有效的避免了向一个不存在的账户发送邮件的情况。例如，在ASP页面里面检查用户输入的邮件地址是否正确，并避免在你的用户数据库里面存储相关的错误信息。

主要内容

工作原理

让我们首先来看一下这个组件是如何进行工作的。

首先给定一个E-mail地址（例如：someone@somewhere.com），然后它会执行如下的步骤：

1、  将用户名（someone）从域名（somewhere.com）中分离出来；

2、  在DNS（域名服务器）上进行查询：域名是否可用；

3、  如果DNS做出响应，它将在服务器上对MX进行查询（Mail Exchanger邮件交换服务器），并试着与在这个域中每一个MX建立会话，直到建立会话成功；

4、  通过使用SMTP协议，它使用VRFY命令和Mail handshake（HELO，MAILT FROM，RCPT TO）来验证用户名在该域中的存在；

5、  随后组件将返回测试的结果，并给出四种可能的结果：

l  “域”不存在。服务器做出否定响应。

l  “域”存在，但是无法查询用户名（见注释）。服务器做出部分确认响应。

l  “域”存在，但是用户名不存在。服务器做出否定响应。

l  “域”和用户名都存在。服务器做出完全确认响应。

注释：

如果“域”存在，但是MX（邮件交换服务器）并不存在于该域中（典型特征是二级域名由ISP掌握着），这样通过SMTP协议将会无效，应为那些服务器被指派去接受子域中的邮件，并且根本不会检查用户名。所以组建的程序设计，从这里跳出并返回出部分确认响应。

组件特征

l   在本地机器上查找DNS。所以必须保持计算机与互联网的连接以确保组建的正常工作

l   通过SimpleDNSRosolover组件（见Credits）发送DNS请求

l   使用UPD协议接收DNS响应

l   经过标准的winsock.ocx接口，建立SMTP会话

l   提供小型的可执行文件（编译为一个小于50kb的ActiveX DLL 动态连接库文件）

l   无任何用户接口，需要ActiveX组建支持的语言（例如，VBScript, ASP, VC++等等）

l   使用VB6.0 Service Pack 4(已测试) 环境下编译，当然也可以在以前的支持winsock.ocx的VB版本中编译（例如VB5.0）

安装方法

l   将压缩包释放到你选定的目录中；

l   将VfabEmailUtils.DLL拷贝到你的系统目录下：

对于Windows NT：C:\WINNT\SYSTEM32\

对于Windows 9 x：C:\WINDOWS\SYSTEM\

l   在注册表中注册组件：

在运行中输入：regsvr32 c:\winnt\system32\VfabEmailUtils.dll

l   重要提示：

为确保组件的正常运行，你必须安装Simple DNS Resolver v1.0（Emmanuel Kartmann’s）。相关信息，请看下面的Credits。

使用方法

l   创建一个组建的应用实例

l   加入属性：
EmailAddr
SmtpTimeOut
DNS Server Address（仅限Windows9x）

l   调用CheckDomain 方法

l   测试Result属性，如果返回的结果不等于vfbInvalidDomain （1）则可以进行如下操作

l   调用CheckUserName 方法

l   然后测试Result属性来返回最终结果：
vfabNotVerify = 0
vfabInvalidDomain = 1
vfabValidDomain = 2
vfabValidDomainInvalidAccount = 3
vfabValidDomainValidAccount = 4

示例代码

dim oVfab

set oVfab=CreateObject("VFabEmailUtils.EmailCheck")  '创建对象

oVfab.EmailAddr = Request.Form("EMAIL")

'从ASP页面获得邮件地址以进行测试，

'并指派给该对象中的EmailAddr属性

oVfab.CheckDomain '检查域是否存在

If oVfab.Result <> 1 Then

'如果存在则对用户名进行检测

oVfab.SmtpTimeOut = 10 '给该对象10秒钟的时间用来连接远程SMTP服务器

oVfab.CheckUserName   '尝试进行SMTP会话，测试用户名

End If

……  '在这里可以用HTML格式显示会话纪录

oVfab.Clear  '关闭连接, 清除日志, 恢复初始状态

组件文档

方法（表1）：

名称

描述

CheckDomain()

检查邮件地址中的域名部分是否是有效的（存在的）域名

CheckUserName()

通过SMTP协议检查用户名是否是该域中的有效邮件账号

Clear()

在结束任务之后，关闭连接, 清除日志, 恢复初始状态

表1

属性（表2）：

名称

类型

可读

可写

描述

EmailAddr

String

Yes

Yes

指定要检验的邮件地址

Result

Integer

Yes

No

从CheckDomain 和（或）CheckUserName 方法中获得处理结果

SmtpTimeOut

Integer

Yes

Yes

获得/设置Timeout（超时-秒计）等待SMTP连接

DnsServer

String

Yes

No

设置域名服务器的IP地址（Win9x中为必选项，Windows NT 中为可选项）

RealName

String

Yes

No

在CheckUserName()被执行后，如果SMTP服务器提供的话，获得用户的真实名称

DomainName

String

Yes

No

获得EmailAddr中的域名部分

UserName

String

Yes

No

获得EmailAddr中的用户名部分

Log(blnHTML)

String

Yes

No

检索会话日志（客户段与服务器的所有信息交换）如果可选参数被设为True，它将重新以HTML格式排列断点以便阅读。

SmtpServer

String

Yes

No

在域中获得完整地邮件交换服务器列表

表2

下面将对主要代码进行分析：

1、检测域名有效性：

Public Enum EmailVerifiedConst   '创建一个枚举类型

…… '包含Result属性来返回最终结果

End Enum

Dim WithEvents oWinsock As Winsock '创建一个包含事件的winsock对象，事件DataArrival在下面被定义

……

Public Sub CheckDomain()   '声明定义CheckDomain方法

Dim oDNS As New SIMPLEDNSRESOLVERLib.SimpleDNSClient

'基于SIMPLEDNSRESOLVERLib建立对象oDNS

intPos = InStr(strEmailAddr, "@")  '计算用户名的长度

If intPos = 0 Then   '如果返回的结果是0

Err.Raise vbObjectError + 699, , "请指定有效的邮件地址！"

Exit Sub '并从sub过程中跳出

End If

strUserName = Left(strEmailAddr, intPos - 1)  '获得用户名

strDomainName = Mid(strEmailAddr, intPos + 1)  '获得域名

……

oDNS.Separator = ", "   '设置各地址之间的分隔符为”,”

intResult = EmailVerifiedConst.vfabInvalidDomain   '以枚举EmailVerifiedConst中的成员vfabInvalidDomain赋初值给intResult

strLog = strLog & "DNS   -> Query: MX records for " & strDomainName & vbCrLf  '进行日志记录

On Error Resume Next   '发生错误继续

oDNS.GetEmailServers strDomainName, strSmtpServers  '利用oDNS对象的GetMailServer方法给strSmtpServers赋值

If Err <> 0 Then

Err.Raise vbObjectError + 698, , Err.Description

End If

strLog = strLog & "DNS   <- " & strSmtpServers & vbCrLf  '进行日志记录

If strSmtpServers <> "" Then

intResult = EmailVerifiedConst.vfabValidDomain '以枚举EmailVerifiedConst中的成员vfabValidDomain赋值给intRe、sult

End If

End Sub

2、检测用户名的有效性：

Public Sub CheckUserName()   '声明定义CheckUserName()方法

Dim strHost As String, i As Integer, intOldStep As Integer

i = 1  '在这里定义循环初始值，并以之为计数标志分割strSmtpServers

……

Do While True   '开始进行循环1

strHost = Trim(LTrim(Token(strSmtpServers, ",", i)))

   '以”,”为分隔符分离字符串中的所有地址，使之各个独立，

'i是计数标志，下面对TOKEN()的声明定义中再作解释。

If strHost = "" Then '如果发现在“,”后有空地址

  Exit Do '跳出循环

End If

If InStr(strHost, strDomainName) > 0 Then   '如果域名以前的部分不是空

  With oWinsock   '设置oWinsock对象所使用的

   .Protocol = sckTCPProtocol '协议为TCP

   .RemoteHost = strHost  '主机地址为strHost的值

   .RemotePort = 25 '通信端口为25

   .Connect '并进行连接

   dblTimeOut = intSmtpTimeOut '设置超时

   intStep = 1   '将步骤索引intStep设为1

   Do While .State <> sckConnected  '如果套接字状态是非连接,开始循环2

Sleep 100  '延迟100ms

DoEvents   '执行oWinsock包含事件DataArrival

 'DataArrival事件是用来对接收到的

  '做出反应用的；事件的定义在下面可以找到

  '该事件发生之后，会影响intStep、连接状态等

dblTimeOut = dblTimeOut - 0.1  '超时减0.1秒

   Loop

   If .State <> sckConnected Then '如果套接字状态是非连接

Exit Sub   '跳出函数体，结束对该方法的调用

   End If

   Do While True  '循环3

Select Case intStep '依据步骤intStep进行判断

……

Case 2

  SendData "VRFY " & strUserName & "@" & strDomainName & vbCrLf  '发送待确认请求

Case 3

  .Close '关闭套接字

  Exit Do   '并结束循环3

……   '在这里可以使用mail handshake 方式 相应的步骤 4、5、6

End Select

intOldStep = intStep   '保护现场 保存intStep当前值

dblTimeOut = intSmtpTimeOut

 '设置超时

Do While intStep = intOldStep And dblTimeOut > 0 '如果没有发生连接超时 进行循环4

  Sleep 100 '延时100ms

  DoEvents '执行oWinsock包含事件DataArrival

 dblTimeOut = dblTimeOut - 0.1

Loop

If dblTimeOut < 0 Then   '如果发生超时

  intStep = 0   '设置intStep为0

  Exit Do   '并跳出循环3

End If

  Loop

   If intStep = 3 Then  '如果intStep=3即 已套接字关闭

Exit Do '跳出循环1

   End If

   .Close   '关闭套接字

   Sleep 1000

  End With

End If

i = i + 1   '对计数标志i进行自增运算，以保证可以读到下一个地址

Loop

End Sub

3、分割邮件地址，用于输入多个邮件地址时,这正是上面使用的Token函数的定义

Private Function Token(ByVal strInput As String, strSep As String, ByVal intOccur As Integer) As String  '声明定义函数TOKEN

Dim i As Long, intLen As Integer

strInput = strSep & strInput & strSep '使strInput被赋值，格式为“,strSmtpServers,”

intLen = Len(strSep)  '获得字符串的长度

For i = 1 To Len(strInput) '在这里取出我们需要的地址 以CheckDomain中

 '的i为参数，这里的i为循环标志

If Mid(strInput, i, intLen) = strSep Then intOccur = intOccur – i  '如果第i位取得的字符正好是分隔符，则以i与intOccur比较

If intOccur = 0 Then '如果这里取得的地址也在第i位（CheckDomain中，即intOccur）

Token = Mid(strInput, i + 1)   '则可以在这里取得一个独立的邮件地址

If Len(Token) > 0 Then

i = InStr(Token, strSep)

If i > 1 Then

Token = Left(Token, i - 1)

End If

End If

Exit For

End If

Next i

End Function

例如，strSmtpServers中的字符串为 brain@123.com,someone@somewhere.com,sherlock@holmes.com 则由strInput = strSep & strInput & strSep处理过 就变为：

,brain@123.com,someone@somewhere.com,sherlock@holmes.com,

再求得字符串的长度57，由1到57进行for循环。在循环中检索，如果发现第i位就是“,”则要求CheckDomain中的i（intOccur计数标志）减1，如果发现“,”所在那位数正是CheckDomain中的i。例如，“，”在第15位，CheckDomain中的i刚好也是15，将在strSmtpServers中取得字符串

someone@somewhere.com,sherlock@holmes.com,

放在Token中，Token不为空，则在Token中寻找第一个“,”并取得前面的内容重新赋给Token。