I have been working on this for a few days and the end goal i have is to be able to copy from one tree in AD to another tree in AD. Currently i can enumerate the listing and dumo it to a file but i want to be able to read one tree and write to another

Here is what i have so far:

'///////////////////////////////////////
Option Explicit
'AccessMask Bits
'Constants would be like ADS_RIGHT_DS_CREATE_CHILD
Dim arrADSRights(18,1) '19 value pairs, name and bit in each
arrADSRights(0,0) = "DS_CREATE_CHILD"
arrADSRights(0,1) = &H1
arrADSRights(1,0) = "DS_DELETE_CHILD"
arrADSRights(1,1) = &H2
arrADSRights(2,0) = "ACTRL_DS_LIST"
arrADSRights(2,1) = &H4
arrADSRights(3,0) = "DS_SELF"
arrADSRights(3,1) = &H8
arrADSRights(4,0) = "DS_READ_PROP"
arrADSRights(4,1) = &H10
arrADSRights(5,0) = "DS_WRITE_PROP"
arrADSRights(5,1) = &H20
arrADSRights(6,0) = "DS_DELETE_TREE"
arrADSRights(6,1) = &H40
arrADSRights(7,0) = "DS_LIST_OBJECT"
arrADSRights(7,1) = &H80
arrADSRights(8,0) = "DS_CONTROL_ACCESS"
arrADSRights(8,1) = &H100
arrADSRights(9,0) = "DELETE"
arrADSRights(9,1) = &H10000
arrADSRights(10,0) = "READ_CONTROL"
arrADSRights(10,1) = &H20000
arrADSRights(11,0) = "WRITE_DAC"
arrADSRights(11,1) = &H40000
arrADSRights(12,0) = "WRITE_OWNER"
arrADSRights(12,1) = &H80000
arrADSRights(13,0) = "SYNCHRONIZE"
arrADSRights(13,1) = &H100000
arrADSRights(14,0) = "ACCESS_SYSTEM_SECURITY"
arrADSRights(14,1) = &H1000000
arrADSRights(15,0) = "GENERIC_ALL"
arrADSRights(15,1) = &H10000000
arrADSRights(16,0) = "GENERIC_EXECUTE"
arrADSRights(16,1) = &H20000000
arrADSRights(17,0) = "GENERIC_WRITE"
arrADSRights(17,1) = &H40000000
arrADSRights(18,0) = "GENERIC_READ"
arrADSRights(18,1) = &H80000000
'AceFlags Bits
'Constants would be like ADS_ACEFLAG_INHERIT_ACE
Dim arrADSACEFlags(5,1) '6 value pairs, name and bit in each
arrADSACEFlags(0,0) = "INHERIT_ACE"
arrADSACEFlags(0,1) = &H2
arrADSACEFlags(1,0) = "NO_PROPAGATE_INHERIT_ACE"
arrADSACEFlags(1,1) = &H4
arrADSACEFlags(2,0) = "INHERIT_ONLY_ACE"
arrADSACEFlags(2,1) = &H8
arrADSACEFlags(3,0) = "INHERITED_ACE"
arrADSACEFlags(3,1) = &H10
arrADSACEFlags(4,0) = "SUCCESSFUL_ACCESS"
arrADSACEFlags(4,1) = &H40
arrADSACEFlags(5,0) = "FAILED_ACCESS"
arrADSACEFlags(5,1) = &H80
'AceTypes
'Constants would be like ADS_ACETYPE_ACCESS_ALLOWED
Dim arrADSACETypes(5,1) '6 value pairs, name and value in each
arrADSACETypes(0,0) = "ACCESS_ALLOWED"
arrADSACETypes(0,1) = 0
arrADSACETypes(1,0) = "ACCESS_DENIED"
arrADSACETypes(1,1) = &H1
arrADSACETypes(2,0) = "SYSTEM_AUDIT"
arrADSACETypes(2,1) = &H2
arrADSACETypes(3,0) = "ACCESS_ALLOWED_OBJECT"
arrADSACETypes(3,1) = &H5
arrADSACETypes(4,0) = "ACCESS_DENIED_OBJECT"
arrADSACETypes(4,1) = &H6
arrADSACETypes(5,0) = "SYSTEM_AUDIT_OBJECT"
arrADSACETypes(5,1) = &H7
'Flags Bits
'Constants would be like ADS_FLAG_OBJECT_TYPE_PRESENT
Dim arrADSFlags(1,1) '2 value pairs, name and bit in each
arrADSFlags(0,0) = "OBJECT_TYPE_PRESENT"
arrADSFlags(0,1) = &H1
arrADSFlags(1,0) = "INHERITED_OBJECT_TYPE_PRESENT"
arrADSFlags(1,1) = &H2
Dim i
DIM objADObject
DIM objSecDesc
DIM objDACL
Dim objACE
Dim objDSE
Dim objFSO
Dim objFile
Dim objTextFile
DIM strsDN
DIM strtDN
Dim strFile
'///////////////////////////////////////
'// Main script
'///////////////////////////////////////
'Set the Source and target paths
Set objDSE = GetObject("LDAP://rootDSE")
'strsDN = "CN=RTC Service,CN=Microsoft,CN=System,dc=lcstst,dc=pri"
strsDN = "CN=RTC Service,CN=Services,CN=Configuration,dc=lcstst,dc=pri"
'WScript.Echo strsDN
'WScript.Echo strtDN
Set objADObject = GetObject("LDAP://" & strsDN)
Set objSecDesc = objADObject.Get("ntSecurityDescriptor")
Set objDACL = objSecDesc.DiscretionaryAcl
WScript.Echo "Number of ACEs: " & objDACL.AceCount
i = 0
For Each objACE In objDACL
i = i + 1
'WScript.Echo ""
'WScript.Echo "ACE " & i
'WScript.Echo "Trustee: " & objACE.Trustee
'WScript.Echo GetStringBits("AccessMask", _
' objACE.AccessMask, arrADSRights)
'WScript.Echo GetStringBits("AceFlags", _
' objACE.AceFlags, arrADSACEFlags)
'WScript.Echo GetStringAceType(objACE.AceType)
'WScript.Echo GetStringBits("Flags", _
' objACE.Flags, arrADSFlags)
'WScript.Echo GetObjectType(objACE.ObjectType)
'WScript.Echo GetInheritedObjectType(objACE.InheritedObjectType)
set objFSO = CreateObject("Scripting.FileSystemObject")
' OpenTextFile Method needs a Const value
' ForAppending = 8 ForReading = 1, ForWriting = 2
set objTextFile = objFSO.OpenTextFile("c:\Test10.csv",8 )
objTextFile.WriteLine (objACE.Trustee & GetStringBits("AccessMask",objACE.AccessMask, arrADSRights) & GetStringBits("AceFlags", objACE.AceFlags, arrADSACEFlags) & GetStringAceType(objACE.AceType) & GetStringBits("Flags", objACE.Flags, arrADSFlags) & GetObjectType(objACE.ObjectType) & GetInheritedObjectType(objACE.InheritedObjectType) )
objTextFile.close




next
'===End of the Main Program===
'==============================
Function GetStringBits(strName, intBitfield, arrBits)
Dim strOut, i
strOut = strName & ": " & Hex(intBitfield)
For i = LBound(arrBits) To UBound(arrBits)
If intBitfield And arrBits(i,1) Then
strOut = strOut & ", " & arrBits(i,0)
End If
Next
GetStringBits = strOut
End Function
'==============================
Function GetStringAceType(intACEType)
Dim strOut, i
strOut = "unknown ACE type"
For i = LBound(arrADSACETypes) To UBound(arrADSACETypes)
If intACEType = arrADSACETypes(i,1) Then
strOut = arrADSACETypes(i,0)
End If
Next
GetStringAceType = "AceType: " & Hex(intACEType) & ", " & strOut
End Function
'==============================
Function GetObjectType(strGUID)
GetObjectType = "ObjectType: " & _
strGUID & " " & MapGUIDToMatchingName(strGUID)
End Function
'==============================
Function GetInheritedObjectType(strGUID)
GetInheritedObjectType = "InheritedObjectType: " & _
strGUID & " " & MapGUIDToMatchingName(strGUID)
End Function
'==============================
Function MapGUIDToMatchingName(strGUIDAsString)
Dim strOut, objExtRights, objChild, objSchema
If strGUIDAsString = "" Then Exit Function
strOut = ""
Set objExtRights = GetObject("LDAP://CN=Extended-Rights," & _
objDSE.Get("configurationNamingContext"))
For Each objChild In objExtRights
'Actually all should be of the same class
If objChild.Class = "controlAccessRight" Then
If UCase("{" & objChild.Get("rightsGuid") & "}") = _
UCase(strGUIDAsString) Then
strOut = objChild.Get("cn") & ":" & _
objChild.Get("displayName")
Exit For
End If
End If
Next
If strOut = "" Then 'Didn't find a match in extended rights
Set objSchema = GetObject("LDAP://" & _
objDSE.Get("schemaNamingContext"))
For Each objChild In objSchema
If objChild.Class = "classSchema" Or _
objChild.Class = "attributeSchema" Then
If UCase(GetSchemaIDGUID(objChild)) = _
UCase(strGUIDAsString) Then
strOut = objChild.Get("cn") & ":" & _
objChild.Get("lDAPDisplayName")
Exit For
End If
End If
Next
End If
MapGUIDToMatchingName = strOut
End Function
'==============================
Function GetSchemaIDGUID(objSchemaObj)
Dim arrValue, i, strByte, strGUID
arrValue = objSchemaObj.Get("schemaIDGUID")
strGUID = ""
For i = 1 to LenB(arrValue)
strByte = Hex(AscB(MidB(arrValue, i, 1)))
If Len(strByte) = 1 Then strByte = "0" & strByte
strGUID = strGUID & strByte
Next
GetSchemaIDGUID = GuidBinFormatToStrFormat(strGUID)
End Function
'==============================
Function GUIDBinFormatToStrFormat(strGUIDBin)
Dim i, strDest
Dim arrBytes(16) 'We will use elements 1 to 16 but not 0
For i = 1 To 16 'A GUID has 16 bytes
arrBytes(i) = Mid(strGUIDBin, 2 * i - 1, 2)
Next
strDest = "{"
For i = 1 To 4 : strDest = strDest & arrBytes(5 - i) : Next
strDest = strDest & "-"
For i = 1 To 2 : strDest = strDest & arrBytes(7 - i) : Next
strDest = strDest & "-"
For i = 1 To 2 : strDest = strDest & arrBytes(9 - i) : Next
strDest = strDest & "-"
For i = 1 To 2 : strDest = strDest & arrBytes(8 + i) : Next
strDest = strDest & "-"
For i = 1 To 6 : strDest = strDest & arrBytes(10 + i) : Next
strDest = strDest & "}"
GuidBinFormatToStrFormat = strDest
End Function
0 Comments   [ + ] Show Comments

Comments

Please log in to comment

There are no answers at this time
Rating comments in this legacy AppDeploy message board thread won't reorder them,
so that the conversation will remain readable.

Answers

Answer this question or Comment on this question for clarity