<%
'**************************************
' Name: Total Email Validation
' Description:Validates email addresses.
' Makes sure the email addresses with IP a
' ddresses are not private network address
' es. Allows multiple sub-domain levels. v
' erifies characters within domain names.
' only allows standard length 26 character
' s for each domain name level, except the
' top (3 max)
' By: Lewis Moten
'
' Inputs:asString - Email address to be
' validated.
'
' Returns:Boolean (true/false) value ind
' icating if the string presented was a va
' lid email address.
'
'This code is copyrighted and has ' limited warranties.Please see http://w
' ww.Planet-Source-Code.com/xq/ASP/txtCode
' Id.6280/lngWId.4/qx/vb/scripts/ShowCode.
' htm 'for details. '**************************************
<%
function IsEmail(ByRef asString)
Dim lsDomain
Dim lsSubDomain
Dim lsSubDomainArray
Dim lbIsIPdomain
Dim lnStart
Dim lsUserName
Dim lnOctect
Dim lnOctect2
Dim lnIndex
Const lsDOMAIN_CHARACTERS = ".ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890-"
' Must have at least 6 characters "a@a.ru"
if Len(asString) < 6 Then
IsEmail = False
Exit function
End if
' Look For "@" delimiter
if Not InStr(asString, "@") > 1 Then
IsEmail = False
Exit function
End if
' Make sure characters exist after the "@"
if Len(asString) = InStr(asString, "@") Then
IsEmail = False
Exit function
End if
' Grab domain information "a.ru"
lsDomain = UCase(Mid(asString, InStr(asString, "@") + 1))
' Grab username information
lsUserName = UCase(Left(asString, InStr(asString, "@") - 1))
' Make sure at least 1 "." exists
if InStr(lsDomain, ".") = 0 Then
IsEmail = False
Exit function
End if
' Check For valid domain characters
lnStart = 1
Do While lnStart <= Len(lsDomain)
if InStr(lsDOMAIN_CHARACTERS, Mid(lsDomain, lnStart, 1)) Then
lnStart = lnStart + 1
Else
IsEmail = False
Exit function
End if
Loop
' Split domains
lsSubDomainArray = Split(lsDomain, ".")
lbIsIPdomain = False
' Loop through Each domain
For lnIndex = 0 To UBound(lsSubDomainArray, 1)
lsSubDomain = lsSubDomainArray(lnIndex)
if Len(lsSubDomain) = 0 Then
IsEmail = False
Exit function
End if
' Check To see if the domain is an IP Address
if lnIndex = 0 Then
if IsNumeric(lsSubDomain) Then
' Only IP Addresses can have only numbers In subdomain area
lbIsIPDomain = True
' Make sure 4 subdomains are present
if Not UBound(lsSubDomainArray, 1) = 3 Then
IsEmail = False
Exit function
End if
End if
End if
if lbIsIPDomain Then
if Len(lsSubDomain) > 3 Then
IsEmail = False
Exit function
ElseIf Not InStr(lsSubDomain, "-") = 0 Then
IsEmail = False
Exit function
ElseIf Not IsNumeric(lsSubDomain)Then
IsEmail = False
Exit function
End if
lnOctect = CInt(lsSubDomain)
if lnOctect > 255 Then
IsEmail = False
Exit function
ElseIf lnOctect < 0 Then
IsEmail = False
Exit function
End if
' Look For Private network settings
if lnIndex = 0 Then
' Grab 2nd IP value
lnOctect2 = lsSubDomainArray(1)
if Len(lnOctect2) > 3 Then
IsEmail = False
Exit function
ElseIf Not IsNumeric(lnOctect2)Then
IsEmail = False
Exit function
End if
lnOctect2 = CInt(lnOctect2)
' TCP/IP addresses reserved For 'private' networks are:
'
' 10.0.0.0to 10.255.255.255
' 172.16.0.0 To 172.31.255.255
' 192.168.0.0to 192.168.255.255
Select Case lnOctect
Case 10 ' Private Network
IsEmail = False
Exit function
Case 172
if lnOctect2 => 16 And lnOctect2 =< 31 Then
IsEmail = False
Exit function
End if
Case 192 ' Local Network
if lnOctect2 = 168 Then
IsEmail = False
Exit function
End if
Case 127 ' Local Machine
IsEmail = False
Exit function
End Select
End if
' End 'private' network check
Else
if lnIndex = UBound(lsSubDomainArray, 1) Then
' Last domain can have 3 characters max
if Len(lsSubDomain) > 3 Then
IsEmail = False
Exit function
ElseIf Not InStr(lsSubDomain, "-") = 0 Then
IsEmail = False
Exit function
End if
Else
' Domain, Sub domain can only have 22 characters max
if Len(lsSubDomain) > 22 Then
IsEmail = False
Exit function
End if
End if
End if
Next
' Check For valid characters In username
lnStart = 1
Do While lnStart <= Len(lsUserName)
if InStr(lsDOMAIN_CHARACTERS, Mid(lsUserName, lnStart, 1)) Then
lnStart = lnStart + 1
Else
IsEmail = False
Exit function
End if
Loop
IsEmail = True
End function
%>