编程实现邮件地址有效性检测
这个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 在注册表中注册组件：
在运行中输入：regsvr
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秒 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 If dblTimeOut < 0 Then '如果发生超时 intStep = 0 '设置intStep为0 Exit Do '并跳出循环3 End If If intStep = 3 Then '如果intStep=3即 已套接字关闭 Exit Do '跳出循环1 End If .Close '关闭套接字 Sleep 1000 End With End If i = i + 1 '对计数标志i进行自增运算，以保证可以读到下一个地址 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。
| 欢迎访问最专业的网吧论坛,无盘论坛,网吧经营,网咖管理,网吧专业论坛
https://bbs.txwb.com
关注天下网吧微信/下载天下网吧APP/天下网吧小程序，一起来超精彩
|
本文来源：vczx 作者：佚名
天下网吧 网吧天下
闽公网安备35010202000238号
