host/vb_net_test/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, 8 months ago) by pjm2
Branch:	MAIN
CVS Tags:	PROJECT_COMPLETION, HEAD
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.
#	User	Rev	Content
1	pjm2	1.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