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.
<!-- #include file="HexGadgets.inc.vbs.asp" --> <!-- #include file="HexValidEmail.inc.vbs.asp" --> <!-- #include file="UtilityVars.inc.vbs.asp" --> <% '// Email Dossier engine '// version 2001-05-02 '// '// Email Dossier validates and investigates email '// addresses. Use with Utility.inc.vbs.asp. '// '// Inputs (form variables): '// - email (string) Email address to check '// - vrfy_expn (bool) Try VRFY and EXPN commands (doesn't affect validation outcome) '// - level (int) Validation level requested '// - to_dns (long) Milliseconds to wait for DNS lookup '// - to_smtp (long) Milliseconds to wait for SMTP session '// - dom_dot (bool) Don't require a dot in the domain '// - dom_literals (bool) Don't allow domain literals '// - mx (bool) Require MX records '// '// HexGadgets (components) required: '// - HexValidEmail '// Info: http://www.HexGadgets.com/ '// Download: http://www.hexillion.com/download/HexGadgets.exe '// '// Other dependencies: '// - HexGadgets.inc.vbs.asp '// - HexValidEmail.inc.vbs.asp '// - UtilityVars.inc.vbs.asp '// - VBScript 5.0 or later '// Get the latest at http://msdn.microsoft.com/scripting/ '// '// History: '// 2001-05-02 Created, based on older EmailDossier.asp '// '// Copyright 2001 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 EmailDossier property Get Name() Name = "Email Dossier" end property property Get Desc() Desc = "Investigate email addresses" end property property Get ViewSourceURL() ViewSourceURL = "http://www.hexillion.com/samples/view_src.asp?name=EmailDossier.inc.vbs.asp" end property property Get DownloadSourceURL() DownloadSourceURL = "http://www.hexillion.com/samples/#EmailDossier" end property private m_oVE '// HexValidEmail object private m_lVeErr '// HexValidEmail license error private m_sEmail '// The input address private m_iLevel '// Validation level to use private m_lTimeoutDns '// DNS stage timeout private m_lTimeoutSmtp '// SMTP stage timeout private m_bExtraText '// Allow comments, etc. in address private m_bDomDot '// Don't require a dot in the domain private m_bDomLiterals '// Don't allow domain literals private m_bMx '// Require MX records for the domain private m_bVrfyExpn '// Try the VRFY and EXPN commands (does not affect validation) Private Sub Class_Initialize() '// Create objects set m_oVE = Server.CreateObject( "HexValidEmail.Connection" ) '// Save license error codes m_lVeErr = m_oVE.Error '// Leave other members uninitialized '// to indicate input has not been processed end sub Private Sub Class_Terminate() set m_oVE = nothing end sub Sub WriteForm() '// Check for form input, set defaults m_sEmail = GetVar( m_sEmail, "email", c_varEmailAddr, "email.test@hotmail.com" ) m_iLevel = cint( GetVar( m_iLevel, "level", c_varNone, hexVeLevelSmtp ) ) m_lTimeoutDns = clng( GetVar( m_lTimeoutDns, "to_dns", c_varNone, m_oVE.Timeouts( hexVeTimeoutDnsTotal ) ) ) m_lTimeoutSmtp = clng( GetVar( m_lTimeoutSmtp, "to_smtp", c_varNone, m_oVE.Timeouts( hexVeTimeoutSmtpTotal ) ) ) m_bExtraText = true m_bDomDot = cbool( GetVar( m_bDomDot, "dom_dot", c_varNone, false ) ) m_bDomLiterals = cbool( GetVar( m_bDomLiterals, "dom_literals", c_varNone, false ) ) m_bMx = cbool( GetVar( m_bMx, "mx", c_varNone, false ) ) m_bVrfyExpn = cbool( GetVar( m_bVrfyExpn, "vrfy_expn", c_varNone, false ) ) WriteLn "<form method=""POST"" action=""" & request( "SCRIPT_NAME" ) & """>" WriteLn "<table cellpadding=""5"" cellspacing=""0"" border=""0"">" WriteLn " <tr>" WriteLn " <td>email address</td>" WriteLn " <td class=""bugfix""><input type=""text"" name=""email"" size=""35"" value=""" & server.HTMLEncode( m_sEmail ) & """></td>" WriteLn " <td><input border=""0"" src=""btn_go.gif"" name=""go"" type=""image"" width=""35"" height=""21"" align=""absmiddle""></td>" WriteLn " </tr>" WriteLn " <tr>" WriteLn " <td> </td>" Response.Write "<td valign=""bottom""><input type=""checkbox"" value=""true"" name=""vrfy_expn""" if m_bVrfyExpn then Response.Write " checked" WriteLn "> try vrfy and expn</td>" WriteLn " <td> </td>" WriteLn " </tr>" WriteLn "</table>" WriteLn "</form>" end sub sub WriteOutput() if "" <> request( "email" ) then DoEmailDossier '// Main work is put off in separate routine '// so "exit sub" statements won't skip the following WriteLicenseWarning "HexValidEmail", m_oVE, m_lVeErr end sub private sub DoEmailDossier dim iRating '// Set cookie InitCookieVars SetVar c_varEmailAddr, m_sEmail WriteLn "<p>Validating <b>" & Server.HtmlEncode( m_sEmail ) & "</b>...</p>" Response.Flush '// Set options m_oVE.Options = m_oVE.Options or iif( m_bExtraText, hexVeOptionAllowExtraText, 0 ) _ or iif( m_bDomDot, hexVeOptionDontRequireDomainDot, 0 ) _ or iif( m_bDomLiterals, hexVeOptionDisallowDomainLiterals, 0 ) _ or iif( m_bMx, hexVeOptionRequireMx, 0 ) _ or iif( m_bVrfyExpn, hexVeOptionTryVrfyAndExpn, 0 ) '// Set timeouts m_oVE.Timeouts(hexVeTimeoutDnsTotal).Value = m_lTimeoutDns m_oVE.Timeouts(hexVeTimeoutSmtpTotal).Value = m_lTimeoutSmtp '// Identify yourself for SMTP (use your own information here) '// See http://www.hexillion.com/docs/guides/HexValidEmail/concepts/polite_usage.htm m_oVE.FromDomain = "hexillion.com" '// The domain name of your machine m_oVE.FromEmail = "HexValidEmail@hexillion.com" '// Email address of technical contact person '// Do the validation iRating = m_oVE.Validate( m_sEmail, m_iLevel ) '// Write out results WriteLn "<h3>Validation results</h3>" WriteLn "<table border=""0"" cellspacing=""0"" cellpadding=""5"">" WriteLn "<tr>" WriteLn "<td align=""right"" valign=""baseline"">confidence rating:</td>" WriteLn "<td valign=""baseline""><b>" & iRating & " - " & Server.HtmlEncode( GetVeLevelString( iRating ) ) & "</b>" if iRating then if hexVeErrSuccess = m_oVE.Error then WriteLn "<br>The email address passed this level of validation " WriteLn "<br>without an error. However, it is not guaranteed to be " WriteLn "<br>a good address. " else WriteLn "<br>The email address passed this level of validation " WriteLn "<br>before the validation stopped due to the error below. " WriteLn "<br>This does not indicate a problem with the address, but" WriteLn "<br>it does not guarantee a good address, either. " end if WriteLn "<a href=""http://www.hexillion.com/docs/guides/HexValidEmail/concepts/interpret.htm"" target=""_top"">more info</a></td>" end if WriteLn "</td>" WriteLn "</tr>" if m_oVE.Error then WriteLn "<tr>" WriteLn "<td align=""right"" valign=""baseline"">error" if iRating then Response.Write " at level " & (iRating + 1) WriteLn ":</td>" WriteLn "<td valign=""baseline""><b>" & Server.HtmlEncode( GetVeErrorString( m_oVE.Error ) ) & "</b></td>" WriteLn "</tr>" end if '// Write out canonical address if available if len( m_oVE.LocalPart ) then WriteLn "<tr><td align=""right"" valign=""baseline"">canonical address:</td>" WriteLn "<td valign=""baseline"">" WriteLn "<span class=""ipaddr"">" if len( m_oVE.ExtraText ) then Response.Write Server.HtmlEncode( m_oVE.ExtraText ) & " " end if Response.Write "<" & Server.HtmlEncode( m_oVE.LocalPart ) & "@" Response.Write "<a href=""DomainDossier.vbs.asp?addr=" & Server.HtmlEncode( Server.UrlEncode( m_oVE.Domain ) ) & _ "&dom_dns=1&dom_whois=1&net_whois=1"" " & _ "title=""Domain Dossier"">" & _ Server.HtmlEncode( m_oVE.Domain ) & "</a>>" WriteLn "</span>" WriteLn "</td></tr>" end if WriteLn "</table>" '// Write out MX records if available if m_oVE.MxRecs.Count then WriteLn "<h3>MX records</h3>" WriteLn "<table border=""0"" cellspacing=""1"" cellpadding=""5"">" WriteLn "<tr>" WriteLn "<td class=""hdr"">preference</td>" WriteLn "<td class=""hdr"">exchange</td>" WriteLn "<td class=""hdr"">IP address (if included)</td>" WriteLn "</tr>" dim oMxRec for each oMxRec in m_oVE.MxRecs WriteLn "<tr>" WriteLn "<td align=""right"">" & oMxRec.Preference & "</td>" WriteLn "<td>" & Server.HtmlEncode( oMxRec.Exchange ) & "</td>" if oMxRec.Addr then WriteLn "<td>[" & m_oVE.AddrToString( oMxRec.Addr ) & "]</td>" else WriteLn "<td> </td>" end if WriteLn "</tr>" next WriteLn "</table>" end if '// Display color-coded session text if available if len( m_oVE.SmtpSession ) then WriteLn "<h3>SMTP session</h3>" WriteSession( m_oVE.SmtpSession ) end if end sub private sub WriteLn( s ) Response.Write s & vbcrlf end sub private function iif( b, v1, v2 ) if b then iif = v1 else iif = v2 end if end function private sub WriteSession( s ) dim sLine, sColor, c, lPos, lPrev, lEnd WriteLn "<p><tt>" lPrev = 1 lEnd = len( s ) + 1 do lPos = instr( lPrev, s, vbcrlf ) if lPos <= 0 then lPos = lEnd sLine = mid( s, lPrev, lPos - lPrev ) c = left( sLine, 1 ) if "[" = c then sColor = "Green" elseif IsNumeric( c ) then sColor = "Black" else sColor = "Navy" end if WriteLn "<font color=""" & sColor & """>" & _ server.HTMLEncode( sLine ) & _ "</font><br>" lPrev = lPos + len( vbcrlf ) loop while lPos < lEnd WriteLn "</tt></p>" end sub end class %>