Im Zeitalter der Spamflut, geben auch die User Ihre Emailadresse nicht mehr an, wenn sie danach gefragt werden.
Mit der unten aufgelisteten Class EmailCheck kann man genau das prüfen.
Im Prinzip, ermittelt die Klasse den MX-Record der UserDomain und macht ein Helo am Mailserver und teilt dem Mailserver mit, dass wir eine Email für eine bestimmte Emailadresse haben. Existiert die Adresse nicht oder ist die Mailbox voll usw., so lehnt der Mailserver an dieser Stelle die Annahme ab und wir wissen, dass mit der Adresse etwas faul ist.
Lehnt der Mailserver an dieser Stelle die Annahme NICHT ab, so ist die Adresse echt (zu >95%) und wir brechen den Vorgang ab, da wir ja keine Email versenden wollen.
Wenn wir dann jedoch eine Bestätigungsmail senden wolle, dann können wir die soeben ermittelten MX-Host natürlich weiter benutzen.
TESTROUTINE:
Dim userEmail As String = "addressToValidate@clientDomain.com"
Dim serverEmail As String = "serverEmailAddress@yourdomain.com"
Dim Mailserver As String = ""
Dim e As New EmailCheck
If e.ChatMailServer(userEmail, ServerEmail) = 1 Then
'################### Email ist echt
'Jetzt wissen wir schon, dass der Domainname existiert
'und das der RemoteEmailserver Nachrichten für den User annimmt
'Wenn wir jetzt noch eine echte Email versenden wollen, dann können wir jetzt den MX-Record nutzen:
Mailserver = e.getMailServer
'Mailserver enthält jetzt den Host aus dem MX Record des Nameservers
'Testmessage erstellen und senden
Dim mymsg As New System.Net.Mail.MailMessage(serverEmail, userEmail)
mymsg.Subject = "TestMail "
mymsg.Body = "Hallo Welt"
Dim myClient As New Net.Mail.SmtpClient()
myClient.Host = Mailserver
myClient.Send(mymsg)
Else
'################### Email ist ungültig
End If
Imports Microsoft.VisualBasic
Imports System.Web.Services
Imports System
Imports System.Diagnostics
Imports System.Net
Imports System.Net.Sockets
Imports System.Text
Imports System.IO
Imports System.Text.RegularExpressions
Imports System.Web
Imports Microsoft.VisualBasic.Strings
Public Class EmailCheck
Public getMailServer As String
Private oStream As NetworkStream
Private sFrom As String
Private sTo As String
Private sResponse As String
Private mserver As String
Private sText As String()
Public Function ChatMailServer(ByVal sEmail As String, _
ByVal Remote_Addr As String) As Long
sTo = "<" + sEmail + ">"
sText = sEmail.Split(CType("@", Char))
If UBound(sText) < 1 Then
Return 3
End If
mserver = NSLookup(sText(1))
If mserver = "" Then
Return 4
Exit Function
End If
sFrom = "<" & Remote_Addr & ">"
'Create Object as late as possible
Dim oConnection As New TcpClient()
Try
'Set connection based on load
oConnection.SendTimeout = 3000
'Connecting on SMTP port
oConnection.Connect(mserver, 25)
'Get Stream from Mailserver
oStream = oConnection.GetStream()
'Collect Response
sResponse = GetData(oStream)
sResponse = TalkToServer(oStream, "HELO " & Remote_Addr & vbCrLf)
sResponse = TalkToServer(oStream, "MAIL FROM: " & sFrom & vbCrLf)
If ValidResponse(sResponse) Then
sResponse = TalkToServer(oStream, "RCPT TO: " & sTo & vbCrLf)
If ValidResponse(sResponse) Then
Return 1
Else
Return 2
End If
End If
TalkToServer(oStream, "QUIT" & vbCrLf)
oConnection.Close()
oStream = Nothing
Catch
Return 3
End Try
End Function
#Region "Utilitiy"
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
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)
If iFirst < 3 Then bResult = True
End If
Return bResult
End Function
Private Function TalkToServer(ByVal oStream As NetworkStream, ByVal sToSend As String) As String
Dim sresponse As String
sresponse = SendData(oStream, sToSend)
Return sresponse
End Function
'This Function fires off a NS lookup and uses a regx expression to find the server
'This idea was from a posting off the microsoft newsgroups
Public Function NSLookup(ByVal sDomain As String) As String
Dim info As New ProcessStartInfo()
info.UseShellExecute = False
info.RedirectStandardInput = True
info.RedirectStandardOutput = True
info.FileName = "nslookup"
info.Arguments = "-type=MX " + sDomain.ToUpper.Trim & "."
Dim ns As Process
ns = Process.Start(info)
Dim sout As StreamReader
sout = ns.StandardOutput
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
getMailServer = mailserver
Return mailserver
End Function
#End Region
End Class