Note: This is not the complete source code--just the main source file.
You can download the full source (with include files) from our sample code archive by clicking on the diskette icons.

OptValidEmail.inc.vbs.asp

<%
'// OptValidEmail class
'// version 2002-12-05
'//
'// An optimized wrapper class for HexValidEmail
'//
'// The OptValidEmail class is a drop-in-compatible wrapper
'// for the HexValidEmail.Connection class. It can dramatically
'// reduce average validation delays by
'//
'//    1. Avoiding unnecessary DNS lookups
'//    2. Avoiding fruitless SMTP checks
'//    3. Reducing the worst-case timeout for SMTP checks
'//
'// These advantages come at a cost:
'//
'//    1. You must tweak the domain name caches in the
'//       Class_Initialize event and update them periodically.
'//    2. The shorter timeout means more SMTP checks will
'//       be abandoned before the SMTP server gets a chance to
'//       respond.
'//
'// One more note: Though this is meant to be completely drop-in
'// compatible, it appears VBScript does not allow optional method
'// parameters. Thus, you will have to explicitly specify the 
'// validation level to the Validate method.
'//
'// HexGadgets (components) required:
'//   - HexValidEmail
'// Info: http://www.HexGadgets.com/
'//
'// Other dependencies:
'//   - VBScript 5.0 or later
'//     Get the latest at http://msdn.microsoft.com/scripting/
'//
'// History:
'// 2002-12-05  Created, based on older OptValidEmail.inc.asp
'//
'// Copyright 2002 Hexillion Technologies. All rights reserved.
'//
'// THIS CODE AND INFORMATION IS PROVIDED "AS IS" WITHOUT WARRANTY
'// OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING BUT NOT
'// LIMITED TO THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND/OR
'// FITNESS FOR A PARTICULAR PURPOSE.


class OptValidEmail
	Private m_oVE
	Private m_lError
	Private m_aGoodDoms
	Private m_aNoSmtpDoms

	Private Sub Class_Initialize()
	    Set m_oVE = Server.CreateObject("HexValidEmail.Connection")
	    m_lError = m_oVE.Error
	    
	    '// List of domains known to accept email
	    '// Roughly ordered by popularity
	    '// DNS check is not necessary for these
	    m_aGoodDoms = Array( _
	                         "hotmail.com", _
	                         "aol.com", _
	                         "yahoo.com", _
	                         "usa.net", _
	                         "bigfoot.com", _
	                         "earthlink.net", _
	                         "att.net", "attglobal.net", _
	                         "netcom.com", _
	                         "pobox.com", "poboxes.com", _
	                         "mindspring.com", _
	                         "iname.com", "ibm.net", _
	                         "msn.com", "compuserve.com", _
	                         "world.std.com", _
	                         "juno.com", _
	                         "geocities.com", _
	                         "excite.com", _
	                         "altavista.com", _
	                         "erols.com", _
	                         "ibm.com", _
	                         "microsoft.com", "email.com", _
	                         "netscape.net", "netzero.net", _
	                         "writeme.com" _
	                         )
	    
	    '// List of domains whose SMTP servers won't reject
	    '// bad usernames. Roughly ordered by popularity.
	    '// Don't bother with SMTP check for these.
	    m_aNoSmtpDoms = Array( _
	                         "yahoo.com", _
	                         "bigfoot.com", _
	                         "msn.com", _
	                         "compuserve.com", _
	                         "altavista.com", _
	                         "microsoft.com", _
	                         "netscape.net", _
	                         "netzero.net" _
	                         )
	                          
	    '// Tune down SMTP timeout
	    '// SMTP validations will time out faster but more often
	    m_oVE.Timeouts(hexVeTimeoutSmtpTotal).Value = 10000
	End Sub
	
	Private Sub Class_Terminate()
		set m_oVE = nothing
	end sub	

	Function Validate(ByVal EmailAddress, ByVal Level)
	    Dim nRating
	    
	    '// Do initial syntax check
	    nRating = m_oVE.Validate(EmailAddress, hexVeLevelSyntax)
	    
	    If hexVeErrSuccess <> m_oVE.Error Or _
	       hexVeLevelSyntax = Level Then
	        
	        '// Exit normally
	        m_lError = m_oVE.Error
	        Validate = nRating
	        
	    ElseIf hexVeLevelDns = Level Then
	    
	        '// If domain is already known to be good...
	        If IsGoodDom(m_oVE.Domain) Then
	        
	            '// Skip check and return success
	            m_lError = hexVeErrSuccess
	            Validate = hexVeLevelDns
	        
	        Else
	            '// Do the normal check
	            Validate = m_oVE.Validate(EmailAddress, Level)
	            m_lError = m_oVE.Error
	        End If
	    
	    ElseIf hexVeLevelSmtp = Level Then
	    
	        '// If SMTP server for this domain won't reject
	        '// a bad username (local part)...
	        If IsNoSmtpDom(m_oVE.Domain) Then
	        
	            '// Skip the SMTP check (and the DNS check--we
	            '// already know the NoSmtpDoms accept email)
	            '// Return codes the validation would have returned
	            m_lError = hexVeErrSuccess
	            Validate = hexVeLevelSmtp
	            
	            '// Or, if you don't want to say the Validation
	            '// passed, you could return the following.
	            '// OptValidEmail won't be completely drop-in
	            '// compatible with HexValidEmail if you do this.
	            'm_lError = hexVeErrCouldNotVerifyRecipient
	            'Validate = hexVeLevelDns
	        
	        Else
	            '// Do the normal check
	            Validate = m_oVE.Validate(EmailAddress, Level)
	            m_lError = m_oVE.Error
	        End If
	        
	    End If
	    
	End Function

	Function AddrToString(ByVal IpAddress)
	    AddrToString = m_oVE.AddrToString(IpAddress)
	End Function

	Property Get Domain()
	    Domain = m_oVE.Domain
	End Property

	Property Get Error()
	    Error = m_oVE.Error
	End Property

	Property Get Expires()
	    Expires = m_oVE.Expires
	End Property

	Property Get ExtraText()
	    ExtraText = m_oVE.ExtraText
	End Property

	Property Get FromDomain()
	    FromDomain = m_oVE.FromDomain
	End Property

	Property Let FromDomain(ByVal sDomain)
	    m_oVE.FromDomain = sDomain
	End Property

	Property Get FromEmail()
	    FromEmail = m_oVE.FromEmail
	End Property

	Property Let FromEmail(ByVal sEmail)
	    m_oVE.FromEmail = sEmail
	End Property

	Property Get LicensedProcessors()
	    LicensedProcessors = m_oVE.LicensedProcessors
	End Property

	Property Get LicensedUser()
	    LicensedUser = m_oVE.LicensedUser
	End Property

	Property Get LocalPart()
	    LocalPart = m_oVE.LocalPart
	End Property

	Property Get MxRecs()
	    Set MxRecs = m_oVE.MxRecs
	End Property

	Property Let Options(ByVal lOptions)
	    m_oVE.Options = lOptions
	End Property

	Property Get Options()
	    Options = m_oVE.Options
	End Property

	Property Get SmtpSession()
	    SmtpSession = m_oVE.SmtpSession
	End Property

	Property Get Timeouts()
	    Set Timeouts = m_oVE.Timeouts
	End Property

	Property Get Version()
	    Version = m_oVE.Version
	End Property

	Private Function IsGoodDom(ByVal sDomain)
	    Dim i, iMax
	    i = LBound(m_aGoodDoms)
	    iMax = UBound(m_aGoodDoms)
	    IsGoodDom = False
	    
	    Do While i <= iMax And Not IsGoodDom
	        If sDomain = m_aGoodDoms(i) Then IsGoodDom = True
	        i = i + 1
	    Loop
	End Function

	Private Function IsNoSmtpDom(ByVal sDomain)
	    Dim i, iMax
	    i = LBound(m_aNoSmtpDoms)
	    iMax = UBound(m_aNoSmtpDoms)
	    IsNoSmtpDom = False
	    
	    Do While i <= iMax And Not IsNoSmtpDom
	        If sDomain = m_aNoSmtpDoms(i) Then IsNoSmtpDom = True
	        i = i + 1
	    Loop
	End Function
end class
%>