<%

    '**************************************

    ' 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

    %>