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