找出 AD 中沒有 Member 的 Group

通常在 AD 中會有許多 Group 代表各單位或部門
但因為組織異動的關係有些 Group 可能已經沒有 Member 或 MemberOf 了

本 VBScript 程式可以找出哪些 Group 已經沒有 Member 或 MemberOf 存在
並將這些 Group 的 DN 以一行一個的方式輸出成純文字檔案
存放在與本程式相同資料夾中

===== 程式開始 =====

' 要查詢的範圍
LDAPScope = "OU=Groups,DC=contoso,DC=com"

'---------------------------------------------------------------------------------------

ResultArray=CheckGroutMemberExist(LDAPScope)

NowPath=left(Wscript.ScriptFullName,len(Wscript.ScriptFullName)-len(Wscript.ScriptName))
MemberOutputFileName = NowPath & "GroupsNoMember-List.txt"
MemberOfOutputFileName = NowPath & "GroupsNoMemberOf-List.txt"

Set fso=CreateObject("Scripting.FileSystemObject")

Set ResultFile = fso.OpenTextFile(MemberOutputFileName, 2, true, -1)
ResultFile.write ResultArray(0)
ResultFile.close

Set ResultFile = fso.OpenTextFile(MemberOfOutputFileName, 2, true, -1)
ResultFile.write ResultArray(1)
ResultFile.close

function CheckGroutMemberExist(DN_Path)

Const ADS_SCOPE_SUBTREE = 6

' Set ADO connection
Set objConnection = CreateObject("ADODB.Connection")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"

' Set ADO command
Set objCommand = CreateObject("ADODB.Command")
Set objCommand.ActiveConnection = objConnection
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
objCommand.CommandText = "SELECT distinguishedName,member,memberOf FROM 'LDAP://" & DN_Path & "' WHERE objectCategory='group'"

' Set recordset to hold the query result
Set objRecordSet = objCommand.Execute

ReturnMamberValue = ""
ReturnMemberOfValue = ""

while Not objRecordSet.EOF

'-- Member
MemberArray=objRecordSet.Fields("member")
Match=0
if VarType(MemberArray)=8204 then
if ubound(MemberArray) >= 0 then
Match = 1
end if
end if
if Match=0 then
ReturnMamberValue = ReturnMamberValue & objRecordSet.Fields("distinguishedName") & vbcrlf
end if

'-- MemberOf
MemberOfArray=objRecordSet.Fields("memberOf")

Match=0
if VarType(MemberOfArray)=8204 then
if ubound(MemberOfArray) >= 0 then
Match = 1
end if
end if
if Match=0 then
ReturnMemberOfValue = ReturnMemberOfValue & objRecordSet.Fields("distinguishedName") & vbcrlf
end if

objRecordSet.movenext
wend

Dim ReturnArray(1)
ReturnArray(0)=ReturnMamberValue
ReturnArray(1)=ReturnMemberOfValue

CheckGroutMemberExist=ReturnArray

end function