<% '************************************** ' 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 %>