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