如何在MS Access VBA中迭代活动目录组(角色)

Question

我有一些代码，如果用户在我传入的特定组中，它将返回true，但是如果用户在另一个组中，该组是我传入的goroup的一部分，则该函数将返回false。我需要能够循环访问组，以查看用户是否可能是我感兴趣的组中的组的成员。

举个例子，如果一个用户在 Group A 中，Group_A的所有成员都在Group_B中，我需要知道该用户是否在Group_B中，他们正在Group_A。这是我现在拥有的：编辑添加了函数 GetCurrentUser in IsUserInRole（）

Public Function GetCurrentUser() As String
    GetCurrentUser = Environ("USERNAME")
End Function
Public Function IsUserInRole(role) As Boolean
Dim UserObj As Object
Dim GroupObj As Object
Dim strObjectString As String
strObjectString = "WinNT://my domain/" & GetCurrentUser() & ""
Set UserObj = GetObject(strObjectString)
For Each GroupObj In UserObj.Groups
Debug.Print GroupObj.Name
   If GroupObj.Name = role Then
        IsUserInRole = True
        Exit Function
   End If
Next

结束功能

Answer 1

好的，我通过 MS 得到了一个解决方案。我在访问表单上有一些代码，它将组名称传递到模块中的函数中。该函数循环访问用户所属的所有组，并循环访问传入的组内的任何组。如果用户是组的成员，或者是传入组的成员的组的成员，则返回 true。

表格上的代码：

strGroup = "_System Admin"
If IsCurrentUserInGroup(strGroup) = True Then
    MsgBox "In System Admin"
End If

模块顶部声明的公共变量：

Public strOut As String
Public objGroupList, objUser

IsCurrentUserInGroup Code：

Function IsCurrentUserInGroup(ByVal strGroup) As Boolean
Dim objSysInfo As Object
Dim strDN As String
'Get currentlly logged in users info
Set objSysInfo = CreateObject("ADSystemInfo")
strDN = objSysInfo.UserName
On Error Resume Next
Set objUser = GetObject("LDAP://" & strDN)
If (Err.Number <> 0) Then
   On Error GoTo 0
   MsgBox "User not found" & vbCrLf & strDN
End If
On Error GoTo 0
' Bind to dictionary object.
Set objGroupList = CreateObject("Scripting.Dictionary")
' Enumerate group memberships.
If EnumGroups(objUser, "", strGroup) = True Then
    IsCurrentUserInGroup = True
Else
    IsCurrentUserInGroup = False
End If
End Function    

枚举组代码：

Public Function EnumGroups(ByVal objADObject, ByVal strOffset, ByVal strGroup) As Boolean
' Recursive subroutine to enumerate user group memberships.
' Includes nested group memberships.
Dim colstrGroups, objGroup, j
objGroupList.CompareMode = vbTextCompare
colstrGroups = objADObject.memberOf
If (IsEmpty(colstrGroups) = True) Then
    Exit Function
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(objGroup.sAMAccountName) = False) Then
        objGroupList.Add objGroup.sAMAccountName, True
         strOut = strOut + strOffset & objGroup.distinguishedName + Chr(13) + Chr(10)
        Call EnumGroups(objGroup, strOffset & "--", "")
    Else
        strOut = strOut + strOffset + strOffset & objGroup.distinguishedName & " (Duplicate)" + Chr(13) + Chr(10)
    End If
    Exit Function
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(objGroup.sAMAccountName) = False) Then
        If objGroup.sAMAccountName = strGroup Then
            EnumGroups = True                 
        End If
        objGroupList.Add objGroup.sAMAccountName, True
        strOut = strOut + strOffset & objGroup.distinguishedName + Chr(13) + Chr(10)
        Call EnumGroups(objGroup, strOffset & "--", "")
    Else
        strOut = strOut + strOffset & objGroup.distinguishedName & " (Duplicate)" + Chr(13) + Chr(10)
    End If
Next
End Function