' IsMember8.vbs
' VBScript program demonstrating the use of Function IsMember.
'
' ----------------------------------------------------------------------
' Copyright (c) 2004-2010 Richard L. Mueller
' Hilltop Lab web site - http://www.rlmueller.net
' Version 1.0 - March 28, 2004
' Version 1.1 - July 6, 2007 - Modify use of Fields collection of
'                              Recordset object.
' Version 1.2 - 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, using the "tokenGroups" attribute. The function
' reveals membership in nested groups and the primary group. It requires
' that the user or computer object be bound with the LDAP provider.
' Based on an idea by Joe Kaplan.
'
' 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 objADUser, objComputer, strGroup, objGroupList
Dim adoCommand, adoConnection, strBase, strAttributes

' Bind to the user or computer object in Active Directory with the LDAP
' provider.
Set objADUser = _
    GetObject("LDAP://cn=TestUser,ou=Sales,dc=MyDomain,dc=com")
Set objComputer = _
    GetObject("LDAP://cn=TestComputer,ou=Sales,dc=MyDomain,dc=com")

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

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

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

' Clean up.
If (IsObject(adoConnection) = True) Then
    adoConnection.Close
End If

Function IsMember(ByVal objADObject, ByVal strGroupNTName)
    ' Function to test for group membership.
    ' objADObject is a user or computer object.
    ' strGroupNTName is the NT name (sAMAccountName) of the group to test.
    ' objGroupList is a dictionary object, with global scope.
    ' Returns True if the user or computer is a member of the group.
    ' Subroutine LoadGroups is called once for each different objADObject.

    Dim objRootDSE, strDNSDomain

    ' The first time IsMember is called, setup the dictionary object
    ' and objects required for ADO.
    If (IsEmpty(objGroupList) = True) Then
        Set objGroupList = CreateObject("Scripting.Dictionary")
        objGroupList.CompareMode = vbTextCompare

        Set adoCommand = CreateObject("ADODB.Command")
        Set adoConnection = CreateObject("ADODB.Connection")
        adoConnection.Provider = "ADsDSOObject"
        adoConnection.Open "Active Directory Provider"
        adoCommand.ActiveConnection = adoConnection

        Set objRootDSE = GetObject("LDAP://RootDSE")
        strDNSDomain = objRootDSE.Get("defaultNamingContext")

        adoCommand.Properties("Page Size") = 100
        adoCommand.Properties("Timeout") = 30
        adoCommand.Properties("Cache Results") = False

        ' Search entire domain.
        strBase = "<LDAP://" & strDNSDomain & ">"
        ' Retrieve NT name of each group.
        strAttributes = "sAMAccountName"

        ' Load group memberships for this user or computer into dictionary
        ' object.
        Call LoadGroups(objADObject)
    End If
    If (objGroupList.Exists(objADObject.sAMAccountName & "\") = False) Then
        ' Dictionary object established, but group memberships for this
        ' user or computer must be added.
        Call LoadGroups(objADObject)
    End If
    ' Return True if this user or computer is a member of the group.
    IsMember = objGroupList.Exists(objADObject.sAMAccountName & "\" _
        & strGroupNTName)
End Function

Sub LoadGroups(ByVal objADObject)
    ' Subroutine to populate dictionary object with group memberships.
    ' objGroupList is a dictionary object, with global scope. It keeps track
    ' of group memberships for each user or computer separately. ADO is used
    ' to retrieve the name of the group corresponding to each objectSid in
    ' the tokenGroup array. Based on an idea by Joe Kaplan.

    Dim arrbytGroups, k, strFilter, adoRecordset, strGroupName, strQuery

    ' Add user name to dictionary object, so LoadGroups need only be
    ' called once for each user or computer.
    objGroupList.Add objADObject.sAMAccountName & "\", True

    ' Retrieve tokenGroups array, a calculated attribute.
    objADObject.GetInfoEx Array("tokenGroups"), 0
    arrbytGroups = objADObject.Get("tokenGroups")

    ' Create a filter to search for groups with objectSid equal to each
    ' value in tokenGroups array.
    strFilter = "(|"
    If (TypeName(arrbytGroups) = "Byte()") Then
        ' tokenGroups has one entry.
        strFilter = strFilter & "(objectSid=" _
            & OctetToHexStr(arrbytGroups) & ")"
    ElseIf (UBound(arrbytGroups) > -1) Then
        ' TokenGroups is an array of two or more objectSid's.
        For k = 0 To UBound(arrbytGroups)
            strFilter = strFilter & "(objectSid=" _
                & OctetToHexStr(arrbytGroups(k)) & ")"
        Next
    Else
        ' tokenGroups has no objectSid's.
        Exit Sub
    End If
    strFilter = strFilter & ")"

    ' Use ADO to search for groups whose objectSid matches any of the
    ' tokenGroups values for this user or computer.
    strQuery = strBase & ";" & strFilter & ";" _
        & strAttributes & ";subtree"
    adoCommand.CommandText = strQuery
    Set adoRecordset = adoCommand.Execute

    ' Enumerate groups and add NT name to dictionary object.
    Do Until adoRecordset.EOF
        strGroupName = adoRecordset.Fields("sAMAccountName").Value
        objGroupList.Add objADObject.sAMAccountName & "\" _
            & strGroupName, True
        adoRecordset.MoveNext
    Loop
    adoRecordset.Close

End Sub

Function OctetToHexStr(ByVal arrbytOctet)
    ' Function to convert OctetString (byte array) to Hex string,
    ' with bytes delimited by \ for an ADO filter.

    Dim k
    OctetToHexStr = ""
    For k = 1 To Lenb(arrbytOctet)
        OctetToHexStr = OctetToHexStr & "\" _
            & Right("0" & Hex(Ascb(Midb(arrbytOctet, k, 1))), 2)
    Next
End Function