Search Tools Links Login

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

About this post

Posted: 2017-06-07
By: vb6boy
Viewed: 1,012 times

Categories

Tip

Scripting

Windows

Attachments

No attachments for this post


Loading Comments ...

Comments

No comments have been added for this post.

You must be logged in to make a comment.

ADODB.Connection error '800a0e79'

Operation is not allowed when the object is open.

/assets/inc/inc_footer.asp, line 37