目的:获取 Workstation 配置信息 和当前用户.
To a form add a command button (Command1), list box (List1), and two labels (Label1, Label2). A third set of labels in a control array can be used for the list item captions. Add the following to the form:
==================================================================
Option Explicit
Private Const NERR_SUCCESS As Long = 0&
Private Const MAX_PREFERRED_LENGTH As Long = -1
Private Const ERROR_MORE_DATA As Long = 234&
Private Const LB_SETTABSTOPS As Long = &H192'for use on Win NT/2000 only
Private Type WKSTA_INFO_102
wki102_platform_id As Long
wki102_computername As Long
wki102_langroup As Long
wki102_ver_major As Long
wki102_ver_minor As Long
wki102_lanroot As Long
wki102_logged_on_users As Long
End TypePrivate Type WKSTA_USER_INFO_0
wkui0_username As Long
End TypePrivate Declare Function NetWkstaGetInfo Lib "netapi32" _
(ByVal servername As Long, _
ByVal level As Long, _
bufptr As Long) As Long
Private Declare Function NetWkstaUserEnum Lib "netapi32" _
(ByVal servername As Long, _
ByVal level As Long, _
bufptr As Long, _
ByVal prefmaxlen As Long, _
entriesread As Long, _
totalentries As Long, _
resume_handle As Long) As Long
Private Declare Function NetApiBufferFree Lib "netapi32" _
(ByVal Buffer As Long) As Long'common
Private Declare Sub CopyMemory Lib "kernel32" _
Alias "RtlMoveMemory" _
(pTo As Any, _
uFrom As Any, _
ByVal lSize As Long)
Private Declare Function lstrlenW Lib "kernel32" _
(ByVal lpString As Long) As LongPrivate Declare Function SendMessage Lib "user32" _
Alias "SendMessageA" _
(ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
lParam As Any) As Long
Private Sub Form_Load() ReDim TabArray(0 To 6) As Long
TabArray(0) = 78
TabArray(1) = 129
TabArray(2) = 159
TabArray(3) = 198
TabArray(4) = 227
TabArray(5) = 253
TabArray(6) = 302 'Clear existing tabs and set list tabstops
Call SendMessage(List1.hwnd, LB_SETTABSTOPS, 0&, ByVal 0&)
Call SendMessage(List1.hwnd, LB_SETTABSTOPS, 7&, TabArray(0))
List1.Refresh Command1.Caption = "NetWkstaGetInfo"
Label1.Caption = "call success (0) or error :"
Label2.Caption = ""
End Sub
Private Sub Command1_Click() Dim bufptr As Long
Dim dwServer As Long
Dim success As Long
Dim nStructSize As Long
Dim bServer As String
Dim ws102 As WKSTA_INFO_102
bServer = "\\" & Environ$("COMPUTERNAME") & vbNullString List1.Clear
Label2.Caption = success
dwServer = StrPtr(bServer)
success = NetWkstaGetInfo(dwServer, 102, bufptr) If success = NERR_SUCCESS And _
success <> ERROR_MORE_DATA Then
nStructSize = LenB(ws102)
'cast data into a WKSTA_INFO_102 type
'and add the data to a list, calling
'the GetWorkstationUserName function
'to retrieve the logon username for
'the dwServer passed
CopyMemory ws102, ByVal bufptr, nStructSize List1.AddItem GetPointerToByteStringW(ws102.wki102_computername) & vbTab & _
GetPointerToByteStringW(ws102.wki102_langroup) & vbTab & _
ws102.wki102_logged_on_users & vbTab & _
ws102.wki102_platform_id & vbTab & _
ws102.wki102_ver_major & vbTab & _
ws102.wki102_ver_minor & vbTab & _
GetWorkstationUserName(dwServer)
End If
Call NetApiBufferFree(bufptr)
End Sub
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
Private Function GetWorkstationUserName(ByVal dwWorkstation As Long) As String Dim bufptr As Long
Dim dwEntriesread As Long
Dim dwTotalentries As Long
Dim dwResumehandle As Long
Dim success As Long
Dim nStructSize As Long
Dim wui0 As WKSTA_USER_INFO_0
success = NetWkstaUserEnum(dwWorkstation, _
0, _
bufptr, _
MAX_PREFERRED_LENGTH, _
dwEntriesread, _
dwTotalentries, _
dwResumehandle) If success = NERR_SUCCESS And _
success <> ERROR_MORE_DATA Then
nStructSize = LenB(wui0)
If dwEntriesread > 0 Then 'cast data into WKSTA_USER_INFO_0 since
'we only need the user name. Although this
'API enumerates and returns information
'about all users currently logged on to
'the workstation, including interactive,
'service and batch logons, chances are
'that the first user enumerated was the
'user who logged on the session so we
'exit after the first user info is returned.
'
'If this presumption is incorrect, please
'let me know via the VBnet Comments link.
CopyMemory wui0, ByVal bufptr, nStructSize
GetWorkstationUserName = GetPointerToByteStringW(wui0.wkui0_username)
'clean up
Call NetApiBufferFree(bufptr)
Exit Function
End If End If
'if the dwWorkstation passed was a Win9x
'machine, dwEntriesread was 0, so return
'a default string.
GetWorkstationUserName = "n\a on Win9x"
Call NetApiBufferFree(bufptr)
End Function
To a form add a command button (Command1), list box (List1), and two labels (Label1, Label2). A third set of labels in a control array can be used for the list item captions. Add the following to the form:
==================================================================
Option Explicit
Private Const NERR_SUCCESS As Long = 0&
Private Const MAX_PREFERRED_LENGTH As Long = -1
Private Const ERROR_MORE_DATA As Long = 234&
Private Const LB_SETTABSTOPS As Long = &H192'for use on Win NT/2000 only
Private Type WKSTA_INFO_102
wki102_platform_id As Long
wki102_computername As Long
wki102_langroup As Long
wki102_ver_major As Long
wki102_ver_minor As Long
wki102_lanroot As Long
wki102_logged_on_users As Long
End TypePrivate Type WKSTA_USER_INFO_0
wkui0_username As Long
End TypePrivate Declare Function NetWkstaGetInfo Lib "netapi32" _
(ByVal servername As Long, _
ByVal level As Long, _
bufptr As Long) As Long
Private Declare Function NetWkstaUserEnum Lib "netapi32" _
(ByVal servername As Long, _
ByVal level As Long, _
bufptr As Long, _
ByVal prefmaxlen As Long, _
entriesread As Long, _
totalentries As Long, _
resume_handle As Long) As Long
Private Declare Function NetApiBufferFree Lib "netapi32" _
(ByVal Buffer As Long) As Long'common
Private Declare Sub CopyMemory Lib "kernel32" _
Alias "RtlMoveMemory" _
(pTo As Any, _
uFrom As Any, _
ByVal lSize As Long)
Private Declare Function lstrlenW Lib "kernel32" _
(ByVal lpString As Long) As LongPrivate Declare Function SendMessage Lib "user32" _
Alias "SendMessageA" _
(ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
lParam As Any) As Long
Private Sub Form_Load() ReDim TabArray(0 To 6) As Long
TabArray(0) = 78
TabArray(1) = 129
TabArray(2) = 159
TabArray(3) = 198
TabArray(4) = 227
TabArray(5) = 253
TabArray(6) = 302 'Clear existing tabs and set list tabstops
Call SendMessage(List1.hwnd, LB_SETTABSTOPS, 0&, ByVal 0&)
Call SendMessage(List1.hwnd, LB_SETTABSTOPS, 7&, TabArray(0))
List1.Refresh Command1.Caption = "NetWkstaGetInfo"
Label1.Caption = "call success (0) or error :"
Label2.Caption = ""
End Sub
Private Sub Command1_Click() Dim bufptr As Long
Dim dwServer As Long
Dim success As Long
Dim nStructSize As Long
Dim bServer As String
Dim ws102 As WKSTA_INFO_102
bServer = "\\" & Environ$("COMPUTERNAME") & vbNullString List1.Clear
Label2.Caption = success
dwServer = StrPtr(bServer)
success = NetWkstaGetInfo(dwServer, 102, bufptr) If success = NERR_SUCCESS And _
success <> ERROR_MORE_DATA Then
nStructSize = LenB(ws102)
'cast data into a WKSTA_INFO_102 type
'and add the data to a list, calling
'the GetWorkstationUserName function
'to retrieve the logon username for
'the dwServer passed
CopyMemory ws102, ByVal bufptr, nStructSize List1.AddItem GetPointerToByteStringW(ws102.wki102_computername) & vbTab & _
GetPointerToByteStringW(ws102.wki102_langroup) & vbTab & _
ws102.wki102_logged_on_users & vbTab & _
ws102.wki102_platform_id & vbTab & _
ws102.wki102_ver_major & vbTab & _
ws102.wki102_ver_minor & vbTab & _
GetWorkstationUserName(dwServer)
End If
Call NetApiBufferFree(bufptr)
End Sub
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
Private Function GetWorkstationUserName(ByVal dwWorkstation As Long) As String Dim bufptr As Long
Dim dwEntriesread As Long
Dim dwTotalentries As Long
Dim dwResumehandle As Long
Dim success As Long
Dim nStructSize As Long
Dim wui0 As WKSTA_USER_INFO_0
success = NetWkstaUserEnum(dwWorkstation, _
0, _
bufptr, _
MAX_PREFERRED_LENGTH, _
dwEntriesread, _
dwTotalentries, _
dwResumehandle) If success = NERR_SUCCESS And _
success <> ERROR_MORE_DATA Then
nStructSize = LenB(wui0)
If dwEntriesread > 0 Then 'cast data into WKSTA_USER_INFO_0 since
'we only need the user name. Although this
'API enumerates and returns information
'about all users currently logged on to
'the workstation, including interactive,
'service and batch logons, chances are
'that the first user enumerated was the
'user who logged on the session so we
'exit after the first user info is returned.
'
'If this presumption is incorrect, please
'let me know via the VBnet Comments link.
CopyMemory wui0, ByVal bufptr, nStructSize
GetWorkstationUserName = GetPointerToByteStringW(wui0.wkui0_username)
'clean up
Call NetApiBufferFree(bufptr)
Exit Function
End If End If
'if the dwWorkstation passed was a Win9x
'machine, dwEntriesread was 0, so return
'a default string.
GetWorkstationUserName = "n\a on Win9x"
Call NetApiBufferFree(bufptr)
End Function
解决方案 »
- VB 远程连接SQL2005
- 下面这段 代码如何 添加 控件数组？
- fpspread 使用大问题...记录条数不到2000条,为什么程序运行好慢~~~~~~~!@$!@$
- 代码配置IIS
- 一个MSHFlexGrid 指向的问题 还有个数据库插入重复数据的问题！
- 如何把richtextbox中的内容添加到SQL中?
- 急！求救！！打印 居中 横向
- 如何用VB实现最短路径
- 请问大虾上网都玩些什么？顺便有个技术问题也请指教。统统给分
- vb串口通信怎样正确接收
- 我在窗体中加了一个ado数据控件，该控件的recordsource="select * from tblCity where ProvinceID=" & lngID 数据源不为空。为什么ado数
- vb安装的问题
For Each computer In GetObject("winmgmts:{impersonationLevel=impersonate}").InstancesOf("Win32_ComputerSystem")
MsgBox computer.domain
Next关于WMI的详细信息，您可以参考以下文档：
http://msdn.microsoft.com/library/?url=/library/en-us/wmisdk/wmistart_5kth.asp?frame=true- 微软全球技术中心 VB技术支持本贴子以“现状”提供且没有任何担保，同时也没有授予任何权利。具体事项可参见使用条款(http://support.microsoft.com/directory/worldwide/zh-cn/community/terms_chs.asp)。