VBScript: Find Stale Computer Objects

Posted On 2017-06-07 by VB6Boy
Tags: Scripting Tip Windows
Views: 339

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)

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
    ' 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#
        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#
            ' 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"
        writefiletext MyFileName, strDN & "," & dtmDate & "," & strUAC
    End If



' Clean up the objects


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)

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

About the Author

has posted a total of 102 articles.

Comments On This Post

No comments on this post yet!

Do you have a thought relating to this post? You can post your comment here. If you have an unrelated question, you can use the Q&A section to ask it.

Or you can drop a note to the administrators if you're not sure where you should post.

Your IP address is:

Before you can post, you need to prove you are human. If you log in, this test goes away.

Code Links