' -------------------------------------------------------------------------
'       Script by Sakari Kouti (see http://www.kouti.com)
' You have a royalty-free right to use, modify, reproduce and distribute
' this script (and/or any modified version) in any way you find useful,
' provided that you agree that Addison-Wesley or Sakari Kouti has no
' warranty, obligations or liability for the script. If you modify
' the script, you must retain this copyright notice.
' -------------------------------------------------------------------------
Option Explicit

Dim objDSE, objExtRights, objChild, i, j, strrightsGuid, strOut

'===The Main Program===

Set objDSE = GetObject("LDAP://rootDSE")
Set objExtRights = GetObject("LDAP://CN=Extended-Rights," & _
	objDSE.Get("configurationNamingContext"))

i = 0

For Each objChild In objExtRights
	If objChild.Class = "controlAccessRight" Then 'actually all should be this class
		If objChild.validAccesses And &H30 Then
			i = i + 1
			WScript.Echo i & ": " & objChild.displayName
			'WScript.Echo i & ": " & objChild.Name & ":" & objChild.rightsGuid & ":" & objChild.displayName
			strrightsGuid = objChild.rightsGuid
			MapGUIDToMatchingName("{" & strrightsGuid & "}")
			WScript.Echo vbTab & strOut
		End If
	End If
Next

'===End of the Main Program===
'==============================

Sub MapGUIDToMatchingName(strGUIDAsString)
	Dim objExtRights, objChild, objSchema

	If strGUIDAsString = "" Then Exit Sub

	Set objSchema = GetObject("LDAP://" & _
		objDSE.Get("schemaNamingContext"))
'WScript.Echo "rightsGuid: " & strGUIDAsString

	For Each objChild In objSchema
		If objChild.Class = "attributeSchema" Then
			If	UCase(GetSchemaIDGUID(objChild)) = _
				UCase(strGUIDAsString) Then
				'WScript.Echo vbTab & objChild.Get("lDAPDisplayName")
				WScript.Echo vbTab & objChild.Get("cn") & vbTab & _
					objChild.Get("lDAPDisplayName")
			End If
		End If
	Next
End Sub

'==============================

Function GetSchemaIDGUID(objSchemaObj)
	Dim arrValue, i, strByte, strGUID

	On Error Resume Next
	Err.Clear
	arrValue = objSchemaObj.Get("attributeSecurityGUID")
	If Err <> 0 Then
		GetSchemaIDGUID = "abc"
		Exit Function
	End If
	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 & "}"
'WScript.Echo "attrSeGuid: " & strDest

	GuidBinFormatToStrFormat = strDest
End Function