|
|
Title | Enumerate registry keys, subkeys, and values |
Description | This example shows how to enumerate registry keys, subkeys, and values in Visual Basic 6. |
Keywords | Regsitry, System Registry, key, subkey |
Categories | Tips and Tricks, Windows |
|
|
When the user selects a Registry section, enters a key, and clicks a button, the program calls subroutine GetKeyInfo, passing it the section, key name, and an indentation level.
|
|
Private Sub Command1_Click()
txtKeys.Text = Text1.Text & vbCrLf & _
GetKeyInfo(m_SelectedSection, Text1.Text, 4)
End Sub
|
|
Function GetKeyInfo uses RegOpenKeyEx to open a key. It then calls RegEnumValue repeatedly to get the value within the key.
After enumerating all of the key's values, the program uses RegEnumKey to find the key's subkeys and add them to a collection.
The function closes the Registry key and recursively calls itself to examine the subkeys.
|
|
' Get the key information for this key and
' its subkeys.
Private Function GetKeyInfo(ByVal section As Long, ByVal _
key_name As String, ByVal indent As Integer) As String
Dim subkeys As Collection
Dim subkey_values As Collection
Dim subkey_num As Integer
Dim subkey_name As String
Dim subkey_value As String
Dim length As Long
Dim hKey As Long
Dim txt As String
Dim subkey_txt As String
Dim value_num As Long
Dim value_name_len As Long
Dim value_name As String
Dim reserved As Long
Dim value_type As Long
Dim value_string As String
Dim value_data(1 To 1024) As Byte
Dim value_data_len As Long
Dim i As Integer
Set subkeys = New Collection
Set subkey_values = New Collection
' Open the key.
If RegOpenKeyEx(section, _
key_name, _
0&, KEY_ALL_ACCESS, hKey) <> ERROR_SUCCESS _
Then
MsgBox "Error opening key."
Exit Function
End If
' Enumerate the key's values.
value_num = 0
Do
value_name_len = 1024
value_name = Space$(value_name_len)
value_data_len = 1024
If RegEnumValue(hKey, value_num, _
value_name, value_name_len, 0, _
value_type, value_data(1), value_data_len) _
<> ERROR_SUCCESS Then Exit Do
value_name = Left$(value_name, value_name_len)
Select Case value_type
Case REG_BINARY
txt = txt & Space$(indent) & "> " & _
value_name & " = [binary]" & vbCrLf
Case REG_DWORD
value_string = "&H" & _
Format$(Hex$(value_data(4)), "00") & _
Format$(Hex$(value_data(3)), "00") & _
Format$(Hex$(value_data(2)), "00") & _
Format$(Hex$(value_data(1)), "00")
txt = txt & Space$(indent) & "> " & _
value_name & " = " & value_string & _
vbCrLf
Case REG_DWORD_BIG_ENDIAN
txt = txt & Space$(indent) & "> " & _
value_name & " = [dword big endian]" & _
vbCrLf
Case REG_DWORD_LITTLE_ENDIAN
txt = txt & Space$(indent) & "> " & _
value_name & " = [dword little endian]" _
& vbCrLf
Case REG_EXPAND_SZ
txt = txt & Space$(indent) & "> " & _
value_name & " = [expand sz]" & vbCrLf
Case REG_FULL_RESOURCE_DESCRIPTOR
txt = txt & Space$(indent) & "> " & _
value_name & " = [full resource " & _
"descriptor]" & vbCrLf
Case REG_LINK
txt = txt & Space$(indent) & "> " & _
value_name & " = [link]" & vbCrLf
Case REG_MULTI_SZ
txt = txt & Space$(indent) & "> " & _
value_name & " = [multi sz]" & vbCrLf
Case REG_NONE
txt = txt & Space$(indent) & "> " & _
value_name & " = [none]" & vbCrLf
Case REG_RESOURCE_LIST
txt = txt & Space$(indent) & "> " & _
value_name & " = [resource list]" & _
vbCrLf
Case REG_RESOURCE_REQUIREMENTS_LIST
txt = txt & Space$(indent) & "> " & _
value_name & " = [resource requirements " & _
"list]" & vbCrLf
Case REG_SZ
value_string = ""
For i = 1 To value_data_len - 1
value_string = value_string & _
Chr$(value_data(i))
Next i
txt = txt & Space$(indent) & "> " & _
value_name & " = """ & value_string & _
"""" & vbCrLf
End Select
value_num = value_num + 1
Loop
' Enumerate the subkeys.
subkey_num = 0
Do
' Enumerate subkeys until we get an error.
length = 256
subkey_name = Space$(length)
If RegEnumKey(hKey, subkey_num, _
subkey_name, length) _
<> ERROR_SUCCESS Then Exit Do
subkey_num = subkey_num + 1
subkey_name = Left$(subkey_name, InStr(subkey_name, _
Chr$(0)) - 1)
subkeys.Add subkey_name
' Get the subkey's value.
length = 256
subkey_value = Space$(length)
If RegQueryValue(hKey, subkey_name, _
subkey_value, length) _
<> ERROR_SUCCESS _
Then
subkey_values.Add "Error"
Else
' Remove the trailing null character.
subkey_value = Left$(subkey_value, length - 1)
subkey_values.Add subkey_value
End If
Loop
' Close the key.
If RegCloseKey(hKey) <> ERROR_SUCCESS Then
MsgBox "Error closing key."
End If
' Recursively get information on the keys.
For subkey_num = 1 To subkeys.Count
subkey_txt = GetKeyInfo(section, key_name & "\" & _
subkeys(subkey_num), indent + 4)
txt = txt & Space(indent) & _
subkeys(subkey_num) & _
": " & subkey_values(subkey_num) & vbCrLf & _
subkey_txt
Next subkey_num
GetKeyInfo = txt
End Function
|
|
|
|
|
|