选择用户组

Option Explicit

Private Const NERR_SUCCESS                            As Long = 0&
Private Const OPENUSERBROWSER_INCLUDE_SYSTEM          As Long = &H10000
Private Const OPENUSERBROWSER_SINGLE_SELECTION        As Long = &H1000&
Private Const OPENUSERBROWSER_NO_LOCAL_DOMAIN         As Long = &H100&
Private Const OPENUSERBROWSER_INCLUDE_CREATOR_OWNER   As Long = &H80&
Private Const OPENUSERBROWSER_INCLUDE_EVERYONE        As Long = &H40&
Private Const OPENUSERBROWSER_INCLUDE_INTERACTIVE     As Long = &H20&
Private Const OPENUSERBROWSER_INCLUDE_NETWORK         As Long = &H10&
Private Const OPENUSERBROWSER_INCLUDE_USERS           As Long = &H8&
Private Const OPENUSERBROWSER_INCLUDE_USER_BUTTONS    As Long = &H4&
Private Const OPENUSERBROWSER_INCLUDE_GROUPS          As Long = &H2&
Private Const OPENUSERBROWSER_INCLUDE_ALIASES         As Long = &H1&
Private Const OPENUSERBROWSER_FLAGS                   As Long = OPENUSERBROWSER_INCLUDE_USERS Or OPENUSERBROWSER_INCLUDE_USER_BUTTONS Or OPENUSERBROWSER_INCLUDE_EVERYONE Or OPENUSERBROWSER_INCLUDE_INTERACTIVE Or OPENUSERBROWSER_INCLUDE_NETWORK Or OPENUSERBROWSER_INCLUDE_ALIASES

Private Declare Function OpenUserBrowser Lib "netui2.dll" (lpOpenUserBrowser As Any) As Long
Private Declare Function EnumUserBrowserSelection Lib "netui2.dll" (ByVal hBrowser As Long, ByRef lpEnumUserBrowser As Any, ByRef cbSize As Long) As Long
Private Declare Function CloseUserBrowser Lib "netui2.dll" (ByVal hBrowser As Long) As Long
Private Declare Function lstrlenW Lib "kernel32" (ByVal lpString As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

Private Type OPENUSERBROWSER_STRUCT
   cbSize        As Long
   fCancelled    As Long
   Unknown       As Long
   hWndParent    As Long
   szTitle       As Long
   szDomainName  As Long
   dwFlags       As Long
   dwHelpID      As Long
   szHelpFile    As Long
End Type

Private Type ENUMUSERBROWSER_STRUCT
   SidType        As Long
   Sid1           As Long
   Sid2           As Long
   szFullName     As Long
   szUserName     As Long
   szDisplayName  As Long
   szDomainName   As Long
   szDescription  As Long
   sBuffer        As String * 1000
End Type

Private Sub Command1_Click()
   Dim sUsers As String
   If GetBrowserNames(Me.hWnd, "//ccc", "Select Users & Groups Demo", sUsers) Then
      Text1.Text = sUsers
   End If
End Sub

Private Function GetBrowserNames(ByVal hParent As Long, ByVal sDomain As String, ByVal sTitle As String, sBuff As String) As Boolean
   Dim hBrowser   As Long
   Dim browser    As OPENUSERBROWSER_STRUCT
   Dim enumb      As ENUMUSERBROWSER_STRUCT
  'initialize the OPENUSERBROWSER structure
   With browser
      .cbSize = Len(browser)
      .fCancelled = 0
      .Unknown = 0
      .hWndParent = hParent
      .szTitle = StrPtr(sTitle)
      .szDomainName = StrPtr(sDomain)
      .dwFlags = OPENUSERBROWSER_FLAGS
   End With
  'show the dialog function
   hBrowser = OpenUserBrowser(browser)
  'if not cancelled...
   If browser.fCancelled = NERR_SUCCESS Then
      '...retrieve any selections and populate
      'the sBuff string passed to this function,
      'returning True if successful.
       Do While EnumUserBrowserSelection(hBrowser, enumb, Len(enumb) + 1) <> 0
          'return selection as //DOMAIN/NAME
          'can be adjusted at will
           sBuff = sBuff & GetPointerToByteStringW(enumb.szDomainName) & "/" & GetPointerToByteStringW(enumb.szUserName) & vbCrLf
           GetBrowserNames = True
       Loop
       Call CloseUserBrowser(hBrowser)
      'if desired, strip the last crlf from the string
       If GetBrowserNames = True Then
           sBuff = Left(sBuff, Len(sBuff) - 2)
       End If
   End If
End Function

Private Function GetPointerToByteStringW(ByVal dwData As Long) As String
   Dim tmp() As Byte
   Dim tmplen As Long

   If dwData <> 0 Then
      tmplen = lstrlenW(dwData) * 2
      If tmplen <> 0 Then
         ReDim tmp(0 To (tmplen - 1)) As Byte
         CopyMemory tmp(0), ByVal dwData, tmplen
         GetPointerToByteStringW = tmp
     End If
   End If
End Function