Displaying Security on Active Directory, Exchange, and Registry Objects
Originally published July 19, 2006
A common request is “how do I determine what security applies to a given [user | mailbox | registry value]”?
The attached script shows you how to do that. None of this is unique to me, I just put it together in a pretty little script. Most of the script can be found on MSDN, except for the mailbox bits, which can be found via google groups on the Microsoft Exchange newsgroups.
This script could easily be modified to also support the display of file ACLs. But that's a common piece of code, so I didn't add it in.
As a bonus, however, I've included the real working version of ReorderDACL() that deal with inherited as well as explicit ACEs properly.
Note: ADsSecurityUtility is part of Windows Server 2003. If you want to run this on Windows 2000 Server, you'll need to install the Windows SDK.
Enjoy!
Option Explicit
'On Error Resume Next
Dim obj ' The object we are messing with
Dim objSD ' The Security Descriptor for obj
Dim iKind ' What kind of object we are messing with
Const KIND_AD = 1 ' active directory object
Const KIND_REG = 2 ' registry object
Const KIND_MB = 3 ' mailbox object
'
' Define ADS_RIGHTS_ENUM constants:
'
const ADS_RIGHT_DELETE = &h10000
const ADS_RIGHT_READ_CONTROL = &h20000
const ADS_RIGHT_WRITE_DAC = &h40000
const ADS_RIGHT_WRITE_OWNER = &h80000
const ADS_RIGHT_SYNCHRONIZE = &h100000
const ADS_RIGHT_ACCESS_SYSTEM_SECURITY = &h1000000
const ADS_RIGHT_GENERIC_READ = &h80000000
const ADS_RIGHT_GENERIC_WRITE = &h40000000
const ADS_RIGHT_GENERIC_EXECUTE = &h20000000
const ADS_RIGHT_GENERIC_ALL = &h10000000
const ADS_RIGHT_DS_CREATE_CHILD = &h1
const ADS_RIGHT_DS_DELETE_CHILD = &h2
const ADS_RIGHT_ACTRL_DS_LIST = &h4
const ADS_RIGHT_DS_SELF = &h8
const ADS_RIGHT_DS_READ_PROP = &h10
const ADS_RIGHT_DS_WRITE_PROP = &h20
const ADS_RIGHT_DS_DELETE_TREE = &h40
const ADS_RIGHT_DS_LIST_OBJECT = &h80
const ADS_RIGHT_DS_CONTROL_ACCESS = &h100
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'
' Ace Type definitions
'
const ADS_ACETYPE_ACCESS_ALLOWED = 0
const ADS_ACETYPE_ACCESS_DENIED = &h1
const ADS_ACETYPE_SYSTEM_AUDIT = &h2
const ADS_ACETYPE_ACCESS_ALLOWED_OBJECT = &h5
const ADS_ACETYPE_ACCESS_DENIED_OBJECT = &h6
const ADS_ACETYPE_SYSTEM_AUDIT_OBJECT = &h7
Const ADS_ACETYPE_SYSTEM_ALARM_OBJECT = &h8
'
' Ace Flag Constants
'
const ADS_ACEFLAG_UNKNOWN = &h1
const ADS_ACEFLAG_INHERIT_ACE = &h2
const ADS_ACEFLAG_NO_PROPAGATE_INHERIT_ACE = &h4
const ADS_ACEFLAG_INHERIT_ONLY_ACE = &h8
const ADS_ACEFLAG_INHERITED_ACE = &h10
const ADS_ACEFLAG_VALID_INHERIT_FLAGS = &h1f
const ADS_ACEFLAG_SUCCESSFUL_ACCESS = &h40
const ADS_ACEFLAG_FAILED_ACCESS = &h80
'
' Flags constants for AD objects
'
const ADS_FLAG_OBJECT_TYPE_PRESENT = &h1
const ADS_FLAG_INHERITED_OBJECT_TYPE_PRESENT = &h2
'
' ADS_PATHTYPE_ENUM
'
Const ADS_PATH_FILE = 1
Const ADS_PATH_FILESHARE = 2
Const ADS_PATH_REGISTRY = 3
'
' ADS_SD_FORMAT_ENUM
'
Const ADS_SD_FORMAT_IID = 1
Const ADS_SD_FORMAT_RAW = 2
Const ADS_SD_FORMAT_HEXSTRING = 3
'
' Mailbox Specific Permissions
'
Const ACE_MB_FULL_ACCESS = &h1
Const ACE_MB_SEND_AS = &h2
Const ACE_MB_ASSOC_EXT_ACCT = &h4 ' This was from stucki and was 5, really should be 4
Const ACE_MB_DELETE_STORAGE = &h10000 ' ADS_RIGHT_DELETE
Const ACE_MB_READ_PERMISSIONS = &h20000 ' ADS_RIGHT_READ_CONTROL
Const ACE_MB_CHANGE_PERMISSIONS = &h40000 ' ADS_RIGHT_WRITE_DAC
Const ACE_MB_TAKE_OWNERSHIP = &h80000 ' ADS_RIGHT_WRITE_OWNER
Const ACE_MB_SYNCHRONIZE = &h100000 ' ADS_RIGHT_SYNCHRONIZE
'
' From WinNT.h
'---------------------------------------------------------------------------
'
' File Specific Access Rights
'
Const DELETE = &h00010000
Const READ_CONTROL = &h00020000
Const WRITE_DAC = &h00040000
Const WRITE_OWNER = &h00080000
Const SYNCHRONIZE = &h00100000
Const STANDARD_RIGHTS_REQUIRED = &h000F0000
Dim STANDARD_RIGHTS_READ : STANDARD_RIGHTS_READ = READ_CONTROL
Dim STANDARD_RIGHTS_WRITE : STANDARD_RIGHTS_WRITE = READ_CONTROL
Dim STANDARD_RIGHTS_EXECUTE: STANDARD_RIGHTS_EXECUTE = READ_CONTROL
Const STANDARD_RIGHTS_ALL = &h001F0000
Const SPECIFIC_RIGHTS_ALL = &h0000FFFF
'
' AccessSystemAcl access type
'
Const ACCESS_SYSTEM_SECURITY = &h01000000
'
' MaximumAllowed access type
'
Const MAXIMUM_ALLOWED = &h02000000
'
' These are the generic rights.
'
Const GENERIC_READ = &h80000000
Const GENERIC_WRITE = &h40000000
Const GENERIC_EXECUTE = &h20000000
Const GENERIC_ALL = &h10000000
'
' AccessMask constants for FILE ACEs
'
Const FILE_READ_DATA = &h0001 ' file & pipe
Const FILE_LIST_DIRECTORY = &h0001 ' directory
Const FILE_WRITE_DATA = &h0002 ' file & pipe
Const FILE_ADD_FILE = &h0002 ' directory
Const FILE_APPEND_DATA = &h0004 ' file
Const FILE_ADD_SUBDIRECTORY = &h0004 ' directory
Const FILE_CREATE_PIPE_INSTANCE = &h0004 ' named pipe
Const FILE_READ_EA = &h0008 ' file & directory
Const FILE_WRITE_EA = &h0010 ' file & directory
Const FILE_EXECUTE = &h0020 ' file
Const FILE_TRAVERSE = &h0020 ' directory
Const FILE_DELETE_CHILD = &h0040 ' directory
Const FILE_READ_ATTRIBUTES = &h0080 ' all
Const FILE_WRITE_ATTRIBUTES = &h0100 ' all
Dim FILE_ALL_ACCESS : FILE_ALL_ACCESS = STANDARD_RIGHTS_REQUIRED Or SYNCHRONIZE Or &h1FF
Dim FILE_GENERIC_READ : FILE_GENERIC_READ = STANDARD_RIGHTS_READ Or _
FILE_READ_DATA Or _
FILE_READ_ATTRIBUTES Or _
FILE_READ_EA Or _
SYNCHRONIZE
Dim FILE_GENERIC_WRITE : FILE_GENERIC_WRITE = STANDARD_RIGHTS_WRITE Or _
FILE_WRITE_DATA Or _
FILE_WRITE_ATTRIBUTES Or _
FILE_WRITE_EA Or _
FILE_APPEND_DATA Or _
SYNCHRONIZE
Dim FILE_GENERIC_EXECUTE : FILE_GENERIC_EXECUTE = STANDARD_RIGHTS_EXECUTE Or _
FILE_READ_ATTRIBUTES Or _
FILE_EXECUTE Or _
SYNCHRONIZE
Const FILE_SHARE_READ = &h00000001
Const FILE_SHARE_WRITE = &h00000002
Const FILE_SHARE_DELETE = &h00000004
'
' AceFlags values for files
'
Const OBJECT_INHERIT_ACE = &H1
Const CONTAINER_INHERIT_ACE = &H2
Const NO_PROPAGATE_INHERIT_ACE = &H4
Const INHERIT_ONLY_ACE = &H8
Const INHERITED_ACE = &H10
'
' Registry specific access rights
'
Const KEY_QUERY_VALUE = &H0001
Const KEY_SET_VALUE = &H0002
Const KEY_CREATE_SUB_KEY = &H0004
Const KEY_ENUMERATE_SUB_KEYS = &H0008
Const KEY_NOTIFY = &H0010
Const KEY_CREATE_LINK = &H0020
Const KEY_WOW64_32KEY = &H0200
Const KEY_WOW64_64KEY = &H0100
Const KEY_WOW64_RES = &H0300
'Const DELETE = &H00010000
'Const READ_CONTROL = &H00020000
'Const WRITE_DAC = &H00040000
'Const WRITE_OWNER = &H00080000
Dim KEY_READ 'access mask designating read access to registry key
Dim KEY_WRITE 'access mask designating write access to registry key
Dim KEY_EXECUTE 'access mask designating execute access to registry key (same as KEY_READ)
Dim KEY_ALL_ACCESS 'access mask designating full access to registry key
KEY_READ = ((STANDARD_RIGHTS_READ Or _
KEY_QUERY_VALUE Or _
KEY_ENUMERATE_SUB_KEYS Or _
KEY_NOTIFY) And _
(Not SYNCHRONIZE))
KEY_WRITE = ((STANDARD_RIGHTS_WRITE Or _
KEY_SET_VALUE Or _
KEY_CREATE_SUB_KEY) And _
(Not SYNCHRONIZE))
KEY_EXECUTE = ((KEY_READ) And _
(Not SYNCHRONIZE))
KEY_ALL_ACCESS = ((STANDARD_RIGHTS_ALL Or _
KEY_QUERY_VALUE Or _
KEY_SET_VALUE Or _
KEY_CREATE_SUB_KEY Or _
KEY_ENUMERATE_SUB_KEYS Or _
KEY_NOTIFY Or _
KEY_CREATE_LINK) And _
(Not SYNCHRONIZE))
' Subroutine to reorder a DACL
' Comments in the subroutine explain how the DACL should be ordered.
' The IADsAccessControlList::AddAce method makes no attempt to properly
' order the ACE being added.
'
Sub ReorderDACL (objDACL, bBreakInheritance)
Dim objACE
Dim objNewDACL
Dim objImpDenyDACL
Dim objImpAllowDACL
Dim objImpDenyObjectDACL
Dim objImpAllowObjectDACL
Dim objInheritedDACL
'
' Initialize all of the new ACLs
'
' VBS methods of creating the ACL bins
'
Set objNewDACL = CreateObject ("AccessControlList")
Set objImpDenyDACL = CreateObject ("AccessControlList")
Set objImpAllowDACL = CreateObject ("AccessControlList")
Set objInheritedDACL = CreateObject ("AccessControlList")
Set objImpDenyObjectDACL = CreateObject ("AccessControlList")
Set objImpAllowObjectDACL = CreateObject ("AccessControlList")
If bBreakInheritance Then
For Each objACE In objDACL
If ((objACE.AceFlags AND ADS_ACEFLAG_INHERITED_ACE) = ADS_ACEFLAG_INHERITED_ACE) Then
objACE.AceFlags = objACE.AceFlags Xor ADS_ACEFLAG_INHERITED_ACE
End If
Next
End If
'
' Sift the DACL into 5 bins:
' Inherited Aces
' Implicit Deny Aces
' Implicit Deny Object Aces
' Implicit Allow Aces
' Implicit Allow object aces
'
For Each objACE In objDACL
'
' Sort the original ACEs into their appropriate
' ACLs
'
If ((objACE.AceFlags And ADS_ACEFLAG_INHERITED_ACE) = ADS_ACEFLAG_INHERITED_ACE) Then
'
' Don't really care about the order of inherited aces. Since we are
' adding them to the top of a new list, when they are added back
' to the DACL for the object, they will be in the same order as
' they were originally. Just a positive side affect of adding items
' of a LIFO ( Last In First Out) type list.
'
objInheritedDACL.AddAce objACE
Else
'
' We have an Implicit ACE, lets put it the proper pool
'
Select Case objACE.AceType
Case ADS_ACETYPE_ACCESS_ALLOWED
'
' We have an implicit allow ace
'
objImpAllowDACL.AddAce objACE
Case ADS_ACETYPE_ACCESS_DENIED
'
' We have a implicit Deny ACE
'
objImpDenyDACL.AddAce objACE
Case ADS_ACETYPE_ACCESS_ALLOWED_OBJECT
'
' We have an object allowed ace
' Does it apply to a property? or an Object?
'
objImpAllowObjectDACL.AddAce objACE
Case ADS_ACETYPE_ACCESS_DENIED_OBJECT
'
' We have a object Deny ace
'
objImpDenyObjectDACL.AddAce objACE
Case Else
'
' Missed a bin?
'
wscript.echo "***ALERT: bad objACE.AceType in ReorderDACL: " & objACE.AceType
End Select
End If
Next
'
' Combine the ACEs in the proper order
' Implicit Deny
' Implicit Deny Object
' Implicit Allow
' Implicit Allow Object
' Inherited aces
'
' Implicit Deny
'
For Each objACE In objImpDenyDACL
objNewDACL.AddAce objACE
Next
'
' Implicit Deny Object
'
For Each objACE In objImpDenyObjectDACL
objNewDACL.AddAce objACE
Next
'
' Implicit Allow
'
For Each objACE In objImpAllowDACL
objNewDACL.AddAce objACE
Next
'
' Implicit Allow Object
'
For Each objACE In objImpAllowObjectDACL
objNewDACL.AddAce objACE
Next
'
' Inherited Aces
'
For Each objACE In objInheritedDACL
objNewDACL.AddAce objACE
Next
'
' Clean up
'
Set objInheritedDACL = Nothing
Set objImpAllowDACL = Nothing
Set objImpDenyObjectDACL = Nothing
Set objImpDenyDACL = Nothing
'
' Set the appropriate revision level
' for the DACL
'
objNewDACL.AclRevision = objDACL.AclRevision
'
' Replace the Security Descriptor
'
Set objDACL = Nothing
Set objDACL = objNewDACL
End Sub
Function strAceType (iAceType)
Dim str
Select Case iAceType
Case ADS_ACETYPE_ACCESS_ALLOWED
'Implicit Allow ACE
str = "ACCESS_ALLOWED"
Case ADS_ACETYPE_ACCESS_DENIED
'Implicit Deny ACE
str = "ACCESS_DENIED"
Case ADS_ACETYPE_ACCESS_ALLOWED_OBJECT
'Object Allowed ACE
str = "ACCESS_ALLOWED_OBJECT"
Case ADS_ACETYPE_ACCESS_DENIED_OBJECT
'Object Deny ACE
str = "ACCESS_DENIED_OBJECT"
Case Else
'Unknown AceType
str = "Unknown AceType: " & iAceType
End Select
str = str & " (0x" & Hex (iAceType) & ")"
strAceType = str
End Function
Function strAceFlags (iOffset, iAceFlags)
Dim str
Dim iMask
iMask = 0
str = "ACE Flags:" & Space (iOffset - Len ("ACE Flags:"))
If (iAceFlags AND ADS_ACEFLAG_VALID_INHERIT_FLAGS) = iAceFlags Then
str = str & "ADS_ACEFLAG_VALID_INHERIT_FLAGS"
Else
str = str & "SACL AceFlags are present"
End If
str = str & " (0x" & Hex (iAceFlags) & ")"
If (iAceFlags AND ADS_ACEFLAG_INHERIT_ACE) Then
str = str & vbCrLf & Space (iOffset)
str = str & "ADS_ACEFLAG_INHERIT_ACE"
iMask = iMask Or ADS_ACEFLAG_INHERIT_ACE
End If
If (iAceFlags AND ADS_ACEFLAG_NO_PROPAGATE_INHERIT_ACE) Then
str = str & vbCrLf & Space (iOffset)
str = str & "ADS_ACEFLAG_NO_PROPAGATE_INHERIT_ACE"
iMask = iMask Or ADS_ACEFLAG_NO_PROPAGATE_INERHIT_ACE
End If
If (iAceFlags AND ADS_ACEFLAG_INHERIT_ONLY_ACE) Then
str = str & vbCrLf & Space (iOffset)
str = str & "ADS_ACEFLAG_INHERIT_ONLY_ACE"
iMask = iMask Or ADS_ACEFLAG_INHERIT_ONLY_ACE
End If
If (iAceFlags AND ADS_ACEFLAG_INHERITED_ACE) Then
str = str & vbCrLf & Space (iOffset)
str = str & "ADS_ACEFLAG_INHERITED_ACE"
iMask = iMask Or ADS_ACEFLAG_INHERITED_ACE
End If
If (iAceFlags AND ADS_ACEFLAG_SUCCESSFUL_ACCESS) Then
str = str & vbCrLf & Space (iOffset)
str = str & "ADS_ACEFLAG_SUCCESSFUL_ACCESS"
iMask = iMask Or ADS_ACEFLAG_SUCCESSFUL_ACCESS
End If
If (iAceFlags AND ADS_ACEFLAG_FAILED_ACCESS) Then
str = str & vbCrLf & Space (iOffset)
str = str & "ADS_ACEFLAG_FAILED_ACCESS"
iMask = iMask Or ADS_ACEFLAG_FAILED_ACCESS
End If
If (iAceFlags AND ADS_ACEFLAG_UNKNOWN) Then
str = str & vbCrLf & Space (iOffset)
str = str & "ADS_ACEFLAG_UNKNOWN/OBJECT_INHERIT_OBJECT"
iMask = iMask Or ADS_ACEFLAG_UNKNOWN
End If
If iAceFlags <> iMask Then
str = str & vbCrLf & Space (iOffset) & "Mismatched AceFlags. Known = " & Hex (iMask) _
& " Unknown = " & Hex (iAceFlags)
End If
strAceFlags = str
End Function
'///////////////////////////////////////////////////////////////////
'/// Name: RegDisplayDACL
'/// Purpose: Displaying Discretionary Access Control List entries for registry object named strTarget
'///////////////////////////////////////////////////////////////////
Sub RegDisplayDACL (strTarget, objDACL)
Dim objAce 'object representing individual ACE
Dim sMsg, sAccessMask 'strings containing message to be displayed
Dim iCalcMask 'number representing Access Mask value
Dim iAccessMask 'the AccessMask value
Dim iOffset : iOffset = 20
WScript.Echo "Permissions on registry item " & strTarget
For Each objAce in objDACL
sMsg = vbCrLf & "Trustee:" & Space (iOffset - Len ("Trustee:")) & objAce.Trustee & vbCrLf
sMsg = sMsg & "ACE Type:" & Space (iOffset - Len ("ACE Type:"))
sMsg = sMsg & strAceType (objAce.AceType)
Wscript.Echo sMsg
sAccessMask = ""
iCalcMask = 0
iAccessMask = objAce.AccessMask
If (iAccessMask AND KEY_QUERY_VALUE) Then
sAccessMask = Space (iOffset) & "KEY_QUERY_VALUE" & vbCrLf
iCalcMask = iCalcMask Or KEY_QUERY_VALUE
End If
If (iAccessMask AND KEY_SET_VALUE) Then
sAccessMask = sAccessMask & Space (iOffset) & "KEY_SET_VALUE" & vbCrLf
iCalcMask = iCalcMask Or KEY_SET_VALUE
End If
If (iAccessMask AND KEY_CREATE_SUB_KEY) Then
sAccessMask = sAccessMask & Space (iOffset) & "KEY_CREATE_SUB_KEY" & vbCrLf
iCalcMask = iCalcMask Or KEY_CREATE_SUB_KEY
End If
If (iAccessMask AND KEY_ENUMERATE_SUB_KEYS) Then
sAccessMask = sAccessMask & Space (iOffset) & "KEY_ENUMERATE_SUB_KEYS" & vbCrLf
iCalcMask = iCalcMask Or KEY_ENUMERATE_SUB_KEYS
End If
If (iAccessMask AND KEY_NOTIFY) Then
sAccessMask = sAccessMask & Space (iOffset) & "KEY_NOTIFY" & vbCrLf
iCalcMask = iCalcMask Or KEY_NOTIFY
End If
If (iAccessMask AND KEY_CREATE_LINK) Then
sAccessMask = sAccessMask & Space (iOffset) & "KEY_CREATE_LINK" & vbCrLf
iCalcMask = iCalcMask Or KEY_CREATE_LINK
End If
If (iAccessMask AND DELETE) Then
sAccessMask = sAccessMask & Space (iOffset) & "DELETE" & vbCrLf
iCalcMask = iCalcMask Or DELETE
End If
If (iAccessMask AND READ_CONTROL) Then
sAccessMask = sAccessMask & Space (iOffset) & "READ_CONTROL" & vbCrLf
iCalcMask = iCalcMask Or READ_CONTROL
End If
If (iAccessMask AND WRITE_DAC) Then
sAccessMask = sAccessMask & Space (iOffset) & "WRITE_DAC" & vbCrLf
iCalcMask = iCalcMask Or WRITE_DAC
End If
If (iAccessMask AND WRITE_OWNER) Then
sAccessMask = sAccessMask & Space (iOffset) & "WRITE_OWNER" & vbCrLf
iCalcMask = iCalcMask Or WRITE_OWNER
End If
If (iAccessMask And GENERIC_READ) Then
sAccessMask = sAccessMask & Space (iOffset) & "GENERIC_READ" & vbCrLf
iCalcMask = iCalcMask Or GENERIC_READ
End If
If (iAccessMask And GENERIC_WRITE) Then
sAccessMask = sAccessMask & Space (iOffset) & "GENERIC_WRITE" & vbCrLf
iCalcMask = iCalcMask Or GENERIC_WRITE
End If
If (iAccessMask And GENERIC_EXECUTE) Then
sAccessMask = sAccessMask & Space (iOffset) & "GENERIC_EXECUTE" & vbCrLf
iCalcMask = iCalcMask Or GENERIC_EXECUTE
End If
If (iAccessMask And GENERIC_ALL) Then
sAccessMask = sAccessMask & Space (iOffset) & "GENERIC_ALL" & vbCrLf
iCalcMask = iCalcMask Or GENERIC_ALL
End If
sAccessMask = Left (sAccessMask, Len (sAccessMask) - 2)
sMsg = "ACE Permissions:" & Space (iOffset - Len ("ACE Permissions:"))
Select Case iCalcMask
Case KEY_ALL_ACCESS
Wscript.Echo sMsg & "FULL CONTROL"
Case KEY_WRITE
Wscript.Echo sMsg & "WRITE"
Case KEY_READ
Wscript.Echo sMsg & "READ/EXECUTE"
Case GENERIC_READ
Wscript.Echo sMsg & "GENERIC_READ"
Case GENERIC_WRITE
Wscript.Echo sMsg & "GENERIC_WRITE"
Case GENERIC_EXECUTE
Wscript.Echo sMsg & "GENERIC_EXECUTE"
Case GENERIC_ALL
Wscript.Echo sMsg & "GENERIC_ALL"
Case Else
If iAccessMask <> iCalcMask Then
WScript.Echo sMsg & iAccessMask & " 0x" & Hex (iAccessMask) & " <> " & Hex (iCalcMask)
Else
WScript.Echo sMsg & "Special Permissions"
End If
WScript.Echo sAccessMask
End Select
If iAccessMask <> iCalcMask Then
sMsg = Space (iOffset) & "Mismatched AccessMask. Known = " & Hex (iCalcMask) _
& " Unknown = " & Hex (iAccessMask)
wscript.echo sMsg
End If
sMsg = strAceFlags (iOffset, objAce.AceFlags)
WScript.Echo sMsg
Next
wscript.echo " "
End Sub
'///////////////////////////////////////////////////////////////////
'/// Name: ADDisplayDACL
'/// Purpose: Displaying Discretionary Access Control List entries for active directory object named strTarget
'///////////////////////////////////////////////////////////////////
Sub ADDisplayDACL (strTarget, objDACL)
Dim objACE
Dim sDisplayText
Dim sMsg, sAccessMask
Dim iCalcMask, iAccessMask
Dim iOffset : iOffset = 20
WScript.Echo "Permissions on Active Directory object " & strTarget
For Each objACE In objDACL
sMsg = vbCrLf & "Trustee:" & Space (iOffset - Len ("Trustee:")) & objAce.Trustee & vbCrLf
sMsg = sMsg & "ACE Type:" & Space (iOffset - Len ("ACE Type:"))
sMsg = sMsg & strAceType (objAce.AceType)
Wscript.Echo sMsg
sAccessMask = ""
iCalcMask = 0
iAccessMask = objAce.AccessMask
If (iAccessMask And ADS_RIGHT_DELETE) Then
sAccessMask = sAccessMask & Space (iOffset) & "Delete" & vbCrLf
iCalcMask = iCalcMask Or ADS_RIGHT_DELETE
End If
If (iAccessMask And ADS_RIGHT_READ_CONTROL) Then
sAccessMask = sAccessMask & Space (iOffset) & "Read Control" & vbCrLf
iCalcMask = iCalcMask Or ADS_RIGHT_READ_CONTROL
End If
If (iAccessMask And ADS_RIGHT_WRITE_DAC) Then
sAccessMask = sAccessMask & Space (iOffset) & "Write DAC" & vbCrLf
iCalcMask = iCalcMask Or ADS_RIGHT_WRITE_DAC
End If
If (iAccessMask And ADS_RIGHT_WRITE_OWNER) Then
sAccessMask = sAccessMask & Space (iOffset) & "Write Owner" & vbCrLf
iCalcMask = iCalcMask Or ADS_RIGHT_WRITE_OWNER
End If
If (iAccessMask And ADS_RIGHT_SYNCHRONIZE) Then
sAccessMask = sAccessMask & Space (iOffset) & "Synchronize" & vbCrLf
iCalcMask = iCalcMask Or ADS_RIGHT_SYNCHRONIZE
End If
If (iAccessMask And ADS_RIGHT_ACCESS_SYSTEM_SECURITY) Then
sAccessMask = sAccessMask & Space (iOffset) & "Access System Security" & vbCrLf
iCalcMask = iCalcMask Or ADS_RIGHT_ACCESS_SYSTEM_SECURITY
End If
If (iAccessMask And ADS_RIGHT_GENERIC_READ) Then
sAccessMask = sAccessMask & Space (iOffset) & "GENERIC_READ" & vbCrLf
iCalcMask = iCalcMask Or ADS_RIGHT_GENERIC_READ
End If
If (iAccessMask And ADS_RIGHT_GENERIC_WRITE) Then
sAccessMask = sAccessMask & Space (iOffset) & "GENERIC_WRITE" & vbCrLf
iCalcMask = iCalcMask Or ADS_RIGHT_GENERIC_WRITE
End If
If (iAccessMask And ADS_RIGHT_GENERIC_EXECUTE) Then
sAccessMask = sAccessMask & Space (iOffset) & "GENERIC_EXECUTE" & vbCrLf
iCalcMask = iCalcMask Or ADS_RIGHT_GENERIC_EXECUTE
End If
If (iAccessMask And ADS_RIGHT_GENERIC_ALL) Then
sAccessMask = sAccessMask & Space (iOffset) & "GENERIC_ALL" & vbCrLf
iCalcMask = iCalcMask Or ADS_RIGHT_GENERIC_ALL
End If
If (iAccessMask And ADS_RIGHT_DS_CREATE_CHILD) Then
sAccessMask = sAccessMask & Space (iOffset) & "DS Create Child" & vbCrLf
iCalcMask = iCalcMask Or ADS_RIGHT_DS_CREATE_CHILD
End If
If (iAccessMask And ADS_RIGHT_DS_DELETE_CHILD) Then
sAccessMask = sAccessMask & Space (iOffset) & "DS Delete Child" & vbCrLf
iCalcMask = iCalcMask Or ADS_RIGHT_DS_DELETE_CHILD
End If
If (iAccessMask And ADS_RIGHT_ACTRL_DS_LIST) Then
sAccessMask = sAccessMask & Space (iOffset) & "List Contents" & vbCrLf
iCalcMask = iCalcMask Or ADS_RIGHT_ACTRL_DS_LIST
End If
If (iAccessMask And ADS_RIGHT_DS_SELF) Then
sAccessMask = sAccessMask & Space (iOffset) & "DS Self" & vbCrLf
iCalcMask = iCalcMask Or ADS_RIGHT_DS_SELF
End If
If (iAccessMask And ADS_RIGHT_DS_READ_PROP) Then
sAccessMask = sAccessMask & Space (iOffset) & "Read All Properties" & vbCrLf
iCalcMask = iCalcMask Or ADS_RIGHT_DS_READ_PROP
End If
If (iAccessMask And ADS_RIGHT_DS_WRITE_PROP) Then
sAccessMask = sAccessMask & Space (iOffset) & "Write All Properties" & vbCrLf
iCalcMask = iCalcMask Or ADS_RIGHT_DS_WRITE_PROP
End If
If (iAccessMask And ADS_RIGHT_DS_DELETE_TREE) Then
sAccessMask = sAccessMask & Space (iOffset) & "Delete Subtree" & vbCrLf
iCalcMask = iCalcMask Or ADS_RIGHT_DS_DELETE_TREE
End If
If (iAccessMask And ADS_RIGHT_DS_LIST_OBJECT) Then
sAccessMask = sAccessMask & Space (iOffset) & "DS List Object" & vbCrLf
iCalcMask = iCalcMask Or ADS_RIGHT_DS_LIST_OBJECT
End If
If (iAccessMask And ADS_RIGHT_DS_CONTROL_ACCESS) Then
sAccessMask = sAccessMask & Space (iOffset) & "DS Control Access" & vbCrLf
iCalcMask = iCalcMask Or ADS_RIGHT_DS_CONTROL_ACCESS
End If
sAccessMask = Left (sAccessMask, Len (sAccessMask) - 2)
sMsg = "ACE Permissions:" & Space (iOffset - Len ("ACE Permissions:"))
WScript.Echo sMsg & "Special Permissions" & " (0x" & Hex (iAccessMask) & ")"
WScript.Echo sAccessMask
If iAccessMask <> iCalcMask Then
sMsg = Space (iOffset) & "Mismatched AccessMask. Known = " & Hex (iCalcMask) _
& " Unknown = " & Hex (iAccessMask)
wscript.echo sMsg
End If
sMsg = strAceFlags (iOffset, objAce.AceFlags)
WScript.Echo sMsg
Next
wscript.echo " "
End Sub
Sub ExchDisplayDACL (strTarget, objDACL)
Dim objACE
Dim accessstr, accessmask, leftoveram, acetypestr, acetype, aceflags, aceflagstr
Dim sMsg, sAccessMask
Dim iCalcMask, iAccessMask
Dim iOffset : iOffset = 20
Wscript.echo "Permissions on mailbox of " & strTarget
For Each objACE In objDACL
sMsg = vbCrLf & "Trustee:" & Space (iOffset - Len ("Trustee:")) & objAce.Trustee & vbCrLf
sMsg = sMsg & "ACE Type:" & Space (iOffset - Len ("ACE Type:"))
sMsg = sMsg & strAceType (objAce.AceType)
Wscript.Echo sMsg
sAccessMask = ""
iCalcMask = 0
iAccessMask = objAce.AccessMask
If (iAccessMask And ACE_MB_FULL_ACCESS) Then
sAccessMask = sAccessMask & Space (iOffset) & "Full mailbox access" & vbCrLf
iCalcMask = iCalcMask Or ACE_MB_FULL_ACCESS
End If
If (iAccessMask And ACE_MB_ASSOC_EXT_ACCT) Then
sAccessMask = sAccessMask & Space (iOffset) & "Associated external account" & vbCrLf
iCalcMask = iCalcMask Or ACE_MB_ASSOC_EXT_ACCT
End If
If (iAccessMask And ACE_MB_DELETE_STORAGE) Then
sAccessMask = sAccessMask & Space (iOffset) & "Delete mailbox storage" & vbCrLf
iCalcMask = iCalcMask Or ACE_MB_DELETE_STORAGE
End If
If (iAccessMask And ACE_MB_READ_PERMISSIONS) Then
sAccessMask = sAccessMask & Space (iOffset) & "Read permissions" & vbCrLf
iCalcMask = iCalcMask Or ACE_MB_READ_PERMISSIONS
End If
If (iAccessMask And ACE_MB_CHANGE_PERMISSIONS) Then
sAccessMask = sAccessMask & Space (iOffset) & "Change permissions" & vbCrLf
iCalcMask = iCalcMask Or ACE_MB_CHANGE_PERMISSIONS
End If
If (iAccessMask And ACE_MB_TAKE_OWNERSHIP) Then
sAccessMask = sAccessMask & Space (iOffset) & "Take ownership" & vbCrLf
iCalcMask = iCalcMask Or ACE_MB_TAKE_OWNERSHIP
End If
If (iAccessMask And ACE_MB_SYNCHRONIZE) Then
sAccessMask = sAccessMask & Space (iOffset) & "Synchronize" & vbCrLf
iCalcMask = iCalcMask Or ACE_MB_SYNCHRONIZE
End If
If (iAccessMask And ACE_MB_SEND_AS) Then
sAccessMask = sAccessMask & Space (iOffset) & "Send As" & vbCrLf
iCalcMask = iCalcMask Or ACE_MB_SEND_AS
End If
sAccessMask = Left (sAccessMask, Len (sAccessMask) - 2)
sMsg = "ACE Permissions:" & Space (iOffset - Len ("ACE Permissions:"))
WScript.Echo sMsg & "Special Permissions" & " (0x" & Hex (iAccessMask) & ")"
WScript.Echo sAccessMask
If iAccessMask <> iCalcMask Then
sMsg = Space (iOffset) & "Mismatched AccessMask. Known = " & Hex (iCalcMask) _
& " Unknown = " & Hex (iAccessMask)
wscript.echo sMsg
End If
sMsg = strAceFlags (iOffset, objAce.AceFlags)
WScript.Echo sMsg
Next
End Sub
Dim objADS
set objADS = CreateObject ("ADsSecurityUtility")
set obj = getobject ("LDAP://CN=Michael B. Smith,CN=Users,DC=brnets,DC=int")
set objSD = obj.Get ("ntSecurityDescriptor")
Call ADDisplayDACL ("Michael B. Smith", objSD.DiscretionaryACL)
set obj = Nothing
set obj = objADS.GetSecurityDescriptor ("HKEY_LOCAL_MACHINE\Software\Microsoft", ADS_PATH_REGISTRY, ADS_SD_FORMAT_IID)
Call RegDisplayDACL ("HKLM\Software\Microsoft", obj.DiscretionaryACL)
set obj = Nothing
set objADS = Nothing
set obj = getobject ("LDAP://CN=Michael B. Smith,CN=Users,DC=brnets,DC=int")
set objSD = obj.MailboxRights
Call ExchDisplayDACL ("Michael B. Smith", objSD.DiscretionaryACL)
set obj = Nothing