VBScript: Find Stale Computer Objects
One of the necessary housekeeping tasks with Active Directory is removing stale or unused computer objects. Removing objects that haven't logged in for a long time helps to keep your Active Directory database lean and clean.
Why would someone have a bunch of unused objects in AD? Someone might have set up a temporary test machine. Or a server or workstation may have been replaced or retired. I'm sure there are other reasons, too.
The first step to cleaning old objects is to identify computers that have not checked in with the domain for a period of time. By default, Windows machines have a thirty day password change interval. If the machine does not check in to change the password within sixty days, they will no longer be able to communicate with the domain.
The VBS script below creates/appends a file containing all computer objects in the current domain, along with their DN and pwdLastSet date. We are using pwdLastSet for computer objects, since by default computers reset their passwords every thirty days (or less).
Option Explicit
Dim objRootDSE, adoConnection, adoCommand, strQuery
Dim adoRecordset, strDNSDomain, objShell, lngBiasKey
Dim lngBias, k, strDN, dtmDate, objDate
Dim strBase, strFilter, strAttributes, lngHigh, lngLow
Dim strUAC, intUAC
Dim MyFileName
MyFileName=Year(now) & "-" & Month(now) & "-" & Day(Now) & "-Computers.csv"
' Obtain local Time Zone bias from machine registry. This bias changes with Daylight Savings Time.
Set objShell = CreateObject("Wscript.Shell")
lngBiasKey = objShell.RegRead("HKLM\System\CurrentControlSet\Control\TimeZoneInformation\ActiveTimeBias")
If (UCase(TypeName(lngBiasKey)) = "LONG") Then
lngBias = lngBiasKey
ElseIf (UCase(TypeName(lngBiasKey)) = "VARIANT()") Then
lngBias = 0
For k = 0 To UBound(lngBiasKey)
lngBias = lngBias + (lngBiasKey(k) * 256^k)
Next
End If
Set objShell = Nothing
' Determine DNS domain from RootDSE object.
Set objRootDSE = GetObject("LDAP://RootDSE")
strDNSDomain = objRootDSE.Get("defaultNamingContext")
Set objRootDSE = Nothing
' Use ADO to search Active Directory.
Set adoCommand = CreateObject("ADODB.Command")
Set adoConnection = CreateObject("ADODB.Connection")
adoConnection.Provider = "ADsDSOObject"
adoConnection.Open "Active Directory Provider"
adoCommand.ActiveConnection = adoConnection
' Search entire domain.
strBase = "
' Filter on computer objects.
strFilter = "(&(objectClass=computer))"
' Comma delimited list of attribute values to retrieve.
strAttributes = "name,pwdLastSet,userAccountControl"
' Construct the LDAP syntax query.
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
' Run the query.
adoCommand.CommandText = strQuery
adoCommand.Properties("Page Size") = 100
adoCommand.Properties("Timeout") = 60
adoCommand.Properties("Cache Results") = False
Set adoRecordset = adoCommand.Execute
' Enumerate resulting recordset.
Do Until adoRecordset.EOF
' Retrieve attribute values for the computer.
strDN = adoRecordset.Fields("name").Value
intUAC=adoRecordset.Fields("userAccountControl").Value
strUAC=TranslateUAC(intUAC)
' Convert Integer8 value to date/time in current time zone.
On Error Resume Next
Set objDate = adoRecordset.Fields("pwdLastSet").Value
If (Err.Number <> 0) Then
On Error GoTo 0
dtmDate = #1/1/1601#
Else
On Error GoTo 0
lngHigh = objDate.HighPart
lngLow = objDate.LowPart
If (lngLow < 0) Then
lngHigh = lngHigh + 1
End If
If (lngHigh = 0) And (lngLow = 0) Then
dtmDate = #1/1/1601#
Else
' this was the hard part (for me, anyway). converting the 64-bit integer number to a date.
' i hate math. thankfully, i found the formula out on the wild, wild web.
dtmDate = #1/1/1601# + (((lngHigh * (2 ^ 32)) + lngLow)/600000000 - lngBias)/1440
End If
End If
' Display values for the computer
If (dtmDate = #1/1/1601#) Then
' if you want to see machines that are listed as never having reset their password,
' uncomment the next line.
'writefiletext MyFileName, strDN & ",Never"
Else
writefiletext MyFileName, strDN & "," & dtmDate & "," & strUAC
End If
adoRecordset.MoveNext
Loop
' Clean up the objects
adoRecordset.Close
adoConnection.Close
wscript.echo "Process Complete. The output file can be found at:" & vbcrlf & vbcrlf & MyFileName
Function WriteFileText(sFilePath, sText)
Dim objFSO ' As FileSystemObject
Dim objTextFile ' As Object
Const ForReading = 1
Const ForWriting = 2
Const ForAppending = 8
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objTextFile = objFSO.OpenTextFile(sFilePath, ForAppending, True)
' add a carriage return
sText=sText & vbcrlf
' Write a line.
objTextFile.Write (sText)
objTextFile.Close
End Function
Function TranslateUAC(TheUAC)
Select Case TheUAC
Case 4096
TranslateUAC="Enabled Workstation"
Case 4098
TranslateUAC="Disabled Workstation"
Case 512
TranslateUAC="Enabled User"
Case 514
TranslateUAC="Disabled User"
Case 528
TranslateUAC="Locked User"
Case Else
TranslateUAC="Other (" & TheUAC & ")"
End Select
End Function
Loading Comments ...
Comments
No comments have been added for this post.
You must be logged in to make a comment.