host/winhost/CNetWksta.cls

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "CNetWksta"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
' *********************************************************
'  Copyright (C)1997, Karl E. Peterson
' *********************************************************
Option Explicit
'
' Win32 APIs to determine OS information.
'
Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long
Private Type OSVERSIONINFO
   dwOSVersionInfoSize As Long
   dwMajorVersion As Long
   dwMinorVersion As Long
   dwBuildNumber As Long
   dwPlatformId As Long
   szCSDVersion As String * 128
End Type
Private Const VER_PLATFORM_WIN32s = 0
Private Const VER_PLATFORM_WIN32_WINDOWS = 1
Private Const VER_PLATFORM_WIN32_NT = 2
'
' Win32 NetAPIs.
'
Private Declare Function NetWkstaGetInfo Lib "Netapi32.dll" (lpServer As Any, ByVal Level As Long, lpBuffer As Any) As Long
Private Declare Function NetWkstaUserGetInfo Lib "Netapi32.dll" (ByVal reserved As Any, ByVal Level As Long, lpBuffer As Any) As Long
Private Declare Function NetApiBufferFree Lib "Netapi32.dll" (ByVal lpBuffer As Long) As Long
'
' Data handling APIs
'
Private Declare Sub CopyMem 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 Long
Private Declare Function lstrcpyW Lib "kernel32" (lpString1 As Byte, ByVal lpString2 As Long) As Long

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 Type

Private Type WkstaInfo102
   PlatformId As Long
   ComputerName As String
   LanGroup As String
   VerMajor As Long
   VerMinor As Long
   LanRoot As String
   LoggedOnUsers As Long
End Type

Private Type WKSTA_USER_INFO_1
   wkui1_username As Long
   wkui1_logon_domain As Long
   wkui1_oth_domains As Long
   wkui1_logon_server As Long
End Type

Private Type WkstaUserInfo1
   UserName As String
   LogonDomain As String
   OtherDomains As String
   LogonServer As String
End Type

Private Const NERR_Success As Long = 0&
'
' Member variables
'
Private m_Wks As WkstaInfo102
Private m_User As WkstaUserInfo1
Private m_IsWinNT As Boolean
   
' *********************************************************
'  Initialization
' *********************************************************
Private Sub Class_Initialize()
   Dim os As OSVERSIONINFO
   '
   ' Check to make sure we're running NT!
   '
   os.dwOSVersionInfoSize = Len(os)
   Call GetVersionEx(os)
   If os.dwPlatformId = VER_PLATFORM_WIN32_NT Then
      m_IsWinNT = True
      Me.Refresh
   End If
End Sub

' *********************************************************
'  Public Properties (Workstation)
' *********************************************************
Public Property Get ComputerName() As String
   ComputerName = m_Wks.ComputerName
End Property

Public Property Get Domain() As String
   Domain = m_Wks.LanGroup
End Property

Public Property Get LanRoot() As String
   LanRoot = m_Wks.LanRoot
End Property

Public Property Get LoggedOnUsers() As Long
   LoggedOnUsers = m_Wks.LoggedOnUsers
End Property

Public Property Get PlatformId() As Long
   PlatformId = m_Wks.PlatformId
End Property

Public Property Get VerMajor() As Long
   VerMajor = m_Wks.VerMajor
End Property

Public Property Get VerMinor() As Long
   VerMinor = m_Wks.VerMinor
End Property

' *********************************************************
'  Public Properties (Workstation User)
' *********************************************************
Public Property Get LogonDomain() As String
   LogonDomain = m_User.LogonDomain
End Property

Public Property Get LogonServer() As String
   LogonServer = m_User.LogonServer
End Property

Public Property Get OtherDomains() As String
   OtherDomains = m_User.OtherDomains
End Property

Public Property Get UserName() As String
   UserName = m_User.UserName
End Property

' *********************************************************
'  Public Methods
' *********************************************************
Public Sub Refresh()
   Dim lpBuffer As Long
   Dim nRet As Long
   Dim wki As WKSTA_INFO_102
   Dim wkui As WKSTA_USER_INFO_1
   '
   ' These functions only exist in Windows NT!!!
   '
   If Not m_IsWinNT Then Exit Sub
   '
   ' Obtain workstation information
   '
   nRet = NetWkstaGetInfo(ByVal 0&, 102&, lpBuffer)
   If nRet = NERR_Success Then
      '
      ' Transfer data to VB-friendly structure
      '
      CopyMem wki, ByVal lpBuffer, Len(wki)
      m_Wks.PlatformId = wki.wki102_platform_id
      m_Wks.ComputerName = PointerToStringW(wki.wki102_computername)
      m_Wks.LanGroup = PointerToStringW(wki.wki102_langroup)
      m_Wks.VerMajor = wki.wki102_ver_major
      m_Wks.VerMinor = wki.wki102_ver_minor
      m_Wks.LanRoot = PointerToStringW(wki.wki102_lanroot)
      m_Wks.LoggedOnUsers = wki.wki102_logged_on_users
      '
      ' Clean up
      '
      If lpBuffer Then
         Call NetApiBufferFree(lpBuffer)
      End If
   End If
   '
   ' Obtain user information for this workstation
   '
   nRet = NetWkstaUserGetInfo(0&, 1&, lpBuffer)
   If nRet = NERR_Success Then
      '
      ' Transfer data to VB-friendly structure
      '
      CopyMem wkui, ByVal lpBuffer, Len(wkui)
      m_User.UserName = PointerToStringW(wkui.wkui1_username)
      m_User.LogonDomain = PointerToStringW(wkui.wkui1_logon_domain)
      m_User.OtherDomains = PointerToStringW(wkui.wkui1_oth_domains)
      m_User.LogonServer = PointerToStringW(wkui.wkui1_logon_server)
      '
      ' Clean up
      '
      If lpBuffer Then
         Call NetApiBufferFree(lpBuffer)
      End If
   End If
End Sub

' *********************************************************
'  Private Methods
' *********************************************************
Private Function PointerToStringW(lpStringW As Long) As String
   Dim buffer() As Byte
   Dim nLen As Long
   
   If lpStringW Then
      nLen = lstrlenW(lpStringW) * 2
      If nLen Then
         ReDim buffer(0 To (nLen - 1)) As Byte
         CopyMem buffer(0), ByVal lpStringW, nLen
         PointerToStringW = buffer
      End If
   End If
End Function


Revision:	1.1
Committed:	Wed Feb 28 09:15:05 2001 UTC (23 years, 9 months ago) by pjm2
Branch:	MAIN
CVS Tags:	PROJECT_COMPLETION
Log Message:	Some VB class files that are used to return certain information about the machine they are running on. I did not write these. I had to change a couple of bits to make them work, however.
#	Content
1	VERSION 1.0 CLASS
2	BEGIN
3	MultiUse = -1 'True
4	Persistable = 0 'NotPersistable
5	DataBindingBehavior = 0 'vbNone
6	DataSourceBehavior = 0 'vbNone
7	MTSTransactionMode = 0 'NotAnMTSObject
8	END
9	Attribute VB_Name = "CNetWksta"
10	Attribute VB_GlobalNameSpace = False
11	Attribute VB_Creatable = True
12	Attribute VB_PredeclaredId = False
13	Attribute VB_Exposed = False
14	' *********************************************************
15	' Copyright (C)1997, Karl E. Peterson
16	' *********************************************************
17	Option Explicit
18	'
19	' Win32 APIs to determine OS information.
20	'
21	Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long
22	Private Type OSVERSIONINFO
23	dwOSVersionInfoSize As Long
24	dwMajorVersion As Long
25	dwMinorVersion As Long
26	dwBuildNumber As Long
27	dwPlatformId As Long
28	szCSDVersion As String * 128
29	End Type
30	Private Const VER_PLATFORM_WIN32s = 0
31	Private Const VER_PLATFORM_WIN32_WINDOWS = 1
32	Private Const VER_PLATFORM_WIN32_NT = 2
33	'
34	' Win32 NetAPIs.
35	'
36	Private Declare Function NetWkstaGetInfo Lib "Netapi32.dll" (lpServer As Any, ByVal Level As Long, lpBuffer As Any) As Long
37	Private Declare Function NetWkstaUserGetInfo Lib "Netapi32.dll" (ByVal reserved As Any, ByVal Level As Long, lpBuffer As Any) As Long
38	Private Declare Function NetApiBufferFree Lib "Netapi32.dll" (ByVal lpBuffer As Long) As Long
39	'
40	' Data handling APIs
41	'
42	Private Declare Sub CopyMem Lib "kernel32" Alias "RtlMoveMemory" (pTo As Any, uFrom As Any, ByVal lSize As Long)
43	Private Declare Function lstrlenW Lib "kernel32" (ByVal lpString As Long) As Long
44	Private Declare Function lstrcpyW Lib "kernel32" (lpString1 As Byte, ByVal lpString2 As Long) As Long
45
46	Private Type WKSTA_INFO_102
47	wki102_platform_id As Long
48	wki102_computername As Long
49	wki102_langroup As Long
50	wki102_ver_major As Long
51	wki102_ver_minor As Long
52	wki102_lanroot As Long
53	wki102_logged_on_users As Long
54	End Type
55
56	Private Type WkstaInfo102
57	PlatformId As Long
58	ComputerName As String
59	LanGroup As String
60	VerMajor As Long
61	VerMinor As Long
62	LanRoot As String
63	LoggedOnUsers As Long
64	End Type
65
66	Private Type WKSTA_USER_INFO_1
67	wkui1_username As Long
68	wkui1_logon_domain As Long
69	wkui1_oth_domains As Long
70	wkui1_logon_server As Long
71	End Type
72
73	Private Type WkstaUserInfo1
74	UserName As String
75	LogonDomain As String
76	OtherDomains As String
77	LogonServer As String
78	End Type
79
80	Private Const NERR_Success As Long = 0&
81	'
82	' Member variables
83	'
84	Private m_Wks As WkstaInfo102
85	Private m_User As WkstaUserInfo1
86	Private m_IsWinNT As Boolean
87
88	' *********************************************************
89	' Initialization
90	' *********************************************************
91	Private Sub Class_Initialize()
92	Dim os As OSVERSIONINFO
93	'
94	' Check to make sure we're running NT!
95	'
96	os.dwOSVersionInfoSize = Len(os)
97	Call GetVersionEx(os)
98	If os.dwPlatformId = VER_PLATFORM_WIN32_NT Then
99	m_IsWinNT = True
100	Me.Refresh
101	End If
102	End Sub
103
104	' *********************************************************
105	' Public Properties (Workstation)
106	' *********************************************************
107	Public Property Get ComputerName() As String
108	ComputerName = m_Wks.ComputerName
109	End Property
110
111	Public Property Get Domain() As String
112	Domain = m_Wks.LanGroup
113	End Property
114
115	Public Property Get LanRoot() As String
116	LanRoot = m_Wks.LanRoot
117	End Property
118
119	Public Property Get LoggedOnUsers() As Long
120	LoggedOnUsers = m_Wks.LoggedOnUsers
121	End Property
122
123	Public Property Get PlatformId() As Long
124	PlatformId = m_Wks.PlatformId
125	End Property
126
127	Public Property Get VerMajor() As Long
128	VerMajor = m_Wks.VerMajor
129	End Property
130
131	Public Property Get VerMinor() As Long
132	VerMinor = m_Wks.VerMinor
133	End Property
134
135	' *********************************************************
136	' Public Properties (Workstation User)
137	' *********************************************************
138	Public Property Get LogonDomain() As String
139	LogonDomain = m_User.LogonDomain
140	End Property
141
142	Public Property Get LogonServer() As String
143	LogonServer = m_User.LogonServer
144	End Property
145
146	Public Property Get OtherDomains() As String
147	OtherDomains = m_User.OtherDomains
148	End Property
149
150	Public Property Get UserName() As String
151	UserName = m_User.UserName
152	End Property
153
154	' *********************************************************
155	' Public Methods
156	' *********************************************************
157	Public Sub Refresh()
158	Dim lpBuffer As Long
159	Dim nRet As Long
160	Dim wki As WKSTA_INFO_102
161	Dim wkui As WKSTA_USER_INFO_1
162	'
163	' These functions only exist in Windows NT!!!
164	'
165	If Not m_IsWinNT Then Exit Sub
166	'
167	' Obtain workstation information
168	'
169	nRet = NetWkstaGetInfo(ByVal 0&, 102&, lpBuffer)
170	If nRet = NERR_Success Then
171	'
172	' Transfer data to VB-friendly structure
173	'
174	CopyMem wki, ByVal lpBuffer, Len(wki)
175	m_Wks.PlatformId = wki.wki102_platform_id
176	m_Wks.ComputerName = PointerToStringW(wki.wki102_computername)
177	m_Wks.LanGroup = PointerToStringW(wki.wki102_langroup)
178	m_Wks.VerMajor = wki.wki102_ver_major
179	m_Wks.VerMinor = wki.wki102_ver_minor
180	m_Wks.LanRoot = PointerToStringW(wki.wki102_lanroot)
181	m_Wks.LoggedOnUsers = wki.wki102_logged_on_users
182	'
183	' Clean up
184	'
185	If lpBuffer Then
186	Call NetApiBufferFree(lpBuffer)
187	End If
188	End If
189	'
190	' Obtain user information for this workstation
191	'
192	nRet = NetWkstaUserGetInfo(0&, 1&, lpBuffer)
193	If nRet = NERR_Success Then
194	'
195	' Transfer data to VB-friendly structure
196	'
197	CopyMem wkui, ByVal lpBuffer, Len(wkui)
198	m_User.UserName = PointerToStringW(wkui.wkui1_username)
199	m_User.LogonDomain = PointerToStringW(wkui.wkui1_logon_domain)
200	m_User.OtherDomains = PointerToStringW(wkui.wkui1_oth_domains)
201	m_User.LogonServer = PointerToStringW(wkui.wkui1_logon_server)
202	'
203	' Clean up
204	'
205	If lpBuffer Then
206	Call NetApiBufferFree(lpBuffer)
207	End If
208	End If
209	End Sub
210
211	' *********************************************************
212	' Private Methods
213	' *********************************************************
214	Private Function PointerToStringW(lpStringW As Long) As String
215	Dim buffer() As Byte
216	Dim nLen As Long
217
218	If lpStringW Then
219	nLen = lstrlenW(lpStringW) * 2
220	If nLen Then
221	ReDim buffer(0 To (nLen - 1)) As Byte
222	CopyMem buffer(0), ByVal lpStringW, nLen
223	PointerToStringW = buffer
224	End If
225	End If
226	End Function
227
228