Scripting

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