Creating the ADObjectManagement Class Module
Creating the ADObjectManagement Class Module
In this section, you will begin an exercise that will ultimately yield the creation of the ADAdmin.DLL COM server.
Exercise 12.1 Creating the ADAdmin.DLL COM Server Application: The ADObject Management Module.
-
Create a new ActiveX DLL Visual Basic project.
-
Set a reference to the Active DS Type Library by clicking the Project menu, selecting References, and placing a checkmark next to the "Active DS Type Library" entry. Click the OK command button to exit the ReferencesProject1 dialog box.
-
Rename Project1 as ADAdmin .
-
Rename the Class1 class module as ADObjectManagement .
-
Enter the following code into the General Declarations section of the class module:
Public Function RootDSEntries(ByVal PropertyName As String) As Variant On Error Resume Next Dim RootDSE As IADs Dim RetVal As Variant Dim RetArray() As Variant Dim i As Long Set RootDSE = GetObject("LDAP://RootDSE") RetVal = RootDSE.Get(PropertyName) If IsArray(RetVal) Then For Each Item In RetVal i = UBound(RetArray) + 1 ReDim Preserve RetArray(i) RetArray(i) = PropertyName & ": " & Item Next RootDSEntries = RetArray Else RootDSEntries = PropertyName & ": " & RootDSE.Get(PropertyName) End If End Function Public Function EnumerateContainer(ByVal ObjectClass As String, ByVal ;RelativePathToObject As String) As Variant On Error Resume Next Dim RootDSE As IADs Dim UserContainer As IADsContainer Dim User As IADs Dim RetArray() As Variant Dim i As Long Dim Obj As Variant Set RootDSE = GetObject("LDAP://RootDSE") Set UserContainer = GetObject("LDAP://" & RelativePathToObject &
RootDSE.Get("DefaultNamingContext")) UserContainer.Filter = Array(ObjectClass) For Each Obj In UserContainer i = UBound(RetArray) + 1 ReDim Preserve RetArray(i) RetArray(i) = Obj.Name Next EnumerateContainer = RetArray End Function Public Function RemoveADObject(ByVal RelativePathToObject As String, ByVal ObjectClass As String, ByVal ObjectRelativeName As String) As Boolean Dim RootDSE As IADs Dim Container As IADsContainer Set RootDSE = GetObject("LDAP://RootDSE") Set Container = GetObject("LDAP://" & RelativePathToObject & RootDSE.Get("DefaultNamingContext")) Call Container.Delete(ObjectClass, ObjectRelativeName) If Err.Number = 0 Then RemoveADObject = True End Function Public Function DeleteADBranch(ByVal RelativePathToObject As String) As Boolean Dim RootDSE As IADs Dim Container As IADsDeleteOps Set RootDSE = GetObject("LDAP://RootDSE") Set Container = GetObject("LDAP://" & RelativePathToObject & RootDSE.Get("DefaultNamingContext")) Container.DeleteObject (0) If Err.Number = 0 Then DeleteADBranch = True End Function Public Function MoveRenameADObject(ByVal RelativePathToNewLocation As String, ByVal OriginalObjectRelativePath As String, Optional ByVal NewObjectName As String) As Boolean Dim RootDSE As IADs Dim Container As IADsContainer Set RootDSE = GetObject("LDAP://RootDSE") Set Container = GetObject("LDAP://" & RelativePathToNewLocation & RootDSE.Get("DefaultNamingContext")) If NewObjectName = "" Then NewObjectName = vbNullString Call Container.MoveHere(OriginalObjectRelativePath, NewObjectName) If Err.Number = 0 Then MoveRenameADObject = True End Function Public Function RemoveADACE(ByVal RelativeObjectPath As String, ByVal TrusteeToRemove As String) As Boolean Dim Obj As IADs Dim ACE As AccessControlEntry Dim DACL As AccessControlList Dim SecurityDescriptor As Variant Dim RootDSE As IADs Set RootDSE = GetObject("LDAP://RootDSE") Set Obj = GetObject("LDAP://" & RelativeObjectPath & RootDSE.Get("DefaultNamingContext")) Set SecurityDescriptor = Obj.Get("ntSecurityDescriptor") Set DACL = SecurityDescriptor.DiscretionaryACL For Each ACE In DACL If UCase(ACE.Trustee) = UCase(TrusteeToRemove) Then DACL.RemoveAce ACE End If Next SecurityDescriptor.DiscretionaryACL = DACL Obj.Put "ntSecurityDescriptor", Array(SecurityDescriptor) Obj.SetInfo If Err.Number = 0 Then RemoveADACE = True End Function Public Function EnumerateAclAces(ByVal RelativeObjectPath As String) As Variant On Error Resume Next Dim Obj As IADs Dim RootDSE As IADs Dim ACE As AccessControlEntry Dim DiscretionaryACL As AccessControlList Dim SecurityDescriptor As Variant Dim ObjectDistinguishedName As String Dim RetArray() As Variant Dim i As Long Set RootDSE = GetObject("LDAP://RootDSE") Set Obj = GetObject("LDAP://" & RelativeObjectPath & RootDSE.Get("DefaultNamingContext")) Set SecurityDescriptor = Obj.Get("ntSecurityDescriptor") Set DiscretionaryACL = SecurityDescriptor.DiscretionaryACL i = 1 For Each ACE In DiscretionaryACL i = UBound(RetArray) + 1 ReDim Preserve RetArray(i) RetArray(i) = ACE.Trustee If (ACE.AccessMask And ADS_RIGHT_DELETE) <> 0 Then If (ACE.ObjectType = "" And ACE.InheritedObjectType = "") Then i = UBound(RetArray) + 1 ReDim Preserve RetArray(i) RetArray(i) = vbTab & "ADS_RIGHT_DELETE" Else If ACE.InheritedObjectType = "" Then i = UBound(RetArray) + 1 ReDim Preserve RetArray(i) RetArray(i) = vbTab & "ADS_RIGHT_DELETE for SchemaIDGuid: " & ACE.ObjectType Else i = UBound(RetArray) + 1 ReDim Preserve RetArray(i) RetArray(i) = vbTab & "Inherited ADS_RIGHT_DELETE for SchemaIDGuid: " & ACE.InheritedObjectType End If End If End If If (ACE.AccessMask And ADS_RIGHT_READ_CONTROL) <> 0 Then If (ACE.ObjectType = "" And ACE.InheritedObjectType = "") Then i = UBound(RetArray) + 1 ReDim Preserve RetArray(i) RetArray(i) = vbTab & "ADS_RIGHT_READ_CONTROL" Else If ACE.InheritedObjectType = "" Then i = UBound(RetArray) + 1 ReDim Preserve RetArray(i) RetArray(i) = vbTab & "ADS_RIGHT_READ_CONTROL for SchemaIDGuid: " & ACE.ObjectType Else i = UBound(RetArray) + 1 ReDim Preserve RetArray(i) RetArray(i) = vbTab & "Inherited ADS_RIGHT_READ_CONTROL for SchemaIDGuid: " & ACE.InheritedObjectType End If End If End If If (ACE.AccessMask And ADS_RIGHT_WRITE_DAC) <> 0 Then If (ACE.ObjectType = "" And ACE.InheritedObjectType = "") Then i = UBound(RetArray) + 1 ReDim Preserve RetArray(i) RetArray(i) = vbTab & "ADS_RIGHT_WRITE_DAC" Else If ACE.InheritedObjectType = "" Then i = UBound(RetArray) + 1 ReDim Preserve RetArray(i) RetArray(i) = vbTab & "ADS_RIGHT_WRITE_DAC for SchemaIDGuid: " & ACE.ObjectType Else i = UBound(RetArray) + 1 ReDim Preserve RetArray(i) RetArray(i) = vbTab & "Inherited ADS_RIGHT_WRITE_DAC for SchemaIDGuid: " & ACE.InheritedObjectType End If End If End If If (ACE.AccessMask And ADS_RIGHT_WRITE_OWNER) <> 0 Then If (ACE.ObjectType = "" And ACE.InheritedObjectType = "") Then i = UBound(RetArray) + 1 ReDim Preserve RetArray(i) RetArray(i) = vbTab & "ADS_RIGHT_WRITE_OWNER" Else If ACE.InheritedObjectType = "" Then i = UBound(RetArray) + 1 ReDim Preserve RetArray(i) RetArray(i) = vbTab & "ADS_RIGHT_WRITE_OWNER for SchemaIDGuid: " & ACE.ObjectType Else i = UBound(RetArray) + 1 ReDim Preserve RetArray(i) RetArray(i) = vbTab & "Inherited ADS_RIGHT_WRITE_OWNER for SchemaIDGuid: " & ACE.InheritedObjectType End If End If End If If (ACE.AccessMask And ADS_RIGHT_SYNCHRONIZE) <> 0 Then If (ACE.ObjectType = "" And ACE.InheritedObjectType = "") Then i = UBound(RetArray) + 1 ReDim Preserve RetArray(i) RetArray(i) = vbTab & "ADS_RIGHT_SYNCHRONIZE" Else If ACE.InheritedObjectType = "" Then i = UBound(RetArray) + 1 ReDim Preserve RetArray(i) RetArray(i) = vbTab & "ADS_RIGHT_SYNCHRONIZE for SchemaIDGuid: " & ACE.ObjectType Else i = UBound(RetArray) + 1 ReDim Preserve RetArray(i) RetArray(i) = vbTab & "Inherited ADS_RIGHT_SYNCHRONIZE for SchemaIDGuid: " & ACE.InheritedObjectType End If End If End If If (ACE.AccessMask And ADS_RIGHT_ACCESS_SYSTEM_SECURITY) <> 0 Then If (ACE.ObjectType = "" And ACE.InheritedObjectType = "") Then i = UBound(RetArray) + 1 ReDim Preserve RetArray(i) RetArray(i) = vbTab & "ADS_RIGHT_ACCESS_SYSTEM_SECURITY" Else If ACE.InheritedObjectType = "" Then i = UBound(RetArray) + 1 ReDim Preserve RetArray(i) RetArray(i) = vbTab & "ADS_RIGHT_ACCESS_SYSTEM_SECURITY for SchemaIDGuid: " & ACE.ObjectType Else i = UBound(RetArray) + 1 ReDim Preserve RetArray(i) RetArray(i) = vbTab & "Inherited ADS_RIGHT_ACCESS_SYSTEM_SECURITY for SchemaIDGuid: " & ACE.InheritedObjectType End If End If End If If (ACE.AccessMask And ADS_RIGHT_GENERIC_READ) <> 0 Then If (ACE.ObjectType = "" And ACE.InheritedObjectType = "") Then i = UBound(RetArray) + 1 ReDim Preserve RetArray(i) RetArray(i) = vbTab & "ADS_RIGHT_GENERIC_READ" Else If ACE.InheritedObjectType = "" Then i = UBound(RetArray) + 1 ReDim Preserve RetArray(i) RetArray(i) = vbTab & "ADS_RIGHT_GENERIC_READ for SchemaIDGuid: " & ACE.ObjectType Else i = UBound(RetArray) + 1 ReDim Preserve RetArray(i) RetArray(i) = vbTab & "Inherited ADS_RIGHT_GENERIC_READ for SchemaIDGuid: " & ACE.InheritedObjectType End If End If End If If (ACE.AccessMask And ADS_RIGHT_GENERIC_WRITE) <> 0 Then If (ACE.ObjectType = "" And ACE.InheritedObjectType = "") Then i = UBound(RetArray) + 1 ReDim Preserve RetArray(i) RetArray(i) = vbTab & "ADS_RIGHT_GENERIC_WRITE" Else If ACE.InheritedObjectType = "" Then i = UBound(RetArray) + 1 ReDim Preserve RetArray(i) RetArray(i) = vbTab & "ADS_RIGHT_GENERIC_WRITE for SchemaIDGuid: " & ACE.ObjectType Else i = UBound(RetArray) + 1 ReDim Preserve RetArray(i) RetArray(i) = vbTab & "Inherited ADS_RIGHT_GENERIC_WRITE for SchemaIDGuid: " & ACE.InheritedObjectType End If End If End If If (ACE.AccessMask And ADS_RIGHT_GENERIC_EXECUTE) <> 0 Then If (ACE.ObjectType = "" And ACE.InheritedObjectType = "") Then i = UBound(RetArray) + 1 ReDim Preserve RetArray(i) RetArray(i) = vbTab & "ADS_RIGHT_GENERIC_EXECUTE" Else If ACE.InheritedObjectType = "" Then i = UBound(RetArray) + 1 ReDim Preserve RetArray(i) RetArray(i) = vbTab & "ADS_RIGHT_GENERIC_EXECUTE for SchemaIDGuid: " & ACE.ObjectType Else i = UBound(RetArray) + 1 ReDim Preserve RetArray(i) RetArray(i) = vbTab & "Inherited ADS_RIGHT_GENERIC_EXECUTE for SchemaIDGuid: " & ACE.InheritedObjectType End If End If End If If (ACE.AccessMask And ADS_RIGHT_GENERIC_ALL) <> 0 Then If (ACE.ObjectType = "" And ACE.InheritedObjectType = "") Then i = UBound(RetArray) + 1 ReDim Preserve RetArray(i) RetArray(i) = vbTab & "ADS_RIGHT_GENERIC_ALL" Else If ACE.InheritedObjectType = "" Then i = UBound(RetArray) + 1 ReDim Preserve RetArray(i) RetArray(i) = vbTab & "ADS_RIGHT_GENERIC_ALL for SchemaIDGuid: " & ACE.ObjectType Else i = UBound(RetArray) + 1 ReDim Preserve RetArray(i) RetArray(i) = vbTab & "Inherited ADS_RIGHT_GENERIC_ALL for SchemaIDGuid: " & ACE.InheritedObjectType End If End If End If If (ACE.AccessMask And ADS_RIGHT_DS_CREATE_CHILD) <> 0 Then If (ACE.ObjectType = "" And ACE.InheritedObjectType = "") Then i = UBound(RetArray) + 1 ReDim Preserve RetArray(i) RetArray(i) = vbTab & "ADS_RIGHT_DS_CREATE_CHILD" Else If ACE.InheritedObjectType = "" Then i = UBound(RetArray) + 1 ReDim Preserve RetArray(i) RetArray(i) = vbTab & "ADS_RIGHT_DS_CREATE_CHILD for SchemaIDGuid: " & ACE.ObjectType Else i = UBound(RetArray) + 1 ReDim Preserve RetArray(i) RetArray(i) = vbTab & "Inherited ADS_RIGHT_DS_CREATE_CHILD for SchemaIDGuid: " & ACE.InheritedObjectType End If End If End If If (ACE.AccessMask And ADS_RIGHT_DS_DELETE_CHILD) <> 0 Then If (ACE.ObjectType = "" And ACE.InheritedObjectType = "") Then i = UBound(RetArray) + 1 ReDim Preserve RetArray(i) RetArray(i) = vbTab & "ADS_RIGHT_DS_DELETE_CHILD" Else If ACE.InheritedObjectType = "" Then i = UBound(RetArray) + 1 ReDim Preserve RetArray(i) RetArray(i) = vbTab & "ADS_RIGHT_DS_DELETE_CHILD for SchemaIDGuid: " & ACE.ObjectType Else i = UBound(RetArray) + 1 ReDim Preserve RetArray(i) RetArray(i) = vbTab & "Inherited ADS_RIGHT_DS_DELETE_CHILD for SchemaIDGuid: " & ACE.InheritedObjectType End If End If End If If (ACE.AccessMask And ADS_RIGHT_ACTRL_DS_LIST) <> 0 Then If (ACE.ObjectType = "" And ACE.InheritedObjectType = "") Then i = UBound(RetArray) + 1 ReDim Preserve RetArray(i) RetArray(i) = vbTab & "ADS_RIGHT_ACTRL_DS_LIST" Else If ACE.InheritedObjectType = "" Then i = UBound(RetArray) + 1 ReDim Preserve RetArray(i) RetArray(i) = vbTab & "ADS_RIGHT_ACTRL_DS_LIST for SchemaIDGuid: " & ACE.ObjectType Else i = UBound(RetArray) + 1 ReDim Preserve RetArray(i) RetArray(i) = vbTab & "Inherited ADS_RIGHT_ACTRL_DS_LIST for SchemaIDGuid: " & ACE.InheritedObjectType End If End If End If If (ACE.AccessMask And ADS_RIGHT_DS_SELF) <> 0 Then If (ACE.ObjectType = "" And ACE.InheritedObjectType = "") Then i = UBound(RetArray) + 1 ReDim Preserve RetArray(i) RetArray(i) = vbTab & "ADS_RIGHT_DS_SELF" Else If ACE.InheritedObjectType = "" Then i = UBound(RetArray) + 1 ReDim Preserve RetArray(i) RetArray(i) = vbTab & "ADS_RIGHT_DS_SELF for SchemaIDGuid: " & ACE.ObjectType Else i = UBound(RetArray) + 1 ReDim Preserve RetArray(i) RetArray(i) = vbTab & "Inherited ADS_RIGHT_DS_SELF for SchemaIDGuid: " & ACE.InheritedObjectType End If End If End If If (ACE.AccessMask And ADS_RIGHT_DS_READ_PROP) <> 0 Then If (ACE.ObjectType = "" And ACE.InheritedObjectType = "") Then i = UBound(RetArray) + 1 ReDim Preserve RetArray(i) RetArray(i) = vbTab & "ADS_RIGHT_DS_READ_PROP" Else If ACE.InheritedObjectType = "" Then i = UBound(RetArray) + 1 ReDim Preserve RetArray(i) RetArray(i) = vbTab & "ADS_RIGHT_DS_READ_PROP for SchemaIDGuid: " & ACE.ObjectType Else i = UBound(RetArray) + 1 ReDim Preserve RetArray(i) RetArray(i) = vbTab & "Inherited ADS_RIGHT_DS_READ_PROP for SchemaIDGuid: " & ACE.InheritedObjectType End If End If End If If (ACE.AccessMask And ADS_RIGHT_DS_WRITE_PROP) <> 0 Then If (ACE.ObjectType = "" And ACE.InheritedObjectType = "") Then i = UBound(RetArray) + 1 ReDim Preserve RetArray(i) RetArray(i) = vbTab & "ADS_RIGHT_DS_WRITE_PROP" Else If ACE.InheritedObjectType = "" Then i = UBound(RetArray) + 1 ReDim Preserve RetArray(i) RetArray(i) = vbTab & "ADS_RIGHT_DS_WRITE_PROP for SchemaIDGuid: " & ACE.ObjectType Else i = UBound(RetArray) + 1 ReDim Preserve RetArray(i) RetArray(i) = vbTab & "Inherited ADS_RIGHT_DS_WRITE_PROP for SchemaIDGuid: " & ACE.InheritedObjectType End If End If End If If (ACE.AccessMask And ADS_RIGHT_DS_DELETE_TREE) <> 0 Then If (ACE.ObjectType = "" And ACE.InheritedObjectType = "") Then i = UBound(RetArray) + 1 ReDim Preserve RetArray(i) RetArray(i) = vbTab & "ADS_RIGHT_DS_DELETE_TREE" Else If ACE.InheritedObjectType = "" Then i = UBound(RetArray) + 1 ReDim Preserve RetArray(i) RetArray(i) = vbTab & "ADS_RIGHT_DS_DELETE_TREE for SchemaIDGuid: " & ACE.ObjectType Else i = UBound(RetArray) + 1 ReDim Preserve RetArray(i) RetArray(i) = vbTab & "Inherited ADS_RIGHT_DS_DELETE_TREE for SchemaIDGuid: " & ACE.InheritedObjectType End If End If End If If (ACE.AccessMask And ADS_RIGHT_DS_LIST_OBJECT) <> 0 Then If (ACE.ObjectType = "" And ACE.InheritedObjectType = "") Then i = UBound(RetArray) + 1 ReDim Preserve RetArray(i) RetArray(i) = vbTab & "ADS_RIGHT_DS_LIST_OBJECT" Else If ACE.InheritedObjectType = "" Then i = UBound(RetArray) + 1 ReDim Preserve RetArray(i) RetArray(i) = vbTab & "ADS_RIGHT_DS_LIST_OBJECT for SchemaIDGuid: " & ACE.ObjectType Else i = UBound(RetArray) + 1 ReDim Preserve RetArray(i) RetArray(i) = vbTab & "Inherited ADS_RIGHT_DS_LIST_OBJECT for SchemaIDGuid: " & ACE.InheritedObjectType End If End If End If If (ACE.AccessMask And ADS_RIGHT_DS_CONTROL_ACCESS) <> 0 Then If (ACE.ObjectType = "" And ACE.InheritedObjectType = "") Then i = UBound(RetArray) + 1 ReDim Preserve RetArray(i) RetArray(i) = vbTab & "ADS_RIGHT_DS_CONTROL_ACCESS" Else If ACE.InheritedObjectType = "" Then i = UBound(RetArray) + 1 ReDim Preserve RetArray(i) RetArray(i) = vbTab & "ADS_RIGHT_DS_CONTROL_ACCESS for SchemaIDGuid: " & ACE.ObjectType Else i = UBound(RetArray) + 1 ReDim Preserve RetArray(i) RetArray(i) = vbTab & "Inherited ADS_RIGHT_DS_CONTROL_ACCESS for SchemaIDGuid: " & ACE.InheritedObjectType End If End If End If Next EnumerateAclAces = RetArray End Function Public Function CreateGenericADObject(ByVal RelativePathToObject As String, ByVal ObjectClass As String, ByVal ObjectRelativeName As String, Optional ByVal MandatoryPropertyName As String, Optional ByVal MandatoryPropertyValue As Variant, Optional ByVal MandatoryPropertyName2 As String, Optional ByVal MandatoryPropertyValue2 As Variant, Optional ByVal MandatoryPropertyName3 As String, Optional ByVal MandatoryPropertyValue3 As Variant, Optional ByVal MandatoryPropertyName4 As String, Optional ByVal MandatoryPropertyValue4 As Variant, Optional ByVal MandatoryPropertyName5 As String, Optional ByVal MandatoryPropertyValue5 As Variant, Optional ByVal MandatoryPropertyName6 As String, Optional ByVal MandatoryPropertyValue6 As Variant, Optional ByVal MandatoryPropertyName7 As String, Optional ByVal MandatoryPropertyValue7 As Variant, Optional ByVal MandatoryPropertyName8 As String, Optional ByVal MandatoryPropertyValue8 As Variant) As Boolean Dim RootDSE As IADs Dim Container As IADsContainer Set RootDSE = GetObject("LDAP://RootDSE") Set Container = GetObject("LDAP://" & RelativePathToObject & RootDSE.Get("DefaultNamingContext")) Set NewObject = Container.Create(ObjectClass, ObjectRelativeName) If MandatoryPropertyName <> "" Then Call NewObject.Put(MandatoryPropertyName, MandatoryPropertyValue) End If If MandatoryPropertyName2 <> "" Then Call NewObject.Put(MandatoryPropertyName2, MandatoryPropertyValue2) End If If MandatoryPropertyName3 <> "" Then Call NewObject.Put(MandatoryPropertyName3, MandatoryPropertyValue3) End If If MandatoryPropertyName4 <> "" Then Call NewObject.Put(MandatoryPropertyName4, MandatoryPropertyValue4) End If If MandatoryPropertyName5 <> "" Then Call NewObject.Put(MandatoryPropertyName5, MandatoryPropertyValue5) End If If MandatoryPropertyName6 <> "" Then Call NewObject.Put(MandatoryPropertyName6, MandatoryPropertyValue6) End If If MandatoryPropertyName7 <> "" Then Call NewObject.Put(MandatoryPropertyName7, MandatoryPropertyValue7) End If If MandatoryPropertyName8 <> "" Then Call NewObject.Put(MandatoryPropertyName8, MandatoryPropertyValue8) End If NewObject.SetInfo If Err.Number = 0 Then CreateADObject = True End Function Public Function SetOptionalProperty(ObjectRelativeName As String, OptionalPropertyName As String, OptionalPropertyValue As Variant) As Boolean Dim RootDSE As IADs Dim Obj As IADs Set RootDSE = GetObject("LDAP://RootDSE") Set Obj = GetObject("LDAP://" & ObjectRelativeName & RootDSE.Get("DefaultNamingContext")) Call Obj.Put(OptionalPropertyName, OptionalPropertyValue) Obj.SetInfo If Err.Number = 0 Then SetOptionalProperty = True End Function Public Function ADSObjectSecurity(ByVal RelativeObjectPath As String, ByVal TrusteeName As String, ByVal AllowAccess As Boolean, ByVal InheritenceType As String, Optional ByVal SchemaIDGuid As String = "ALL", Optional ByVal Generic_All As Boolean, Optional ByVal Generic_Read As Boolean, Optional ByVal Generic_Write As Boolean, Optional ByVal DS_Create_Child As Boolean, Optional ByVal DS_Delete_Child As Boolean, Optional ByVal Delete As Boolean, Optional ByVal Read_Control As Boolean, Optional ByVal Write_DAC As Boolean, Optional ByVal Write_Owner As Boolean, Optional ByVal Synchronize As Boolean, Optional ByVal Access_System_Security As Boolean, Optional ByVal ACtrl_DS_List As Boolean, Optional ByVal DS_Self As Boolean, Optional ByVal DS_Read_Prop As Boolean, Optional ByVal DS_Write_Prop As Boolean, Optional ByVal DS_Delete_Tree As Boolean, Optional ByVal DS_List_Object As Boolean, Optional ByVal DS_Control_Access As Boolean) As Boolean Dim Obj As IADs Dim SecurityDescriptor As Variant Dim ACE As AccessControlEntry Dim DACL As AccessControlList Dim RootDSE As IADs Dim AccessMask As Long Set RootDSE = GetObject("LDAP://RootDSE") Set Obj = GetObject("LDAP://" & RelativeObjectPath & RootDSE.Get("DefaultNamingContext")) Set SecurityDescriptor = Obj.Get("ntSecurityDescriptor") Set DACL = SecurityDescriptor.DiscretionaryACL Set ACE = CreateObject("AccessControlEntry") If FullControl = True Then AccessMask = -1 End If If Delete = True Then AccessMask = AccessMask Or ADS_RIGHT_DELETE End If If Read_Control = True Then AccessMask = AccessMask Or ADS_RIGHT_READ_CONTROL End If If Write_DAC = True Then AccessMask = AccessMask Or ADS_RIGHT_WRITE_DAC End If If Write_Owner = True Then AccessMask = AccessMask Or ADS_RIGHT_WRITE_OWNER End If If Synchronize = True Then AccessMask = AccessMask Or ADS_RIGHT_SYNCHRONIZE End If If Access_System_Security = True Then AccessMask = AccessMask Or ADS_RIGHT_ACCESS_SYSTEM_SECURITY End If If Generic_Read = True Then AccessMask = AccessMask Or ADS_RIGHT_GENERIC_READ End If If Generic_Write = True Then AccessMask = AccessMask Or ADS_RIGHT_GENERIC_WRITE End If If Generic_All = True Then AccessMask = AccessMask Or ADS_RIGHT_GENERIC_ALL End If If DS_Create_Child = True Then AccessMask = AccessMask Or ADS_RIGHT_DS_CREATE_CHILD End If If DS_Delete_Child = True Then AccessMask = AccessMask Or ADS_RIGHT_DS_DELETE_CHILD End If If ACtrl_DS_List = True Then AccessMask = AccessMask Or ADS_RIGHT_ACTRL_DS_LIST End If If DS_Self = True Then AccessMask = AccessMask Or ADS_RIGHT_DS_SELF End If If DS_Read_Prop = True Then AccessMask = AccessMask Or ADS_RIGHT_DS_READ_PROP End If If DS_Write_Prop = True Then AccessMask = AccessMask Or ADS_RIGHT_DS_WRITE_PROP End If If DS_Delete_Tree = True Then AccessMask = AccessMask Or ADS_RIGHT_DS_DELETE_TREE End If If DS_List_Object = True Then AccessMask = AccessMask Or ADS_RIGHT_DS_LIST_OBJECT End If If DS_Control_Access = True Then AccessMask = AccessMask Or ADS_RIGHT_DS_CONTROL_ACCESS End If ACE.AccessMask = AccessMask Select Case UCase(InheritenceType) Case "NONE" Case "INHERIT" ACE.AceFlags = ADS_ACEFLAG_INHERIT_ACE Case "INHERIT_ONLY" ACE.AceFlags = ADS_ACEFLAG_INHERIT_ONLY_ACE Case "NO_PROPAGATE" ACE.AceFlags = ADS_ACEFLAG_NO_PROPAGATE_INHERIT_ACE End Select If AllowAccess = True Then If UCase(SchemaIDGuid) = "ALL" Then ACE.AceType = ADS_ACETYPE_ACCESS_ALLOWED Else ACE.AceType = ADS_ACETYPE_ACCESS_ALLOWED_OBJECT ACE.ObjectType = SchemaIDGuid ACE.Flags = ADS_FLAG_OBJECT_TYPE_PRESENT End If Else If UCase(SchemaIDGuid) = "ALL" Then ACE.AceType = ADS_ACETYPE_ACCESS_DENIED Else ACE.AceType = ADS_ACETYPE_ACCESS_DENIED_OBJECT ACE.ObjectType = SchemaIDGuid ACE.Flags = ADS_FLAG_OBJECT_TYPE_PRESENT End If End If ACE.Trustee = UCase(TrusteeName) DACL.AddAce ACE SecurityDescriptor.DiscretionaryACL = DACL Obj.Put "ntSecurityDescriptor", Array(SecurityDescriptor) Obj.SetInfo If Err.Number = 0 Then ADSObjectSecurity = True End Function -
Compile the code as ADAdmin.DLL.
-
Save and close the ADAdmin project.
Tip
If you do not want to share your code between applications, you can enter the preceding code into a code module in any Visual Basic application .;
Tip
You can download the Visual Basic 6.0 project or precompiled version of ADAdmin.DLL from http://www.newriders.com/adsi .
Using the Functions in ADObjectManagement
With the ADObjectManagement class module created, you can access the functions contained in the class module from any programming language that supports OLE automation, including Visual Basic, VBScript, and JavaScript.
Tip
To instantiate the object, follow the appropriate syntax found in Chapter 3. Substitute the ADObjectManagement class name where necessary .
Use Table 12.6 to help you use the proper syntax for each of the methods of the ADObjectManagement interface.
| Action | Syntax |
|---|---|
| Query RootDSE Properties | Debug.Print RootDSEntries("CurrentTime") Debug.Print RootDSEntries ("SubSchemaSubEntry") Debug.Print RootDSEntries("DsServiceName") For Each Element In RootDSEntries ("NamingContexts") Debug.Print Element Next Debug.Print RootDSEntries ("DefaultNamingContext") Debug.Print RootDSEntries ("SchemaNamingContext") Debug.Print RootDSEntries ("ConfigurationNamingContext") Debug.Print RootDSEntries ("RootDomainNamingContext") For Each Element In RootDSEntries ("SupportedControl") Debug.Print Element Next For Each Element In RootDSEntries ("SupportedLDAPVersion") Debug.Print Element Next Debug.Print RootDSEntries ("HighestCommittedUSN") For Each Element In RootDSEntries ("SupportedSASLMechanisms") Debug.Print Element Next Debug.Print RootDSEntries("DnsHostName") Debug.Print RootDSEntries("LdapServiceName") Debug.Print RootDSEntries("ServerName") |
| Enumerate Container Elements | For Each Element In EnumerateContainer ("user", "CN=Users,") Debug.Print Element Next |
| Remove AD Object from Directory | Debug.Print RemoveADObject("cn=Users,", "user", "cn=IWAM_SERVERNAME") |
| Remove AD Branch | Debug.Print DeleteADBranch ("ou=Printer_Queues,") |
| Move AD Object | Debug.Print MoveRenameADObject ("ou=DelegatedAdmins,", "LDAP://cn=Admin1, cn=Users,dc=crash,dc=burn") |
| Rename AD Object | Debug.Print MoveRenameADObject ("ou=DelegatedAdmins,", "LDAP://cn=Admin1, cn=users,dc=crash,dc=burn", "cn=DMZAdmin") |
| Remove AD ACE | Debug.Print RemoveADACE("cn=JunkObject, ou=DelegatedAdmins,", "Crash\Guest") |
| Enumerate ACEs in an AD Object ACL | For Each ACE In EnumerateAclAces("cn=Users,") Debug.Print ACE Next |
| Create AD Object | Debug.Print CreateADObject("ou=TestOU,", "user", "cn=TestUsr1", "sAMAccountName", "testUsr1") |
| Populate AD Object Attribute | Debug.Print SetOptionalProperty ("cn=TEck,ou=Users,", "sn", "Eck") |
| Set Full Control Security for AD Object | Debug.Print ADSObjectSecurity("ou=Users,", "Crash\OUAdmin", False, "Inherit", "all", True) |
| Allow Trustee To Create UserObjects in Container | Debug.Print ADSObjectSecurity ("ou=Users,", "Crash\UserAdmin", True, "Inherit", "{BF967ABA-0DE6-11D0- A285-00AA003049E2}", False, False, False, True, True) |
| Top |
Windows NT/2000 ADSI Scripting for System Administration
ISBN: 1578702194
EAN: 2147483647
EAN: 2147483647
Year: 2000
Pages: 194
Pages: 194
Authors: Thomas Eck