' 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.