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 = (?[^///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) As Long
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 = " '尽可能延迟创建对象的时间 Dim oConnection As New TcpClient() Try '超时时间 oConnection.SendTimeout = 3000 '连接SMTP端口 oConnection.Connect(mserver, 25) '收集邮件服务器的应答信息 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