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

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

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