1

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

例如，如果一个用户在 GroupA 中并且 Group_A 的所有成员都在 Group_B 中，我需要知道用户是否在 Group_B 中，他们在 Group_A 中。这是我现在所拥有的： ****EDIT 添加了在 IsUserInRole() 中使用的函数 GetCurrentUser

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

结束功能

4

1 回答 1

2

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

表格代码：

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

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

Public strOut As String
Public objGroupList, objUser

IsCurrentUserInGroup 代码：

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
于 2012-08-17T18:21:28.970 回答