' -------------------------------------------------------------------------
'       From the book Inside Active Directory, ISBN 0-201-61621-1
'       Copyright (C) 2002 by Addison-Wesley
'       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

Const E_ADS_PROPERTY_NOT_FOUND = &H8000500D

Dim objDSE, objADObject, objClass, i, strPropName

Set objDSE = GetObject("LDAP://rootDSE")
Set objADObject = GetObject("LDAP://CN=Guest,CN=Users," & _
	objDSE.Get("defaultNamingContext"))
objADObject.GetInfo

Set objClass = GetObject(objADObject.Schema)

i = 0		'this will count each property

For Each strPropName In objClass.MandatoryProperties
	Call ShowPropAndValues(i, strPropName, objADObject)
Next

For Each strPropName In objClass.OptionalProperties
	Call ShowPropAndValues(i, strPropName, objADObject)
Next

Sub ShowPropAndValues(i, strPropName, objADObject)
	Dim objAttribute, strName

	i = i + 1

	Set objAttribute = GetObject("LDAP://schema/" & strPropName)
	strName = i & ": " & strPropName & " (" & objAttribute.Syntax & ")"

	Select Case objAttribute.Syntax
		Case "OctetString", "ObjectSecurityDescriptor"
			Call ShowBinary(strName, strPropName, objADObject)
		Case "INTEGER8"
			Call ShowLargeInteger(strName, strPropName, objADObject, _
				objAttribute)
		Case Else
			Call ShowOtherTypes(strName, strPropName, objADObject)
	End Select
End Sub

Sub ShowBinary(strName, strPropName, objADObject)
	Dim varPropValue, arrPropValues

	On Error Resume Next

	Err = 0
	arrPropValues = objADObject.GetEx(strPropName)
	If Err = E_ADS_PROPERTY_NOT_FOUND Then
		varPropValue = "<not in property cache>"
	Else
		varPropValue = "???"
	End If
	Call ShowValue(strName, varPropValue)
End Sub

Sub ShowLargeInteger(strName, strPropName, objADObject, _
	objAttribute)
	Dim varPropValue, objLargeInt

	On Error Resume Next
	If objAttribute.MultiValued Then
		varPropValue = "<cannot retrieve multivalued large integers>"
	Else
		Err = 0
		Set objLargeInt = objADObject.Get(strPropName)
		If Err = E_ADS_PROPERTY_NOT_FOUND Then
			varPropValue = "<not in property cache>"
		Else
			varPropValue = objLargeInt.HighPart * 2^32 + _
								  objLargeInt.LowPart
		End If
	End If
	Call ShowValue(strName, varPropValue)
End Sub

Sub ShowOtherTypes(strName, strPropName, objADObject)
	Dim arrPropName, varPropValue, arrPropValues

	On Error Resume Next

	Err = 0
	arrPropValues = objADObject.GetEx(strPropName)
	If Err = E_ADS_PROPERTY_NOT_FOUND Then
		arrPropName = Array(strPropName)
		Call objADObject.GetInfoEx(arrPropName, 0)
		Err = 0
		arrPropValues = objADObject.GetEx(strPropName)
	End If
	If Err = E_ADS_PROPERTY_NOT_FOUND Then
		varPropValue = "<not set>"
		Call ShowValue(strName, varPropValue)
	Else
		For Each varPropValue In arrPropValues
			Call ShowValue(strName, varPropValue)
		Next
	End If
End Sub

Sub ShowValue(strName, varPropValue)
	Dim intGap		'number of spaces before the value

	intGap = 40 - Len(strName)
	If intGap < 1 Then intGap = 1
	WScript.Echo strName & String(intGap, " ") & varPropValue
	strName = ""
End Sub