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

No related posts.

Related posts brought to you by Yet Another Related Posts Plugin.

Respond to this post