Skip to content

Commit 826cdbf

Browse files
franklesniakfranklesniak
authored
Initial upload from VBS Resources and other code
1 parent e8464b3 commit 826cdbf

File tree

37 files changed

+10115
-0
lines changed

37 files changed

+10115
-0
lines changed

‎VBScript/02_Upfront_Encapsualed_Code_With_No_Dependencies/ConnectLocalWMINamespace.vbs‎

Lines changed: 274 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,274 @@
1+
Function ConnectLocalWMINamespace(ByRef objSWbemServicesWMINamespace, ByVal strTargetWMINamespace, ByVal objSWbemNamedValueSetContextOrIntTargetWMIProviderArchitectureBitWidth)
2+
'region FunctionMetadata ####################################################
3+
' Safely creates a SWbemServices object with a connection to the specified WMI namespace on
4+
' the local computer.
5+
'
6+
' Function takes three positional arguments:
7+
' The first argument (objSWbemServicesWMINamespace) will be populated with the
8+
' SWbemServices (WMI connection) object upon successful connection.
9+
' The second argument (strTargetWMINamespace) specifies the namespace target to which
10+
' this function will connect. If vbNullString ("") or Null is passed, the function
11+
' defaults to "root\cimv2", which is the most commonly-used WMI namespace.
12+
' The third argument
13+
' (objSWbemNamedValueSetContextOrIntTargetWMIProviderArchitectureBitWidth) specifies
14+
' either a SWbemNamedValueSet that sets the required bit-width to use when opening
15+
' the WMI connection, **or** it specifies an integer target bit width "context" to
16+
' use when opening WMI. For example, supplying 32 or 64 will force a respective 32-
17+
' or 64-bit context when opening the WMI connection. Generally, when using this
18+
' function, it is recommended to use SWbemNamedValueSet instead of an integer. This
19+
' feature is commonly used when connecting to the "root\default" WMI namespace and
20+
' then using the StdRegProv class to connect to the Windows registry. If Null is
21+
' passed, the function defaults to the context supplied by the VBScript process that
22+
' is running this script.
23+
'
24+
' The function returns 0 if the SWbemServices (WMI connection) object
25+
' objSWbemServicesWMINamespace was created successfully; a negative number otherwise.
26+
'
27+
' Example 1:
28+
' intReturnCode = ConnectLocalWMINamespace(objWMI, Null, Null)
29+
' If intReturnCode = 0 Then
30+
' ' objWMI is initialized and connected to the root\CIMv2 namespace
31+
' Set colOS = objWMI.InstancesOf("Win32_OperatingSystem")
32+
' For Each objOS in colOS
33+
' WScript.Echo(objOS.Caption)
34+
' Next
35+
' End If
36+
'
37+
' Example 2:
38+
' Const HKEY_CLASSES_ROOT = &H80000000
39+
' Const HKEY_CURRENT_USER = &H80000001
40+
' Const HKEY_LOCAL_MACHINE = &H80000002
41+
' Const HKEY_USERS = &H80000003
42+
' intReturnCode = NewWMIBitWidthContext(objWMIContext, 32)
43+
' If intReturnCode = 0 Then
44+
' intReturnCode = ConnectLocalWMINamespace(objWMI, "root\default", objWMIContext)
45+
' If intReturnCode = 0 Then
46+
' ' objWMI is initialized and connected to the root\default namespace
47+
' ' Create the StdRegProv:
48+
' Set objStdRegProv = objWMI.Get("StdRegProv")
49+
' ' Create a registry key in the 32-bit process context:
50+
' Set objInParams = objStdRegProv.Methods_("CreateKey").Inparameters
51+
' objInParams.hDefKey = HKEY_CURRENT_USER
52+
' objInParams.sSubKeyName = "SOFTWARE\West Monroe Partners\Temp"
53+
' Set objOutParams = objStdRegProv.ExecMethod_("CreateKey",objInParams,,objWMIContext)
54+
' intReturnCode = objOutParams.ReturnValue
55+
' End If
56+
' End If
57+
'
58+
' Example 3:
59+
' intReturnCode = ConnectLocalWMINamespace(objWMI, Null, 64)
60+
' If intReturnCode = 0 Then
61+
' ' objWMI is initialized and connected to the root\cimv2 namespace
62+
' Set colWinSATs = objWMI.ExecQuery("Select * From Win32_WinSAT")
63+
' For Each objWinSAT in colWinSATs
64+
' WScript.Echo(objWinSAT.WinSATAssessmentState)
65+
' Next
66+
' End If
67+
'
68+
' Version: 2.2.20210613.0
69+
'endregion FunctionMetadata ####################################################
70+
71+
'region License ####################################################
72+
' Copyright 2021 Frank Lesniak
73+
'
74+
' Permission is hereby granted, free of charge, to any person obtaining a copy of this
75+
' software and associated documentation files (the "Software"), to deal in the Software
76+
' without restriction, including without limitation the rights to use, copy, modify, merge,
77+
' publish, distribute, sublicense, and/or sell copies of the Software, and to permit
78+
' persons to whom the Software is furnished to do so, subject to the following conditions:
79+
'
80+
' The above copyright notice and this permission notice shall be included in all copies or
81+
' substantial portions of the Software.
82+
'
83+
' THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED,
84+
' INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR
85+
' PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE
86+
' FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR
87+
' OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
88+
' DEALINGS IN THE SOFTWARE.
89+
'endregion License ####################################################
90+
91+
'region DownloadLocationNotice ####################################################
92+
' The most up-to-date version of this script can be found on the author's GitHub repository
93+
' at https://github.com/franklesniak/VBScript_Resources
94+
'endregion DownloadLocationNotice ####################################################
95+
96+
'region DependsOn ####################################################
97+
' TestObjectForData()
98+
' TestObjectIsAnyTypeOfInteger()
99+
' NewWMIBitWidthContext() <- not a strict dependency, but connecting to an alternative
100+
' bit-width context requires this function
101+
'endregion DependsOn ####################################################
102+
103+
Dim strEffectiveComputerName
104+
Dim intReturnCode
105+
Dim strEffectiveNamespace
106+
Dim objSWbemLocator
107+
Dim objSWbemNamedValueSetContext
108+
Dim objSWbemServicesTemp
109+
110+
Const wbemImpersonationLevelImpersonate = 3
111+
strEffectiveComputerName = "."
112+
113+
Err.Clear
114+
115+
intReturnCode = 0
116+
117+
If TestObjectForData(strTargetWMINamespace) = False Then
118+
strEffectiveNamespace = "root\cimv2"
119+
Else
120+
strEffectiveNamespace = strTargetWMINamespace
121+
End If
122+
123+
On Error Resume Next
124+
Set objSWbemLocator = CreateObject("Wbemscripting.SWbemLocator")
125+
If Err Then
126+
On Error Goto 0
127+
Err.Clear
128+
intReturnCode = -1
129+
Else
130+
On Error Goto 0
131+
End If
132+
133+
If intReturnCode = 0 Then
134+
' No error occurred
135+
If TestObjectForData(objSWbemNamedValueSetContextOrIntTargetWMIProviderArchitectureBitWidth) = True Then
136+
' objSWbemNamedValueSetContextOrIntTargetWMIProviderArchitectureBitWidth parameter
137+
' was supplied
138+
If TestObjectIsAnyTypeOfInteger(objSWbemNamedValueSetContextOrIntTargetWMIProviderArchitectureBitWidth) = True Then
139+
' objSWbemNamedValueSetContextOrIntTargetWMIProviderArchitectureBitWidth is an
140+
' integer
141+
On Error Resume Next
142+
Set objSWbemNamedValueSetContext = CreateObject("WbemScripting.SWbemNamedValueSet")
143+
If Err Then
144+
On Error Goto 0
145+
Err.Clear
146+
intReturnCode = -2
147+
Else
148+
objSWbemNamedValueSetContext.Add "__ProviderArchitecture", objSWbemNamedValueSetContextOrIntTargetWMIProviderArchitectureBitWidth
149+
If Err Then
150+
On Error Goto 0
151+
Err.Clear
152+
intReturnCode = -3
153+
Else
154+
objSWbemNamedValueSetContext.Add "__RequiredArchitecture", True
155+
If Err Then
156+
On Error Goto 0
157+
Err.Clear
158+
intReturnCode = -4
159+
Else
160+
Set objSWbemServicesTemp = objSWbemLocator.ConnectServer(strEffectiveComputerName, strEffectiveNamespace,,,,,,objSWbemNamedValueSetContext)
161+
If Err Then
162+
On Error Goto 0
163+
Err.Clear
164+
intReturnCode = -5
165+
Else
166+
On Error Goto 0
167+
End If
168+
End If
169+
End If
170+
End If
171+
Else
172+
' objSWbemNamedValueSetContextOrIntTargetWMIProviderArchitectureBitWidth is not
173+
' an integer; it is probably a SWbemNamedValueSet
174+
On Error Resume Next
175+
Set objSWbemServicesTemp = objSWbemLocator.ConnectServer(strEffectiveComputerName, strEffectiveNamespace,,,,,,objSWbemNamedValueSetContextOrIntTargetWMIProviderArchitectureBitWidth)
176+
If Err Then
177+
On Error Goto 0
178+
Err.Clear
179+
intReturnCode = -6
180+
Else
181+
On Error Goto 0
182+
End If
183+
End If
184+
Else
185+
' objSWbemNamedValueSetContextOrIntTargetWMIProviderArchitectureBitWidth parameter
186+
' was not supplied
187+
On Error Resume Next
188+
Set objSWbemServicesTemp = objSWbemLocator.ConnectServer(strEffectiveComputerName, strEffectiveNamespace)
189+
If Err Then
190+
On Error Goto 0
191+
Err.Clear
192+
intReturnCode = -7
193+
Else
194+
On Error Goto 0
195+
End If
196+
End If
197+
198+
If intReturnCode = 0 Then
199+
' No error occurred
200+
On Error Resume Next
201+
objSWbemServicesTemp.Security_.ImpersonationLevel = wbemImpersonationLevelImpersonate
202+
If Err Then
203+
On Error Goto 0
204+
Err.Clear
205+
intReturnCode = -8
206+
Else
207+
On Error Goto 0
208+
End If
209+
End If
210+
End If
211+
212+
If intReturnCode = 0 Then
213+
' No error occurred
214+
' We fully connected to WMI, but did so with a "dummy" object...
215+
' ... so, let's connect using the real object
216+
Set objSWbemServicesTemp = Nothing
217+
If TestObjectForData(objSWbemNamedValueSetContextOrIntTargetWMIProviderArchitectureBitWidth) = True Then
218+
' objSWbemNamedValueSetContextOrIntTargetWMIProviderArchitectureBitWidth parameter
219+
' was supplied
220+
If TestObjectIsAnyTypeOfInteger(objSWbemNamedValueSetContextOrIntTargetWMIProviderArchitectureBitWidth) = True Then
221+
' objSWbemNamedValueSetContextOrIntTargetWMIProviderArchitectureBitWidth is an
222+
' integer
223+
' objSWbemNamedValueSetContext already constructed
224+
On Error Resume Next
225+
Set objSWbemServicesWMINamespace = objSWbemLocator.ConnectServer(strEffectiveComputerName, strEffectiveNamespace,,,,,,objSWbemNamedValueSetContext)
226+
If Err Then
227+
On Error Goto 0
228+
Err.Clear
229+
intReturnCode = -9
230+
Else
231+
On Error Goto 0
232+
End If
233+
Else
234+
' objSWbemNamedValueSetContextOrIntTargetWMIProviderArchitectureBitWidth is not
235+
' an integer; it is probably a SWbemNamedValueSet
236+
On Error Resume Next
237+
Set objSWbemServicesWMINamespace = objSWbemLocator.ConnectServer(strEffectiveComputerName, strEffectiveNamespace,,,,,,objSWbemNamedValueSetContextOrIntTargetWMIProviderArchitectureBitWidth)
238+
If Err Then
239+
On Error Goto 0
240+
Err.Clear
241+
intReturnCode = -10
242+
Else
243+
On Error Goto 0
244+
End If
245+
End If
246+
Else
247+
' objSWbemNamedValueSetContextOrIntTargetWMIProviderArchitectureBitWidth parameter
248+
' was not supplied
249+
On Error Resume Next
250+
Set objSWbemServicesWMINamespace = objSWbemLocator.ConnectServer(strEffectiveComputerName, strEffectiveNamespace)
251+
If Err Then
252+
On Error Goto 0
253+
Err.Clear
254+
intReturnCode = -11
255+
Else
256+
On Error Goto 0
257+
End If
258+
End If
259+
If intReturnCode = 0 Then
260+
' No error occurred
261+
On Error Resume Next
262+
objSWbemServicesWMINamespace.Security_.ImpersonationLevel = wbemImpersonationLevelImpersonate
263+
If Err Then
264+
On Error Goto 0
265+
Err.Clear
266+
intReturnCode = -12
267+
Else
268+
On Error Goto 0
269+
End If
270+
End If
271+
End If
272+
273+
ConnectLocalWMINamespace = intReturnCode
274+
End Function

0 commit comments

Comments
 (0)