验证邮箱是否真实存在类(vb.net)

在做群发软件时，为了提高准确率，除了要保实邮箱合法性，发现也可以验证邮箱真实性。

在上篇发表的文章中也有邮箱真实性验证功能，但是我测试了一下，好像不准，不能使用；

VB。NET类我也测试了一下，发现比较准确，CheckEmail() 返回值小于等于1表示邮箱存在，

其它返回值表示邮箱不存在,至少代码表示什么错误，有兴趣的朋友自已研究。。。我比较懒啦


基本原理:

从邮件地址分离出帐户名和域名

查找该域的邮件服务器

收集邮件服务器的应答信息, 如果对MAIL FROM指令有肯定的应答, 至少表明邮件地址的域名正确, 如果对RCPT TO指令有肯定的应答, 表明邮件服务器已认可该地址

实例源代码(vn.net) **********

Namespace WebXml.com.cn.CryptoAngelProfessional
'VB.NET编程验证邮件地址的合法性

Public Class ValidateEmailAddress
Private Function GetMailServer(ByVal sDomain As String) As String
Dim info As New ProcessStartInfo()
Dim ns As Process
'调用Windows的nslookup命令，查找邮件服务器
info.UseShellExecute = False
info.RedirectStandardInput = True
info.RedirectStandardOutput = True
info.FileName = "nslookup"
info.CreateNoWindow = True
'查找类型为MX。关于nslookup的详细说明，请参见
'Windows帮助
info.Arguments = "-type=MX " + sDomain.ToUpper.Trim
'启动一个进行执行Windows的nslookup命令()
ns = Process.Start(info)
Dim sout As StreamReader
sout = ns.StandardOutput
' 利用正则表达式找出nslookup命令输出结果中的邮件服务器信息
Dim reg As Regex = New Regex("mail exchanger = (?<server>[^/s]+)")
Dim mailserver As String = ""
Dim response As String = ""
Do While (sout.Peek() > -1)
response = sout.ReadLine()
Dim amatch As Match = reg.Match(response)
If (amatch.Success) Then
mailserver = amatch.Groups("server").Value
Exit Do
End If
Loop
Return mailserver
End Function

Public Function CheckEmail(ByVal sEmail As String, Optional ByVal sPort As Integer = 25) As Byte
Dim oStream As NetworkStream
Dim sFrom As String '发件人
Dim sTo As String '收件人
Dim sResponse As String '邮件服务器的应答
Dim Remote_Addr As String '发件人的域名
Dim mserver As String '邮件服务器
Dim sText As String()

sTo = "<" + sEmail + ">"
' 从邮件地址分离出帐户名和域名
sText = sEmail.Split(CType("@", Char))
' 查找该域的邮件服务器
mserver = GetMailServer(sText(1))
'mserver为空值表明查找邮件服务器失败
If mserver = "" Then
Return 4
Exit Function
End If
'发件人地址的域名必须合法
Remote_Addr = "sina.com.cn"
sFrom = "<myIP@" & Remote_Addr + ">"
'尽可能延迟创建对象的时间
Dim oConnection As New TcpClient()
Try
'超时时间
oConnection.SendTimeout = 5000
'连接SMTP端口
oConnection.Connect(mserver, sPort)
'收集邮件服务器的应答信息
oStream = oConnection.GetStream()
sResponse = GetData(oStream)
sResponse = SendData(oStream, "HELO " & Remote_Addr & vbCrLf)
sResponse = SendData(oStream, "MAIL FROM: " & sFrom & vbCrLf)
'如果对MAIL FROM指令有肯定的应答，
'至少表明邮件地址的域名正确
If ValidResponse(sResponse) Then
sResponse = SendData(oStream, "RCPT TO: " & sTo & vbCrLf)
'如果对RCPT TO指令有肯定的应答
'表明邮件服务器已认可该地址
If ValidResponse(sResponse) Then
Return 1 '邮件地址有效
Else
Return 2 '只有域名有效
End If
End If
'结束与邮件服务器的会话
SendData(oStream, "QUIT" & vbCrLf)
oConnection.Close()
oStream = Nothing
Catch
Return 3 '错误！
End Try
End Function

'获取服务器应答数据，并将其转换为String
Private Function GetData(ByRef oStream As NetworkStream) As String

Dim bResponse(1024) As Byte
Dim sResponse As String = ""

Dim lenStream As Integer = oStream.Read(bResponse, 0, 1024)
If lenStream > 0 Then
sResponse = Encoding.ASCII.GetString(bResponse, 0, 1024)
End If
Return sResponse
End Function
'向邮件服务器发送数据
Private Function SendData(ByRef oStream As NetworkStream, ByVal sToSend As String) As String
Dim sResponse As String
'将String转换成Byte数组
Dim bArray() As Byte = Encoding.ASCII.GetBytes(sToSend.ToCharArray)
'发送数据
oStream.Write(bArray, 0, bArray.Length())
sResponse = GetData(oStream)
'返回应答
Return sResponse
End Function

'服务器是否返回肯定的回答？
Private Function ValidResponse(ByVal sResult As String) As Boolean
Dim bResult As Boolean
Dim iFirst As Integer
If sResult.Length > 1 Then
iFirst = CType(sResult.Substring(0, 1), Integer)
'如果服务器返回应答的第一个字符小于'3'
'我们认为服务器已认可刚才的操作
If iFirst < 3 Then bResult = True
End If
Return bResult
End Function

End Class
End Namespace

调用 CheckEmail()