Question

我如何获得活动用户在VBA中所属的动态/虚拟组？我尝试了以下问题的解决方案：Determining a User's Group Membership using VBA

这意味着我尝试了以下代码：

Public Function UserIsInGroup(GroupName As String, _
                              Optional Username As String, _
                              Optional Domain As String) As Boolean
Dim strUsername As String
Dim objGroup    As Object
Dim objUser     As Object
Dim objNetwork  As Object

UserIsInGroup = False

If Username = "" Then
    Set objNetwork = CreateObject("WScript.Network")
    strUsername = objNetwork.UserDomain & "/" & objNetwork.Username
Else
    strUsername = Username
End If

strUsername = Replace(strUsername, "\", "/")
If InStr(strUsername, "/") Then
    ' No action: Domain has already been supplied in the user name
Else    
    If Domain = "" Then
        Set objNetwork = CreateObject("WScript.Network")
        Domain = objNetwork.UserDomain
    End If        
    strUsername = Domain & "/" & strUsername        
End If

Set objUser = GetObject("WinNT://" & strUsername & ",user")    
If objUser Is Nothing Then    
    ' Insert error-handler here if you want to report an unknown user name
Else
    For Each objGroup In objUser.Groups
        Debug.Print objGroup.Name
        If GroupName = objGroup.Name Then
            UserIsInGroup = True
            Exit For
        End If
    Next objGroup
End If

Set objNetwork = Nothing
Set objGroup = Nothing
Set objUser = Nothing

End Function

，但似乎仅返回活动目录（AD）组。我感兴趣的组（在cmd“ whoami / groups”中可以看到）没有列出。

那么，如何找出当前用户属于哪个动态组？

Answer 1

我正在搜索的用户组可以通过UserToken在哪里查询“令牌组”。

我使用以下代码进行了此操作：

Enum TokenInformation
  TokenUser = 1
  TokenGroups = 2
End Enum

Private Const TOKEN_READ As Long = &H20008

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pTo As Any, uFrom As Any, ByVal lSize As Long)
Private Declare Function GetCurrentProcess Lib "kernel32" () As Long
Private Const GetCurrentProcessFail As Long = 0

Private Declare Function OpenProcessToken Lib "advapi32.dll" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As Long
Private Const OpenProcessTokenFail As Long = 0
Private Declare Function GetTokenInformation Lib "advapi32.dll" (ByVal TokenHandle As Long, ByVal TokenInformationClass As Long, TokenInformation As Any, ByVal TokenInformationLength As Long, ReturnLength As Long) As Long
Private Const GetTokenInformationFail As Long = 0
Private Declare Function ConvertSidToStringSid Lib "advapi32.dll" Alias "ConvertSidToStringSidA" (ByVal lpSid As Long, lpString As Long) As Long
Private Declare Function LocalFree Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As Long) As Long

Private Type SID_AND_ATTRIBUTES
  Sid             As Long
  Attributes      As Long
End Type

Private Type VB_TOKEN_GROUPS
  GroupCount      As Long
  Groups()        As SID_AND_ATTRIBUTES
End Type

Private Const SizeDword As Long = 4

Public Function fn_checkForTokenGroup(ByVal par_UserGroupSid As String) As Boolean

  Dim dPseudoProcessHandle As Long
  Dim dTokenHandler As Long
  Dim dNeeded As Long
  Dim dReadBuffer() As Byte
  Dim dStringBuffer As String
  Dim dStringPointer As Long
  Dim dGroupData As VB_TOKEN_GROUPS

  On Error GoTo fn_checkForTokenGroup_error

  fn_checkForTokenGroup = False

  dPseudoProcessHandle = GetCurrentProcess()
  If dPseudoProcessHandle <> GetCurrentProcessFail Then
    If OpenProcessToken(dPseudoProcessHandle, TOKEN_READ, dTokenHandler) <> OpenProcessTokenFail Then
      Call GetTokenInformation(dTokenHandler, TokenInformation.TokenGroups, ByVal 0, 0, dNeeded)
      ReDim dReadBuffer(0 To dNeeded)
      If GetTokenInformation(dTokenHandler, TokenInformation.TokenGroups, dReadBuffer(0), UBound(dReadBuffer), dNeeded) <> GetTokenInformationFail Then
        Call CopyMemory(dGroupData.GroupCount, dReadBuffer(0), SizeDword)
        ReDim dGroupData.Groups(0 To dGroupData.GroupCount - 1)
        Call CopyMemory(dGroupData.Groups(0), dReadBuffer(SizeDword), dGroupData.GroupCount * Len(dGroupData.Groups(0)))

        Dim i As Long
        For i = 0 To dGroupData.GroupCount - 1
          If ConvertSidToStringSid(dGroupData.Groups(i).Sid, dStringPointer) Then
            dStringBuffer = Space(lstrlen(dStringPointer))
            Call CopyMemory(ByVal dStringBuffer, ByVal dStringPointer, Len(dStringBuffer))
            Call LocalFree(dStringPointer)
            If (dStringBuffer = par_UserGroupSid) Then
              fn_checkForTokenGroup = True
              GoTo fn_checkForTokenGroup_endeSchleife:
            End If
          End If
        Next
fn_checkForTokenGroup_endeSchleife:

      End If
      Call CloseHandle(dTokenHandler)
    End If
    Call CloseHandle(dPseudoProcessHandle)
  End If

fn_checkForTokenGroup_exit:

  Exit Function

fn_checkForTokenGroup_error:
  Call MsgBox(ModuleName, "CheckForTokenGroup")
  GoTo fn_checkForTokenGroup_exit:
End Function

如何获取活动Windows用户的动态用户组？

1 个答案: