Auditing userAccountControl with VbScript

This VbScript searches the current domain for all users with “User cannot change password”, “Password never expires”, or “Trusted for delegation” set, the results of the search are written to a tab delimited text file.

' UserAccountControl.vbs
'
' Script to report User Account Control Flag usage within the current domain. '
' Author: Chris Dent
' Modified: 06/03/2008

Option Explicit

Const REPORT_FILE = "Users.txt"

' userAccountControl flag values
Const ADS_UF_PASSWD_CANT_CHANGE = &H40
Const ADS_UF_DONT_EXPIRE_PASSWD = &H10000
Const ADS_UF_TRUSTED_FOR_DELEGATION = &H80000

Const ADS_SCOPE_SUBTREE = 2
Const ADS_ACETYPE_ACCESS_DENIED_OBJECT = &H6

Const CHANGE_PASSWORD_GUID = "{ab721a53-1e2f-11d0-9819-00aa0040529b}"

'
' Main Code
'

Dim objFileSystem, objFile, objConnection, objCommand
Dim objRootDSE, objRecordSet, objUser
Dim objSD, objDACL, objACE
Dim strPwdCantChange, strPwdDontExpire, strTrustedForDelegation
Dim strDisplayName, strUsername, strDN
Dim intUAC 
Dim booList

' Create report file
Set objFileSystem = CreateObject("Scripting.FileSystemObject")
Set objFile = objFileSystem.OpenTextFile(REPORT_FILE, 2, True, 0)

' Write header
objFile.WriteLine "Display Name" & VbTab & "Username" & VbTab & _
    "Distinguished Name" & VbTab & "Password Cannot Change" & _
    VbTab & "Password Never Expires" & VbTab & "Trusted for Delegation"
    
Set objConnection = CreateObject("ADODB.Connection")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"

Set objCommand = CreateObject("ADODB.Command")
objCommand.ActiveConnection = objConnection

' Configure search
Set objRootDSE = GetObject("LDAP://RootDSE")
objCommand.CommandText = "SELECT displayName, distinguishedName, " & _
    "sAMAccountName, userAccountControl, nTSecurityDescriptor FROM 'LDAP://" & _
    objRootDSE.Get("defaultNamingContext") & _
    "' WHERE objectClass='user' AND objectCategory='person'"
Set objRootDSE = Nothing

objCommand.Properties("Page Size") = 1000
objCommand.Properties("Timeout") = 600
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
objCommand.Properties("Cache Results") = False

Set objRecordSet = objCommand.Execute

While Not objRecordSet.EOF
    strPwdCantChange = "False" : strPwdDontExpire = "False"
    strTrustedForDelegation = "False"
    booList = False
    
    intUAC = objRecordSet.Fields("userAccountControl")
    ' Check for Password Cannot Change Flag
    Set objUser = GetObject("LDAP://" & objRecordSet.Fields("distinguishedName"))
    
    Set objSD = objUser.Get("nTSecurityDescriptor")
    Set objDACL = objSD.DiscretionaryAcl
    For Each objACE in objDACL
        If objACE.AceType = ADS_ACETYPE_ACCESS_DENIED_OBJECT And _
            LCase(objACE.ObjectType) = CHANGE_PASSWORD_GUID Then 
            
            strPwdCantChange = "True" : booList = True
            Exit For
        End If
    Next
    Set objDACL = Nothing
    Set objSD = Nothing
    
    Set objUser = Nothing
    
    ' Check for password never expires
    If intUAC And ADS_UF_DONT_EXPIRE_PASSWD Then
        strPWDDontExpire = "True" : booList = True
    End If
    
    ' Check for trusted for delegation
    If intUAC And ADS_UF_TRUSTED_FOR_DELEGATION Then
        strTrustedForDelegation = "True" : booList = True
    End If
    
    If booList = True Then
        strDisplayName = objRecordSet.Fields("displayName")
        strUsername = objRecordSet.Fields("sAMAccountName")
        strDN = objRecordSet.Fields("distinguishedName")
        
        objFile.WriteLine strDisplayName & VbTab & strUsername & VbTab & _
            strDN & VbTab & strPwdCantChange & VbTab & strPwdDontExpire & _
            VbTab & strTrustedForDelegation
    End If
    
    objRecordSet.MoveNext
Wend

objConnection.Close

Set objRecordSet = Nothing
Set objCommand = Nothing
Set objConnection = Nothing