' IsMember5.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.1 - February 19, 2003 - Standardize Hungarian notation.
' Version 1.2 - May 23, 2003 - Account for tokenGroups having less than
'                              two values.
' Version 1.3 - January 15, 2004 - Bug fixes.
' Version 1.4 - 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.
'
' 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

' 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")

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

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.
    ' Returns True if the user or computer is a member of the group.
    ' Subroutine LoadGroups is called once for each different objADObject.

    If (IsEmpty(objGroupList) = True) Then
        Set objGroupList = CreateObject("Scripting.Dictionary")
        objGroupList.CompareMode = vbTextCompare
        Call LoadGroups(objADObject)
    End If
    If (objGroupList.Exists(objADObject.sAMAccountName & "\") = False) Then
        Call LoadGroups(objADObject)
    End If
    IsMember = objGroupList.Exists(objADObject.sAMAccountName & "\" _
        & strGroup)
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.

    Dim arrbytGroups, j
    Dim arrstrGroupSids(), objGroup

    objGroupList.Add objADObject.sAMAccountName & "\", True

    objADObject.GetInfoEx Array("tokenGroups"), 0
    arrbytGroups = objADObject.Get("tokenGroups")
    If (TypeName(arrbytGroups) = "Byte()") Then
        ReDim arrstrGroupSids(0)
        arrstrGroupSids(0) = OctetToHexStr(arrbytGroups)
        Set objGroup = GetObject("LDAP://<SID=" & arrstrGroupSids(0) _
            & ">")
        objGroupList.Add objADObject.sAMAccountName & "\" _
            & objGroup.sAMAccountName, True
        Exit Sub
    End If
    If (UBound(arrbytGroups) = -1) Then
        Exit Sub
    End If

    ReDim arrstrGroupSids(UBound(arrbytGroups))
    For j = 0 To UBound(arrbytGroups)
        arrstrGroupSids(j) = OctetToHexStr(arrbytGroups(j))
        Set objGroup = GetObject("LDAP://<SID=" & arrstrGroupSids(j) _
            & ">")
        objGroupList.Add objADObject.sAMAccountName & "\" _
            & objGroup.sAMAccountName, True
    Next

End Sub

Function OctetToHexStr(ByVal arrbytOctet)
    ' Function to convert OctetString (byte array) to Hex string.

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