1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148
   | ' IsMember6.vbs
' http://www.rlmueller.net/IsMember6.htm
' VBScript program demonstrating the use of Function IsMember.
'
' ----------------------------------------------------------------------
' Copyright (c) 2003 Richard L. Mueller
' Hilltop Lab web site - http://www.rlmueller.net
' Version 1.0 - May 1, 2003
'
' 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, strGroup, strDNSDomain
 
' Declare objects and variables with global scope.
Dim objGroupList, objCommand, objConnection, objRootDSE
Dim objRecordSet, strAttributes, strFilter, strQuery
 
' Bind to user objects in Active Directory with the LDAP provider.
Set objADObject1 = GetObject("LDAP://CN=LOGIN,OU=SITE,OU=USERS,DC=societe,DC=ma,DC=fr")
 
strGroup = "MonGroupe"
If IsMember(objADObject1, strGroup) 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.
objConnection.Close
Set objGroupList = Nothing
Set objADObject1 = Nothing
Set objRootDSE = Nothing
Set objCommand = Nothing
Set objConnection = Nothing
Set objRecordSet = Nothing
 
Function IsMember(objADObject, 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) Then
' Create dictionary object.
    Set objGroupList = CreateObject("Scripting.Dictionary")
    objGroupList.CompareMode = vbTextCompare
 
' Use ADO to retrieve all group "primaryGroupToken" values.
    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") = 100
    objCommand.Properties("Timeout") = 30
    objCommand.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"
    objCommand.CommandText = strQuery
    Set objRecordSet = objCommand.Execute
  End If
  If Not objGroupList.Exists(objADObject.sAMAccountName & "\") 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(objADObject.sAMAccountName & "\") = True
 
' Determine which group is the primary group for this object.
    intPrimaryGroupID = objADObject.primaryGroupID
    objRecordSet.MoveFirst
    Do Until objRecordSet.EOF
      intPrimaryGroupToken = objRecordSet("primaryGroupToken")
      If intPrimaryGroupToken = intPrimaryGroupID Then
        strPrimaryGroup = objRecordSet.Fields("sAMAccountName")
        objGroupList(objADObject.sAMAccountName & "\" & strPrimaryGroup) = True
        Exit Do
      End If
      objRecordSet.MoveNext
    Loop
  End If
 
' Check group membership.
  IsMember = objGroupList.Exists(objADObject.sAMAccountName & "\" & strGroup)
End Function
 
Sub LoadGroups(objPriADObject ,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) Then
    Exit Sub
  End If
  If TypeName(colstrGroups) = "String" Then
    Set objGroup = GetObject("LDAP://" & colstrGroups)
    If Not objGroupList.Exists(objPriADObject.sAMAccountName & "\" & objGroup.sAMAccountName) Then
      objGroupList(objPriADObject.sAMAccountName & "\" & objGroup.sAMAccountName) = True
      Call LoadGroups(objPriADObject, objGroup)
    End If
    Set objGroup = Nothing
    Exit Sub
  End If
  For j = 0 To UBound(colstrGroups)
    Set objGroup = GetObject("LDAP://" & colstrGroups(j))
    If Not objGroupList.Exists(objPriADObject.sAMAccountName & "\" & objGroup.sAMAccountName) Then
      objGroupList(objPriADObject.sAMAccountName & "\" & objGroup.sAMAccountName) = True
      Call LoadGroups(objPriADObject, objGroup)
    End If
  Next
  Set objGroup = Nothing
End Sub | 
Partager