上一篇
下一篇
VB调用NT系统“选择用户组”对话框
作者:JiaJia 日期:2007-12-10
贴出来方便一下。
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
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
文章来自: 
引用通告: 
Tags: 评论: 0 | 引用: 0 | 查看次数: -
发表评论