Working with Object Access Control

  • Thread starter Thread starter Scott cooper
  • Start date Start date
S

Scott cooper

I am trying to understand and work with access control of AD objects. I used
a section of code from the SDK to help me but it generates an error when it
attempts to set the security descriptor for the object (with error control
turned off). There are some notes embedded as comments.

Thank you in advance.
Scott


'Code startes here:
Const ACL_REVISION_DS = &H4

Debug.Print SetRight(dsObject.ADsPath, _
ADS_RIGHT_READ_PROP Or ADS_RIGHT_WRITE_PROP, _
ADS_ACETYPE_ACCESS_ALLOWED_OBJECT, _
ADS_FLAG_OBJECT_TYPE_PRESENT, _
"{BF9679C0-0DE6-11D0-A285-00AA003049E2)", _
vbNullString, _
"aDomain\aUserAccount")

' With the error catch turned off, it will stop as it attempts to 'PUT' the
ntSecurityDescriptor. I have no ideas except that I
' noticed that the variables for newace are not showing up in Watches.
Public Function SetRight(objectAdsPath As String, _
accessrights As Long, _
accesstype As Long, _
aceinheritflags As Long, _
objectGUID As String, _
inheritedObjectGUID As String, _
trustee As String) As Boolean

Dim dsObject As IADs
Dim sd As IADsSecurityDescriptor
Dim dacl As IADsAccessControlList
Dim newace As New AccessControlEntry
Dim lflags As Long

On Error GoTo Cleanup

' Bind to the specified object.
Set dsObject = GetObject(objectAdsPath)

' Read the security descriptor on the object.
Set sd = dsObject.Get("ntSecurityDescriptor")

' Get the DACL from the security descriptor.
Set dacl = sd.DiscretionaryAcl

' Set the properties of the new ACE.
newace.AccessMask = accessrights
newace.AceType = accesstype
newace.AceFlags = aceinheritflags
newace.trustee = trustee

' Set the GUID for the object type or inherited object type.
lflags = 0

If Not objectGUID = vbNullString Then
newace.ObjectType = objectGUID
lflags = lflags Or &H1 'ADS_FLAG_OBJECT_TYPE_PRESENT
End If

If Not inheritedObjectGUID = vbNullString Then
newace.InheritedObjectType = inheritedObjectGUID
lflags = lflags Or &H2 'ADS_FLAG_INHERITED_OBJECT_TYPE_PRESENT
End If

If Not (lflags = 0) Then newace.Flags = lflags

' Set the ACL Revision
dacl.AclRevision = ACL_REVISION_DS

' Now add the ACE to the DACL and to the security descriptor.
dacl.AddAce newace
sd.DiscretionaryAcl = dacl

' Apply it to the object. This is where the error occurs.
' I have tried with and without Array command.
dsObject.Put "ntSecurityDescriptor", Array(sd)
dsObject.SetInfo
SetRight = True
Exit Function

Cleanup:
Set dsObject = Nothing
Set sd = Nothing
Set dacl = Nothing
Set newace = Nothing
SetRight = False

End Function
 
PS: ADS_RIGHT_READ_PROP Or ADS_RIGHT_WRITE_PROP should be
ADS_RIGHT_DS_READ_PROP Or ADS_RIGHT_DS_WRITE_PROP. Code still does not work.
 
OK, I got it work. The problem was an invalid peren type used in the
objectGUID. Thank you anyway.
 
Back
Top