urgent: registry question

[mvrp350]

I know I posted this question yesterday also, but there was no answer, and only a few people had taken a look at it, so I give it a new shot:

I want to check the registry for subkeys, so I can display them in a listbox.
i.e. in the registry the 'mainkey' is like:
\software\myapp,
and it has a number of profiles that are stored as a subkey like:
\software\myapp\profile1,
\software\myapp\profile2 etc.

So I want the names profile1 and profile2 to be stored in a list.
Is there a way to do this?

Can somebody please help me?
Thanks in advance

[Nucleus]

Do you want to:

1. Enumerate the child keys beneath a single key only 1 level down?

2. Enumerate all keys beneath a given key i.e. the full registry tree structure beneath a given key.

3. Enumerate all the data in a given key?

[mvrp350]

I want to enumerate the child keys only 1 level down.

[Nucleus]

Here you go, Enjoy!

In a module:

Option Explicit

Public Enum RegBaseKey
HKEY_CLASSES_ROOT = &H80000000
HKEY_CURRENT_USER = &H80000001
HKEY_LOCAL_MACHINE = &H80000002
HKEY_USERS = &H80000003
HKEY_CURRENT_CONFIG = &H80000005
HKEY_DYN_DATA = &H80000006
End Enum

Private Const REG_SZ = 1 'Unicode nul terminated string
Private Const REG_BINARY = 3 'Free form binary
Private Const REG_DWORD = 4 '32-bit number
Private Const ERROR_SUCCESS = 0& 'unusually registry API functions return 0 on success

Private Const SYNCHRONIZE = &H100000
Private Const READ_CONTROL = &H20000
Private Const STANDARD_RIGHTS_READ = (READ_CONTROL)
Private Const STANDARD_RIGHTS_WRITE = (READ_CONTROL)
Private Const STANDARD_RIGHTS_ALL = &H1F0000
Private Const KEY_QUERY_VALUE = &H1
Private Const KEY_ENUMERATE_SUB_KEYS = &H8
Private Const KEY_NOTIFY = &H10
Private Const KEY_SET_VALUE = &H2
Private Const KEY_CREATE_SUB_KEY = &H4
'Now to define what we really need to use for ulOptions argument of RegOpenKeyEx
Private Const KEY_READ = ((READ_CONTROL Or KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) And (Not SYNCHRONIZE))
Private Const KEY_WRITE = ((STANDARD_RIGHTS_WRITE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY) And (Not SYNCHRONIZE))

Public Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey 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 RegEnumKeyEx Lib "advapi32.dll" Alias "RegEnumKeyExA" _
(ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As String, _
lpcbName As Long, ByVal lpReserved As Long, ByVal lpClass As String, _
lpcbClass As Long, lpftLastWriteTime As Any) As Long

Private regkeys() As String 'used by RegEnumKeys Function
Private Cnt As Long 'used by RegEnumKeys Function


Public Function RegEnumKeys(ByVal hKey As RegBaseKey, ByVal sKeyPath As String, _
Optional IncludeSubKeys As Boolean = False, _
Optional ErrorCode As Variant = Null) As Variant

'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>'
'By Nucleus '
'Enumerates through all keys beneath a given key '
'Returns Array with paths of keys or error code '
'<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<'

ReDim regkeys(1 To 100)
Cnt = 0

Call EnumKeys(hKey, sKeyPath, IncludeSubKeys)

If Cnt = 0 Then
RegEnumKeys = ErrorCode
Else
ReDim Preserve regkeys(1 To Cnt)
RegEnumKeys = regkeys
End If

Erase regkeys 'erase array and reclaim memory before called again
End Function

Private Sub EnumKeys(ByVal hKey As Long, ByVal sKeyPath As String, SubKeys As Boolean)
Dim sSave$, sKeyName$
Dim hCurKey&, lRes&, lCount&

' Open key, exit if not found. Even if skeyPath = "" hcurkey returns hkey (cool huh!)
Call RegOpenKeyEx(hKey, sKeyPath, 0, KEY_READ, hCurKey) 'open handle to a reg key
Do
sSave = String(255, 0) 'Create a buffer

If RegEnumKeyEx(hCurKey, lCount, sSave, 255, 0, vbNullString, _
ByVal 0&, ByVal 0&) Then Exit Do

lCount = lCount + 1
sKeyName = StripVBNullChar(sSave)

Cnt = Cnt + 1
If Cnt Mod 100 = 0 Then ReDim Preserve regkeys(1 To (Cnt + 100))
regkeys(Cnt) = sKeyPath & "\" & sKeyName

Loop

Call RegCloseKey(hCurKey) 'Close the registry key
End Sub


Private Function StripVBNullChar(sInput As String) As String
Dim pos&
StripVBNullChar = sInput
pos = InStr(1, sInput, vbNullChar)
If pos > 0 Then StripVBNullChar = Left$(sInput, pos - 1)
End Function



In a form add a listbox and a command button:
Private Sub Command1_Click()
'example of enumerating through keys
Dim Keys As Variant
Keys = RegEnumKeys(HKEY_LOCAL_MACHINE, "HARDWARE\DESCRIPTION\SYSTEM", True)
Dim i&

If Not IsNull(Keys) Then
For i = 1 To UBound(Keys)
List1.AddItem Keys(i)
Next i
Else
MsgBox "No keys found"
End If
End Sub

[mvrp350]

Thanx Nucleus.

[Nucleus]

No problem.