EMail validator

Let you know if an e-mail is well formed.

RFC2822 - This class is a "Close enough" approximation

File Name : EMailValidatorCLS.vbs
Requirement : none
Author : Branimir Petrovic
Submitted : 04/12/2001
Category : Class

To use a class, follow this syntax :
Dim MyObjClass
set MyObjClass=new MyClass
MyObjClass.Property="Any value"
MsgBox MyObjClass.AnotherProperty
MyObjClass.MyMethod MyParam1,MyParam2
Set MyObjClass=Nothing

Very simple, no need to rename any variable nor register any ActiveX.

'   FileName:   EMailValidatorCLS.vbs
'   Author:     Branimir Petrovic
'   Date:       3 December 2001
'   Version:    1.0
'
'   Description:
'
'   The "EMailValidatorCLS.vbs" inspired by, but IS NOT
'   FULLY RFC2822 COMPLIANT validator!!!
'   "Close enough for most purposes" would be the motto.
'
'
'   Notes:
'
'   To some extent class tends to be "overly permissive" rather
'   than "overly restrictive" with few notable exceptions:
'   - no RFC2822 compliant comments accepted,
'       (RFC2822 labels them as 'comment' in ABNF notation)
'   - no blank (in RFC822 sense permissive) primitive tokens allowed,
'       (RFC2822 labels these as 'FWS' and 'WSP' in ABNF notation)
'
'
'   Not As Important Notes :
'
'   1.) RFC 2822 (Internet Message Format April 2001) 
'           obsoletes 
'       RFC 822 
'       (Standard for the format of ARPA Internet Messages August 1982) 
'       
'       For actual details on specs, see:
'           http://rfc.net/rfc2822.html
'               and
'           http://rfc.net/rfc1034.html
'
'   2.) See regex for RFC822 regex-only compliant e-mail validation:
'           http://www.foad.org/~abigail/Perl/url3.regex
'       to get a hint on why bother "cutting corners".
'       (in other words - why this watered down solution)
'
'   3.) Fresh listing of top level domain names can be obtained at:
'           http://www.iana.com/domain-names.htm
'       (should there be a need to extend functionality and properly
'        validate top level domain part of the e-mail address)
'
' ////////////////////////////////////////////////////////////////////
Option Explicit
If ((WScript.ScriptName)="EMailValidatorCLS.vbs") Then Demo_EMailValidatorCLS()

' ////////////////////////////////////////////////////////////////////

' ====================== CLASS =======================================
Class EMailValidatorCLS
' Versioning:   1.0                 3 December 2001
'
'   Methods:
'       isValidEMail(sEMailAddr)    True when address pattern is OK
'       isValidHostName(sFQDN)      True when host name is OK
'       isValidIP(sIP)              True when IP address is OK


    '   =====   Public Methods =======================================
    Function isValidEmail(sEmail)
    '   Returtns true for all valid patterns like:
    '
    '       *@qz.to
    '       [email protected][123.22.33.1:25]
    '       [email protected]
    '       "Merry Chimp"@quite.happy.pl
    '       [email protected]
    '
    '   and many other funny looking but otherwise valid e-mail patterns.
    '
    '   These "corners" will be cut in the checking process:
    '
    '   - Only the whole local part may be quoted. If it is - method 
    '     will not not bother looking/checking inside the quoted part.
    '     As a result - some stuff explicitly forbiden by RFC2822 might
    '     (and I promiss ya - will) slip by unchallenged.
    '
    '   - Does not accept (as per older - RFC822 valid) space
    '     delimited and/or commented expressions like:
    '
    '           Muhammed.(I am the greatest) Ali @(the)Vegas.WBA
    '
    '           This very thingy after implicit "de-fancy-ing" should
    '           pass as valid RFC822 pattern: [email protected]
    '           See the RFC822 for explanation.
    '
    '   - Top lavel domains are not checked against the list of valid
    '     top level domains.(http://www.iana.com/domain-names.htm)

        isValidEmail = False

        If TypeName("str")<>TypeName(sEmail) Then   
            Exit Function                               '   >>>
        End If

        Dim sAry, nSlices
        sAry = Split(sEmail, "@")
        nSlices = UBound(sAry) + 1

        If nSlices<>2 Then Exit Function                '   >>>

        If NOT isQuoted(sAry(0)) Then
            If haveIllegalLocPartContents(sAry(0)) Then 
                Exit Function                           '   >>>
            End If
        End If

        ' If we got to this point, then the local part is OK meaning:
        '   - local part is quoted thus not looked into,
        '       OR
        '   - local part contains no offending characters.

        If NOT isDomainLiteral(sAry(1)) Then
            isValidEmail = isValidHostName(sAry(1))
            Exit Function                               '   >>>
        End If

        isValidEmail = isValidIP( Mid(sAry(1), 2, Len(sAry(1))-2) )
    End Function

    '   =====
    Function isValidHostName(sFQDN)
    '   Returns true if passed string is valid Fully Qualified Domain Name
    '   
    '   As per RFC 1034 (Page 11):
    '   ...
    '   The labels must follow the rules for ARPANET host names.  They must
    '   start with a letter, end with a letter or digit, and have as interior
    '   characters only letters, digits, and hyphen.  There are also some
    '   restrictions on the length.  Labels must be 63 characters or less...

        isValidHostName = False
        If TypeName("str")<>TypeName(sFQDN) Then    
            Exit Function                               '   >>>
        End If

        If Len(sFQDN)>255 Then Exit Function            '   >>>

        Dim sAry, nSlices, nI, oRegX_1, oRegX_2, oRegX_3
        sAry = Split(sFQDN, ".")
        nSlices = UBound(sAry) + 1

        If nSlices<2 Then Exit Function                 '   >>>
        
        Const WRONG_HOST_PATRN_1 = "(^[^a-zA-Z])|([^a-zA-Z0-9]$)"
        Const WRONG_HOST_PATRN_2 = "[^a-zA-Z0-9-]"
        Const WRONG_HOST_PATRN_3 = "[^a-zA-Z]"
        Set oRegX_1 = new RegExp
        Set oRegX_2 = new RegExp
        Set oRegX_3 = new RegExp
        oRegX_1.Pattern = WRONG_HOST_PATRN_1
        oRegX_2.Pattern = WRONG_HOST_PATRN_2
        oRegX_3.Pattern = WRONG_HOST_PATRN_3

        For nI=0 To nSlices-1
            If Len(sAry(nI))>63 OR sAry(nI)="" Then 
                Exit Function                           '   >>>
            End If

            If nI = nSlices-1 Then
                If Len(sAry(nI))<2 Then Exit Function   '   >>>
                If oRegX_3.Test(sAry(nI)) Then Exit Function'   >>>
            End If

            If ( oRegX_1.Test(sAry(nI)) OR oRegX_2.Test(sAry(nI)) ) Then
                Exit Function                           '   >>>
            End If
        Next

        isValidHostName = True
    End Function

    '   =====
    Function isValidIP(sIP)
    '   Will return true if passed string - "IP [:portNo]" is OK

        isValidIP = False
        If TypeName("str")<>TypeName(sIP) Then  
            Exit Function                               '   >>>
        End If

        Dim sTmpIP, oRegX, sAry, nSlices
        Const IP_PART = "(\d+)"
        Set oRegX = new RegExp
        oRegX.Pattern = IP_PART
        oRegX.Global = True
        Set sAry = oRegX.Execute(sIP)
        nSlices = sAry.Count

        Select Case nSlices
            Case 4
                If (    (sAry(0)>0) AND (sAry(0)<255)_
                    AND (sAry(1)<=255)_
                    AND (sAry(2)<=255)_
                    AND (sAry(3)<=255)      ) Then

                    sTmpIP = sAry(0) & "." & sAry(1) & "." &_
                            sAry(2) & "." & sAry(3)

                    If (sTmpIP=sIP) Then
                        isValidIP = True
                        Exit Function                   '   >>>
                    End If
                End If
            Case 5
                If (    (sAry(0)>0) AND (sAry(0)<255)_
                    AND (sAry(1)<=255)_
                    AND (sAry(2)<=255)_
                    AND (sAry(3)<=255)_
                    AND (sAry(4)>0) AND (sAry(4)<65535)     ) Then

                    sTmpIP = sAry(0) & "." & sAry(1) & "." &_
                            sAry(2) & "." & sAry(3) & ":" & sAry(4)

                    If (sTmpIP=sIP) Then
                        isValidIP = True
                        Exit Function                   '   >>>
                    End If
                End If
            Case Else
                Exit Function                           '   >>>
        End Select

    End Function

    '   -----   Private Functions ------------------------------------
    '   Next three functions can be re-worked as one that accepts
    '   string for validation and pattern, but having them as three
    '   separate entities, each with its own and suitable name
    '   makes for much easier code reading.
    Private Function isQuoted(sStr)
        Const QUOTED = "^"".+""$"
        Dim oRegX
        Set oRegX = new RegExp
        oRegX.Pattern = QUOTED
        isQuoted = oRegX.Test(sStr)
    End Function
    '   ---
    Private Function haveIllegalLocPartContents(sStr) 
        Const ILLEGAL_CHARS = "["" @<>\[\]\(\):;,]"
        Dim oRegX
        Set oRegX = new RegExp
        oRegX.Pattern = ILLEGAL_CHARS
        haveIllegalLocPartContents = oRegX.Test(sStr)
    End Function
    '   ---
    Private Function isDomainLiteral(sStr)
        Const DOM_LITERAL = "^\[.+\]$"
        Dim oRegX
        Set oRegX = new RegExp
        oRegX.Pattern = DOM_LITERAL
        isDomainLiteral = oRegX.Test(sStr)
    End Function
    '   --------------------------------------------------------------

End Class
' ====================== END OF CLASS ================================

Function Demo_EMailValidatorCLS()
    Dim oVal, sMsg
    Const sMail_1 = "*@qz.to"
    Const sMail_2 = "[email protected][123.22.33.1:25]"
    Const sMail_3 = "[email protected]"
    Const sMail_4 = """Merry Chimp""@quite.happy.pl"
    Const sMail_5 = "[email protected]"

    Set oVal = new EMailValidatorCLS

    sMsg = "oVal.isValidEmail(" & sMail_1 & ") -> " &_
            oVal.isValidEmail(sMail_1) & vbCrLf
    sMsg = sMsg & "oVal.isValidEmail(" & sMail_2 & ") -> " &_
                oVal.isValidEmail(sMail_2) & vbCrLf
    sMsg = sMsg & "oVal.isValidEmail(" & sMail_3 & ") -> " &_
                oVal.isValidEmail(sMail_3) & vbCrLf
    sMsg = sMsg & "oVal.isValidEmail(" & sMail_4 & ") -> " &_
                oVal.isValidEmail(sMail_4) & vbCrLf
    sMsg = sMsg & "oVal.isValidEmail(" & sMail_5 & ") -> " &_
                oVal.isValidEmail(sMail_5) & vbCrLf

    WScript.Echo(sMsg)
End Function
Server Info
Remote Info
Compress

Batchs
BootSector
Droit
Accessoire GFA
On Now
Ecran plasma
Système d'exploitation
Son
Unités
Scripting
Multilingue
Site Web
Bruit et son
Architecture Google


4K
Color picker
TaskList
Backup files
Mini Port Scanner
Website To CHM
PixyDemo
Web password recovery
4KWebServer
Kill Popup
VBE decoder
Script Optimizer
Database Password Recovery
Class
Ini
EMail validator
Graphical Class
MP3 Info
Pinger Class
IP ranger class
SoftwareMetering
Path Validator
Time Stamper Class
LoggerCLS
HTA
Keyword Ranking
DOM Explorer
HTA-Notepad
PixyPortManager
Other
flashMessage
Kill Popup
VBE decoder (fixed)
Error Codes
Maze generator
Char counter
HTML To Word
ICQ Choose User
ScreenSaver Password decoder
Mp3Playlister - singleList
Long Filename To Short
Trace Math
Dump Hexa File
Self modifying script
Mp3Playlister - multiList
HTANoid
PixyWebServer
Python
Progress indication

©2002 Jean-Luc Antoine. All Rights Reserved. Scripts or any other material on this website may not be redistributed or put as part of ANY collection (script archives, CDs etc) without prior written permission. Permission granted to use and modify any of the scripts found on InterClasse.com