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