VB.NET驗證郵件地址的合法性實現代碼

2020-01-18 00:41:49

字體：大中小

來源：轉載

供稿：網友

一、提出問題
　　現在，對于用戶在Web頁面上或電話中給出的Email地址，我們越來越不敢肯定它是否真的有效。在今天這個垃圾郵件泛濫成災的年代，人們完全有理由舍不得輕易透露Email地址。
　　
　　另一方面，對于通過正規途徑得到的郵件地址，當我們將它用于合法的目的時，也常常要為郵件地址是否有效而煩惱，用戶可能有意或無意地寫錯地址，也可能由于長時間不訪問而導致郵箱失效。對于少量的郵件地址，也許可以手工驗證其合法性，例如發送測試email；但是，當郵件地址的數量達到數萬甚至更多時，手工驗證就不可能了，必須用專門的工具或自己編寫程序自動執行驗證。
　　
　　常規的驗證方法只從email地址的格式判斷其合法性，例如檢查它是否包含“@”和“.”符號。顯然，這種檢查是不充分的，郵件地址格式正確并不證明它一定有效。由于這個原因，一些網站采取了用email發送密碼、特殊資源的URL等辦法，或者要求用戶回復email，以此確保email地址的有效性。但是，這些辦法不見得任何時候都有效，例如，你可能不是從自己的網站上收集用戶email，而是通過第三者獲得。
　　
　　考慮到這些原因，驗證email地址合法性最根本的辦法是查詢郵件服務器。本文將給出完成這一任務的完整VB.NET代碼。
　　
　　二、郵件服務器之合法性
　　對于任何郵件地址，判斷其合法性的第一步當然是看看它的格式是否正確，例如是否包含“@”和“.”符號，這方面的資料很多，甚至還有現成的控件，所以本文不再贅述。我們的任務從判斷郵件地址的域是否合法開始，例如對于abc@sina.com.cn這個地址，首先判斷sina.com.cn的郵件服務器是否有效。
　　
　　每一個域有一個MX記錄，即郵件交換器（Mail Exchanger）記錄，它指向該域內處理email的服務器，我們只要查詢DNS服務器即可獲得該信息。Windows本身帶來的nslookup命令非常適合于完成該任務，例如，要查找sina.com.cn的郵件服務器，只需執行nslookup -type=mx sina.com.cn，其中-type=MX表示要查找MX記錄，輸出結果如圖一所示。Windows的nslookup命令要安裝了TCP/IP協議后才可用，詳細說明可參見Windows幫助。
　　　

　　下面的GetMailServer函數封裝了調用Windows nslookup命令的操作，根據參數中指定的域名返回郵件服務器。
　　
　　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
　　
　　三、郵件地址之合法性
　　只要郵件地址中指定的域合法，我們就可以連接郵件服務器，試著發送一個email。如果郵件服務器回答說該用戶非法或不存在，表明郵件地址無效。這一步的主要操作包括創建一個連接郵件服務器的Socket，然后按照SMTP郵件傳輸協議的要求與服務器通信，完成郵件發送操作。關于SMTP協議的詳細說明，有興趣的讀者可參見SMTP規范（RFC 821）：http://www.ietf.org/rfc/rfc821.txt。
　　
　　下面CheckEmail函數的輸入參數是一個郵件地址，函數的返回值表示該地址是否合法。該函數有兩個數值可隨意調整：在發送郵件的過程中，我們要向對方的郵件服務器提供一個合法的域名以表明自己的身份，這里選擇的是sina.com.cn；根據網絡和對方郵件服務器的忙閑程度，響應時間也會發生變化，這里選擇的等待時間是3秒。當網絡或對方服務器非常忙時，減小等待時間會增加測試失敗的可能性。
　　
　　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
　　
　　CheckEmail函數的返回值表示測試結果：1表示郵件地址合法，2表示只有域名正確（可能是用戶的郵件帳戶無效），3表示出現了錯誤，4表示無法找到郵件服務器。
　　
　　四、用戶界面
　　以上我們完成了測試郵件地址是否合法的核心功能，這些函數可用于各種形式的應用程序，包括Web服務、Windows應用程序、控件等，最多只要修改一下聲明方式。為便于測試這些函數，下面我們要做一個Windows應用形式的簡單用戶界面。
　　
　　啟動VS.NET，選擇新建Visual Basic項目、Windows應用程序，如圖二，輸入項目名稱CheckMail以及保存位置，點擊“確定”按鈕，VS.NET創建一個新的項目。
　　　