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