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