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="HexDns.inc.vbs.asp" --> <!-- #include file="UtilityVars.inc.vbs.asp" --> <% '// NsLookup engine '// version 2001-06-05 '// '// This file defines a class that implements the NsLookup '// engine. Use with Utility.inc.vbs.asp. '// '// NsLookup is a general-purpose utility for looking up '// all kinds of DNS records. It lets you specify all the '// parameters for a query and then displays the complete '// results. '// '// Inputs (form variables): '// - domain (string) Domain for which to get records '// - type (int) Record type to get '// - class (int) Record class to get '// - server (string) Domain or IP addr of DNS server to use '// - port (int) Port to use on DNS server '// - timeout (long) Milliseconds to wait for query '// - no_recurse (bool) Don't use recursion for query '// - advanced (bool) Show advanced output (including header) '// '// HexGadgets (components) required: '// - HexDns '// Info: http://www.HexGadgets.com/ '// Download: http://www.hexillion.com/download/HexGadgets.exe '// '// Other dependencies: '// - HexGadgets.inc.vbs.asp '// - HexDns.inc.vbs.asp '// - UtilityVars.inc.vbs.asp '// - VBScript 5.0 or later '// Get the latest at http://msdn.microsoft.com/scripting/ '// '// History: '// 2001-06-05 Renamed "query" input parameter to "domain" '// Changed output to indicate auth/nonauth on err rcode '// 2001-04-11 Created, based on older AspNsLookup.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 NsLookup property Get Name() Name = "NsLookup" end property property Get Desc() Desc = "Query the DNS for resource records" end property property Get ViewSourceURL() ViewSourceURL = "http://www.hexillion.com/samples/view_src.asp?name=NsLookup.inc.vbs.asp" end property property Get DownloadSourceURL() DownloadSourceURL = "http://www.hexillion.com/samples/#NsLookup" end property private m_oDns '// Connection object private m_oLkup '// Lookup object private m_sServer '// DNS server address private m_sDomain '// Queried domain private m_iType '// RR type requested private m_iClass '// RR class requested private m_iPort '// DNS server port private m_lTimeout '// Max query time (ms) private m_bNoRecurse '// No recursion requested private m_bAdvanced '// Display complete response data private m_lLicErr '// HexDns license error Private Sub Class_Initialize() '// Create objects set m_oDns = Server.CreateObject( "HexDns.Connection" ) set m_oLkup = Server.CreateObject( "HexDns.Lookup" ) '// Save license error code m_lLicErr = m_oDns.Error '// Leave other members uninitialized '// to indicate input has not been processed '// Initialize display strings HexDnsInit end sub Private Sub Class_Terminate() set m_oLkup = nothing set m_oDns = nothing end sub Sub WriteForm() '// Check for form input, set defaults m_sServer = GetVar( m_sServer, "server", c_varDnsServer, _ m_oLkup.AddrToString( m_oDns.RemoteAddr ) ) m_sDomain = GetVar( m_sDomain, "domain", c_varDomain, null ) m_sDomain = GetVar( m_sDomain, "query", c_varDerivedDomain, "yahoo.com" ) '// Check for "query" form variable for backward compatibility m_iType = cint( GetVar( m_iType, "type", c_varDnsType, hexDnsTypeANY ) ) m_iClass = cint( GetVar( m_iClass, "class", c_varDnsClass, hexDnsClassIN ) ) m_iPort = cint( GetVar( m_iPort, "port", c_varDnsPort, m_oDns.RemotePort ) ) m_lTimeout = clng( GetVar( m_lTimeout, "timeout", c_varDnsTimeout, m_oDns.Timeout ) ) m_bNoRecurse = cbool( GetVar( m_bNoRecurse, "no_recurse", _ c_varNone, false ) ) m_bAdvanced = cbool( GetVar( m_bAdvanced, "advanced", _ c_varNone, false ) ) WriteLn "<form method=""POST"" action=""" & request( "SCRIPT_NAME" ) & """>" WriteLn "<table cellpadding=""5"">" WriteLn "<tr>" WriteLn "<td align=""right"">domain</td>" WriteLn "<td class=""bugfix"">" WriteLn "<input type=""text"" name=""domain"" size=""22"" value=""" & Server.HtmlEncode( m_sDomain ) & """>" WriteLn "</td>" WriteLn "<td align=""right"">query type</td>" WriteLn "<td class=""bugfix"">" WriteLn "<select name=""type"">" dim i For i = 0 To 255 If Len(GetTypeStringShort( i )) Then Response.Write "<option " if m_iType = i then Response.Write "selected " Response.Write "value=""" & i & """>" & GetTypeStringShort( i ) & " - " & GetTypeStringLong( i ) & "</option>" & vbcrlf end if Next WriteLn "</select>" WriteLn "</td>" WriteLn "</tr>" WriteLn "<tr>" WriteLn "<td align=""right"">server</td>" WriteLn "<td class=""bugfix"">" WriteLn "<input type=""text"" name=""server"" size=""22"" value=""" & Server.HtmlEncode( m_sServer ) & """>" WriteLn "</td>" WriteLn "<td align=""right"">query class</td>" WriteLn "<td class=""bugfix"">" WriteLn "<select name=""class"">" For i = 0 To 255 If Len(GetClassStringShort( i )) Then Response.Write "<option " if m_iClass = i then Response.Write "selected " Response.Write "value=""" & i & """>" & GetClassStringShort( i ) & " - " & GetClassStringLong( i ) & "</option>" & vbcrlf end if Next WriteLn "</select>" WriteLn "</td>" WriteLn "</tr>" WriteLn "<tr>" WriteLn "<td align=""right"">port</td>" WriteLn "<td class=""bugfix"">" WriteLn "<input type=""text"" name=""port"" size=""7"" value=""" & m_iPort & """>" WriteLn "</td>" WriteLn "<td align=""right"">timeout (ms)</td>" WriteLn "<td class=""bugfix"">" WriteLn "<input type=""text"" name=""timeout"" size=""7"" value=""" & m_lTimeout & """>" WriteLn "</td>" WriteLn "</tr>" WriteLn "<tr>" WriteLn "<td colspan=""3"">" Response.Write "<input type=""checkbox"" value=""true"" name=""no_recurse""" if m_bNoRecurse then Response.Write " checked" WriteLn "> no recursion" WriteLn " " Response.Write "<input type=""checkbox"" value=""true"" name=""advanced""" if m_bAdvanced then Response.Write " checked" WriteLn "> advanced output" WriteLn "</td>" WriteLn "<td>" WriteLn "<input border=""0"" src=""btn_go.gif"" name=""go"" type=""image"" width=""35"" height=""21"" align=""absmiddle"">" WriteLn "</td>" WriteLn "</tr>" WriteLn "</table>" WriteLn "</form>" end sub sub WriteOutput() if "" <> request( "domain" ) then DoNsLookup '// Main work is put off in separate routine '// so "exit sub" statements won't skip the following WriteLicenseWarning "HexDns", m_oDns, m_lLicErr end sub private sub DoNsLookup() '// Check port number if m_iPort > 0 then m_oDns.RemotePort = m_iPort else Response.Write "<p>Port number must be greater than zero</p>" exit sub end if '// Check timeout if m_lTimeout > 0 and m_lTimeout <= 30000 then m_oDns.Timeout = m_lTimeout else Response.Write "<p>Timeout must be from 1 to 30000</p>" exit sub end if '// Check for default server if 0 = m_oDns.RemoteAddr then Response.Write "<p>Could not obtain default server address.</p>" exit sub end if '// Write input variables to non-persistent cookie '// for use with other utilities and future calls to '// this one InitCookieVars SetVar c_varDnsServer, m_sServer SetVar c_varDomain, m_sDomain SetVar c_varDnsType, m_iType SetVar c_varDnsClass, m_iClass SetVar c_varDnsPort, m_iPort SetVar c_varDnsTimeout, m_lTimeout '// Send what we have so far to browser Response.Flush '// Look up address for server (if specified) using default server dim lAddr if "" <> m_sServer then lAddr = m_oLkup.LookUp(m_sServer) if hexDnsErrSuccess <> m_oLkup.Error then Response.Write "<p>Address lookup for <span class=""ipaddr"">" Response.Write Server.HtmlEncode( m_sServer ) & "</span> failed: <b>" Response.Write Server.HtmlEncode( GetDnsErrorString( m_oLkup.Error ) ) & "</b></p>" exit sub end if '// Use the address received as the server address '// for the next query m_oDns.RemoteAddr = lAddr end if '// Make a display-friendly server address string dim sServer if 0 = m_oLkup.StringToAddr( m_sServer ) then sServer = Server.HtmlEncode( m_sServer ) & " " end if sServer = sServer & "[" & m_oLkup.AddrToString( m_oDns.RemoteAddr ) & "]" '// Set up query message '// We're doing this to get access to the recursion option '// Normally we'd skip all this and use the Query method dim oResponse, oQ, oQMsg, fTime set oQ = Server.CreateObject( "HexDns.Question" ) set oQMsg = Server.CreateObject( "HexDns.Message" ) oQ.Name = m_sDomain oQ.Type = m_iType oQ.Class = m_iClass oQMsg.Questions.Add oQ oQMsg.RecursionDesired = not m_bNoRecurse '// Query for records using QueryEx fTime = timer() Set oResponse = m_oDns.QueryEx( oQMsg ) fTime = (timer() - fTime) * 1000 '// Get query time in ms '// Clean up set oQMsg = nothing set oQ = nothing '// Check for errors if 0 <> m_oDns.Error then Response.Write "<p>DNS query for <span class=""ipaddr"">" & _ Server.HtmlEncode( m_sDomain ) & "</span> failed: <b>" Response.Write Server.HtmlEncode( GetDnsErrorString( m_oDns.Error ) ) & "</b></p>" exit sub end if '// Indicate response received Response.Write "<p><span class=""ipaddr"">" Response.Write sServer Response.Write "</span> returned a" if oResponse.AuthAnswer then Response.Write "n <b>" else Response.Write " <b>non-" end if Response.Write "authoritative</b> response in " & formatnumber( fTime, 0 ) & " ms:" & vbcrlf '// If the response is an error and we're not doing advanced ouput... if 0 <> oResponse.ResponseCode and not m_bAdvanced then '// Display message and quit Response.Write "<p><b>" & Server.HtmlEncode( GetMsgRcodeString( oResponse.ResponseCode ) ) & "</b></p>" exit sub end if '// Write top of table Response.Write "<table cellpadding=""5"" cellspacing=""1"" border=""0"">" & vbcrlf if m_bAdvanced then '// Write out header information Response.Write "<tr><td colspan=""3""><h3><br>Header</h3></td></tr>" & vbcrlf Response.Write "<tr><td colspan=""6""><table cellpadding=""6"" cellspacing=""0"" border=""0"">" Response.Write "<tr>" Response.Write "<td align=""right"">rcode:</td>" Response.Write "<td colspan=""3""><b>" & Server.HtmlEncode( GetMsgRcodeString( oResponse.ResponseCode ) ) & "</b></td>" Response.Write "</tr><tr>" WriteHeaderVal "id", oResponse.Id WriteHeaderVal "opcode", Server.HtmlEncode( GetMsgOpCodeString( oResponse.Opcode ) ) Response.Write "</tr><tr>" WriteHeaderVal "is a response", oResponse.IsResponse WriteHeaderVal "authoritative", oResponse.AuthAnswer Response.Write "</tr><tr>" WriteHeaderVal "recursion desired", oResponse.RecursionDesired WriteHeaderVal "recursion avail", oResponse.RecursionAvailable Response.Write "</tr><tr>" WriteHeaderVal "truncated", oResponse.Truncated Response.Write "</tr><tr>" WriteHeaderVal "questions", oResponse.Questions.Count WriteHeaderVal "answers", oResponse.AnswerRecords.Count Response.Write "</tr><tr>" WriteHeaderVal "authority recs", oResponse.AuthRecords.Count WriteHeaderVal "additional recs", oResponse.AddtlRecords.Count Response.Write "</tr></table></td></tr>" '// Write out questions (should just be one) Response.Write "<tr><td colspan=""3""><h3>" Response.Write "Questions</h3></td></tr>" & vbcrlf if 0 = oResponse.Questions.Count then '// Indicate no questions (!) Response.Write "<tr><td colspan=""3"">[none]</td></tr>" & vbcrlf else '// Write column headers Response.Write "<tr><td class=""hdr"">name</td>" Response.Write "<td class=""hdr"">class</td>" Response.Write "<td class=""hdr"">type</td>" & vbcrlf '// Dump questions dim o For Each o In oResponse.Questions Response.Write "<tr><td>" & Server.HtmlEncode( o.Name ) & "</td><td>" if len( GetClassStringShort( o.Class ) ) then Response.Write GetClassStringShort( o.Class ) else Response.Write o.Class end if Response.Write "</td><td>" if len( GetTypeStringShort( o.Type ) ) then Response.Write GetTypeStringShort( o.Type ) else Response.Write o.Type end if Response.Write "</td><tr>" Next set o = nothing end if end if '// Dump record collections WriteRecColl oResponse.AnswerRecords, "Answer records" WriteRecColl oResponse.AuthRecords, "Authority records" WriteRecColl oResponse.AddtlRecords, "Additional records" Response.Write "</table>" set oResponse = nothing end sub private sub WriteHeaderVal( sName, vVal ) Response.Write "<td align=""right"">" & sName & ":</td>" Response.Write "<td><b>" & vVal & "</b></td>" end sub private sub WriteRecColl( oRecColl, sHeading ) Response.Write "<tr><td colspan=""3""><h3>" '<br> Response.Write sHeading & "</h3></td></tr>" & vbcrlf if 0 = oRecColl.Count then '// Indicate no records Response.Write "<tr><td colspan=""3"">[none]</td></tr>" & vbcrlf else '// Write column headers Response.Write "<tr><td class=""hdr"">name</td>" Response.Write "<td class=""hdr"">class</td>" Response.Write "<td class=""hdr"">type</td>" Response.Write "<td class=""hdr"">data</td>" Response.Write "<td class=""hdr"" colspan=""2"">time to live</td>" & vbcrlf '// Dump records dim o For Each o In oRecColl WriteRecord o Next set o = nothing end if end sub private sub WriteRecord( oRec ) Response.Write "<tr><td valign=""top"">" & oRec.Name & "</td>" Response.Write "<td valign=""top"">" if len( GetClassStringShort( oRec.Class ) ) then Response.Write GetClassStringShort( oRec.Class ) else Response.Write oRec.Class end if Response.Write "</td><td valign=""top"">" select case oRec.Class case hexDnsClassIN select case oRec.Type case hexDnsTypeA Response.Write "A</td><td valign=""top"">" & m_oLkup.AddrToString( oRec.Addr ) case hexDnsTypeNS Response.Write "NS</td><td valign=""top"">" & Server.HtmlEncode( oRec.Server ) case hexDnsTypeCNAME Response.Write "CNAME</td><td valign=""top"">" & Server.HtmlEncode( oRec.CName ) case hexDnsTypeSOA Response.Write "SOA</td><td valign=""top"">" Response.Write "<table cellpadding=""2"" cellspacing=""0"" border=""0"" width=""100%"">" Response.Write "<tr><td>server:</td><td align=""right"">" & Server.HtmlEncode( oRec.Server ) & "</td></tr>" Response.Write "<tr><td>email:</td><td align=""right"">" & Server.HtmlEncode( oRec.Email ) & "</td></tr>" Response.Write "<tr><td>serial:</td><td align=""right"">" & CULng(oRec.Serial) & "</td></tr>" Response.Write "<tr><td>refresh:</td><td align=""right"">" & CULng(oRec.Refresh) & "</td></tr>" Response.Write "<tr><td>retry:</td><td align=""right"">" & CULng(oRec.Retry) & "</td></tr>" Response.Write "<tr><td>expire:</td><td align=""right"">" & CULng(oRec.Expire) & "</td></tr>" Response.Write "<tr><td>minimum ttl:</td><td align=""right"">" & CULng(oRec.MinTtl) & "</td></tr>" Response.Write "</table>" case hexDnsTypePTR Response.Write "PTR</td><td valign=""top"">" & Server.HtmlEncode( oRec.Pointer ) case hexDnsTypeHINFO Response.Write "HINFO</td><td valign=""top"">" Response.Write "<table cellpadding=""2"" cellspacing=""0"" border=""0"" width=""100%"">" Response.Write "<tr><td>CPU:</td><td align=""right"">" & Server.HtmlEncode( oRec.Cpu ) & "</td></tr>" Response.Write "<tr><td>OS:</td><td align=""right"">" & Server.HtmlEncode( oRec.Os ) & "</td></tr>" Response.Write "</table>" case hexDnsTypeMX Response.Write "MX</td><td valign=""top"">" Response.Write "<table cellpadding=""2"" cellspacing=""0"" border=""0"" width=""100%"">" Response.Write "<tr><td>preference:</td><td align=""right"">" & oRec.Preference & "</td></tr>" Response.Write "<tr><td>exchange:</td><td align=""right"">" & Server.HtmlEncode( oRec.Exchange ) & "</td></tr>" Response.Write "</table>" case hexDnsTypeTXT Response.Write "TXT</td><td valign=""top"">" & Server.HTMLEncode(oRec.String) case hexDnsTypeRP Response.Write "RP</td><td valign=""top"">" Response.Write "<table cellpadding=""2"" cellspacing=""0"" border=""0"" width=""100%"">" Response.Write "<tr><td>email:</td><td align=""right"">" & Server.HtmlEncode( oRec.Email ) & "</td></tr>" Response.Write "<tr><td>txt domain:</td><td align=""right"">" & Server.HtmlEncode( oRec.TxtDomain ) & "</td></tr>" Response.Write "</table>" case hexDnsTypeLOC Response.Write "LOC</td><td valign=""top"">" Response.Write "<table cellpadding=""2"" cellspacing=""0"" border=""0"" width=""100%"">" Response.Write "<tr><td>version:</td><td align=""right"">" & oRec.Version & "</td></tr>" Response.Write "<tr><td>size:</td><td align=""right"">" & ConvertLocSize(oRec.Size) & "m</td></tr>" Response.Write "<tr><td>horz precision:</td><td align=""right"">±" & (ConvertLocSize(oRec.HorzPre) / 2) & "m</td></tr>" Response.Write "<tr><td>vert precision:</td><td align=""right"">±" & (ConvertLocSize(oRec.VertPre) / 2) & "m</td></tr>" Response.Write "<tr><td>longitude:</td><td align=""right"">" & GetCoordString( oRec.Latitude, true ) & "</td></tr>" Response.Write "<tr><td>latitude:</td><td align=""right"">" & GetCoordString( oRec.Longitude, false ) & "</td></tr>" Response.Write "<tr><td>altitude:</td><td align=""right"">" & CStr((oRec.Altitude - 10000000) / 100) & "m</td></tr>" Response.Write "</table>" case else if len( GetTypeStringShort( oRec.Type ) ) then Response.Write GetTypeStringShort( oRec.Type ) else Response.Write oRec.Type end if Response.Write "</td><td valign=""top"">" WriteRawTable oRec end select case else if len( GetTypeStringShort( oRec.Type ) ) then Response.Write GetTypeStringShort( oRec.Type ) else Response.Write oRec.Type end if Response.Write "</td><td valign=""top"">" WriteRawTable oRec end select Response.Write "</td><td valign=""top"" align=""right"">" & oRec.Ttl & "s</td><td valign=""top"">(" & GetTtlString( oRec.Ttl ) & ")</td></tr>" end sub private sub WriteRawTable( oRec ) WriteLn "[No interpretation available]<br>" WriteLn "<table cellpadding=""4"" cellspacing=""1"" border=""0"">" WriteLn "<tr>" WriteLn "<td class=""hdr"">hex</td>" WriteLn "<td class=""hdr"">ansi</td>" WriteLn "</tr><tr>" WriteLn "<td><tt>" & GetRawHexString( oRec, 8 ) & "</tt></td>" WriteLn "<td><tt>" & GetRawAnsiString( oRec, 8 ) & "</tt></td>" WriteLn "</tr>" WriteLn "</table>" end sub private sub WriteLn( s ) Response.Write s & vbcrlf end sub '// Convert a signed long value into an '// an unsigned long (actually currency) private function CULng( byval l ) dim ul ul = CCur( l ) if ul < 0 then ul = CCur( &h7FFFFFFF ) + &h7FFFFFFF + ul + 2 CULng = ul end function end class %>