下面将对主要代码进行分析：
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。
您现在的位置：