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.

NsLookup.inc.vbs.asp

<!-- #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 "&nbsp;&nbsp;&nbsp;"
		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"">&plusmn;" & (ConvertLocSize(oRec.HorzPre) / 2) & "m</td></tr>"
						Response.Write "<tr><td>vert precision:</td><td align=""right"">&plusmn;" & (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
%>