' IsMember6.vbs
' VBScript program demonstrating the use of Function IsMember.
'
' ----------------------------------------------------------------------
' Copyright (c) 2003-2010 Richard L. Mueller
' Hilltop Lab web site - http://www.rlmueller.net
' Version 1.0 - May 1, 2003
' Version 1.1 - July 6, 2007 - Modify use of Fields collection of
'                              Recordset object.
' Version 1.2 - July 31, 2007 - Escape any "/" characters in group DN's.
' Version 1.3 - November 6, 2010 - No need to set objects to Nothing.
'
' An efficient IsMember function to test group membership for any number
' of users or computers. The function reveals membership in nested
' groups, as well as the primary group. It requires that the user or
' computer objects be bound with the LDAP provider.
'
' You have a royalty-free right to use, modify, reproduce, and
' distribute this script file in any way you find useful, provided that
' you agree that the copyright owner above has no warranty, obligations,
' or liability for such use.

Option Explicit

Dim objADObject1, objADObject2, strGroup

' Declare objects and variables with global scope.
Dim objGroupList, adoCommand, adoConnection, objRootDSE
Dim adoRecordset, strAttributes, strFilter, strQuery

' Bind to user objects in Active Directory with the LDAP provider.
Set objADObject1 = GetObject("LDAP://cn=Usr,ou=Engr,dc=MyDomain,dc=com")
Set objADObject2 = GetObject("LDAP://cn=Admin,ou=IT,dc=MyDomain,dc=com")

strGroup = "Sales"
If (IsMember(objADObject1, strGroup) = True) Then
    Wscript.Echo "User " & objADObject1.name _
        & " is a member of group " & strGroup
Else
    Wscript.Echo "User " & objADObject1.name _
        & " is NOT a member of group " & strGroup
End If

strGroup = "Engineering"
If (IsMember(objADObject1, strGroup) = True) Then
    Wscript.Echo "User " & objADObject1.name _
        & " is a member of group " & strGroup
Else
    Wscript.Echo "User " & objADObject1.name _
        & " is NOT a member of group " & strGroup
End If

If (IsMember(objADObject2, strGroup) = True) Then
    Wscript.Echo "User " & objADObject2.name _
        & " is a member of group " & strGroup
Else
    Wscript.Echo "User " & objADObject2.name _
        & " is NOT a member of group " & strGroup
End If

strGroup = "Domain Users"
If (IsMember(objADObject1, strGroup) = True) Then
    Wscript.Echo "User " & objADObject1.name _
        & " is a member of group " & strGroup
Else
    Wscript.Echo "User " & objADObject1.name _
        & " is NOT a member of group " & strGroup
End If

' Clean up.
adoConnection.Close

Function IsMember(ByVal objADObject, ByVal strGroup)
    ' Function to test for group membership.
    ' objADObject is a user or computer object.
    ' strGroup is the NT name (sAMAccountName) of the group to test.
    ' objGroupList is a dictionary object, with global scope.
    ' ADO is used to retrieve all group objects from the domain, with
    ' their PrimaryGroupToken. Each objADObject has a PrimaryGroupID.
    ' The group with the matching PrimaryGroupToken is the primary group.
    ' Returns True if the user or computer is a member of the group.
    ' Subroutine LoadGroups is called once for each different objADObject.

    Dim strPrimaryGroup
    Dim intPrimaryGroupToken, intPrimaryGroupID

    If (IsEmpty(objGroupList) = True) Then
        ' Create dictionary object.
        Set objGroupList = CreateObject("Scripting.Dictionary")
        objGroupList.CompareMode = vbTextCompare

        ' Use ADO to retrieve all group "primaryGroupToken" values.
        Set adoConnection = CreateObject("ADODB.Connection")
        Set adoCommand = CreateObject("ADODB.Command")
        adoConnection.Provider = "ADsDSOObject"
        adoConnection.Open "Active Directory Provider"
        Set adoCommand.ActiveConnection = adoConnection
        adoCommand.Properties("Page Size") = 100
        adoCommand.Properties("Timeout") = 30
        adoCommand.Properties("Cache Results") = False
        strAttributes = "sAMAccountName,primaryGroupToken"
        Set objRootDSE = GetObject("LDAP://RootDSE")
        strDNSDomain = objRootDSE.Get("defaultNamingContext")
        strFilter = "(objectCategory=group)"
        strQuery = "<LDAP://" & strDNSDomain & ">;" & strFilter & ";" _
            & strAttributes & ";subtree"
        adoCommand.CommandText = strQuery
        Set adoRecordset = adoCommand.Execute
    End If
    If (objGroupList.Exists(objADObject.sAMAccountName & "\") = False) Then
        ' Call LoadGroups for each different objADObject.
        ' Add object name to dictionary object so groups need only be
        ' enumerated once.
        Call LoadGroups(objADObject, objADObject)
        objGroupList.Add objADObject.sAMAccountName & "\", True

        ' Determine which group is the primary group for this object.
        intPrimaryGroupID = objADObject.primaryGroupID
        adoRecordset.MoveFirst
        Do Until adoRecordset.EOF
            intPrimaryGroupToken = adoRecordset.Fields("primaryGroupToken").Value
            If (intPrimaryGroupToken = intPrimaryGroupID) Then
                strPrimaryGroup = adoRecordset.Fields("sAMAccountName").Value
                objGroupList.Add objADObject.sAMAccountName & "\" _
                    & strPrimaryGroup, True
                Exit Do
            End If
            adoRecordset.MoveNext
        Loop
        adoRecordset.Close
    End If

    ' Check group membership.
    IsMember = objGroupList.Exists(objADObject.sAMAccountName & "\" _
        & strGroup)
End Function

Sub LoadGroups(ByVal objPriADObject, ByVal objSubADObject)
    ' Recursive subroutine to populate dictionary object with group
    ' memberships. When this subroutine is first called by Function
    ' IsMember, both objPriADObject and objSubADObject are the user or
    ' computer object. On recursive calls objPriADObject still refers to the
    ' user or computer object being tested, but objSubADObject will be a
    ' group object. The dictionary object objGroupList keeps track of group
    ' memberships for each user or computer separately.
    ' For each group in the MemberOf collection, first check to see if
    ' the group is already in the dictionary object. If it is not, add the
    ' group to the dictionary object and recursively call this subroutine
    ' again to enumerate any groups the group might be a member of (nested
    ' groups). It is necessary to first check if the group is already in the
    ' dictionary object to prevent an infinite loop if the group nesting is
    ' "circular". The MemberOf collection does not include any "primary"
    ' groups.

    Dim colstrGroups, objGroup, j
    colstrGroups = objSubADObject.memberOf
    If (IsEmpty(colstrGroups) = True) Then
        Exit Sub
    End If
    If (TypeName(colstrGroups) = "String") Then
        ' Escape any forward slash characters, "/", with the backslash
        ' escape character. All other characters that should be escaped are.
        colstrGroups = Replace(colstrGroups, "/", "\/")
        Set objGroup = GetObject("LDAP://" & colstrGroups)
        If (objGroupList.Exists(objPriADObject.sAMAccountName & "\" _
                & objGroup.sAMAccountName) = False) Then
            objGroupList.Add objPriADObject.sAMAccountName & "\" _
                & objGroup.sAMAccountName, True
            Call LoadGroups(objPriADObject, objGroup)
        End If
        Exit Sub
    End If
    For j = 0 To UBound(colstrGroups)
        ' Escape any forward slash characters, "/", with the backslash
        ' escape character. All other characters that should be escaped are.
        colstrGroups(j) = Replace(colstrGroups(j), "/", "\/")
        Set objGroup = GetObject("LDAP://" & colstrGroups(j))
        If (objGroupList.Exists(objPriADObject.sAMAccountName & "\" _
                & objGroup.sAMAccountName) = False) Then
            objGroupList.Add objPriADObject.sAMAccountName & "\" _
                & objGroup.sAMAccountName, True
            Call LoadGroups(objPriADObject, objGroup)
        End If
    Next
End Sub