A good example of a useful real-world task is when you are curious to see what ACEs have been set on all objects below a container, such as a domain or Organizational Unit. Example 23-4 is a piece of code that can be used as the basis for checking through an Active Directory forest looking for irregularities.
This code also could be used on the root of Active Directory when dealing with the problem outlined in Section 11.3.3 in Chapter 11. The code is fairly simple but very long, due to the fact that it has to check every constant for both the SACL and DACL of each object.
On Error Resume Next '**************************************************************************** 'If the GUID corresponds to a schema object or attribute, then print the 'schema attribute/object name and the GUID. Otherwise just print the GUID. '**************************************************************************** Sub PrintGUID(ByVal objType) Dim strACEGUID, bolFound, intIndex '**************************************************************************** 'Convert a GUID that starts and ends with { } and has dashes within to a 'simple string of text '**************************************************************************** strACEGUID = Replace(Mid(objType,2,Len(objType)-2),"-","") '**************************************************************************** 'Scan the array of schema values for a matching GUID (after converting both 'GUIDs to uppercase first). If a GUID is found, the name is printed. '**************************************************************************** ts.WriteLine vbTab & vbTab & "GUID: " & objType For intIndex=0 To UBound(arrSchema,2) If (UCase(strACEGUID) = UCase(arrSchema(0,intIndex))) Then ts.WriteLine vbTab & vbTab & "Name: " & arrSchema(1,intIndex) End If Next End Sub '**************************************************************************** 'This function checks to see if the first integer value contains the constant 'passed in as the second integer value. If it does, then the third parameter 'is written out to the file, and the first value is decremented by the amount 'of the constant. '**************************************************************************** Sub CheckValue(ByRef lngValueToCheck, ByVal lngConstant, ByVal strConstantName) If ((lngValueToCheck And lngConstant) = lngConstant) Then ts.WriteLine vbTab & strConstantName lngValueToCheck = lngValueToCheck Xor lngConstant Else lngValueToCheck = lngValueToCheck End If End Sub '************************************************************************** 'AccessMask constants '************************************************************************** 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_SYSTEM_SECURITY = &H1000000 Const ADS_RIGHT_SYNCHRONIZE = &H100000 Const ADS_RIGHT_WRITE_OWNER = &H80000 Const ADS_RIGHT_WRITE_DAC = &H40000 Const ADS_RIGHT_READ_CONTROL = &H20000 Const ADS_RIGHT_DELETE = &H10000 Const ADS_RIGHT_DS_CONTROL_ACCESS = &H100 Const ADS_RIGHT_DS_LIST_OBJECT = &H80 Const ADS_RIGHT_DS_DELETE_TREE = &H40 Const ADS_RIGHT_DS_WRITE_PROP = &H20 Const ADS_RIGHT_DS_READ_PROP = &H10 Const ADS_RIGHT_DS_SELF = &H8 Const ADS_RIGHT_ACTRL_DS_LIST = &H4 Const ADS_RIGHT_DS_DELETE_CHILD = &H2 Const ADS_RIGHT_DS_CREATE_CHILD = &H1 Const FULL_CONTROL = -1 '************************************************************************** 'AceType constants '************************************************************************** Const ADS_ACETYPE_SYSTEM_AUDIT_OBJECT = &H7 Const ADS_ACETYPE_ACCESS_DENIED_OBJECT = &H6 Const ADS_ACETYPE_ACCESS_ALLOWED_OBJECT = &H5 Const ADS_ACETYPE_SYSTEM_AUDIT = &H2 Const ADS_ACETYPE_ACCESS_DENIED = &H1 Const ADS_ACETYPE_ACCESS_ALLOWED = &H0 '************************************************************************** 'AceFlags constants '************************************************************************** Const ADS_ACEFLAG_FAILED_ACCESS = &H80 Const ADS_ACEFLAG_SUCCESSFUL_ACCESS = &H40 Const ADS_ACEFLAG_VALID_INHERIT_FLAGS = &H1F Const ADS_ACEFLAG_INHERITED_ACE = &H10 Const ADS_ACEFLAG_INHERIT_ONLY_ACE = &H8 Const ADS_ACEFLAG_NO_PROPAGATE_INHERIT_ACE = &H4 Const ADS_ACEFLAG_INHERIT_ACE = &H2 '************************************************************************** 'Security Descriptor constants '************************************************************************** Const ADS_SD_CONTROL_SE_OWNER_DEFAULTED = &H1 Const ADS_SD_CONTROL_SE_GROUP_DEFAULTED = &H2 Const ADS_SD_CONTROL_SE_DACL_PRESENT = &H4 Const ADS_SD_CONTROL_SE_DACL_DEFAULTED = &H8 Const ADS_SD_CONTROL_SE_SACL_PRESENT = &H10 Const ADS_SD_CONTROL_SE_SACL_DEFAULTED = &H20 Const ADS_SD_CONTROL_SE_DACL_AUTO_INHERIT_REQ = &H100 Const ADS_SD_CONTROL_SE_SACL_AUTO_INHERIT_REQ = &H200 Const ADS_SD_CONTROL_SE_DACL_AUTO_INHERITED = &H400 Const ADS_SD_CONTROL_SE_SACL_AUTO_INHERITED = &H800 Const ADS_SD_CONTROL_SE_DACL_PROTECTED = &H1000 Const ADS_SD_CONTROL_SE_SACL_PROTECTED = &H2000 '************************************************************************** 'Flags constants '************************************************************************** Const ADS_FLAG_INHERITED_OBJECT_TYPE_PRESENT = &H2 Const ADS_FLAG_OBJECT_TYPE_PRESENT = &H1 '**************************************************************************** 'Two example paths. You need to specify your own path here in the constant or 'obtain it from an argument to the script or an InputBox. '**************************************************************************** 'Const LDAP_PATH = "LDAP://cn=Mike Felmeri,ou=Sales,dc=amer,dc=mycorp,dc=com" 'Const LDAP_PATH = "LDAP://dc=amer,dc=mycorp,dc=com" Const SCHEMA_ROOT="LDAP://cn=Schema,cn=Configuration,dc=mycorp,dc=com" ' ********************************************************************** ' Opens a file, and lets you start writing from the beginning of the ' file. ' ********************************************************************** Const ForWriting = 2 ' ********************************************************************** ' Sets the location of the temporary file ' ********************************************************************** Const TEMPFILE = "C:\SD-LIST-TEMP.TXT" '**************************************************************************** 'Declare the variables '**************************************************************************** Dim objUser, objSecDesc, objSecDescControl, objACE, objDACL Dim objSACL, objACEAccessMask, objACEAceType, objACEAceFlags Dim lngBeforeChange, intCount, fso, ts, strCriteria, objObject Dim arrSchema( ), objSchema, intIndex '**************************************************************************** 'Fill an array with GUIDs and CNs from all the objects in the schema. As we 'don't know the maximum number of elements in advance, the array is gradually 'redimensioned (i.e., has its size increased) each time we wish to add a new value. ' 'So, if there are 4,000 values in the schema, then the array will look like 'this: ' ' arrSchema(0,0) = 1st schema object GUID ' arrSchema(1,0) = 1st schema object cn ' arrSchema(0,1) = 2nd schema object GUID ' arrSchema(1,1) = 2nd schema object cn ' arrSchema(0,2) = 3rd schema object GUID ' arrSchema(1,2) = 3rd schema object cn ' etc. ' arrSchema(0,3999) = 4,000th schema object GUID ' arrSchema(1,3999) = 4,000th schema object cn ' 'UBound(arrSchema,1) gives the max-size of the first dimension (i.e., 1) 'UBound(arrSchema,2) gives the max-size of the second dimension (i.e., 3999) '**************************************************************************** Set objSchema = GetObject(SCHEMA_ROOT) intIndex = 0 For Each objObject in objSchema 'Increase the size of the array while preserving values ReDim Preserve arrSchema(1,intIndex) arrSchema(0,intIndex) = objObject.GUID 'Set the name to be everything except the "cn=" on the front arrSchema(1,intIndex) = Right(objObject.cn, Len(objObject.Name)-3) intIndex = intIndex + 1 Next '********************************************************************** 'Opens the temporary text file for writing. If the text file already 'exists, overwrite it. '********************************************************************** Set fso = CreateObject("Scripting.FileSystemObject") Set ts = fso.OpenTextFile(TEMPFILE, ForWriting, True) '**************************************************************************** 'Get the security descriptor of the object '**************************************************************************** Set objObject = GetObject(LDAP_PATH) Set objSecDesc = objObject.Get("nTSecurityDescriptor") '**************************************************************************** 'Write out the SD general information '**************************************************************************** ts.WriteLine "------------------------------------------------------------------" ts.WriteLine "SD revision is: " & objSecDesc.Revision ts.WriteLine "SD Owner is: " & objSecDesc.Owner ts.WriteLine "SD Group is: " & objSecDesc.Group ts.WriteLine "SD GroupDefaulted is: " & objSecDesc.GroupDefaulted ts.WriteLine "SD OwnerDefaulted is: " & objSecDesc.OwnerDefaulted ts.WriteLine "SD DaclDefaulted is: " & objSecDesc.DaclDefaulted ts.WriteLine "SD SaclDefaulted is: " & objSecDesc.SaclDefaulted ts.WriteLine "------------------------------------------------------------------" '**************************************************************************** 'Write out the SD control flags '**************************************************************************** ts.WriteLine "SD Control is: " objSecDescControl = objSecDesc.Control CheckValue objSecDescControl, ADS_SD_CONTROL_SE_SELF_RELATIVE, _ "The SD is held in a contiguous block of memory." CheckValue objSecDescControl, ADS_SD_CONTROL_SE_SACL_PROTECTED, "The SACL of " _ & "the SD is protected and will not be modified when new rights propagate " _ & "through the tree." CheckValue objSecDescControl, ADS_SD_CONTROL_SE_DACL_PROTECTED, "The DACL of " _ & "the SD is protected and will not be modified when new rights propagate " _ & "through the tree." CheckValue objSecDescControl, ADS_SD_CONTROL_SE_SACL_AUTO_INHERITED, "The SACL" _ & " of the SD supports auto-propagation of inheritable ACEs to existing " _ & " child objects." CheckValue objSecDescControl, ADS_SD_CONTROL_SE_DACL_AUTO_INHERITED, "The DACL" _ & " of the SD supports auto-propagation of inheritable ACEs to existing " _ & "child objects." CheckValue objSecDescControl, ADS_SD_CONTROL_SE_SACL_AUTO_INHERIT_REQ, "The " _ & "SACL of the SD must be inherited." CheckValue objSecDescControl, ADS_SD_CONTROL_SE_DACL_AUTO_INHERIT_REQ, "The " _ & "DACL of the SD must be inherited." CheckValue objSecDescControl, ADS_SD_CONTROL_SE_SACL_DEFAULTED, "The ACL " _ & "pointed to by the SystemAcl field was provided by the default mechanism " _ & "rather than explicitly set by the person or application that created the " _ & "SD in the first place." CheckValue objSecDescControl, ADS_SD_CONTROL_SE_SACL_PRESENT, "The security " _ & "descriptor contains a SACL." CheckValue objSecDescControl, ADS_SD_CONTROL_SE_DACL_DEFAULTED, "The " _ & "DiscretionaryAcl field was provided by the default mechanism rather than " _ & "explicitly set by the person or application that created the SD in the " _ & "first place." CheckValue objSecDescControl, ADS_SD_CONTROL_SE_DACL_PRESENT, "The security " _ & "descriptor contains a DACL." CheckValue objSecDescControl, ADS_SD_CONTROL_SE_GROUP_DEFAULTED, "The SID in " _ & "the Group field was provided by the default mechanism rather than " _ & "explicitly set by the person or application that created the SD in the " _ & "first place." CheckValue objSecDescControl, ADS_SD_CONTROL_SE_OWNER_DEFAULTED, "The SID " _ & "pointed to by the Owner field was provided by the default mechanism " _ & "rather than set by the person or application that created the SD in the " _ & "first place." '**************************************************************************** 'Write out the DACL general information '**************************************************************************** Set objDACL = objSecDesc.DiscretionaryAcl 'Permissions List ts.WriteLine "-----------------" ts.WriteLine "-----------------" ts.WriteLine "Discretionary ACL" ts.WriteLine "-----------------" ts.WriteLine "-----------------" ts.WriteLine "There are " & objDACL.AceCount & " ACEs in the DACL." ts.WriteLine "DACL revision is: " & objDACL.AclRevision intCount = 1 For Each objACE In objDACL ts.WriteLine "----------------------------------------------------------------" ts.WriteLine "ACE Trustee " & intCount & " of " & objDACL.AceCount & " is: " _ & objACE.Trustee '**************************************************************************** 'Write out the ACEType details '**************************************************************************** objACEAceType = objACE.AceType ts.WriteLine "AceType: " If (objACEAceType <> 0) Then CheckValue objACEAceType, ADS_ACETYPE_SYSTEM_AUDIT_OBJECT, "This is a " _ & "System Audit Entry ACE using a GUID" CheckValue objACEAceType, ADS_ACETYPE_ACCESS_DENIED_OBJECT, "This is an " _ & "Access Denied ACE using a GUID" CheckValue objACEAceType, ADS_ACETYPE_ACCESS_ALLOWED_OBJECT, "This is an " _ & "Access Allowed ACE using a GUID." CheckValue objACEAceType, ADS_ACETYPE_SYSTEM_AUDIT, "This is a System " _ & "Audit Entry ACE using a Windows NT Security Descriptor." CheckValue objACEAceType, ADS_ACETYPE_ACCESS_DENIED, "This is an Access " _ & "Denied ACE using a Windows NT Security Descriptor." Else ts.WriteLine vbTab & "This is an Access Allowed ACE using a Windows NT " _ & "Security Descriptor." End If '**************************************************************************** 'Write out the AccessMask details '**************************************************************************** objACEAccessMask = objACE.AccessMask ts.WriteLine "Access Mask: " If objACEAccessMask = FULL_CONTROL Then ts.WriteLine vbTab & "Full Control" ElseIf (objACEAccessMask <> 0) Then CheckValue objACEAccessMask, ADS_RIGHT_GENERIC_READ, "Right to read from " _ & "the security descriptor, to examine the object and its children, and " _ & "to read all properties." CheckValue objACEAccessMask, ADS_RIGHT_GENERIC_WRITE, "Right to write all " _ & "properties and write to the DACL. User can also add/remove the " _ & "object from the tree." CheckValue objACEAccessMask, ADS_RIGHT_GENERIC_EXECUTE, "Right to list " _ & "children of the object." CheckValue objACEAccessMask, ADS_RIGHT_GENERIC_ALL, "Right to " _ & "create/delete children, delete the tree, read/write properties, " _ & "examine the object and its children, add/remove the object from the " _ & "tree, and read/write with an extended right." CheckValue objACEAccessMask, ADS_RIGHT_ACCESS_SYSTEM_SECURITY, "The right " _ & "to get or set the SACL in the SD of the object." CheckValue objACEAccessMask, ADS_RIGHT_SYNCHRONIZE, "The right to use the " _ & "object for synchronization." CheckValue objACEAccessMask, ADS_RIGHT_WRITE_OWNER, "Right to assume " _ & "ownership of the object; no right to grant ownership to others. " _ & "[User must be a trustee of the object]." CheckValue objACEAccessMask, ADS_RIGHT_WRITE_DAC, "Right to write to the " _ & "DACL of the object." CheckValue objACEAccessMask, ADS_RIGHT_READ_CONTROL, "Right to read from " _ & "the security descriptor of the object." CheckValue objACEAccessMask, ADS_RIGHT_DELETE, "Right to delete the object." lngBeforeChange = objACEAccessMask CheckValue objACEAccessMask, ADS_RIGHT_DS_CONTROL_ACCESS, "Right to " _ & "perform an application specific extension on the object." If (objACEAccessMask <> lngBeforeChange) Then PrintGUID objACE.ObjectType End If CheckValue objACEAccessMask, ADS_RIGHT_DS_LIST_OBJECT, "Right to examine " _ & "the object. [If this is missing the object is hidden from the user]." CheckValue objACEAccessMask, ADS_RIGHT_DS_DELETE_TREE, "Right to delete " _ & "all children of this object, regardless of the permission on the " _ & "children." lngBeforeChange = objACEAccessMask CheckValue objACEAccessMask, ADS_RIGHT_DS_WRITE_PROP, "Right to write " _ & "properties of the object." If (objACEAccessMask <> lngBeforeChange) Then If objACE.ObjectType = "" Then ts.WriteLine vbTab & vbTab & "All properties can be written." Else PrintGUID objACE.ObjectType End If End If lngBeforeChange = objACEAccessMask CheckValue objACEAccessMask, ADS_RIGHT_DS_READ_PROP, "Right to read " _ & "properties of the object." If (objACEAccessMask <> lngBeforeChange) Then If objACE.ObjectType = "" Then ts.WriteLine vbTab & vbTab & "All properties can be read." Else PrintGUID objACE.ObjectType End If End If CheckValue objACEAccessMask, ADS_RIGHT_DS_SELF, "Right to modify the " _ & "group membership of a group object." CheckValue objACEAccessMask, ADS_RIGHT_ACTRL_DS_LIST, "Right to examine " _ & "children of the object." lngBeforeChange = objACEAccessMask CheckValue objACEAccessMask, ADS_RIGHT_DS_DELETE_CHILD, "Right to delete " _ & "children of the object" If (objACEAccessMask <> lngBeforeChange) Then If objACE.ObjectType = "" Then ts.WriteLine vbTab & vbTab & "All Children inherit this right." Else PrintGUID objACE.ObjectType End If End If lngBeforeChange = objACEAccessMask CheckValue objACEAccessMask, ADS_RIGHT_DS_CREATE_CHILD, "Right to create " _ & "children of the object" If (objACEAccessMask <> lngBeforeChange) Then If objACE.ObjectType = "" Then ts.WriteLine vbTab & vbTab & "All Children inherit this right." Else PrintGUID objACE.ObjectType End If End If Else ts.WriteLine vbTab & "ACE Access Mask is 0, therefore no permissions " _ & "exist for this ACE!" End If '**************************************************************************** 'Write out the ACEFlags details '**************************************************************************** objACEAceFlags = objACE.AceFlags ts.WriteLine "ACEFlags: " If (objACEAceFlags <> 0) Then CheckValue objACEAceFlags, ADS_ACEFLAG_FAILED_ACCESS, "SACL: Generates " _ & "audit messages for failed access attempts." CheckValue objACEAceFlags, ADS_ACEFLAG_SUCCESSFUL_ACCESS, "SACL: " _ & "Generates audit messages for successful access attempts." CheckValue objACEAceFlags, ADS_ACEFLAG_VALID_INHERIT_FLAGS, "Indicates " _ & "whether the inherit flags are valid. [Set only by the system]." CheckValue objACEAceFlags, ADS_ACEFLAG_INHERITED_ACE, "Indicates whether " _ & "or not the ACE was inherited. [Set only by the system]." CheckValue objACEAceFlags, ADS_ACEFLAG_INHERIT_ONLY_ACE, "Indicates an " _ & "inherit-only ACE that does not exercise access controls on the " _ & "object to which it is attached." CheckValue objACEAceFlags, ADS_ACEFLAG_NO_PROPAGATE_INHERIT_ACE, "Child " _ & "objects will not inherit this ACE." CheckValue objACEAceFlags, ADS_ACEFLAG_INHERIT_ACE, "Child objects will " _ & "inherit this ACE." Else ts.WriteLine vbTab & "ACE is not inherited by children." End If '**************************************************************************** 'Write out the Flags details '**************************************************************************** ts.WriteLine "Flags: " If (objACE.Flags = 0) Then ts.WriteLine vbTab & "Object Type and Inherited Object Type aren't present." ElseIf (objACE.Flags = ADS_FLAG_INHERITED_OBJECT_TYPE_PRESENT) Then ts.WriteLine vbTab & "Inherited Object Type present: " PrintGUID objACE.InheritedObjectType ElseIf (objACE.Flags = ADS_FLAG_OBJECT_TYPE_PRESENT) Then ts.WriteLine vbTab & "Object Type present: " PrintGUID objACE.ObjectType ElseIf (objACE.Flags = (ADS_FLAG_OBJECT_TYPE_PRESENT + _ ADS_FLAG_INHERITED_OBJECT_TYPE_PRESENT)) Then 'Both present, so print the GUIDs ts.WriteLine vbTab & "Inherited Object Type present: " PrintGUID objACE.InheritedObjectType ts.WriteLine vbTab & "Object Type present: " PrintGUID objACE.ObjectType End If intCount = intCount + 1 Next '**************************************************************************** 'Write out the SACL general information '**************************************************************************** Set objSACL = objSecDesc.SystemAcl 'System Auditing List ts.WriteLine "----------" ts.WriteLine "----------" ts.WriteLine "System ACL" ts.WriteLine "----------" ts.WriteLine "----------" ts.WriteLine "There are " & objSACL.AceCount & " ACEs in the SACL." ts.WriteLine "SACL revision is: " & objSACL.AclRevision intCount = 1 For Each objACE In objSACL ts.WriteLine "----------------------------------------------------------------" ts.WriteLine "ACE Trustee " & intCount & " of " & objSACL.AceCount & " is: " _ & objACE.Trustee '**************************************************************************** 'Add the ACEType, AccessMask, ACEFlags, and Flags code here from the preceding. 'The code has been cut to save wasting space by duplicating it in the book. 'You could even move the entire section of code to a Sub rather than including 'it twice. '**************************************************************************** intCount = intCount + 1 Next ts.WriteLine "------------------------------------------------------------------" ts.Close MsgBox "End!"