Discovering Registry SubKey information 1

[SiJP]

I'm trying to find out what subkey's exist for "HKEY_CURRENT_USER\Software\Microsoft\Outlook Express"

The result (singular) that should be returned is "5.0" but I'm getting blanks (literally, Chr(0)'s). I'm using the following code:

Private Function GetKeyName(hInKey As Long, ByVal subkey As String, dwIndex As Long) As Variant

'
' Code courtesy of Terry Kreft, January 1998
'
'
  Dim hKey              As Long
  Dim lpName            As String
  Dim lpcbName          As Long
  Dim lpReserved        As Long
  Dim lpClass           As String
  Dim lpcbClass         As Long
  Dim lpftLastWriteTime As FILETIME
  Dim lngRet            As Long
  Dim hSubKey           As Long
  
  Const ERROR_SUCCESS As Long = 0
  Const REG_SZ As Long = 1
  
  hKey = RegOpenKeyEx(hInKey, subkey, 0, KEY_ALL_ACCESS, hSubKey)
  
  If hKey <> ERROR_SUCCESS Then
    Exit Function
  End If
  
  lpcbName = 256
  lpName = String(lpcbName, 0)
  lpReserved = 0
  lpClass = String(1, 0)
  lpcbClass = 0

  lngRet = RegEnumKeyEx(hSubKey, dwIndex, lpName, lpcbName, lpReserved, lpClass, lpcbClass, lpftLastWriteTime)
  GetKeyName = Left(lpName, lpcbName)
  
End Function

If I debug.print GetKeyName, I get lots of chr(0)'s and nothing else.

I'm not too au-fait with registry access through API's, so any help where I'm going wrong would be appreciated.

(NB, The function is called with GetKeyName(HKEY_CURRENT_USER, sKeyName, 0), all constants are publically declared.)

Many Thanks,
Si


------------------------
Hit any User to continue

 

[gmmastros]

I found this code a long time ago. I didn't write it, but it appears to work fine.

Option Explicit

Private Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, ByRef phkResult As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As Long
Private Declare Function RegEnumKeyEx Lib "advapi32.dll" Alias "RegEnumKeyExA" (ByVal hKey As Long, _
                        ByVal dwIndex As Long, ByVal lpName As String, ByRef lpcbName As Long, _
                        ByVal lpReserved As Long, ByVal lpClass As String, ByRef lpcbClass As Long, _
                        lpftLastWriteTime As FILE_TIME) As Long

Private Enum HKEYS
    HKEY_CLASSES_ROOT = &H80000000
    HKEY_CURRENT_USER = &H80000001
    HKEY_LOcal_machine = &H80000002
    HKEY_USERS = &H80000003
End Enum

Const lngHKEY_CLASSES_ROOT = &H80000000
Const lngHKEY_CURRENT_USER = &H80000001
Const lngHKEY_LOCAL_MACHINE = &H80000002
Const lngHKEY_USERS = &H80000003

Const lngERROR_SUCCESS = 0&
Const lngERROR_FAILURE = 13&
Const lngUNREADABLE_NODE = 234&
Const lngNO_MORE_NODES = 259&
Const lngERROR_MORE_DATA = 234&

Const lngREG_OPTION_NON_VOLATILE = 0
Const lngSYNCHRONIZE = &H100000
Const lngSTANDARD_RIGHTS_READ = &H20000
Const lngKEY_QUERY_VALUE = &H1
Const lngKEY_ENUMERATE_SUB_KEYS = &H8
Const lngKEY_NOTIFY = &H10
Const lngKEY_SET_VALUE = &H2
Const lngKEY_CREATE_SUB_KEY = &H4
Const lngKEY_CREATE_LINK = &H20
Const lngSTANDARD_RIGHTS_ALL = &H1F0000
Const lngKEY_READ = ((lngSTANDARD_RIGHTS_READ Or lngKEY_QUERY_VALUE Or lngKEY_ENUMERATE_SUB_KEYS Or _
                             lngKEY_NOTIFY) And (Not lngSYNCHRONIZE))
Const lngKEY_ALL_ACCESS = ((lngSTANDARD_RIGHTS_ALL Or lngKEY_QUERY_VALUE Or lngKEY_SET_VALUE Or _
                                   lngKEY_CREATE_SUB_KEY Or lngKEY_ENUMERATE_SUB_KEYS Or lngKEY_NOTIFY Or _
                                   lngKEY_CREATE_LINK) And (Not lngSYNCHRONIZE))
Const lngREG_SZ = 1
Const lngREG_BINARY = 3
Const lngREG_DWORD = 4

' Declare Windows API types...
Private Type FILE_TIME
  dwLowDateTime As Long
  dwHighDateTime As Long
End Type


Private Function EnumKeys(ByVal RootKey As HKEYS, ByVal sKey As String) As Variant
    
    Dim hKeyHandle As Long
    Dim X As Variant
    Call RegOpenKeyEx(RootKey, sKey, 0&, lngKEY_ALL_ACCESS, hKeyHandle)
    Call EnumerateRegistryKeys(hKeyHandle, X)
    Call RegCloseKey(hKeyHandle)
    EnumKeys = X

End Function

Private Function EnumerateRegistryKeys(ByVal vhKeyHandle As Long, ByRef rvntKeys As Variant) As String
    Dim strValue As String, strClass As String, strMessage As String, strError As String
    Dim hKeyHandle As Long, lngDataLen As Long, lngValueLen As Long, lngReturn As Long, lngIndex As Long
    Dim lngClass As Long
    Dim strNodes() As String
    Dim typFileTime As FILE_TIME
    
    lngIndex = 0
    
    ' then loop through the nodes under the 'base node'...
    Do
      lngValueLen = 2000
      strValue = String(lngValueLen, 0)
      lngDataLen = 2000
    
      ' and read the names of all the nodes under it...
      lngReturn = RegEnumKeyEx(vhKeyHandle, lngIndex, strValue, lngValueLen, 0&, strClass, lngClass, typFileTime)
      strValue = VBA.Left(strValue, lngValueLen)
      ' checking for problems.
      If lngReturn <> lngERROR_SUCCESS And lngReturn <> lngNO_MORE_NODES Then
      End If
      
      ' Add each node into an array...
      ReDim Preserve strNodes(lngIndex)
      strNodes(lngIndex) = strValue
      lngIndex = lngIndex + 1
      
      ' and loop until the enumeration return fails.
    Loop While lngReturn <> lngNO_MORE_NODES
    rvntKeys = strNodes()
    Erase strNodes

End Function

Private Sub Command1_Click()
    
    Dim Keys() As String
    Dim i As Long
    
    Keys = EnumKeys(HKEY_CURRENT_USER, "Software\Microsoft\Outlook Express")
    For i = LBound(Keys) To UBound(Keys)
        MsgBox Keys(i)
    Next
    
End Sub

-George

Strong and bitter words indicate a weak cause. - Fortune cookie wisdom

 

[SiJP]

George, yes the code you posted works first time.

I think the code I had may not work due to a combination having the string buffer size set too small, and not correctly looping through array's... but all's well than ends well.

Thanks for your response,

Si

------------------------
Hit any User to continue

 

[gmmastros]

glad to help.

-George

Strong and bitter words indicate a weak cause. - Fortune cookie wisdom