query all keys within a key

[icybeer]

Say I have the following Key

HKEY_CURRENT_USER/Software/test/key1
HKEY_CURRENT_USER/Software/test/key2

How do I get all the keys under HKEY_CURRENT_USER/Software/test?


Thank you

[vbud]

'* Assume you have keys and your form has a cmdLoad command button
'* HKEY_CURRENT_USER\Software\Test\New Key #1\New Value #1
'* HKEY_CURRENT_USER\Software\Test\New Key #2\New Value #1

'* So we first get the collection of sub keys i.e New Key #1 and New Key #2
'* then get their corresponding values...

Option Explicit

Private Const HKEY_CLASSES_ROOT = &H80000000
Private Const HKEY_CURRENT_USER = &H80000001
Private Const HKEY_LOCAL_MACHINE = &H80000002
Private Const HKEY_USERS = &H80000003

Private Const ERROR_SUCCESS = 0&

Const REG_SZ = 1
Const REG_BINARY = 3
Const REG_DWORD = 4

Private Type HKEY_CACHE
    hKey    As Long
    strHkey As String
End Type

Private hkeyCache() As HKEY_CACHE

Private Declare Function OSRegCloseKey Lib "advapi32" Alias "RegCloseKey" ( _
                         ByVal hKey As Long) As Long
                         
Private Declare Function OSRegOpenKey Lib "advapi32" Alias "RegOpenKeyA" ( _
                         ByVal hKey As Long, _
                         ByVal lpszSubKey As String, _
                         phkResult As Long) As Long
                         
Private Declare Function OSRegQueryValueEx Lib "advapi32" Alias "RegQueryValueExA" ( _
                         ByVal hKey As Long, _
                         ByVal lpszValueName As String, _
                         ByVal dwReserved As Long, _
                         lpdwType As Long, _
                         lpbData As Any, _
                         cbData As Long) As Long

Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" ( _
                         ByVal hKey As Long, _
                         ByVal lpSubKey As String, _
                         ByVal ulOptions As Long, _
                         ByVal samDesired As Long, _
                         phkResult As Long) As Long
    
Private Declare Function RegEnumKey Lib "advapi32.dll" Alias "RegEnumKeyA" ( _
                         ByVal hKey As Long, _
                         ByVal dwIndex As Long, _
                         ByVal lpName As String, _
                         ByVal cbName As Long) As Long

Const KEY_READ = &H20019

'* This function gives you a collection of subkeys from a given keyName
Function EnumRegistryKeys(ByVal hKey As Long, ByVal KeyName As String) As Collection
    
    '* Code for this Function picked up from www.vb2themax.com
    Dim handle As Long
    Dim length As Long
    Dim index As Long
    Dim subkeyName As String
    
    ' initialize the result collection
    Set EnumRegistryKeys = New Collection
    
    ' Open the key, exit if not found
    If Len(KeyName) Then
      If RegOpenKeyEx(hKey, KeyName, 0, KEY_READ, handle) Then Exit Function
      ' in all case the subsequent functions use hKey
      hKey = handle
    End If
    
    Do
      ' this is the max length for a key name
      length = 260
      subkeyName = Space$(length)
      ' get the N-th key, exit the loop if not found
      If RegEnumKey(hKey, index, subkeyName, length) Then Exit Do
      
      ' add to the result collection
      subkeyName = Left$(subkeyName, InStr(subkeyName, vbNullChar) - 1)
      EnumRegistryKeys.Add subkeyName, subkeyName
      ' prepare to query for next key
      index = index + 1
    Loop
   
    ' Close the key, if it was actually opened
    If handle Then RegCloseKey handle
        
End Function

'* open a registry key
Function RegOpenKey(ByVal hKey As Long, ByVal lpszSubKey As String, phkResult As Long) As Boolean

  Dim lResult As Long
  Dim strHkey As String

  On Error GoTo 0
  strHkey = strGetHKEYString(hKey)

  lResult = OSRegOpenKey(hKey, lpszSubKey, phkResult)
  If lResult = ERROR_SUCCESS Then
    RegOpenKey = True
  Else
    RegOpenKey = False
  End If

End Function

Private Function strGetHKEYString(ByVal hKey As Long) As String
    
  Dim strKey As String

  'Is the hkey predefined?
  strKey = strGetPredefinedHKEYString(hKey)
  If strKey <> "" Then
      strGetHKEYString = strKey
      Exit Function
  End If
    
End Function

Private Function strGetPredefinedHKEYString(ByVal hKey As Long) As String
    
  Select Case hKey
    Case HKEY_CLASSES_ROOT
      strGetPredefinedHKEYString = "HKEY_CLASSES_ROOT"
    Case HKEY_CURRENT_USER
      strGetPredefinedHKEYString = "HKEY_CURRENT_USER"
    Case HKEY_LOCAL_MACHINE
      strGetPredefinedHKEYString = "HKEY_LOCAL_MACHINE"
    Case HKEY_USERS
      strGetPredefinedHKEYString = "HKEY_USERS"
  End Select
    
End Function

Function RegQueryStringValue(ByVal hKey As Long, ByVal strValueName As String, strData As String) As Boolean
  
  Dim lResult As Long
  Dim lValueType As Long
  Dim strBuf As String
  Dim lDataBufSize As Long
  
  RegQueryStringValue = False
  On Error GoTo 0
  ' Get length/data type
  lResult = OSRegQueryValueEx(hKey, strValueName, 0&, lValueType, ByVal 0&, lDataBufSize)
  If lResult = ERROR_SUCCESS Then
    If lValueType = REG_SZ Then
      strBuf = String(lDataBufSize, " ")
      lResult = OSRegQueryValueEx(hKey, strValueName, 0&, 0&, ByVal strBuf, lDataBufSize)
      If lResult = ERROR_SUCCESS Then
          RegQueryStringValue = True
          strData = StripTerminator(strBuf)
      End If
    End If
  End If
  
End Function

Function StripTerminator(ByVal strString As String) As String
    
  Dim intZeroPos As Integer

  intZeroPos = InStr(strString, Chr$(0))
  If intZeroPos > 0 Then
    StripTerminator = Left$(strString, intZeroPos - 1)
  Else
    StripTerminator = strString
  End If
    
End Function

Function RegCloseKey(ByVal hKey As Long) As Boolean
  
  Dim lResult As Long
  
  On Error GoTo 0
  lResult = OSRegCloseKey(hKey)
  RegCloseKey = (lResult = ERROR_SUCCESS)
  
End Function

Private Function GetKeyValue(ByVal SubKey As String) As String
  
  Dim Key               As Long
  Dim strDisplayName    As String
  Dim lcStrRegPath      As String
  
  '* Give the key you want to retrieve here!!!
  Const strKEY_DISPLAYNAME$ = "New Value #1"
  
  lcStrRegPath = "Software\Test\" & SubKey
  
  If RegOpenKey(HKEY_CURRENT_USER, lcStrRegPath, Key) Then
      
    If RegQueryStringValue(Key, strKEY_DISPLAYNAME, strDisplayName) Then
      '* retrieve key value here from strDisplayName
      GetKeyValue = strDisplayName
      RegCloseKey Key
      Exit Function
    End If

    GetKeyValue = ""
    
    RegCloseKey Key
  
  End If
  
  GetKeyValue = ""
  
End Function

Private Sub cmdLoad_Click()

  Dim lcStrRegPath          As String
  Dim lcObjColl             As Collection
  Dim lcIntCount            As Integer
  Dim lcintI                As Integer
  Dim lcStrKeyValue         As String
  
  '* Give Subkey here
  lcStrRegPath = "Software\Test"
                                
  Set lcObjColl = EnumRegistryKeys(HKEY_CURRENT_USER, lcStrRegPath)
  
  lcIntCount = lcObjColl.Count
  
  For lcintI = 1 To lcIntCount
    '* Loop in collection of Registry values to get value of key
    lcStrKeyValue = GetKeyValue(lcObjColl.Item(lcintI))
    
    If Not Len(Trim$(lcStrKeyValue)) = 0 Then
      Debug.Print "Key values = " & lcStrKeyValue
    End If
  
  Next lcintI

End Sub

[Hack]

Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegEnumKey Lib "advapi32.dll" Alias "RegEnumKeyA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As String, ByVal cbName As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
 
Private Const HKEY_CURRENT_USER = &H80000001
 
Private Sub Command2_Click()
Dim sKey As String * 255
    Dim lRegKey As Long
    Dim iKey As Integer
 
    List1.Clear
 
    Call RegOpenKey(HKEY_CURRENT_USER, "Software\test", lRegKey)
 
    While RegEnumKey(lRegKey, iKey, sKey, 255) = 0
        List1.AddItem Left(sKey, InStr(sKey, Chr(0)) - 1)
        iKey = iKey + 1
    Wend
 
    Call RegCloseKey(lRegKey)
 
End Sub