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
复制代码