Active Directoryのグループをツリー構造で表示させるVBScript

ファイルサーバの権限やらその他もろもろのアクセス権限をActive Directoryで行っていると、便利なんだけど僕の場合どんどんグループが複雑になり過ぎてこんがらがってしまいます。

そこでActive Directoryのグループをツリー構造で表示させるVBScriptを作ってみました。グループ構造を自動的に出せるようになるといちいち面倒なデータの更新なんかもやらなくて済むし、棚卸の際にも負担がかなり軽くなります。

動作はWindows Server 2003と2008で確認しましたのである程度末永く使えるんじゃないかと思っています。また、Domain Usersの一覧が上手く取得出来ませんがその他は取得出来ていると思います。

Domain Usersが上手く取得出来ない理由をご存じの方いらっしゃいましたら教えてください。

スクリプトを動作させる場合には、

DomainName = "dc=pnpk,dc=local"

の部分だけ、自分のドメイン環境に合わせて変更してください。

また、サイトレイアウトの都合で’が全角になってしまっているのでテキストに保存してから半角に置換してください。

'Active Directoryのグループをツリー構造で表示させる

Option Explicit

Const ADS_SCOPE_SUBTREE = 2

Dim SQL,SQL_QUERY
Dim DomainName

'//////////////ドメイン名を入力//////////////
DomainName = "dc=pnpk,dc=local"

'追加検索条件
'(例)
'SQL_QUERY  = " Name = 'Domain Admins'"
SQL_QUERY  = ""

'SQL_QUERYに何か指定があった場合、ANDを追加
If SQL_QUERY <> "" Then
	SQL_QUERY = " AND " & SQL_QUERY
End If

SQL = "SELECT distinguishedName FROM 'LDAP://" & DomainName & "' WHERE objectCategory='group'" & SQL_QUERY

'QueryADSIの呼び出し
Call QueryADSI(SQL)

'////////////ADSIにクエリ問い合わせ////////////
'SQLクエリでActive Directory内を検索します。
Function QueryADSI(SQL)

		Dim objConnection,objCommand

		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

		Dim objRecordSet

		Set objRecordSet = objCommand.Execute

		objRecordSet.MoveFirst
		Do Until objRecordSet.EOF

		'ShowStatusの呼び出し
		Wscript.Echo ShowStatus(objRecordSet.Fields("distinguishedName").Value, 0)

		objRecordSet.MoveNext
		Loop
End Function


'////////////DN名を利用して情報を取得////////////
Function ShowStatus(DN,cnt)
	Dim adsGroup,adsMember
	Dim strName
	Dim i
	Dim stdout

	Dim Members
	Dim ArrMembers

	Set adsGroup = GetObject("LDAP://" & DN )
	set stdout = WScript.StdOut

	'////////////親グループ以外の場合Function終了////////////
	If cnt = 0 Then
		If IsArray(adsGroup.MemberOf) Then
			Exit Function
		ElseIf Not adsGroup.MemberOf = "" Then
			Exit Function
		End If
	End If


	'////////////書き込み////////////
	'タブを追加
	For i = 1 to cnt
		stdout.Write vbTab
	Next

	'CN=を削除
	stdout.Write Mid(adsGroup.Name,4) & " (" & adsGroup.description & ") " & vbCrlf

	For Each adsMember In adsGroup.Members

		If adsMember.Class = "group" Then
			Call ShowStatus(adsMember.distinguishedName, cnt +1)
		Else
			'タブを追加
			For i = 1 to cnt
							stdout.Write vbTab
			Next

			Wscript.Echo vbTab & Mid(adsMember.Name,4)
		End If
	Next
End Function