VB 调用NT系统“选择用户组”对话框

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, "\\shang" , "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