' -------------------------------------------------------------------------
'       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

Dim intYesNo, objSchema, objAttr, objClass, objDSE

intYesNo =  MsgBox("Create a new attribute and class?", _
	vbYesNo + vbQuestion +vbDefaultButton2, _
	"Extending the Schema")
If intYesNo = vbNo Then
	WScript.Quit(0)	'no error so no errorlevel
End If

Set objSchema = GetObject("LDAP://dc1.sanao.com/" & _
	"CN=Schema,CN=Configuration,DC=sanao,DC=com")

On Error Resume Next

Set objAttr = objSchema.Create("attributeSchema", _
	"CN=Sanao-Com-2000-MyProduct-User-Data")

Call objAttr.Put("lDAPDisplayName", _
	"sanaoCom2000-MyProduct-UserData")
Call objAttr.Put("attributeID", "1.3.6.1.4.1.123123123.2.1")
Call objAttr.Put("attributeSyntax", "2.5.5.10")
Call objAttr.Put("oMSyntax", 4)
Call objAttr.Put("isSingleValued", True)
Call objAttr.Put("rangeLower", 200)
Call objAttr.Put("rangeUpper", 200)
Call objAttr.Put("showInAdvancedViewOnly", True)	
Call objAttr.Put("searchFlags", 0)

Err.Clear
objAttr.SetInfo	'write the new attribute to the server
Call CheckIfError("create the attribute")
WScript.Echo "Created the attribute"

'Err.Clear
'Set objDSE = GetObject("LDAP://dc1.sanao.com/rootDSE")
'Call objDSE.Put("schemaUpdateNow", 1) 'trigger schema cache update
'objDSE.SetInfo
'Call CheckIfError("trigger schema cache update")
'WScript.Echo "Updated the schema cache"

Set objClass = objSchema.Create("classSchema", _
	"CN=Sanao-Com-2000-MyProduct-Config-Info")

Call objClass.Put("lDAPDisplayName", _
	"sanaoCom2000-MyProduct-ConfigInfo")
Call objClass.Put("governsID", "1.3.6.1.4.1.123123123.1.1")
Call objClass.Put("mustContain", _
	Array("1.3.6.1.4.1.123123123.2.1"))
'Call objClass.Put("mustContain", _
'	Array("sanaoCom2000-MyProduct-UserData"))
Call objClass.Put("possSuperiors", Array("container"))
Call objClass.Put("objectClassCategory", 1)	 'Structural
Call objClass.Put("subClassOf", "top")
Call objClass.Put("defaultHidingValue", True)
Call objClass.Put("showInAdvancedViewOnly", True)

Err.Clear
objClass.SetInfo	'write the new class to the server
Call CheckIfError("create the class")
WScript.Echo "Created the class"

Err.Clear
Set objDSE = GetObject("LDAP://dc1.sanao.com/rootDSE")
Call objDSE.Put("schemaUpdateNow", 1)	 'trigger schema cache update
objDSE.SetInfo
Call CheckIfError("trigger schema cache update")
WScript.Echo "Updated the schema cache"

Sub CheckIfError(strAttemptedOperation)
	If Err <> 0 Then
		MsgBox "Couldn't " & strAttemptedOperation & vbCrLf & _
			"Error code " & Hex(Err), _
			vbOKOnly + vbCritical, "Error"
		WScript.Quit(1)	'there was an error so we set the errorlevel
	End If
End Sub