Hi, I am new in VBScript. I want to search and delete all ".reboot pending" registry keys in the HKLM uninstall hive. Please help me.
Answers (4)
Second, search for 'cRegistry.cls' a rather good registry class for VBScript. Don't be put off by the scary word 'class': think of it like an INCLUDE file. This class has features like enumerating all the keys in a sub-key and all the keys and values in a sub-key.
'// A registry class to abstract the WMI registry provider
'// Option Explicit
'//
'// Dim strMsg
'// Dim blnResult
'// Dim blnFailed
'// Dim objRegistry
'// Dim objRecord
'// Dim objDictionary
'//
'// Set objRegistry = New clsRegistry
'//
'// blnResult = objRegistry.Connect(".")
'// If blnResult Then
'// With objRegistry
'//
'// '// Create key
'// blnResult = .CreateKey("HKCU", "Control Panel\Accessibility\Dummy Key")
'// If blnResult Then
'// WScript.Echo "Created key."
'// Else
'// WScript.Echo "Failed to create key."
'// End If
'//
'// '// Delete key
'// '// True Delete sub-keys
'// '// False Do not delete sub-keys
'// blnResult = .DeleteKey("HKCU", "Control Panel\Accessibility\Dummy Key", True)
'// If blnResult Then
'// WScript.Echo "Deleted key."
'// Else
'// WScript.Echo "Failed to delete key."
'// End If
'//
'// '// Write value
'// blnResult = .WriteValue("HKCU", "Control Panel\Accessibility", "Dummy Value", "REG_SZ", "Dummy data")
'// If blnResult Then
'// WScript.Echo "Created value."
'// Else
'// WScript.Echo "Failed to create value."
'// End If
'//
'// '// Check value exists
'// blnResult = .ExistValue("HKCU", "Control Panel\Accessibility", "Dummy Value")
'// If blnResult Then
'// WScript.Echo "Value exists."
'// Else
'// WScript.Echo "Value does not exist."
'// End If
'//
'// '// Read value
'// '// Typically, you would use ExistValue before calling ReadValue
'// blnResult = .ReadValue("HKCU", "Control Panel\Accessibility", "Dummy Value")
'// If blnResult Then
'// WScript.Echo "Value is " & .get_RegResult & ", and is of type " & .get_RegValueType
'// Else
'// WScript.Echo "Failed to read value."
'// End If
'//
'// '// Delete value
'// blnResult = .DeleteValue("HKCU", "Control Panel\Accessibility", "Dummy Value")
'// If blnResult Then
'// WScript.Echo "Deleted value."
'// Else
'// WScript.Echo "Failed to delete value."
'// End If
'//
'// '// Check key exists
'// blnResult = .ExistKey("HKCU", "Control Panel\Accessibility", "Keyboard Response")
'// If blnResult Then
'// WScript.Echo "Key exists."
'// Else
'// WScript.Echo "Key does not exist."
'// End If
'//
'// '// Enumerate key
'// blnResult = .EnumKey("HKCU", "Control Panel\Accessibility")
'// If blnResult Then
'// Set objDictionary = .get_EnumDict
'// strMsg = Empty
'// For Each objRecord In objDictionary
'// '// objDictionary(objRecord) is always null string for this method
'// WScript.Echo "Key name is " & objRecord
'// Next
'// Else
'// WScript.Echo "No sub-keys exist under that key."
'// End If
'//
'// '// Enumerate values
'// blnResult = .EnumValues("HKCU", "Control Panel\Accessibility\Keyboard Response")
'// If blnResult Then
'// Set objDictionary = .get_EnumDict
'// strMsg = Empty
'// For Each objRecord In objDictionary
'// WScript.Echo "Value is " & objRecord & ", and is of type " & objDictionary(objRecord)
'// Next
'// Else
'// WScript.Echo "No values exist under that key."
'// End If
'//
'// '// Enumerate values and data
'// blnResult = .EnumValuesAndData("HKCU", "Control Panel\Accessibility\Keyboard Response")
'// If blnResult Then
'// Set objDictionary = .get_EnumDict
'// strMsg = Empty
'// For Each objRecord In objDictionary
'// '// Ignore '_Stage Number' and '_Stage Description'
'// If Left(CStr(objRecord), 1) <> "_" Then
'// If objDictionary(objRecord) = 1024 Then
'// blnFailed = True
'// strMsg = strMsg & vbCRLF
'// strMsg = strMsg & String(2, vbTAB)
'// strMsg = strMsg & CStr(objRecord)
'// End If
'// End If
'// WScript.Echo "Value is " & objRecord & ", data is " & objDictionary(objRecord)
'// Next
'// Else
'// WScript.Echo "No value/data pairs exist under that key."
'// End If
'// End With
'// End If
Option Explicit
Class clsRegistry
'// This class makes it simple to manipulate the registry on the local or a remote computer.
'// Internally it uses the WMI StdRegProv class methods.
'//
'// It provides a simpler set of methods than the StdRegProv methods:
'//
'// * Rather than numeric values, this object's methods use string input: For example, "HKLM" instead of 0x80000002.
'//
'// * Rather than separate Get...Value() methods for each data type, it provides a single ReadValue() method.
'// The get_RegResult property will contain the registry value's data, and the get_RegValueType property
'// will contain the registry value's data type as a string (e.g. "REG_SZ").
'//
'// * Rather than separate Set...Value() methods for each data type, it provides a single WriteValue() method
'// that lets you specify the data type as a string parameter.
'//
'// * The DeleteKey() method provides a DeleteSubKeys parameter. If True, then it will attempt to delete all subkeys
'// of the specified subkey.
'//
'// * The ExistKey() and ExistValue() methods return True if the specified key or value exists in a specified subkey,
'// or False otherwise.
'//
'// This class also implements the EnumValues(), EnumValuesAndData(), and EnumKey() methods:
'//
'// * The array outputs of these methods are accessible from the EnumResult property, which returns a reference to a
'// Scripting.Dictionary object.
'//
'// * After calling the EnumValues() method, the EnumResult dictionary will contain the value names and types.
'// The types will be stored as strings (e.g. "REG_SZ").
'//
'// * After calling the EnumValuesAndData() method, the EnumDict dictionary will contain the value names and contents
'// of each value. If a value contains a REG_BINARY, the contents will be a string containing a series of the hex bytes
'// in the data (like the registry editor). If a value contains a REG_MULTI_SZ, the multiple strings will be separated
'// by a "|" character. This method exists mainly as a quick way for a program to output all of the values in a registry subkey.
'//
'// * After calling the EnumKey() method, the EnumResult dictionary will contain the names of the subkeys.
'// The "value" parts of the dictionary will be empty strings.
'//
'// * For JScript, the dictToJSArray() method converts a dictionary to a JScript array.
Dim REG_SZ
Dim REG_EXPAND_SZ
Dim REG_BINARY
Dim REG_DWORD
Dim REG_QWORD
Dim REG_MULTI_SZ
Dim REG_RESOURCE_LIST
Dim REG_FULL_RESOURCE_DESCRIPTOR
Dim REG_RESOURCE_REQUIREMENTS_LIST
Dim ERR_INVALID_DATA
Dim SEPARATOR
Dim g_RegTypes
Dim g_EnumDict
Dim g_RegProv
Dim g_RegResult
Dim g_RegValueType
Private Sub Class_Initialize()
REG_SZ = 1
REG_EXPAND_SZ = 2
REG_BINARY = 3
REG_DWORD = 4
REG_MULTI_SZ = 7
REG_RESOURCE_LIST = 8
REG_FULL_RESOURCE_DESCRIPTOR = 9
REG_RESOURCE_REQUIREMENTS_LIST = 10
REG_QWORD = 11
ERR_INVALID_DATA = 13
SEPARATOR = "|"
' Contains constants and some numbers for quick lookup.
Set g_RegTypes = CreateObject("Scripting.Dictionary")
' Dictionary object for EnumKey() and EnumValues().
Set g_EnumDict = CreateObject("Scripting.Dictionary")
' Case-insensitive key comparisons.
g_RegTypes.CompareMode = vbTextCompare
g_EnumDict.CompareMode = vbTextCompare
' Populate the dictionary with needed data.
With g_RegTypes
.Add "HKCR", &H80000000
.Add "HKEY_CLASSES_ROOT", &H80000000
.Add "HKCU", &H80000001
.Add "HKEY_CURRENT_USER", &H80000001
.Add "HKLM", &H80000002
.Add "HKEY_LOCAL_MACHINE", &H80000002
.Add "HKEY_USERS", &H80000003
.Add "HKEY_CURRENT_CONFIG", &H80000005
.Add "REG_SZ", REG_SZ
.Add REG_SZ, "REG_SZ"
.Add "REG_EXPAND_SZ", REG_EXPAND_SZ
.Add REG_EXPAND_SZ, "REG_EXPAND_SZ"
.Add "REG_BINARY", REG_BINARY
.Add REG_BINARY, "REG_BINARY"
.Add "REG_DWORD", REG_DWORD
.Add REG_DWORD, "REG_DWORD"
.Add "REG_MULTI_SZ", REG_MULTI_SZ
.Add REG_MULTI_SZ, "REG_MULTI_SZ"
.Add "REG_QWORD", REG_QWORD
.Add REG_QWORD, "REG_QWORD"
.Add "REG_RESOURCE_LIST", REG_RESOURCE_LIST
.Add REG_RESOURCE_LIST, "REG_RESOURCE_LIST"
.Add "REG_FULL_RESOURCE_DESCRIPTOR", REG_FULL_RESOURCE_DESCRIPTOR
.Add REG_FULL_RESOURCE_DESCRIPTOR, "REG_FULL_RESOURCE_DESCRIPTOR"
.Add "REG_RESOURCE_REQUIREMENTS_LIST", REG_RESOURCE_REQUIREMENTS_LIST
.Add REG_RESOURCE_REQUIREMENTS_LIST, "REG_RESOURCE_REQUIREMENTS_LIST"
End With
' No valid data yet
g_RegResult = Null
g_RegValueType = Null
End Sub
Private Sub Class_Terminate()
Set g_EnumDict = Nothing
Set g_RegTypes = Nothing
End Sub
' PROPERTY get_RegResult()
' Returns the result data from a registry operation.
Function get_RegResult()
get_RegResult = g_RegResult
End Function
' PROPERTY get_RegValueType()
' Returns the result data's data type.
Function get_RegValueType()
get_RegValueType = g_RegValueType
End Function
' PROPERTY get_EnumDict()
' Returns a reference to the dictionary populated by the Enum...() methods.
Function get_EnumDict()
Set get_EnumDict = g_EnumDict
End Function
' METHOD Connect()
' Connects to the specified computer using WMI; returns True for success,
' or the WMI error code if it fails. If the computer is already connected,
' it will not attempt to connect again and will return True.
Function Connect(ByVal ComputerName)
Dim Result
Connect = False
ComputerName = UCase(Trim(ComputerName))
If Left(ComputerName, 2) = "\\" Then
ComputerName = Mid(ComputerName, 3)
End If
On Error Resume Next
Set g_RegProv = GetObject("winmgmts:{impersonationlevel=impersonate}!//" & ComputerName & "/root/default:StdRegProv")
Result = Err.Number
On Error GoTo 0
If Err.Number <> 0 Then
Exit Function
End If
Connect = True
End Function
' If Condition is True, return TrueValue; otherwise, return FalseValue.
Function IIf(ByVal Condition, ByVal TrueValue, ByVal FalseValue)
If Condition Then
IIf = TrueValue
Else
IIf = FalseValue
End If
End Function
' METHOD CheckAccess()
' Returns True for success, False for failure.
' HiveName is a string representing the registry hive (e.g. "HKLM").
' Required is a numeric value representing the desired access level.
' KEY_QUERY_VALUE 1 0x1 Required to query the values of a registry key.
' KEY_SET_VALUE 2 0x2 Required to create, delete, or set a registry value.
' KEY_CREATE_SUB_KEY 4 0x4 Required to create a subkey of a registry key.
' KEY_ENUMERATE_SUB_KEYS 8 0x8 Required to enumerate the subkeys of a registry key.
' KEY_NOTIFY 16 0x10 Required to request change notifications for a registry key or for subkeys of a registry key.
' KEY_CREATE 32 0x20 Required to create a registry key.
' DELETE 65536 0x10000 Required to delete a registry key.
' READ_CONTROL 131072 0x20000 Combines the STANDARD_RIGHTS_READ, KEY_QUERY_VALUE, KEY_ENUMERATE_SUB_KEYS, and KEY_NOTIFY values.
' WRITE_DAC 262144 0x40000 Required to modify the DACL in the object's security descriptor.
' WRITE_OWNER 524288 0x80000 Required to change the owner in the object's security descriptor.
'
' If the WMI CheckAccess method succeeded, update g_RegResult.
Function CheckAccess(ByVal HiveName, ByVal SubKeyName, ByVal Required)
Dim Result
Dim blnGranted
CheckAccess = False
Result = g_RegProv.CheckAccess(g_RegTypes(HiveName), SubKeyName, Required, blnGranted)
g_RegResult = IIf(Result = 0, blnGranted, Null)
g_RegValueType = Null
If Result <> 0 Then
Exit Function
End If
CheckAccess = True
End Function
' METHOD CreateKey()
' Returns True for success, False for failure.
' HiveName is a string representing the registry hive (e.g. "HKLM").
Function CreateKey(ByVal HiveName, ByVal SubKeyName)
Dim Result
CreateKey = False
Result = g_RegProv.CreateKey(g_RegTypes(HiveName), SubKeyName)
If Result <> 0 Then
Exit Function
End If
CreateKey = True
End Function
' METHOD DeleteKey()
' Returns True for success, False for failure.
' HiveName is a string representing the registry hive (e.g. "HKLM").
' If DeleteSubKeys is True, then the method will attempt to delete all
' subkeys of the specified subkey before deleting the specified subkey.
' If DeleteSubKeys is True and the method encounters an error deleting
' a subkey under the specified subkey, it will abort.
Function DeleteKey(ByVal HiveName, ByVal SubKeyName, ByVal DeleteSubKeys)
Dim Result
Dim strRegSubKey
Dim strRegKey
Dim Names
Dim I
DeleteKey = False
'// If the key isn't present, then DeleteKey will be True!
'// In order to use ExistKey, we have to split SubKeyName
'// at the final '\'. This is imposed on us by the way
'// that the WMI registry object works.
'// If there's no backslash in SubKeyName, we have to fail
I = InStrRev(SubKeyName, "\")
If I = 0 Then
Exit Function
End If
strRegSubKey = Left(SubKeyName, I - 1)
strRegKey = Right(SubKeyName, Len(SubKeyName) - I)
If Not ExistKey(HiveName, strRegSubKey, strRegKey) Then
DeleteKey = True
Exit Function
End If
If DeleteSubKeys Then
Result = g_RegProv.EnumKey(g_RegTypes(HiveName), SubKeyName, Names)
If (Result = 0) And (Not IsNull(Names)) Then
For I = 0 To UBound(Names)
DeleteKey = DeleteKey(HiveName, _
SubKeyName & "\" & Names(I), DeleteSubKeys)
If DeleteKey <> 0 Then
Exit Function
End if
Next
End If
End If
Result = g_RegProv.DeleteKey(g_RegTypes(HiveName), SubKeyName)
If Result <> 0 Then
Exit Function
End If
DeleteKey = True
End Function
' METHOD WriteValue()
' Returns True for success, False for failure.
' HiveName is a string representing the registry hive (e.g. "HKLM").
' ValueType is a string representing the value's type (e.g. "REG_SZ").
' If you specify "REG_BINARY" or "REG_MULTI_SZ" for the value type,
' RegData must contain a safearray (VB array) of data. If you are using
' JScript, you can use the toVBarray() method to convert the JScript
' array to a safearray, but keep in mind that it must be a zero-based
' array with contiguous elements.
Function WriteValue(ByVal HiveName, ByVal SubKeyName, ByVal ValueName, ByVal ValueType, ByRef RegData)
Dim Result
WriteValue = False
If ValueName = "" Then
Result = g_RegProv.SetStringValue(g_RegTypes(HiveName), _
SubKeyName, _
ValueName, _
RegData)
Else
Select Case UCase(ValueType)
Case "REG_SZ"
Result = g_RegProv.SetStringValue(g_RegTypes(HiveName), _
SubKeyName, _
ValueName, _
RegData)
Case "REG_EXPAND_SZ"
Result = g_RegProv.SetExpandedStringValue(g_RegTypes(HiveName), _
SubKeyName, _
ValueName, _
RegData)
Case "REG_BINARY"
Result = g_RegProv.SetBinaryValue(g_RegTypes(HiveName), _
SubKeyName, _
ValueName, _
RegData)
Case "REG_DWORD"
Result = g_RegProv.SetDWORDValue(g_RegTypes(HiveName), _
SubKeyName, _
ValueName, _
RegData)
Case "REG_MULTI_SZ"
Result = g_RegProv.SetMultiStringValue(g_RegTypes(HiveName), _
SubKeyName, _
ValueName, _
RegData)
Case "REG_QWORD"
Result = g_RegProv.SetqWORDValue(g_RegTypes(HiveName), _
SubKeyName, _
ValueName, _
RegData)
Case Else
Result = ERR_INVALID_DATA
End Select
End If
If Result <> 0 Then
Exit Function
End If
WriteValue = True
End Function
' METHOD ExistValue()
' Returns True if the specified value exists, or False if not.
Function ExistValue(ByVal HiveName, ByVal SubKeyName, ByVal ValueName)
Dim Exists
Dim Result
Dim Names
Dim Types
Dim I
Exists = False
Result = g_RegProv.EnumValues(g_RegTypes(HiveName), SubKeyName, Names, Types)
If (Result = 0) And (Not IsNull(Names)) Then
For I = 0 To UBound(Names)
Exists = UCase(Names(I)) = UCase(ValueName)
If Exists Then
Exit For
End If
Next
End If
ExistValue = Exists
End Function
' METHOD ReadValue()
' Returns True for success, False for failure.
' HiveName is a string representing the registry hive (e.g. "HKLM").
' If the WMI method succeeds, the Result property will contain the
' registry data and the ValueType property will contain a string
' representing the data type (e.g. "REG_SZ").
Function ReadValue(ByVal HiveName, ByVal SubKeyName, ByVal ValueName)
Dim Result
Dim Names
Dim Types
Dim I
Dim RegData
ReadValue = False
' If ValueName is blank, retrieve the key's (Default) value (REG_SZ)
If ValueName = "" Then
Result = g_RegProv.GetStringValue(g_RegTypes(HiveName), SubKeyName, ValueName, RegData)
If Result = 0 Then
g_RegResult = RegData: g_RegValueType = "REG_SZ"
Else
g_RegResult = Null: g_RegValueType = Null
End If
Else
Result = g_RegProv.EnumValues(g_RegTypes(HiveName), SubKeyName, Names, Types)
If (Result = 0) And (Not IsNull(Names)) Then
For I = 0 To UBound(Names)
If UCase(Names(I)) = UCase(ValueName) Then
Select Case Types(I)
Case REG_SZ
Result = g_RegProv.GetStringValue(g_RegTypes(HiveName), _
SubKeyName, _
ValueName, _
RegData)
g_RegValueType = IIf(Result = 0, g_RegTypes(REG_SZ), Null)
Exit For
Case REG_EXPAND_SZ
Result = g_RegProv.GetExpandedStringValue(g_RegTypes(HiveName), _
SubKeyName, _
ValueName, _
RegData)
g_RegValueType = IIf(Result = 0, g_RegTypes(REG_EXPAND_SZ), Null)
Exit For
Case REG_BINARY
Result = g_RegProv.GetBinaryValue(g_RegTypes(HiveName), _
SubKeyName, _
ValueName, _
RegData)
g_RegValueType = IIf(Result = 0, g_RegTypes(REG_BINARY), Null)
Exit For
Case REG_DWORD
Result = g_RegProv.GetDWORDValue(g_RegTypes(HiveName), _
SubKeyName, _
ValueName, _
RegData)
g_RegValueType = IIf(Result = 0, g_RegTypes(REG_DWORD), Null)
Exit For
Case REG_QWORD
Result = g_RegProv.GetQWORDValue(g_RegTypes(HiveName), _
SubKeyName, _
ValueName, _
RegData)
g_RegValueType = IIf(Result = 0, g_RegTypes(REG_QWORD), Null)
Exit For
Case REG_MULTI_SZ
Result = g_RegProv.GetMultiStringValue(g_RegTypes(HiveName), _
SubKeyName, _
ValueName, _
RegData)
g_RegValueType = IIf(Result = 0, g_RegTypes(REG_MULTI_SZ), Null)
Exit For
Case Else
Result = ERR_INVALID_DATA
g_RegResult = Null
g_RegValueType = Null
Exit For
End Select
End If
Next
g_RegResult = IIf(Result = 0, RegData, Null)
End If
End If
If Result <> 0 Then
Exit Function
End If
ReadValue = True
End Function
' METHOD DeleteValue()
' Returns True for success, False for failure.
' HiveName is a string representing the registry hive (e.g. "HKLM").
Function DeleteValue(ByVal HiveName, ByVal SubKeyName, ByVal ValueName)
Dim Result
DeleteValue = False
'// If the value isn't present, then DeleteValue will be True!
If Not ExistValue(HiveName, SubKeyName, ValueName) Then
DeleteValue = True
Exit Function
End If
Result = g_RegProv.DeleteValue(g_RegTypes(HiveName), SubKeyName, ValueName)
If Result <> 0 Then
Exit Function
End If
DeleteValue = True
End Function
' METHOD ExistKey()
' Returns True if the specified subkey exists, or False if not.
Function ExistKey(ByVal HiveName, ByVal SubKeyName, ByVal KeyName)
Dim Exists
Dim Result
Dim Names
Dim I
Exists = False
Result = g_RegProv.EnumKey(g_RegTypes(HiveName), SubKeyName, Names)
If (Result = 0) And (Not IsNull(Names)) Then
For I = 0 To UBound(Names)
Exists = UCase(KeyName) = UCase(Names(I))
If Exists Then
Exit For
End If
Next
End If
ExistKey = Exists
End Function
' METHOD EnumKey()
' Returns True for success, False for failure.
' Populates the EnumDict dictionary's key names with the subkeys in the
' specified subkey. The dictionary's value names will be blank strings.
Function EnumKey(ByVal HiveName, ByVal SubKeyName)
Dim Result
Dim Names
Dim I
EnumKey = False
Result = g_RegProv.EnumKey(g_RegTypes(HiveName), SubKeyName, Names)
g_EnumDict.RemoveAll
If (Result = 0) And (Not IsNull(Names)) Then
For I = 0 To UBound(Names)
g_EnumDict.Add Names(I), ""
Next
End If
'If Result = 0 Then
If (Result = 0) And (Not IsNull(Names)) Then
EnumKey = True
End If
End Function
' METHOD EnumValues()
' Returns True for success, False for failure.
' Populates the EnumDict property's key/value pairs with
' the value entries and their corresponding data types.
Function EnumValues(ByVal HiveName, ByVal SubKeyName)
Dim Result
Dim Names
Dim Types
Dim I
EnumValues = False
Result = g_RegProv.EnumValues(g_RegTypes(HiveName), SubKeyName, Names, Types)
g_EnumDict.RemoveAll
If (Result = 0) And (Not IsNull(Names)) Then
For I = 0 To UBound(Names)
g_EnumDict.Add Names(I), g_RegTypes(Types(I))
Next
End If
'If Result = 0 Then
If (Result = 0) And (Not IsNull(Names)) Then
EnumValues = True
End If
End Function
' METHOD EnumValuesAndData()
' Returns True for success, False for failure.
' Populates the EnumDict property's key/value pairs with
' the value entries and their contents. For REG_BINARY and REG_MULTI_SZ
' values, they will be represented as strings with | separators.
Function EnumValuesAndData(ByVal HiveName, ByVal SubKeyName)
Dim Result
Dim Names
Dim Types
Dim I
Dim RegData
Dim J
Dim S
EnumValuesAndData = False
Result = g_RegProv.EnumValues(g_RegTypes(HiveName), SubKeyName, Names, Types)
g_EnumDict.RemoveAll
If (Result = 0) And (Not IsNull(Names)) Then
For I = 0 To UBound(Names)
Select Case Types(I)
Case REG_SZ
Result = g_RegProv.GetStringValue(g_RegTypes(HiveName), _
SubKeyName, _
Names(I), _
RegData)
If Result = 0 Then
g_EnumDict.Add Names(I), RegData
End If
Case REG_EXPAND_SZ
Result = g_RegProv.GetExpandedStringValue(g_RegTypes(HiveName), _
SubKeyName, _
Names(I), _
RegData)
If Result = 0 Then
g_EnumDict.Add Names(I), RegData
End If
Case REG_BINARY
Result = g_RegProv.GetBinaryValue(g_RegTypes(HiveName), _
SubKeyName, _
Names(I), _
RegData)
If Result = 0 Then
S = ""
For J = 0 To UBound(RegData)
S = IIf(S <> "", S & " " & ToHex(RegData(J)), ToHex(RegData(J)))
Next
g_EnumDict.Add Names(I), S
End If
Case REG_DWORD
Result = g_RegProv.GetDWORDValue(g_RegTypes(HiveName), _
SubKeyName, _
Names(I), _
RegData)
If Result = 0 Then
g_EnumDict.Add Names(I), RegData
End If
Case REG_DQWORD
Result = g_RegProv.GetQWORDValue(g_RegTypes(HiveName), _
SubKeyName, _
Names(I), _
RegData)
If Result = 0 Then
g_EnumDict.Add Names(I), RegData
End If
Case REG_MULTI_SZ
Result = g_RegProv.GetMultiStringValue(g_RegTypes(HiveName), _
SubKeyName, _
Names(I), _
RegData)
If Result = 0 Then
S = ""
For J = 0 To UBound(RegData)
S = IIf(S <> "", S & SEPARATOR & RegData(J), RegData(J))
Next
g_EnumDict.Add Names(I), S
End If
Case Else
Result = ERR_INVALID_DATA
End Select
Next
End If
'If Result = 0 Then
If (Result = 0) And (Not IsNull(Names)) Then
EnumValuesAndData = True
End If
End Function
' Returns the byte N in hexadecimal notation with a leading zero.
Function ToHex(ByVal N)
ToHex = IIf(N < &H10, "0" & Hex(N), Hex(N))
End Function
End Class
'// A registry class to abstract the WMI registry provider
'// Option Explicit
'//
'// Dim strMsg
'// Dim blnResult
'// Dim blnFailed
'// Dim objRegistry
'// Dim objRecord
'// Dim objDictionary
'//
'// Set objRegistry = New clsRegistry
'//
'// blnResult = objRegistry.Connect(".")
'// If blnResult Then
'// With objRegistry
'//
'// '// Create key
'// blnResult = .CreateKey("HKCU", "Control Panel\Accessibility\Dummy Key")
'// If blnResult Then
'// WScript.Echo "Created key."
'// Else
'// WScript.Echo "Failed to create key."
'// End If
'//
'// '// Delete key
'// '// True Delete sub-keys
'// '// False Do not delete sub-keys
'// blnResult = .DeleteKey("HKCU", "Control Panel\Accessibility\Dummy Key", True)
'// If blnResult Then
'// WScript.Echo "Deleted key."
'// Else
'// WScript.Echo "Failed to delete key."
'// End If
'//
'// '// Write value
'// blnResult = .WriteValue("HKCU", "Control Panel\Accessibility", "Dummy Value", "REG_SZ", "Dummy data")
'// If blnResult Then
'// WScript.Echo "Created value."
'// Else
'// WScript.Echo "Failed to create value."
'// End If
'//
'// '// Check value exists
'// blnResult = .ExistValue("HKCU", "Control Panel\Accessibility", "Dummy Value")
'// If blnResult Then
'// WScript.Echo "Value exists."
'// Else
'// WScript.Echo "Value does not exist."
'// End If
'//
'// '// Read value
'// '// Typically, you would use ExistValue before calling ReadValue
'// blnResult = .ReadValue("HKCU", "Control Panel\Accessibility", "Dummy Value")
'// If blnResult Then
'// WScript.Echo "Value is " & .get_RegResult & ", and is of type " & .get_RegValueType
'// Else
'// WScript.Echo "Failed to read value."
'// End If
'//
'// '// Delete value
'// blnResult = .DeleteValue("HKCU", "Control Panel\Accessibility", "Dummy Value")
'// If blnResult Then
'// WScript.Echo "Deleted value."
'// Else
'// WScript.Echo "Failed to delete value."
'// End If
'//
'// '// Check key exists
'// blnResult = .ExistKey("HKCU", "Control Panel\Accessibility", "Keyboard Response")
'// If blnResult Then
'// WScript.Echo "Key exists."
'// Else
'// WScript.Echo "Key does not exist."
'// End If
'//
'// '// Enumerate key
'// blnResult = .EnumKey("HKCU", "Control Panel\Accessibility")
'// If blnResult Then
'// Set objDictionary = .get_EnumDict
'// strMsg = Empty
'// For Each objRecord In objDictionary
'// '// objDictionary(objRecord) is always null string for this method
'// WScript.Echo "Key name is " & objRecord
'// Next
'// Else
'// WScript.Echo "No sub-keys exist under that key."
'// End If
'//
'// '// Enumerate values
'// blnResult = .EnumValues("HKCU", "Control Panel\Accessibility\Keyboard Response")
'// If blnResult Then
'// Set objDictionary = .get_EnumDict
'// strMsg = Empty
'// For Each objRecord In objDictionary
'// WScript.Echo "Value is " & objRecord & ", and is of type " & objDictionary(objRecord)
'// Next
'// Else
'// WScript.Echo "No values exist under that key."
'// End If
'//
'// '// Enumerate values and data
'// blnResult = .EnumValuesAndData("HKCU", "Control Panel\Accessibility\Keyboard Response")
'// If blnResult Then
'// Set objDictionary = .get_EnumDict
'// strMsg = Empty
'// For Each objRecord In objDictionary
'// '// Ignore '_Stage Number' and '_Stage Description'
'// If Left(CStr(objRecord), 1) <> "_" Then
'// If objDictionary(objRecord) = 1024 Then
'// blnFailed = True
'// strMsg = strMsg & vbCRLF
'// strMsg = strMsg & String(2, vbTAB)
'// strMsg = strMsg & CStr(objRecord)
'// End If
'// End If
'// WScript.Echo "Value is " & objRecord & ", data is " & objDictionary(objRecord)
'// Next
'// Else
'// WScript.Echo "No value/data pairs exist under that key."
'// End If
'// End With
'// End If
Option Explicit
Class clsRegistry
'// This class makes it simple to manipulate the registry on the local or a remote computer.
'// Internally it uses the WMI StdRegProv class methods.
'//
'// It provides a simpler set of methods than the StdRegProv methods:
'//
'// * Rather than numeric values, this object's methods use string input: For example, "HKLM" instead of 0x80000002.
'//
'// * Rather than separate Get...Value() methods for each data type, it provides a single ReadValue() method.
'// The get_RegResult property will contain the registry value's data, and the get_RegValueType property
'// will contain the registry value's data type as a string (e.g. "REG_SZ").
'//
'// * Rather than separate Set...Value() methods for each data type, it provides a single WriteValue() method
'// that lets you specify the data type as a string parameter.
'//
'// * The DeleteKey() method provides a DeleteSubKeys parameter. If True, then it will attempt to delete all subkeys
'// of the specified subkey.
'//
'// * The ExistKey() and ExistValue() methods return True if the specified key or value exists in a specified subkey,
'// or False otherwise.
'//
'// This class also implements the EnumValues(), EnumValuesAndData(), and EnumKey() methods:
'//
'// * The array outputs of these methods are accessible from the EnumResult property, which returns a reference to a
'// Scripting.Dictionary object.
'//
'// * After calling the EnumValues() method, the EnumResult dictionary will contain the value names and types.
'// The types will be stored as strings (e.g. "REG_SZ").
'//
'// * After calling the EnumValuesAndData() method, the EnumDict dictionary will contain the value names and contents
'// of each value. If a value contains a REG_BINARY, the contents will be a string containing a series of the hex bytes
'// in the data (like the registry editor). If a value contains a REG_MULTI_SZ, the multiple strings will be separated
'// by a "|" character. This method exists mainly as a quick way for a program to output all of the values in a registry subkey.
'//
'// * After calling the EnumKey() method, the EnumResult dictionary will contain the names of the subkeys.
'// The "value" parts of the dictionary will be empty strings.
'//
'// * For JScript, the dictToJSArray() method converts a dictionary to a JScript array.
Dim REG_SZ
Dim REG_EXPAND_SZ
Dim REG_BINARY
Dim REG_DWORD
Dim REG_QWORD
Dim REG_MULTI_SZ
Dim REG_RESOURCE_LIST
Dim REG_FULL_RESOURCE_DESCRIPTOR
Dim REG_RESOURCE_REQUIREMENTS_LIST
Dim ERR_INVALID_DATA
Dim SEPARATOR
Dim g_RegTypes
Dim g_EnumDict
Dim g_RegProv
Dim g_RegResult
Dim g_RegValueType
Private Sub Class_Initialize()
REG_SZ = 1
REG_EXPAND_SZ = 2
REG_BINARY = 3
REG_DWORD = 4
REG_MULTI_SZ = 7
REG_RESOURCE_LIST = 8
REG_FULL_RESOURCE_DESCRIPTOR = 9
REG_RESOURCE_REQUIREMENTS_LIST = 10
REG_QWORD = 11
ERR_INVALID_DATA = 13
SEPARATOR = "|"
' Contains constants and some numbers for quick lookup.
Set g_RegTypes = CreateObject("Scripting.Dictionary")
' Dictionary object for EnumKey() and EnumValues().
Set g_EnumDict = CreateObject("Scripting.Dictionary")
' Case-insensitive key comparisons.
g_RegTypes.CompareMode = vbTextCompare
g_EnumDict.CompareMode = vbTextCompare
' Populate the dictionary with needed data.
With g_RegTypes
.Add "HKCR", &H80000000
.Add "HKEY_CLASSES_ROOT", &H80000000
.Add "HKCU", &H80000001
.Add "HKEY_CURRENT_USER", &H80000001
.Add "HKLM", &H80000002
.Add "HKEY_LOCAL_MACHINE", &H80000002
.Add "HKEY_USERS", &H80000003
.Add "HKEY_CURRENT_CONFIG", &H80000005
.Add "REG_SZ", REG_SZ
.Add REG_SZ, "REG_SZ"
.Add "REG_EXPAND_SZ", REG_EXPAND_SZ
.Add REG_EXPAND_SZ, "REG_EXPAND_SZ"
.Add "REG_BINARY", REG_BINARY
.Add REG_BINARY, "REG_BINARY"
.Add "REG_DWORD", REG_DWORD
.Add REG_DWORD, "REG_DWORD"
.Add "REG_MULTI_SZ", REG_MULTI_SZ
.Add REG_MULTI_SZ, "REG_MULTI_SZ"
.Add "REG_QWORD", REG_QWORD
.Add REG_QWORD, "REG_QWORD"
.Add "REG_RESOURCE_LIST", REG_RESOURCE_LIST
.Add REG_RESOURCE_LIST, "REG_RESOURCE_LIST"
.Add "REG_FULL_RESOURCE_DESCRIPTOR", REG_FULL_RESOURCE_DESCRIPTOR
.Add REG_FULL_RESOURCE_DESCRIPTOR, "REG_FULL_RESOURCE_DESCRIPTOR"
.Add "REG_RESOURCE_REQUIREMENTS_LIST", REG_RESOURCE_REQUIREMENTS_LIST
.Add REG_RESOURCE_REQUIREMENTS_LIST, "REG_RESOURCE_REQUIREMENTS_LIST"
End With
' No valid data yet
g_RegResult = Null
g_RegValueType = Null
End Sub
Private Sub Class_Terminate()
Set g_EnumDict = Nothing
Set g_RegTypes = Nothing
End Sub
' PROPERTY get_RegResult()
' Returns the result data from a registry operation.
Function get_RegResult()
get_RegResult = g_RegResult
End Function
' PROPERTY get_RegValueType()
' Returns the result data's data type.
Function get_RegValueType()
get_RegValueType = g_RegValueType
End Function
' PROPERTY get_EnumDict()
' Returns a reference to the dictionary populated by the Enum...() methods.
Function get_EnumDict()
Set get_EnumDict = g_EnumDict
End Function
' METHOD Connect()
' Connects to the specified computer using WMI; returns True for success,
' or the WMI error code if it fails. If the computer is already connected,
' it will not attempt to connect again and will return True.
Function Connect(ByVal ComputerName)
Dim Result
Connect = False
ComputerName = UCase(Trim(ComputerName))
If Left(ComputerName, 2) = "\\" Then
ComputerName = Mid(ComputerName, 3)
End If
On Error Resume Next
Set g_RegProv = GetObject("winmgmts:{impersonationlevel=impersonate}!//" & ComputerName & "/root/default:StdRegProv")
Result = Err.Number
On Error GoTo 0
If Err.Number <> 0 Then
Exit Function
End If
Connect = True
End Function
' If Condition is True, return TrueValue; otherwise, return FalseValue.
Function IIf(ByVal Condition, ByVal TrueValue, ByVal FalseValue)
If Condition Then
IIf = TrueValue
Else
IIf = FalseValue
End If
End Function
' METHOD CheckAccess()
' Returns True for success, False for failure.
' HiveName is a string representing the registry hive (e.g. "HKLM").
' Required is a numeric value representing the desired access level.
' KEY_QUERY_VALUE 1 0x1 Required to query the values of a registry key.
' KEY_SET_VALUE 2 0x2 Required to create, delete, or set a registry value.
' KEY_CREATE_SUB_KEY 4 0x4 Required to create a subkey of a registry key.
' KEY_ENUMERATE_SUB_KEYS 8 0x8 Required to enumerate the subkeys of a registry key.
' KEY_NOTIFY 16 0x10 Required to request change notifications for a registry key or for subkeys of a registry key.
' KEY_CREATE 32 0x20 Required to create a registry key.
' DELETE 65536 0x10000 Required to delete a registry key.
' READ_CONTROL 131072 0x20000 Combines the STANDARD_RIGHTS_READ, KEY_QUERY_VALUE, KEY_ENUMERATE_SUB_KEYS, and KEY_NOTIFY values.
' WRITE_DAC 262144 0x40000 Required to modify the DACL in the object's security descriptor.
' WRITE_OWNER 524288 0x80000 Required to change the owner in the object's security descriptor.
'
' If the WMI CheckAccess method succeeded, update g_RegResult.
Function CheckAccess(ByVal HiveName, ByVal SubKeyName, ByVal Required)
Dim Result
Dim blnGranted
CheckAccess = False
Result = g_RegProv.CheckAccess(g_RegTypes(HiveName), SubKeyName, Required, blnGranted)
g_RegResult = IIf(Result = 0, blnGranted, Null)
g_RegValueType = Null
If Result <> 0 Then
Exit Function
End If
CheckAccess = True
End Function
' METHOD CreateKey()
' Returns True for success, False for failure.
' HiveName is a string representing the registry hive (e.g. "HKLM").
Function CreateKey(ByVal HiveName, ByVal SubKeyName)
Dim Result
CreateKey = False
Result = g_RegProv.CreateKey(g_RegTypes(HiveName), SubKeyName)
If Result <> 0 Then
Exit Function
End If
CreateKey = True
End Function
' METHOD DeleteKey()
' Returns True for success, False for failure.
' HiveName is a string representing the registry hive (e.g. "HKLM").
' If DeleteSubKeys is True, then the method will attempt to delete all
' subkeys of the specified subkey before deleting the specified subkey.
' If DeleteSubKeys is True and the method encounters an error deleting
' a subkey under the specified subkey, it will abort.
Function DeleteKey(ByVal HiveName, ByVal SubKeyName, ByVal DeleteSubKeys)
Dim Result
Dim strRegSubKey
Dim strRegKey
Dim Names
Dim I
DeleteKey = False
'// If the key isn't present, then DeleteKey will be True!
'// In order to use ExistKey, we have to split SubKeyName
'// at the final '\'. This is imposed on us by the way
'// that the WMI registry object works.
'// If there's no backslash in SubKeyName, we have to fail
I = InStrRev(SubKeyName, "\")
If I = 0 Then
Exit Function
End If
strRegSubKey = Left(SubKeyName, I - 1)
strRegKey = Right(SubKeyName, Len(SubKeyName) - I)
If Not ExistKey(HiveName, strRegSubKey, strRegKey) Then
DeleteKey = True
Exit Function
End If
If DeleteSubKeys Then
Result = g_RegProv.EnumKey(g_RegTypes(HiveName), SubKeyName, Names)
If (Result = 0) And (Not IsNull(Names)) Then
For I = 0 To UBound(Names)
DeleteKey = DeleteKey(HiveName, _
SubKeyName & "\" & Names(I), DeleteSubKeys)
If DeleteKey <> 0 Then
Exit Function
End if
Next
End If
End If
Result = g_RegProv.DeleteKey(g_RegTypes(HiveName), SubKeyName)
If Result <> 0 Then
Exit Function
End If
DeleteKey = True
End Function
' METHOD WriteValue()
' Returns True for success, False for failure.
' HiveName is a string representing the registry hive (e.g. "HKLM").
' ValueType is a string representing the value's type (e.g. "REG_SZ").
' If you specify "REG_BINARY" or "REG_MULTI_SZ" for the value type,
' RegData must contain a safearray (VB array) of data. If you are using
' JScript, you can use the toVBarray() method to convert the JScript
' array to a safearray, but keep in mind that it must be a zero-based
' array with contiguous elements.
Function WriteValue(ByVal HiveName, ByVal SubKeyName, ByVal ValueName, ByVal ValueType, ByRef RegData)
Dim Result
WriteValue = False
If ValueName = "" Then
Result = g_RegProv.SetStringValue(g_RegTypes(HiveName), _
SubKeyName, _
ValueName, _
RegData)
Else
Select Case UCase(ValueType)
Case "REG_SZ"
Result = g_RegProv.SetStringValue(g_RegTypes(HiveName), _
SubKeyName, _
ValueName, _
RegData)
Case "REG_EXPAND_SZ"
Result = g_RegProv.SetExpandedStringValue(g_RegTypes(HiveName), _
SubKeyName, _
ValueName, _
RegData)
Case "REG_BINARY"
Result = g_RegProv.SetBinaryValue(g_RegTypes(HiveName), _
SubKeyName, _
ValueName, _
RegData)
Case "REG_DWORD"
Result = g_RegProv.SetDWORDValue(g_RegTypes(HiveName), _
SubKeyName, _
ValueName, _
RegData)
Case "REG_MULTI_SZ"
Result = g_RegProv.SetMultiStringValue(g_RegTypes(HiveName), _
SubKeyName, _
ValueName, _
RegData)
Case "REG_QWORD"
Result = g_RegProv.SetqWORDValue(g_RegTypes(HiveName), _
SubKeyName, _
ValueName, _
RegData)
Case Else
Result = ERR_INVALID_DATA
End Select
End If
If Result <> 0 Then
Exit Function
End If
WriteValue = True
End Function
' METHOD ExistValue()
' Returns True if the specified value exists, or False if not.
Function ExistValue(ByVal HiveName, ByVal SubKeyName, ByVal ValueName)
Dim Exists
Dim Result
Dim Names
Dim Types
Dim I
Exists = False
Result = g_RegProv.EnumValues(g_RegTypes(HiveName), SubKeyName, Names, Types)
If (Result = 0) And (Not IsNull(Names)) Then
For I = 0 To UBound(Names)
Exists = UCase(Names(I)) = UCase(ValueName)
If Exists Then
Exit For
End If
Next
End If
ExistValue = Exists
End Function
' METHOD ReadValue()
' Returns True for success, False for failure.
' HiveName is a string representing the registry hive (e.g. "HKLM").
' If the WMI method succeeds, the Result property will contain the
' registry data and the ValueType property will contain a string
' representing the data type (e.g. "REG_SZ").
Function ReadValue(ByVal HiveName, ByVal SubKeyName, ByVal ValueName)
Dim Result
Dim Names
Dim Types
Dim I
Dim RegData
ReadValue = False
' If ValueName is blank, retrieve the key's (Default) value (REG_SZ)
If ValueName = "" Then
Result = g_RegProv.GetStringValue(g_RegTypes(HiveName), SubKeyName, ValueName, RegData)
If Result = 0 Then
g_RegResult = RegData: g_RegValueType = "REG_SZ"
Else
g_RegResult = Null: g_RegValueType = Null
End If
Else
Result = g_RegProv.EnumValues(g_RegTypes(HiveName), SubKeyName, Names, Types)
If (Result = 0) And (Not IsNull(Names)) Then
For I = 0 To UBound(Names)
If UCase(Names(I)) = UCase(ValueName) Then
Select Case Types(I)
Case REG_SZ
Result = g_RegProv.GetStringValue(g_RegTypes(HiveName), _
SubKeyName, _
ValueName, _
RegData)
g_RegValueType = IIf(Result = 0, g_RegTypes(REG_SZ), Null)
Exit For
Case REG_EXPAND_SZ
Result = g_RegProv.GetExpandedStringValue(g_RegTypes(HiveName), _
SubKeyName, _
ValueName, _
RegData)
g_RegValueType = IIf(Result = 0, g_RegTypes(REG_EXPAND_SZ), Null)
Exit For
Case REG_BINARY
Result = g_RegProv.GetBinaryValue(g_RegTypes(HiveName), _
SubKeyName, _
ValueName, _
RegData)
g_RegValueType = IIf(Result = 0, g_RegTypes(REG_BINARY), Null)
Exit For
Case REG_DWORD
Result = g_RegProv.GetDWORDValue(g_RegTypes(HiveName), _
SubKeyName, _
ValueName, _
RegData)
g_RegValueType = IIf(Result = 0, g_RegTypes(REG_DWORD), Null)
Exit For
Case REG_QWORD
Result = g_RegProv.GetQWORDValue(g_RegTypes(HiveName), _
SubKeyName, _
ValueName, _
RegData)
g_RegValueType = IIf(Result = 0, g_RegTypes(REG_QWORD), Null)
Exit For
Case REG_MULTI_SZ
Result = g_RegProv.GetMultiStringValue(g_RegTypes(HiveName), _
SubKeyName, _
ValueName, _
RegData)
g_RegValueType = IIf(Result = 0, g_RegTypes(REG_MULTI_SZ), Null)
Exit For
Case Else
Result = ERR_INVALID_DATA
g_RegResult = Null
g_RegValueType = Null
Exit For
End Select
End If
Next
g_RegResult = IIf(Result = 0, RegData, Null)
End If
End If
If Result <> 0 Then
Exit Function
End If
ReadValue = True
End Function
' METHOD DeleteValue()
' Returns True for success, False for failure.
' HiveName is a string representing the registry hive (e.g. "HKLM").
Function DeleteValue(ByVal HiveName, ByVal SubKeyName, ByVal ValueName)
Dim Result
DeleteValue = False
'// If the value isn't present, then DeleteValue will be True!
If Not ExistValue(HiveName, SubKeyName, ValueName) Then
DeleteValue = True
Exit Function
End If
Result = g_RegProv.DeleteValue(g_RegTypes(HiveName), SubKeyName, ValueName)
If Result <> 0 Then
Exit Function
End If
DeleteValue = True
End Function
' METHOD ExistKey()
' Returns True if the specified subkey exists, or False if not.
Function ExistKey(ByVal HiveName, ByVal SubKeyName, ByVal KeyName)
Dim Exists
Dim Result
Dim Names
Dim I
Exists = False
Result = g_RegProv.EnumKey(g_RegTypes(HiveName), SubKeyName, Names)
If (Result = 0) And (Not IsNull(Names)) Then
For I = 0 To UBound(Names)
Exists = UCase(KeyName) = UCase(Names(I))
If Exists Then
Exit For
End If
Next
End If
ExistKey = Exists
End Function
' METHOD EnumKey()
' Returns True for success, False for failure.
' Populates the EnumDict dictionary's key names with the subkeys in the
' specified subkey. The dictionary's value names will be blank strings.
Function EnumKey(ByVal HiveName, ByVal SubKeyName)
Dim Result
Dim Names
Dim I
EnumKey = False
Result = g_RegProv.EnumKey(g_RegTypes(HiveName), SubKeyName, Names)
g_EnumDict.RemoveAll
If (Result = 0) And (Not IsNull(Names)) Then
For I = 0 To UBound(Names)
g_EnumDict.Add Names(I), ""
Next
End If
'If Result = 0 Then
If (Result = 0) And (Not IsNull(Names)) Then
EnumKey = True
End If
End Function
' METHOD EnumValues()
' Returns True for success, False for failure.
' Populates the EnumDict property's key/value pairs with
' the value entries and their corresponding data types.
Function EnumValues(ByVal HiveName, ByVal SubKeyName)
Dim Result
Dim Names
Dim Types
Dim I
EnumValues = False
Result = g_RegProv.EnumValues(g_RegTypes(HiveName), SubKeyName, Names, Types)
g_EnumDict.RemoveAll
If (Result = 0) And (Not IsNull(Names)) Then
For I = 0 To UBound(Names)
g_EnumDict.Add Names(I), g_RegTypes(Types(I))
Next
End If
'If Result = 0 Then
If (Result = 0) And (Not IsNull(Names)) Then
EnumValues = True
End If
End Function
' METHOD EnumValuesAndData()
' Returns True for success, False for failure.
' Populates the EnumDict property's key/value pairs with
' the value entries and their contents. For REG_BINARY and REG_MULTI_SZ
' values, they will be represented as strings with | separators.
Function EnumValuesAndData(ByVal HiveName, ByVal SubKeyName)
Dim Result
Dim Names
Dim Types
Dim I
Dim RegData
Dim J
Dim S
EnumValuesAndData = False
Result = g_RegProv.EnumValues(g_RegTypes(HiveName), SubKeyName, Names, Types)
g_EnumDict.RemoveAll
If (Result = 0) And (Not IsNull(Names)) Then
For I = 0 To UBound(Names)
Select Case Types(I)
Case REG_SZ
Result = g_RegProv.GetStringValue(g_RegTypes(HiveName), _
SubKeyName, _
Names(I), _
RegData)
If Result = 0 Then
g_EnumDict.Add Names(I), RegData
End If
Case REG_EXPAND_SZ
Result = g_RegProv.GetExpandedStringValue(g_RegTypes(HiveName), _
SubKeyName, _
Names(I), _
RegData)
If Result = 0 Then
g_EnumDict.Add Names(I), RegData
End If
Case REG_BINARY
Result = g_RegProv.GetBinaryValue(g_RegTypes(HiveName), _
SubKeyName, _
Names(I), _
RegData)
If Result = 0 Then
S = ""
For J = 0 To UBound(RegData)
S = IIf(S <> "", S & " " & ToHex(RegData(J)), ToHex(RegData(J)))
Next
g_EnumDict.Add Names(I), S
End If
Case REG_DWORD
Result = g_RegProv.GetDWORDValue(g_RegTypes(HiveName), _
SubKeyName, _
Names(I), _
RegData)
If Result = 0 Then
g_EnumDict.Add Names(I), RegData
End If
Case REG_DQWORD
Result = g_RegProv.GetQWORDValue(g_RegTypes(HiveName), _
SubKeyName, _
Names(I), _
RegData)
If Result = 0 Then
g_EnumDict.Add Names(I), RegData
End If
Case REG_MULTI_SZ
Result = g_RegProv.GetMultiStringValue(g_RegTypes(HiveName), _
SubKeyName, _
Names(I), _
RegData)
If Result = 0 Then
S = ""
For J = 0 To UBound(RegData)
S = IIf(S <> "", S & SEPARATOR & RegData(J), RegData(J))
Next
g_EnumDict.Add Names(I), S
End If
Case Else
Result = ERR_INVALID_DATA
End Select
Next
End If
'If Result = 0 Then
If (Result = 0) And (Not IsNull(Names)) Then
EnumValuesAndData = True
End If
End Function
' Returns the byte N in hexadecimal notation with a leading zero.
Function ToHex(ByVal N)
ToHex = IIf(N < &H10, "0" & Hex(N), Hex(N))
End Function
End Class
Comments:
-
Thanks for your answer. But it is too complex for a beginner like me.
To be specific I am looking for {someProductCode}.RebootRequired registries. This "ProductCode" is different for different products.
So I want to search for ".RebootRequired" registries in Uninstall hive of HKLM.
Please help - Ishan Girdhar 9 years ago
To be blunt, you'll struggle with any scripting if you give up at this early stage.
Whilst the class itself is fairly complex, using it isn't.
- Paste the complete text as it is at the foot of the script you're building.
- Declare a variable to contain the registry object:
Dim objRegistry
- From here, I'll assume you declare all variables before use. You're either a fool or a masochist if you don't.
- Create the object
Set objRegistry = New clsRegistry
- Connect to the registry you want to interrogate. The form "." means "use the local computer". To connect to remote machines, you'll need to insert the machine name:
blnResult = objRegistry.Connect(".")
- Test the return value in your variable (in the case, 'blnResult') is True, then proceed.
'// Enumerate values and data
blnResult = .EnumValuesAndData("HKLM", "TheSubKey\InHKLM\YouAreSearchingIn")
If blnResult Then
'// The class returns this data in a dictionary:
Set objDictionary = .get_EnumDict
For Each objRecord In objDictionary
'// The dictionary's key, the registry key's value, is contained in 'objRecord' and the data is in 'objDictionary(objRecord)'
Next
End If
BTW, I've been doing this stuff since Spielberg filmed the dinosaurs and I have never come across a registry key like the one you're searching for. What is the full path to a specimen value?
Comments:
-
Below is the full path for 32 bit machine:
HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall
Under this Uninstall hive .RebootRequired registry is formed when we install some complex tools like MSVS. And these .RebootRequired registries hampered other tools installations thats why i want to delete them. Since the product codes are different for every tools thats why I cannot search the registry key by its full name. I only know its extension ( or suffix) .RebootRequired.
Is it clear now??
And its my second day to work on VBS. So its better if you don't call fool without knoing about his/her background. - Ishan Girdhar 9 years ago-
It sounds like you are trying to "cheat" not rebooting the computer after a software installation requires it? Is there some reason you CANNOT reboot the machine in between software installations?
I'm going to second VBScab and suggest that you reboot after your updates rather than try to work around it. - htomlinson 9 years ago
I didn't refer to you as a fool. What I said was, you'd be a fool to not declare your variables before using them. To avoid that becoming an issue, make this the first line of *every* VBS you write:
Option Explicit
If Not IsObject(objSomeObjectOrOther) Then
'// Perform some operation here, either log the error, exit the function/sub/script
End If