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

Pri
vate 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


 
目前有0条回应
Comment
Trackback
你目前的身份是游客,请输入昵称和电邮!