Retrieve DNS Records (VBScript)

AddThis Social Bookmark Button

As a network administrator you are often working with machines across different domains or subnets in the business and it can be hard to see and access these computers by name. Instead of remembering a long list of fully qualified domain names this script finds your primary DNS server and enumerates all of the PTR records and exports them to an easy to read spreadsheet. For DNS servers with multiple domains this will retrieve all records. If possible it also retrieves the time this information was updated so you can identify computers that have not 'checked in' to the network recently or stale DNS records. This script may require you to have permission to read WMI from the DNS server so is best run by a network administrator on a server however the script can be easily modified so the spreadsheet is generated in a location shared to users.

 

 

'##################################################
'DNS PRT Records CSV Report
'----------------------
'Created by Christian Dunn January 2013
'##################################################
Dim IPAdd
Dim Computer
strComputer = "."
Dim objFile, strHTML, objWMIService, colInstalledAdapters, objAdapter, strComputerSummary, spaceused, jico
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2")
Set colInstalledAdapters = objWMIService.ExecQuery _ ("Select * from Win32_NetworkAdapterConfiguration Where IPEnabled = True")
For Each objAdapter In colInstalledAdapters
On Error Resume Next
If objAdapter.DNSServerSearchOrder(0) <> "0.0.0.0" and objAdapter.DNSServerSearchOrder(0) <> "" then
strComputer = objAdapter.DNSServerSearchOrder(0)
Exit For
End If
Next
Set colInstalledAdapters = Nothing
Set objWMIService = Nothing
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objTextFile = objFSO.CreateTextFile("primary-DNS.csv")
objTextFile.WriteLine "Current Primary DNS PTR Records," & Now() & ",(" & strComputer & "),"
objTextFile.WriteLine "SERVER,IP,TIMESTAMP,"
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\MicrosoftDNS")
Set colItems = objWMIService.ExecQuery( _ "SELECT * FROM MicrosoftDNS_PTRType",,48)
For Each objItem in colItems
CompNameArray = Split(objItem.RecordData , ".")
For i = LBound(CompNameArray) to UBound(CompNameArray)
Computer = CompNameArray(0)
Next
IPAddArray = Split (objItem.OwnerName , ".")
For i = LBound(IPAddArray) to UBound(IPAddArray)
IPAdd = IPAddArray(3) & "." & IPAddArray(2) & "." & IPAddArray(1) & "." & IPAddArray(0)
Next
Dim MyDate
MyDate = DateAdd("h", objItem.TimeStamp, "01/01/1601 00:00:00")
If MyDate = "1/01/1601" then MyDate = ""
objTextFile.WriteLine objItem.RecordData& "," & IPAdd & "," & MyDate & ","
Next
objTextFile.Close
Set objFSO = Nothing
Set objFile = Nothing
Set objWMIService = Nothing
Set colItems = Nothing
Attachments:
Download this file (extract-dns.zip)extract-dns.zip0.9 kB2013-01-20