narrow default width wide
colour style colour style colour style colour style

AD - Finding Unconfigured Subnets

Finding unconfigured sites/subnets in Active Directory

Here's a script that will let you know whenever a computer on your domain connects on a subnet that you don't have configured in Active Directory Sites and Services. It is extremely important to make sure that you have your Sites/Subnets setup correctly so that computers connect to the closest servers for logons and DFS. If a computers connects via and unknown subnet/site, it may validate using a DC on a remote subnet and/or use DFS off of a file server on a remote subnet.

Whenever a client logs on and it can't figure out what site it is in, the DC that ends up validating the logon logs a record in \SYSTEM32\DEBUG\NETLOGON.LOG. This script just gathers those logfiles from every DC each day and parses through them to see if any clients have logged on from an unconfigured subnet. You can just setup this script to run as a scheduled task every night a bit before midnight and you will get an e-mail the next morning if there were any errors the day before.

NETLOGON.LOG will have records that look like this:


(NOTE: The entire script can be downloaded here:)

First, let's create all of our scripting objects and dim our variables:

Option Explicit
Dim objFSO, WshShell, objErrorFile, objDCList, strDCFileName, strNetLogonErrorFile
Dim strCurrDir
Dim arrstrDCs()
Dim strNetLogonLogsFolder, strNetLogonLogsSrcLoc
Dim strDate, strDay, strMonth
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set WshShell = WScript.CreateObject("WScript.Shell")

Now, let's set a few hard-coded variables.

strDCFileName = "DClist.txt"
strNetLogonLogsFolder = "Exports\Netlogon-logs\"
strNetLogonLogsSrcLoc = "\admin$\debug\netlogon.Log"
strNetLogonErrorFile = strNetLogonLogsFolder & "__Errors.log"
strCurrDir = WshShell.CurrentDirectory
Set objErrorFile = objFSO.CreateTextFile(strNetLogonErrorFile, True)

Now, we just call each subroutine and function that does all of the work.

  • GetDate - This gets the current date and formats it in the same way that Netlogon.log uses.
  • GetDCs - This runs a query against AD to find all of the domain controllers.
  • SortDCArray - This just sorts the domain controller list alphabetically.
  • WriteToText - This writes the sorted domain controller list to a text file.
  • GetNetLogonLogs - This copies Netlogon.log from each DC to a central location.
  • GetCurrentErrors - This one checks for records that match today's date
  • SendEmailIfErrorsFound - This sends an e-mail if any errors were found today

Call GetDate
Call GetDCs
Call SortDCArray
Call WriteToText
Call GetNetLogonLogs
Call GetCurrentErrors
Call SendEmailIfErrorsFound

The GetDate sub just gets the current day and month and formats it like Netlogon.log does. It prepends zeroes to any single-digit number and puts a “/“ between the day and month.

Sub GetDate
 'Formats the date so we can match it with the date format in the logs
 strMonth = Month(Now)
 strDay = Day(Now)
 If Len(strMonth) = 1 Then strMonth = "0" & strMonth
 If Len(strDay) = 1 Then strDay = "0" & strDay
 strDate = strMonth & "/" & strDay
 'WScript.Echo strDate

End Sub

GetDCs does a query against AD looking for all computers that have the objectclass “nTDSDSA“. Only Domain Controllers will have this objectclass. The script gets the DNSHostName attribute from each DC and stores it in an array for use later on (arrstrDCs).

Sub GetDCs
 'Finds all the DCs on the domain
 Dim objRootDSE, strConfig, strDNSDomain
 Dim objConnection, objCommand
 Dim strBase, strFilter, strAttributes, strQuery
 Dim objRecordSet, objDC, k
 ' Determine DNS domain name.
 Set objRootDSE = GetObject("LDAP://RootDSE")
 strDNSDomain = objRootDSE.Get("defaultNamingContext")
 ' Determine configuration context.
 strConfig = objRootDSE.Get("configurationNamingContext")
 ' Use ADO to search Active Directory for ObjectClass nTDSDSA.
 ' This will identify all Domain Controllers.
 Set objCommand = CreateObject("ADODB.Command")
 Set objConnection = CreateObject("ADODB.Connection")
 objConnection.Provider = "ADsDSOObject"
 objConnection.Open = "Active Directory Provider"
 objCommand.ActiveConnection = objConnection
 strBase = ""
 strFilter = "(objectClass=nTDSDSA)"
 strAttributes = "AdsPath"
 strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
 objCommand.CommandText = strQuery
 objCommand.Properties("Page Size") = 100
 objCommand.Properties("Timeout") = 60
 objCommand.Properties("Cache Results") = False
 Set objRecordSet = objCommand.Execute
 ' Enumerate parent objects of class nTDSDSA. Save Domain Controller
 ' DNS host names in dynamic array arrstrDCs.
 k = 0
 Do Until objRecordSet.EOF
  Set objDC = _
    ReDim Preserve arrstrDCs(k)
    arrstrDCs(k) = objDC.DNSHostName
    k = k + 1
    'WScript.Echo objDC.DNSHostName
End Sub

SortDCArray is just a simple subroutine to sort an array. I've written better sort functions since I wrote this script but this one works fine for this script and I haven't gone back to update it.

Sub SortDCArray
 'Sorts the DC list alphabetically

 Dim i, j, temp
 'WScript.Echo UBound(arrstrDCs)
 For i = 0 To UBound(arrstrDCs)
  For j = 0 To UBound(arrstrDCs)
   If(arrstrDCs(i) <= arrstrDCs(j)) Then
    temp = arrstrDCs(i)
    arrstrDCs(i) = arrstrDCs(j)
    arrstrDCs(j) = temp
   End If
End Sub

WriteToText just writes names of each DC to a text file. This isn't really necessary but I threw it in.

Sub WriteToText
 'Writes out a list of all DCs found

 Dim i
 Set objDCList = objFSO.CreateTextFile(strDCFileName,True)
 For i = 0 To UBound(arrstrDCs)
End Sub

GetNetLogonLogs just copies the Netlogon.log from each DC. It just goes through each DC in the array and uses the FileSystemObject to copy the file.

Sub GetNetLogonLogs
 'Copies the netlogon.log files from each DC

 Dim i, strSourceFile, strDestFile
 For i = 0 To UBound(arrstrDCs)
  strSourceFile = "\\" & arrstrDCs(i) & strNetLogonLogsSrcLoc
  strDestFile = strNetLogonLogsFolder & arrstrDCs(i) & "-Netlogon.Log"
  'WScript.Echo strSourceFile & vbTab & strDestFile
  On Error Resume Next
  objFSO.CopyFile strSourceFile, strDestFile, True
  If Err.Number 0 Then
   objErrorFile.WriteLine("ERROR COPYING NETLOGON.LOG for server: " & arrstrDCs(i))
  End If
  On Error Goto 0
End Sub

GetCurrentErrors parses each log file to look for current errors. This is probably the trickiest part of the script. It would've been extremely simple if Microsoft had included the year in the date that they store in Netlogon.log but the fact that they only store the month and day forces us to do a bit more work.

This subroutine just goes through each Netlogon.log line by line and looks for a date that matches the current date. If it finds a match, it adds that line to a string variable named strCurrDateLines. When it is done processing the file, it writes that string variable out to our ErrorLog file.

When I ran the script for the first time, I kept getting records from previous years. That's when I added the ELSE to the IF statement that I am using to check for current records. If the script ever runs into a line that doesn't match the current date, it resets the string variable strCurrDateLines to an empty string. This is how we keep the script from returning old data.

Sub GetCurrentErrors
 'Parses each log file and puts todays records into the error log

 Dim objNetLogonLogsFolder, File, objFile
 Dim strLine, strCurrDateLines
 Set objNetLogonLogsFolder = objFSO.GetFolder(strNetLogonLogsFolder)
 For Each File In objNetLogonLogsFolder.Files
  objErrorFile.WriteLine File & VbCrLf
  Set objFile = objFSO.OpenTextFile(File,ForReading)
  Do Until objFile.AtEndOfStream
   strLine = objFile.ReadLine
   'This makes sure we only get records from the current date
   If InStr(strLine,strDate) 0 Then
    'Add the current line to the variable
    strCurrDateLines = strCurrDateLines & strLine & vbcrlf
    '***IMPORTANT***This might affect whether you get the correct records
    'This resets the variable that stores all of the records for this server if it finds a line that
    'does NOT have the correct date - This will make sure that we don't get records from previous years
    'This is the only way to do it b/c no year information is stored in the logs
    strCurrDateLines = ""
   End If
  'Write all of the records for this server to the error log
  objErrorFile.Write strCurrDateLines
End Sub

This last subroutine is fairly common in any scripts that I use for auditing. I don't like to review the logs unless there is actually something wrong. So I usually make the scripts smart enough to check to make sure something noteworthy happened. And if it did, I just have it e-mail the logfile to me so I can review it. If the logfile is big, I'll usually just send myself a link to the file so I don't have to send a huge attachment via e-mail.

For this script, we just open up the ErrorLog file that we created and look for the string “NO_CLIENT_SITE“. If the ErrorLog contains that string, we know something is wrong. In this case, I just send myself a copy of the logfile to review. I left in some comments in the code that show you how you can send other types of e-mail messages via vbscript. Sometimes I find it useful to send myself an HTML message but for this one a simple message with the attachment is good enough.

Sub SendEmailIfErrorsFound
 Dim objMessage, strErrorFile, blnDiffsFound
 'Dim strHTML

 Set objErrorFile = Nothing 'Close file so we can attach it
 'WScript.Echo strCurrDir & "\" & strNetLogonErrorFile
 Set objErrorFile = objFSO.OpenTextFile(strCurrDir & "\" & strNetLogonErrorFile, ForReading)
 strErrorFile = objErrorFile.Readall
 If InStr(strErrorFile, "NO_CLIENT_SITE") 0 Then blnDiffsFound = True
 'blnDiffsFound = True 'Use to force e-mail to send during testing

 If blnDiffsFound = True Then
  ''Build HTML for e-mail message
  'strHTML = ""
  'strHTML = strHTML & ""
  'strHTML = strHTML & ""
  'strHTML = strHTML & "Changes found - Please review

  ' strHTMLOutputFile & strQuote & " target=content>" & strHTMLOutputFile & ""
  'strHTML = strHTML & ""
  'strHTML = strHTML & ""
  'Sending a text email using a remote server  
  Set objMessage = CreateObject("CDO.Message") 
  objMessage.Subject = "New subnet Report" 
  objMessage.Sender = " matt_broadstock@mycompany.comCloaking " 
  objMessage.To = " matt_broadstock@mycompany.comCloaking " 
  'WScript.Echo strHTML
  objMessage.TextBody = "Subnet not found in AD"
  'objMessage.HTMLBody = strHTML
  'objMessage.CreateMHTMLBody "file:" & strHTMLOutputFile
  'objMessage.Bcc = " you@your.comCloaking "
  objMessage.AddAttachment(strCurrDir & "\" & strNetLogonErrorFile)
  objMessage.Configuration.Fields.Item _
  ("") = 2 
  'Name or IP of Remote SMTP Server
  objMessage.Configuration.Fields.Item _
  ("") = ""
  'Server port (typically 25)
  objMessage.Configuration.Fields.Item _
  ("") = 25 
 End If
End Sub