Source code for wmi.reg.vbs

' This script is just a demo for the function it contains: ReadRegValue()

' ReadRegValue() will read a value from the registry on any computer, and

' without the need to specify the data type for the registry value.

' This data type is returned by ReadRegValue(), besides the data itself.

' Read the comment lines inside the function for more details.

```
 
```
```
Option Explicit
```
```
 
```

Dim arrRegTypes, arrRegVal, i, strComputer, strMsg, strTemp

```
 
```

arrRegTypes = Array( "", "REG_SZ", "REG_EXPAND_SZ", "REG_BINARY", _

                     "REG_DWORD", "REG_DWORD_BIG_ENDIAN", "REG_LINK", _

                     "REG_MULTI_SZ", "REG_RESOURCE_LIST", _

                     "REG_FULL_RESOURCE_DESCRIPTOR", _

                     "REG_RESOURCE_REQUIREMENTS_LIST", "REG_QWORD" )

```
 
```

' Specify a computer name, or use a dot for the local computer

```
strComputer = "."
```
```
 
```

' Let's read the default file type associated with .PDF extensions

arrRegVal = ReadRegValue( strComputer, "HKEY_CLASSES_ROOT\.pdf", "" )

```
If arrRegVal( 4 ) = 0 Then
```
```
	strTemp = arrRegVal( 6 )
```

	strMsg = "[HKEY_CLASSES_ROOT\.pdf]" & vbCrLf _

	       & "@=" & arrRegVal( 6 ) & vbCrLf

```
	If UBound( arrRegVal ) > 6 Then
```
```
		For i = 5 To UBound( arrRegVal )
```
```
			strMsg = strMsg & Space( 12 ) _
```
```
			       & arrRegVal( i ) & vbCrLf
```
```
		Next
```
```
	End If
```
```
	strMsg = strMsg & "Data type: " _
```

	       & arrRegTypes( arrRegVal( 5 ) ) & vbCrLf

```
Else
```
```
	On Error Resume Next
```
```
	Err.Raise arrRegVal( 4 )
```

	strMsg = "Error: " & Err.Number & vbCrLf & Err.Description

```
	Err.Clear
```
```
	On Error Goto 0
```
```
End If
```
```
WScript.Echo strMsg
```
```
 
```

' Now let's use the result from the previous invocation to

' read the default (open) command associated with .PDF files

arrRegVal = ReadRegValue( strComputer, "HKEY_CLASSES_ROOT\" _

                        & strTemp & "\shell\open\command", "" )

```
If arrRegVal( 4 ) = 0 Then
```

	strMsg = "[HKEY_CLASSES_ROOT\" & strTemp _

	       & "\shell\open\command]" & vbCrLf _

	       & "@=" & arrRegVal( 6 ) & vbCrLf

```
	If UBound( arrRegVal ) > 6 Then
```
```
		For i = 6 To UBound( arrRegVal )
```
```
			strMsg = strMsg & Space( 12 ) _
```
```
			       & arrRegVal( i ) & vbCrLf
```
```
		Next
```
```
	End If
```
```
	strMsg = strMsg & "Data type: " _
```

	       & arrRegTypes( arrRegVal( 5 ) ) & vbCrLf

```
Else
```
```
	On Error Resume Next
```
```
	Err.Raise arrRegVal( 4 )
```
```
	strMsg = "Error: " & Err.Number _
```
```
	       & vbCrLf & Err.Description
```
```
	Err.Clear
```
```
	On Error Goto 0
```
```
End If
```
```
WScript.Echo strMsg
```
```
 
```

' And this code demonstrates reading REG_BINARY data,

' which is returned as an array instead of a single value

arrRegVal = ReadRegValue( strComputer, _

                          "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\DirectX", _

                          "InstalledVersion" )

```
If arrRegVal( 4 ) = 0 Then
```

	strMsg = "[HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\DirectX]" & vbCrLf _

```
	       & "InstalledVersion=" 
```
```
	strMsg = strMsg & arrRegVal( 6 )
```
```
	strMsg = strMsg & vbCrLf
```
```
	If UBound( arrRegVal ) > 6 Then
```
```
		For i = 6 To UBound( arrRegVal )
```
```
			strMsg = strMsg & Space( 17 ) _
```
```
			       & arrRegVal( i ) & vbCrLf
```
```
		Next
```
```
	End If
```
```
	strMsg = strMsg & "Data type: " _
```

	       & arrRegTypes( arrRegVal( 5 ) ) & vbCrLf

```
Else
```
```
	On Error Resume Next
```
```
	Err.Raise arrRegVal( 4 )
```
```
	strMsg = "Error: " & Err.Number _
```
```
	       & vbCrLf & Err.Description
```
```
	Err.Clear
```
```
	On Error Goto 0
```
```
End If
```
```
WScript.Echo strMsg
```
```
 
```
```
 
```
```
 
```
```
 
```
```
 
```

Function ReadRegValue( myComputer, myRegPath, myRegValue )

' This function reads a value from the registry of any WMI

```
' enabled computer.
```
```
'
```
```
' Arguments:
```

' myComputer        a computer name or IP address,

'                   or a dot for the local computer

' myRegPath         a full registry key path, e.g.

'                   HKEY_CLASSES_ROOT\.jpg or

'                   HKLM\SOFTWARE\Microsoft\DirectX

' myRegValue        the value name to be queried, e.g.

'                   InstalledVersion or "" for default

```
'                   values
```
```
'
```

' The function returns an array with the following elements:

' ReadRegValue(0)   the computer name (the first argument)

' ReadRegValue(1)   the hive number (see const declarations)

' ReadRegValue(2)   the key path without the hive

' ReadRegValue(3)   the value name (the third argument)

' ReadRegValue(4)   the error number: 0 means no error

' ReadRegValue(5)   the data type of the result

' ReadRegValue(6)   the actual data, or the first element of an

'                   array of data for REG_BINARY or REG_MULTI_SZ

```
'
```
```
' Written by Rob van der Woude
```
```
' http://www.robvanderwoude.com
```
```
 
```
```
 
```
```
	' Standard housekeeping
```

	Const HKEY_CLASSES_ROOT              = &H80000000

	Const HKEY_CURRENT_USER              = &H80000001

	Const HKEY_LOCAL_MACHINE             = &H80000002

	Const HKEY_USERS                     = &H80000003

	Const HKEY_CURRENT_CONFIG            = &H80000005

	Const HKEY_DYN_DATA                  = &H80000006 ' Windows 95/98 only

```
 
```

	Const REG_SZ                         =  1

	Const REG_EXPAND_SZ                  =  2

	Const REG_BINARY                     =  3

	Const REG_DWORD                      =  4

	Const REG_DWORD_BIG_ENDIAN           =  5

	Const REG_LINK                       =  6

	Const REG_MULTI_SZ                   =  7

	Const REG_RESOURCE_LIST              =  8

	Const REG_FULL_RESOURCE_DESCRIPTOR   =  9

	Const REG_RESOURCE_REQUIREMENTS_LIST = 10

	Const REG_QWORD                      = 11

```
 
```

	Dim arrRegPath, arrResult(), arrValueNames, arrValueTypes

	Dim i, objReg, strHive, valRegError, valRegType, valRegVal

```
 
```
```
	' Assume no error, for now
```
```
	valRegError = 0
```
```
 
```

	' Split the registry path in a hive part

	' and the rest, and check if that succeeded

	arrRegPath = Split( myRegPath, "\", 2 )

```
	If IsArray( arrRegPath ) Then
```

		If UBound( arrRegPath ) <> 1 Then valRegError = 5

```
	Else
```
```
		valRegError = 5
```
```
	End If
```
```
 
```

	' Convert the hive string to a hive number

```
	Select Case UCase( arrRegPath( 0 ) )
```
```
		Case "HKCR", "HKEY_CLASSES_ROOT"
```
```
			strHive = HKEY_CLASSES_ROOT
```
```
		Case "HKCU", "HKEY_CURRENT_USER"
```
```
			strHive = HKEY_CURRENT_USER
```
```
		Case "HKLM", "HKEY_LOCAL_MACHINE"
```
```
			strHive = HKEY_LOCAL_MACHINE
```
```
		Case "HKU",  "HKEY_USERS"
```
```
			strHive = HKEY_USERS
```
```
		Case "HKCC", "HKEY_CURRENT_CONFIG"
```
```
			strHive = HKEY_CURRENT_CONFIG
```
```
		Case "HKDD", "HKEY_DYN_DATA"
```
```
			strHive = HKEY_DYN_DATA
```
```
		Case Else
```
```
			valRegError = 5
```
```
	End Select
```
```
 
```

	' Abort if any error occurred, and return an error code

```
	If valRegError > 0 Then
```

		ReadRegValue = Array( myComputer, myRegPath, _

		                      myRegPath, myRegValue, _

		                      valRegError, "-", "-" )

```
		Exit Function
```
```
	End If
```
```
 
```
```
	' Initiate custom error handling
```
```
	On Error Resume Next
```
```
 
```
```
	' Create a WMI registry object
```

	Set objReg = GetObject( "winmgmts:{impersonationLevel=impersonate}!//" _

	           & myComputer & "/root/default:StdRegProv" )

```
 
```

	' Abort on failure to create the object

```
	If Err Then
```
```
		valRegError = Err.Number
```
```
		Err.Clear
```
```
		On Error Goto 0
```

		ReadRegValue = Array( myComputer, myRegPath, _

		                      myRegPath, myRegValue, _

		                      valRegError, "-", "-" )

```
		Exit Function
```
```
	End If
```
```
 
```

	' Get a list of all values in the registry path;

	' we need to do this in order to find out the

	' exact data type for the requested value

	objReg.EnumValues strHive, arrRegPath( 1 ), arrValueNames, arrValueTypes

```
 
```

	' If no values were found, we'll need to retrieve a default value

```
	If Not IsArray( arrValueNames ) Then
```
```
		arrValueNames = Array( "" )
```
```
		arrValueTypes = Array( REG_SZ )
```
```
	End If
```
```
 
```
```
	If Err Then
```

		' Abort on failure, returning an error code

```
		valRegError = Err.Number
```
```
		Err.Clear
```
```
		On Error Goto 0
```

		ReadRegValue = Array( myComputer, myRegPath, _

		                      myRegPath, myRegValue, _

		                      valRegError, "-", "-" )

```
		Exit Function
```
```
	Else
```

		' Loop through all values in the list . . .

```
		For i = 0 To UBound( arrValueNames )
```
```
			' . . . and find the one requested
```

			If UCase( arrValueNames( i ) ) = UCase( myRegValue ) Then

				' Read the requested value's data type

```
				valRegType = arrValueTypes( i )
```

				' Based on the data type, use the appropriate query to retrieve the data

```
				Select Case valRegType
```
```
					Case REG_SZ
```

						objReg.GetStringValue strHive, arrRegPath( 1 ), _

						                      myRegValue, valRegVal

						If Err Then valRegError = Err.Number

```
					Case REG_EXPAND_SZ
```

						objReg.GetExpandedStringValue strHive, arrRegPath( 1 ), _

						                              myRegValue, valRegVal

						If Err Then valRegError = Err.Number

					Case REG_BINARY ' returns an array of bytes

						objReg.GetBinaryValue strHive, arrRegPath( 1 ), _

						                      myRegValue, valRegVal

						If Err Then valRegError = Err.Number

```
					Case REG_DWORD
```

						objReg.GetDWORDValue strHive, arrRegPath( 1 ), _

						                     myRegValue, valRegVal

						If Err Then valRegError = Err.Number

					Case REG_MULTI_SZ ' returns an array of strings

						objReg.GetMultiStringValue strHive, arrRegPath( 1 ), _

						                           myRegValue, valRegVal

						If Err Then valRegError = Err.Number

```
					Case REG_QWORD
```

						objReg.GetQWORDValue strHive, arrRegPath( 1 ), _

						                     myRegValue, valRegVal

						If Err Then valRegError = Err.Number

```
					Case Else
```
```
						valRegError = 5
```
```
				End Select
```
```
			End If
```
```
		Next
```
```
	End If
```
```
 
```
```
	' Check if an error occurred
```
```
	If valRegError > 0 Then
```
```
		valRegType = ""
```
```
		valRegVal  = ""
```
```
		Err.Clear
```
```
		On Error Goto 0
```
```
	End If
```
```
 
```
```
	' Return the data in an array
```

	If valRegType = REG_BINARY Or valRegType = REG_MULTI_SZ Then

		' First, deal with registry data which is

		' returned as array instead of single value

		ReDim Preserve arrResult( 6 + UBound( valRegVal ) )

```
		arrResult( 0 ) = myComputer
```
```
		arrResult( 1 ) = strHive
```
```
		arrResult( 2 ) = arrRegPath( 1 )
```
```
		arrResult( 3 ) = myRegValue
```
```
		arrResult( 4 ) = valRegError
```
```
		arrResult( 5 ) = valRegType
```
```
		For i = 0 To UBound( valRegVal )
```
```
			arrResult( 6 + i ) = valRegVal( i )
```
```
		Next
```
```
		ReadRegValue = arrResult
```
```
	Else
```

		ReadRegValue = Array( myComputer, strHive, arrRegPath( 1 ), _

		                      myRegValue, valRegError, valRegType, valRegVal )

```
	End If
```
```
 
```
```
	' Finished
```
```
	Set objReg = Nothing
```
```
	On Error Goto 0
```
```
End Function
```
```
 
```