AD上のオブジェクトのプロパティを一括で変更する@ADSI

後から後からごちゃごちゃ追加していったらなんだか訳のわからないVBスクリプトになってしまいました。
たぶん動くと思いますがエラー処理をほぼやっていないので過信しないでください。

このスクリプトは

ADSIを使ってAD上のコンピュータのプロパティの管理者の値をテキストファイルから一括で入れる（削除する）スクリプト

です。

そもそもPCViewなんかを使ってコンピュータを管理していたことがあったんですが、そこから一括でActive Directory上に値を入れられないものかと思って作ってみたわけです。

とりあえずコンピュータオブジェクトの管理者タブに最後にログインしたユーザの名前を入れたくて作ったので

managedBy

以外の値には対応していないです。男らしいでしょ。

テキスト文書を適当に作ってタブ区切りで

PC名 ユーザ名

の一覧を作ればあとはVBSを実行するだけです。

管理者タブに値を入力する場合、ユーザのdistinguishedNameを入れないといけないのでそのへんがややこしくなっています。プログラマーの人ならサクッと作るんだろうなーなんて思いながらHey, Scripting Guy!を読みつつ書いていました。

もし使うのであれば“’”が全角になってしまっているのでそこだけ半角に置換して使ってください。

実行にはAD上のオブジェクトを変更できる権限が必要です。

ちなみにこのスクリプトを実行してAD上のオブジェクトがおかしくなったなんて言われても責任取れませんのでよろしくお願いします。

'AD上のコンピュータのプロパティの管理者の値をテキストファイルから一括で入れる（削除する）スクリプト
'追加する場合はWriteStatus、削除する場合はDeleteStatusを実行。
'2008.05.10
'cscript C:\Script\一発でADSIの値更新.vbs

Option Explicit

Const ADS_SCOPE_SUBTREE = 2

'テキストにあるかどうか検索
Dim objFS,objText
Dim strPCList
Dim strReadLine

'↓PCとユーザ一覧を記載するテキストのパス
'（例）PC-001 pnpk
strPCList = "C:\Script\list.txt"

Set objFS   = WScript.CreateObject("Scripting.FileSystemObject")
Set objText = objFS.OpenTextFile(strPCList)	'除外するリストのパスを入力

'↓テキストから文字列を読み込んでタブで区切って配列にする
Do Until objText.AtEndOfStream
    strReadLine = UCase(objText.ReadLine)

'	Wscript.Echo strReadLine
	
	Dim strValue
	Dim strPCDN
	Dim strUserDN
	Dim strPropertyName
	Dim strPropertyValue
	Dim lngLoop
	Dim QueryPCNAME2DN
	Dim QueryUserNAME2DN
	
	strValue = Split(strReadLine, "	", -1, vbTextCompare)

	'コンピュータ名からDNを探し出すクエリ
	QueryPCNAME2DN = "SELECT distinguishedName FROM 'LDAP://dc=pnpk,dc=local' WHERE objectCategory='computer' AND name = '" & strValue(0) & "'"
	'ユーザ名（sAMAccountName）からDNを探し出すクエリ
	QueryUserNAME2DN = "SELECT distinguishedName FROM 'LDAP://dc=pnpk,dc=local' WHERE objectCategory='user' AND sAMAccountName = '" & strValue(1) & "'"

'	Wscript.Echo QueryPCNAME2DN
'	Wscript.Echo QueryUserNAME2DN
	
	strPCDN          = QueryADSI(QueryPCNAME2DN)
	strUserDN        = QueryADSI(QueryUserNAME2DN)
	strPropertyName = "managedBy"
	'↓書き込む場合
	Call WriteStatus(strPCDN,strPropertyName,strUserDN)
	'↓削除する場合
'	Call DeleteStatus(QueryADSI(QueryPCNAME2DN),"managedBy")

Loop

objText.Close

'ADSIにクエリを投げてDN名を返す
'QueryADSI(SQL文)
'戻り値 DN名
Function QueryADSI(SQL)
	Dim objConnection,objCommand,objRecordSet
	
	Set objConnection = CreateObject("ADODB.Connection")
	Set objCommand =   CreateObject("ADODB.Command")
	objConnection.Provider = "ADsDSOObject"
	objConnection.Open "Active Directory Provider"
	Set objCommand.ActiveConnection = objConnection

	objCommand.Properties("Page Size") = 1000
	objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE 

	objCommand.CommandText = SQL

	Set objRecordSet = objCommand.Execute

	objRecordSet.MoveFirst
	Do Until objRecordSet.EOF

	QueryADSI = ShowStatus(objRecordSet.Fields("distinguishedName").Value)

	    objRecordSet.MoveNext
	Loop
	
	Set objConnection = Nothing
	Set objCommand    = Nothing
	Set objRecordSet = Nothing
End Function


'DNからその他の情報を取得
Function ShowStatus(DN)
	Dim objDN
	
	Set objDN = GetObject("LDAP://" & DN )
		ShowStatus = objDN.distinguishedName
	Set objDN = Nothing
End Function


'コンピュータオブジェクトに管理者を追加
'WriteStatus(コンピュータDN名,対象のプロパティ名,対象の値)
'(例)
'WriteStatus("CN=PC003,OU=コンピュータ,"managedBy",DC=pnpk,DC=local","CN=pnpk,OU=ユーザ,DC=pnpk,DC=local")
Sub WriteStatus(strPCDN,strProperty,strValue)
	Dim objADSysInfo,objUser
	Dim strUser,strGivenName

	Set objUser = GetObject("LDAP://" & strPCDN)

'	Wscript.Echo strPCDN
'	Wscript.Echo strProperty
'	Wscript.Echo strValue

	objUser.Put strProperty,strValue
	objUser.SetInfo
	objUser.GetInfo

	Wscript.Echo strProperty & "に" & objUser.Get(strProperty) & "が書き込まれました。"
	
	Set objADSysInfo = Nothing
	Set objUser = Nothing
End Sub

'項目を削除する場合
'DeleteStatus(コンピュータDN名,削除対象のプロパティ名)
'(例)
'DeleteStatus("CN=PC003,OU=コンピュータ,DC=pnpk,DC=local","managedBy")
Sub DeleteStatus(strPCDN,strProperty)
	'On Error Resume Next
	Const ADS_PROPERTY_CLEAR = 1 
	
'	Wscript.Echo strPCDN
'	Wscript.Echo strProperty
	
	Dim objPC
	Dim strProp
	
	Set objPC = GetObject("LDAP://" & strPCDN)

	objPC.PutEx ADS_PROPERTY_CLEAR,strProperty, 0
	objPC.SetInfo
	
	Wscript.Echo strProperty & "の値削除は成功しました"
	
	Set objPC = Nothing
End Sub