' *********************************************************
' DS-Ex-FindAllRODCs V01.00.00vbs
' 
' Example script to illustrate how to locate all RODCs in
' a forest.  Script is more lengthy than expected due to 
' error handling, debug info., etc.
' 
' Version:	V01.00.00vbs
' Written:	03-12-2007
' 
' *********************************************************

Option Explicit

' Variant used as a constant to determine whether or not the
' print sub-routine should actually print to the screen (console)
Dim printInfoToConsole : printInfoToConsole = True
Dim printDebugInfoToConsole : printDebugInfoToConsole = False


' ***** ***** ***** ***** ***** ***** ***** ***** ***** ***** 
'	----- MAIN BODY OF SCRIPT -----

On Error Resume Next
	Dim dse : Set dse = GetObject("LDAP://RootDSE")
	Dim result : result = verifyError(Err)
	If Not result Then printDirectoryInfo(dse)
On Error Goto 0

' testing only
Dim hostname : hostname = dse.get("dNSHostName")
Dim rodc, rodcs() : rodcs = getRODCs(hostname)
For Each rodc In rodcs
	print(rodc)
Next

'   ----- END OF "MAIN" (subs and funcs follow)
' ***** ***** ***** ***** ***** ***** ***** ***** ***** ***** 


Private Function getRODCs(targetHostname) ' as String()
	Dim rootDse, connection, command, recordSet
	Dim ldapQuery, ldapBase, ldapFilter, ldapAttrs, ldapScope ' as string
	
	If Not ((targetHostname = "") And (Right(targetHostname, 1) = "/"))Then
		targetHostname = targetHostname & "/"
	End If
	
	Set rootDse = GetObject("LDAP://" & targetHostname & "RootDSE")
	Set connection = CreateObject("ADODB.Connection")
	Set command = CreateObject("ADODB.Command")
	
	' define filter
	ldapBase	= "<GC://" & rootDse.get("rootDomainNamingContext") & ">;"
	ldapFilter= "(&(objectCategory=computer)(msDS-IsRodc=true));"
	ldapAttrs	= "distinguishedName,cn,memberOf,displayName;"
	ldapScope	= "SubTree"
	
	ldapQuery	= ldapBase & ldapFilter & ldapAttrs & ldapScope
	
	' configure ADO
	connection.provider = "ADsDSOObject"
	connection.open "Active Directory Provider"
	
	command.activeConnection = connection
	command.CommandText = ldapQuery
	
	command.properties("Page Size") = 100
	command.properties("Size Limit") = 10000
	command.properties("Cache Results") = False
	
	' execute the command
	Set recordSet = command.execute
	
	If(recordSet.EOF)Then quit"No RODCs in the forest"
	recordSet.MoveFirst
	
	While Not recordSet.EOF
		Dim i, j ' as int
		
		If Not IsNull(recordSet.fields("distinguishedName").value)Then _
			print "DN: " & recordSet.Fields("distinguishedName").Value
		
		For i = 1 To recordSet.Fields.Count - 1
			If(TypeName(recordSet.Fields(i).Value) = "Variant()" And Not (IsNull(recordSet.Fields(i).Value)))Then
				print "  " & recordSet.Fields(i).Name & " ("  & _
					UBound(recordSet.Fields(i).Value) & "):"

				Dim item : For Each item In recordSet.Fields(i).Value
					print "    > " & item
				Next
			
				print ""
			Else
					print "  " & recordSet.Fields(i).Name & ": " & recordSet.Fields(i).Value

			End If
		Next
		
		print""
		recordSet.MoveNext
	Wend
	
	' testing
	Dim str() : getRODCs = str
End Function


' *******************************************************************
' Print-Directory-Info
' 
' Sub prints the DC that is being used and the level of the 
' directory service, e.g. Win2003 or ADAM
' 
' 
' Note.  Sub calls function Get-DS-Functionality
' 
' *******************************************************************
Private Sub printDirectoryInfo(oRootDse)
	Dim sServer, sDSFunctionality
	
	sServer = oRootDse.get("dNSHostName")
	sDSFunctionality = _
		getDSFunctionality(oRootDse.get("domainControllerFunctionality"), _
			oRootDse.get("supportedCapabilities"))
	
	print"Using server: " & sServer
	print"Directory: " & sDSFunctionality & vbCrLf
End Sub



' *******************************************************************
' Get-DS-Functionality
' 
' Get the domain functional level for info. purposes.  Function 
' returns a string defining the current value of the DC queried 
' (via serverless bind)
' 
' *******************************************************************
Private Function getDSFunctionality(iDSFunctionality, _
		cSupportedCapabilities)
	
	' supportedCapability of an ADAM directory.  Presence indicates AD LDS
	Const LDAP_CAP_ACTIVE_DIRECTORY_ADAM_OID = "1.2.840.113556.1.4.1851"

	' supportedCapability of an RODC.  Presence indictes DS is RO
	Const ACTIVE_DIRECTORY_PARTIAL_SECRETS  = "1.2.840.113556.1.4.1920" ' as string

	Dim oBase, dsf, nTMixedDomain, supportedCapability, ldsFlag, rodcFlag
	ldsFlag = False
	rodcFlag = False
	
	For Each supportedCapability In cSupportedCapabilities
		If(supportedCapability = _
			LDAP_CAP_ACTIVE_DIRECTORY_ADAM_OID)Then _
				ldsFlag = True
		
		If(supportedCapability = _
			ACTIVE_DIRECTORY_PARTIAL_SECRETS)Then _
				rodcFlag = True
	Next
	
	If(ldsFlag)Then
		If(iDSFunctionality > 2)Then
			dsf = "Active Directory Lightweight Directory Services (AD LDS)"
		Else
			dsf = "Active Directory Application Mode (ADAM)"
		End If
	Else
		Select Case iDSFunctionality
			Case 0
				Set oBase = oRootDse.get("defaultNamingContext")
				nTMixedDomain = oBase.get("nTMixedDomain")
				
				If(nTMixedDomain=1)Then
					dsf = "Windows 2000 Native"
				Else
					dsf = "Windows 2000 Mixed"
				End If
				
			Case 1
				dsf = "Windows Server 2003 Interim"
				
			Case 2
				dsf = "Windows Server 2003"
				
			Case 3
				dsf = "Windows Server 2008"
				
		End Select
	End If
	
	If(rodcFlag)Then dsf = dsf  & " (RODC)"
	
	getDSFunctionality = dsf
End Function


' Verify-Error(ByVal _err as Error-Object)
' 
' Function checks to see if the passed error object is in
' an error state and, if so, returns TRUE, otherwise
' returns FALSE
' 
Private Function verifyError(oErr)
	Dim inErrorState : inErrorState = False
	
	If(oErr.number <> 0)Then _
		inErrorState = True
	
	dbgPrint"Verify-Error::inErrorState=" & inErrorState
	
	verifyError = inErrorState
End Function


' Handle-Error(ByVal _err as Error-Object)
' 
' Sub prints the error number and, if present, description
' to the console if the passed argument print is enabled 
' and terminates, if the passed argument fatal is enabled.
' 
Private Sub handleError(oErr, fatal, shouldPrint)
	On Error Goto 0
	
	dbgPrint"Handle-Error::shouldPrint=" & shouldPrint
	dbgPrint"Handle-Error::fatal=" & fatal
	
	Dim errorMessage ' as string
	errorMessage = "Error: " & oErr.number
	
	If Not (oErr.description="")Then _
		errorMessage = errorMessage & "Details: " & _
			oErr.description & vbCrLf
	
	If(shouldPrint)Then print errorMessage
	
	If(fatal)Then 
		print vbCrLf & "Error requires premature termination.  " & _
			"Exiting script..." & vbCrLf
		
		WScript.Quit(-1)
	End If
End Sub

' Print(ByVal printStr as String)
'  
' Sub prints the passed string to the console if the constant-
' esq variant Print-Info-To-Console is TRUE.  Otherwise the
' passed string is logged (if implemented) or ignored.
' 
Private Sub print(printStr)
	If(printInfoToConsole)Then
		WScript.Echo(printStr)
	Else
		' code to write to file goes here...
	End If	
End Sub

Private Sub dbgPrint(debugStr)
	If(printDebugInfoToConsole)Then _
		WScript.Echo(" [script-debug-string] " & debugStr)
End Sub


Private Sub quit(quitStr)
	print(quitStr)
	WScript.Quit(0)
End Sub

---