Monday, September 13, 2010

Computer Account Cleanup


With the Labor Day holiday now behind us, the summer vacation season is unofficially over. It is time to buckle down and address the cobwebs that have been collecting in the environment while you have been short-staffed addressing paid time off throughout your organization. With that in mind, I thought I would share some of my favorite scripts this week that help to keep the systems environment tidy.
One task that many organizations struggle with is keeping computer accounts throughout the domain structure in check and current.
 It isn't anyone's fault that this occurs. It is just too easy to simply miss the step to remove the computer account when you decommission a system or simply rebuild it using a new name. Luckily, Active Directory gives us some pretty good clues as what machines are still active and what ones are not. This is because computers need to change their passwords just like users. By looking at the length of time since the last computer account password change, one can reasonably tell whether a machine has been online or not. Exceptions to this would be machines that have been offsite and disconnected for a long period of time. These are usually of little risk as they are either fairly well known or have been offline so long that they will likely need to be rejoined to the domain to be used anyway.
The script below was a combination of two scripts that I found some time ago from http://cwashington.netreach.net/ and http://www.developersdex.com/.
Usage is straightforward. Assuming you save the script contents as caarr2k.vbs, the command line syntax is:
Cscript caarr2k.vbs [-DAYS <n>] [-DISABLE] [-OU <OU>] [-FILE <fn>]
-DAYS <n>Display computer accounts that have not reset their domain password within n days. Note: n must be an integer, and must be at least 1.
-DISABLEDisable computer accounts that have not reset their domain password within n days. Note: If this switch is used, n must be at least 30
-OU <OU>If disabling accounts, the -OU switch allows you to move the accounts to the specified OU within the current domain. Note: The OU must be specified in LDAP format. i.e. LDAP://OU=Disabled,CN=DOMAIN,CN=COM
-FILE <fn>Specifies a source file to create if reporting, or a source file to use if disabling computer accounts within the domain. Note: This option should be used if disabling accounts in order to facilitate QA.
-?, -HDisplays this help
  
In normal use, it is recommended to run this script as 2 separate steps. A first step to search the domain for all computer accounts that have not had their passwords changed in the prescribed length of time. This step should be run such that it writes an output file that can be reviewed manually by the internal team to make sure there are not any systems that would be disabled unnecessarily. When performing this step, make sure that the length of time specified for the scan is at least 1.5X the length of your computer account password expiration setting in AD (By default 30 days). This can also be controlled via GPO. (See the Configuration\Windows Settings\Security Settings\Local Policies\Security Options\ container) If you wish to run the script to look for computer accounts older than 60 days and save them to a output file named c:\review.txt, the command line would be:
Cscript caarr2k.vbs –days 60 –file c:\review.txt
The result will be a vertical bar (|) delimited file that can be modified easily with a text editor or parsed into Excel for review. This file will include 2 columns of data: The machine name and the date of the last password change. Once the review cycle is complete and you have made any required changes to the source file, the script can be rerun to disable the affected accounts. I also like to move all of them to a separate OU, for ease of clean-up after a week or so to make sure there were not any accidental oversights. Assuming your domain is called domain.com, the command line to disable all of the computer accounts in the c:\review.txt file and move them to an OU called review off the root of the domain would be:
Cscript caarr2k.vbs –disable –file c:\review.txt –OU LDAP://OU=review,cn=domain,cn=com
Hopefully, this script provides a good starting point for system cleanup.


Script contents below:
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Computer Account Age Reporter & Disabler
'
' Please refer to the "Instructions" subroutine below for information
' on what this VB script does, and how it works.
'
' Original Source: cwashington.netreach.net & www.developersdex.com
' Modified by: Tom Owen
' Date: 8/2005
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''












''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' BEGIN VARIABLE DECLARATION SECTION
' The Option Explicit statement requires that all variables be declared. This is
' advantageous because it minimizes the liklihood of a misspelled variable.
OPTION EXPLICIT
On Error Resume Next
'''''''''''''''''BEGIN LEGEND'''''''''''''''''''''''''''''
' bol_        boolean
' col_        collection
' con_        constant
' dtm_        date or time
' err_        error code
' fil_        file
' flp_        floating point (real)
' fun_        function
' int_        integer
' lng_        long integer
' obj_        object reference
' str_        string
'''''''''''''''''END LEGEND'''''''''''''''''''''''''''''''
DIM bol_disable
DIM dtm_lastLogonDate
DIM dtm_now
DIM dtm_passwordLastSetDate
DIM int_counterK
DIM int_numDays
DIM int_whileCounter
DIM lng_bias
DIM lng_biasKey
DIM lng_high
DIM lng_lastLogonDate
DIM lng_low
DIM lng_passwordLastSetDate
DIM obj_account
DIM obj_command
DIM obj_connection
DIM obj_date
DIM obj_recordSet
DIM obj_rootDSE
DIM obj_shell
DIM str_attributes
DIM str_base
DIM str_DN
DIM str_DNSDomain
DIM str_filter
DIM str_parameter
DIM str_query
Dim bol_usefile
Dim bol_OU
Dim sOU
Dim objOU
Dim strLine
Dim sFileName
Dim oFile
Dim fso
Dim str_CM




''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' END VARIABLE DECLARATION SECTION
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''












''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' This section of code parses the user-entered command line and extracts
' the parameters from it.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
int_whileCounter = 0
int_numDays = -1
bol_disable = False
bol_usefile = False
bol_OU = false


WHILE int_whileCounter < WScript.Arguments.Count
    str_parameter = UCASE (WScript.Arguments.Item(int_whileCounter))
    str_parameter = REPLACE (str_parameter, "/", "-")
    SELECT CASE str_parameter
CASE "-DAYS":
int_whileCounter = int_whileCounter + 1
int_numDays = CLNG(WScript.Arguments.Item(int_whileCounter))
CASE "-DISABLE":
bol_disable = True
        CASE "-FILE":
            bol_usefile = True
            int_whileCounter = int_whileCounter + 1
            sFileName = WScript.Arguments.Item(int_whileCounter)
        Case "-OU":
            bol_OU = True
            int_whileCounter = int_whileCounter + 1
            sOU = WScript.Arguments.Item(int_whileCounter)
CASE "-?":
Instructions()
CASE "-H":
Instructions()
CASE ELSE:
Instructions()
END SELECT
int_whileCounter = int_whileCounter + 1
WEND


If (bol_disable = TRUE) AND (bol_usefile = True) Then
int_numDays = 999
End If


IF (bol_disable = TRUE) AND (int_numDays < 30) THEN
    Instructions()
ELSEIF (int_numDays < 1) THEN
    Instructions()
END IF


wscript.echo "This script will process computer accounts older than " & int_numDays & " days."
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''


If bol_usefile = True Then
Set fso = CreateObject("Scripting.FileSystemObject")
If Err.number <> 0 Then
wscript.echo "Unable to create File System Object" & vbcrlf & Err.description
     Err.clear
     wscript.quit
End If


If bol_disable = True Then
Set oFile = fso.OpenTextFile(sFileName, 1)
     If Err.number <> 0 Then
wscript.echo "Unable to open source file: " & sFileName & vbcrlf & Err.description
     Err.clear
     wscript.quit
End If
strLine = oFile.readline
If Err.number <> 0 Then
wscript.echo "Unable to read source file: " & sFileName & vbcrlf & Err.description
     Err.clear
     wscript.quit
End If
Else
Set oFile = fso.CreateTextFile(sFileName, true)
     If Err.number <> 0 Then
wscript.echo "Unable to create source file: " & sFileName & vbcrlf & Err.description
     Err.clear
     wscript.quit
End If
     oFile.writeline "Distinquished Name" & "|" & "Password Last Set"
     If Err.number <> 0 Then
wscript.echo "Unable to write to file: " & sFileName & vbcrlf & Err.description
     Err.clear
     wscript.quit
End If
End if
End if


If (bol_disable = true) And (Len(sOU) > 0) Then
If UCase(Left(sOU, 4)) = "LDAP" Then
sOU = Mid(sOU, 8)
End If




Set objOU = GetObject("LDAP://" & sOU)
If Err.number <> 0 Then
wscript.echo "Unable to connect to the Disabled Systems OU: " & sOU & vbcrlf & Err.description
     Err.clear
     wscript.quit
End if
End if




If (bol_disable = True) And (bol_usefile = True) Then
do while oFile.AtEndofStream=False
strLine = oFile.readline
     arrLine = Split(strLine, "|")
str_DN = arrLine(0)
     SET obj_account = GETOBJECT("LDAP://" & str_DN)
IF err.number <> 0 THEN
            Wscript.Echo str_DN & " ; Unable to Connect"
            err.clear
     ELSE
            obj_account.AccountDisabled = TRUE
        IF err.number <> 0 THEN
                Wscript.Echo str_DN & " ; Unable set disabled flag"
                err.clear
        ELSE
                obj_account.setinfo
            IF err.number <> 0 THEN
                    Wscript.Echo str_DN & " ; Unable to Disable"
                    err.clear
            ELSE
                    Wscript.Echo str_DN & " ; Disabled"
                If bol_OU Then
                 Err.clear
                 Set NewObj = objOU.MoveHere("LDAP://" & str_DN, vbNullString)
                 If Err.number <> 0 Then
                     Wscript.Echo str_DN & " ; Unable to Move to " & "LDAP://" & str_DN
                 Else
                     Wscript.Echo str_DN & " ; Moved"
                 End If
                
                 Set NewObj = Nothing
                End if
            END IF
        END IF
    END IF
    SET obj_account = NOTHING


Loop
else
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Set the parameters necessary to query the Active Directory.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''


' Obtain local Time Zone bias from machine registry.
SET obj_shell = CREATEOBJECT("Wscript.Shell")
lng_biasKey = obj_shell.RegRead("HKLM\System\CurrentControlSet\Control\" & "TimeZoneInformation\ActiveTimeBias")
IF UCASE(TYPENAME(lng_biasKey)) = "LONG" THEN
    lng_bias = lng_biasKey
ELSEIF UCASE(TYPENAME(lng_biasKey)) = "VARIANT()" THEN
    lng_bias = 0
    FOR int_counterK = 0 TO UBOUND(lng_biasKey)
        lng_bias = lng_bias + (lng_biasKey(int_counterK) * 256^int_counterK)
    NEXT
END IF


' Determine DNS domain from Root DSE object.
SET obj_rootDSE = GETOBJECT("LDAP://RootDSE")
str_DNSDomain = obj_rootDSE.Get("defaultNamingContext")
wscript.echo "This script will process computer accounts from the following Active Directory domain: " & str_DNSDomain


' Use ADO to search Active Directory for all computers.
SET obj_command = CREATEOBJECT("ADODB.Command")
SET obj_connection = CREATEOBJECT("ADODB.Connection")
obj_connection.Provider = "ADsDSOObject"
obj_connection.Open "Active Directory Provider"
obj_command.ActiveConnection = obj_connection


' Search entire domain.
str_base = "<LDAP://" & str_DNSDomain & ">"


' Filter on computer objects.
str_filter = "(& (objectCategory=computer)(objectClass=computer))"


' Retrieve DN and lastLogon for all computers.
str_attributes = "distinguishedName,lastLogon,pwdLastSet"
str_query = str_base & ";" & str_filter & ";" & str_attributes & ";subtree"
obj_command.CommandText = str_query
obj_command.Properties("Page Size") = 100
obj_command.Properties("Timeout") = 60
obj_command.Properties("Cache Results") = FALSE
SET obj_recordSet = obj_command.Execute
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''












''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Each time this loop is run, a single computer account is processed and displayed.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
DO Until obj_recordSet.EOF
    str_DN = obj_recordSet.Fields("distinguishedName")
    lng_lastLogonDate = obj_recordSet.Fields("lastLogon")
    lng_passwordLastSetDate = obj_recordSet.Fields("pwdLastSet")
    
    Err.clear
    
    SET obj_date = lng_lastLogonDate






    IF Err.Number <> 0 THEN
        
        dtm_lastLogonDate = #1/1/1601#
        Err.clear
    ELSE
        
        lng_high = obj_date.HighPart
        lng_low = obj_date.LowPart
        IF lng_low < 0 THEN
            lng_high = lng_high + 1
        END IF
        
        IF (lng_high = 0) AND (lng_low = 0 ) THEN
            dtm_lastLogonDate = #1/1/1601#
        ELSE
            dtm_lastLogonDate = #1/1/1601# + (((lng_high * (2 ^ 32)) + lng_low)/600000000 - lng_bias)/1440
        END IF
    END IF


    Err.clear


    
    SET obj_date = lng_passwordLastSetDate






    IF Err.Number <> 0 THEN
        
        dtm_passwordLastSetDate = #1/1/1601#
        Err.clear
    ELSE
        
        lng_high = obj_date.HighPart
        lng_low = obj_date.LowPart
        IF lng_low < 0 THEN
            lng_high = lng_high + 1
        END IF
        IF (lng_high = 0) AND (lng_low = 0 ) THEN
            dtm_passwordLastSetDate = #1/1/1601#
        ELSE
            dtm_passwordLastSetDate = #1/1/1601# + (((lng_high * (2 ^ 32)) + lng_low)/600000000 - lng_bias)/1440
        END IF
    END IF






    ' Get the current time
    dtm_now = NOW()






    IF (bol_disable = FALSE) THEN ' the Disable option has NOT been specified.''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        IF (DATEDIFF ("D", dtm_passwordLastSetDate, dtm_now) > int_numDays) THEN
            Wscript.Echo str_DN & " ; " & dtm_lastLogonDate & " ; " & dtm_passwordLastSetDate
            If bol_Usefile = True then
oFile.writeline str_DN & "|" & dtm_passwordLastSetDate
            End if
        END IF
    ELSEIF DATEDIFF ("D", dtm_passwordLastSetDate, dtm_now) > int_numDays THEN ' the Disable option has been specified.'''''''''''''''''''
        err.clear
        SET obj_account = GETOBJECT("LDAP://" & str_DN)
        IF err.number <> 0 THEN
            Wscript.Echo str_DN & " ; " & dtm_lastLogonDate & " ; " & dtm_passwordLastSetDate & " ; Unable to Connect"
            err.clear
        ELSE
            obj_account.AccountDisabled = TRUE
            IF err.number <> 0 THEN
                Wscript.Echo str_DN & " ; " & dtm_lastLogonDate & " ; " & dtm_passwordLastSetDate & " ; Unable set disabled flag"
                err.clear
            ELSE
                obj_account.setinfo
                IF err.number <> 0 THEN
                    Wscript.Echo str_DN & " ; " & dtm_lastLogonDate & " ; " & dtm_passwordLastSetDate & " ; Unable to Disable"
                    err.clear
                ELSE
                    Wscript.Echo str_DN & " ; " & dtm_lastLogonDate & " ; " & dtm_passwordLastSetDate & " ; Disabled"
                    If bol_OU Then
                 Err.clear
                 Set NewObj = objOU.MoveHere("LDAP://" & str_DN, vbNullString)
                     If Err.number <> 0 Then
                     Wscript.Echo str_DN & " ; Unable to Move " & Err.description
                     Else
                     Wscript.Echo str_DN & " ; Moved"
                     End If
                     Set NewObj = Nothing
                    End if
                END IF
            END IF
        END IF
        SET obj_account = NOTHING
    END IF ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''






obj_recordSet.MoveNext


LOOP
' In the above, the "zero" date is displayed as 1/1/1601, and that value is
' necessary for this script to function properly.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
End if










''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub Instructions()
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    WScript.Echo                                                                                            vbNewLine &_
                                                                                                            vbNewLine &_
                                                                                                            vbNewLine &_
                                                                                                            vbNewLine &_
    "--------------------------------------------------------------------------------"                        & vbNewLine &_
    " Computer Account Age Reporter & Disabler "                        & vbNewLine &_
    "--------------------------------------------------------------------------------"                        & vbNewLine &_
    WScript.ScriptName &     " [-DAYS <n>] [-DISABLE] [-OU <OU>] [-FILE <fn>]"                         & vbNewLine &_
                                                                                                            vbNewLine &_
    "    -DAYS <n>    Display computer accounts that have not reset their domain password within n days."        & vbNewLine &_
    "                Note: n must be an integer, and must be at least 1."                                    & vbNewLine &_    
    "    -DISABLE    Disable computer accounts that have not reset their domain password within n days."        & vbNewLine &_
    "                Note: If this switch is used, n must be at least 30."                                    & vbNewLine &_
    "    -OU    <OU>    If disabling accounts, the -OU switch allows you to move the accounts to the specified"        & vbNewLine &_
    "                OU within the current domain.                        "                                    & vbNewLine &_
    "                Note: The OU must be specified in LDAP format. i.e. LDAP://OU=Disabled,CN=DOMAIN,CN=COM"    & vbNewLine &_
    "    -FILE <fn>    Specifies a source file to create if reporting, or a source file to use if disabling"        & vbNewLine &_
    "                computer accounts within the domain.                        "                                    & vbNewLine &_
    "                Note: This option should be used if disabling accounts in order to facilitiate QA. "    & vbNewLine &_
    "    -?, -H        Displays this help"                                                                        & vbNewLine &_
                                                                                                            vbNewLine &_
                                                                                                            vbNewLine &_
    "Usage considerations:"                                                                                    & vbNewLine &_
    "    * Due to the large amount of output, run this script from a command line and redirect to a file."    & vbNewLine &_
    "     example: cscript " & WScript.ScriptName & " -DAYS 100 > output.txt"                                & vbNewLine &_
    "    * The output from this script is semi-colen (;) delimited."                                            & vbNewLine &_
    "    * By default, a 2000/2003 Active Directory computer account will reset its password every 30 days." & vbNewLine &_
    WScript.Quit
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''










''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Clean up.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
obj_connection.Close
SET obj_rootDSE = Nothing
SET obj_connection = Nothing
SET obj_command = Nothing
SET obj_recordSet = Nothing
SET obj_date = Nothing
SET obj_shell = Nothing


WScript.Quit
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

1 comment: