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
" 利用Regex找出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
