EnumRegValue

'EnumRegistryValues - Retrieve all values under a Registry

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 RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As _
Long
Private Declare Function RegEnumValue Lib "advapi32.dll" Alias "RegEnumValueA" _
(ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpValueName As String, _
lpcbValueName As Long, ByVal lpReserved As Long, lpType As Long, _
lpData As Any, lpcbData As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (dest As _
Any, source As Any, ByVal numBytes As Long)
Const REG_SZ = 1
Const REG_EXPAND_SZ = 2
Const REG_BINARY = 3
Const REG_DWORD = 4
Const REG_MULTI_SZ = 7
Const ERROR_MORE_DATA = 234
Const KEY_READ = &H20019 ' ((READ_CONTROL Or KEY_QUERY_VALUE Or
' KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) And (Not

' SYNCHRONIZE))

' Enumerate values under a given registry key

'

' returns a collection, where each element of the collection

' is a 2-element array of Variants:

' element(0) is the value name, element(1) is the value's value

Function EnumRegistryValues(ByVal hKey As Long, ByVal KeyName As String) As _
Collection
Dim handle As Long
Dim index As Long
Dim valueType As Long
Dim name As String
Dim nameLen As Long
Dim resLong As Long
Dim resString As String
Dim dataLen As Long
Dim valueInfo(0 To 1) As Variant
Dim retVal As Long

' initialize the result

Set EnumRegistryValues = 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 cases, subsequent functions use hKey

hKey = handle
End If

Do
' this is the max length for a key name

nameLen = 260
name = Space$(nameLen)
' prepare the receiving buffer for the value

dataLen = 4096
ReDim resBinary(0 To dataLen - 1) As Byte

' read the value's name and data

' exit the loop if not found

retVal = RegEnumValue(hKey, index, name, nameLen, ByVal 0&, valueType, _
resBinary(0), dataLen)

' enlarge the buffer if you need more space

If retVal = ERROR_MORE_DATA Then
ReDim resBinary(0 To dataLen - 1) As Byte
retVal = RegEnumValue(hKey, index, name, nameLen, ByVal 0&, _
valueType, resBinary(0), dataLen)
End If
' exit the loop if any other error (typically, no more values)

If retVal Then Exit Do

' retrieve the value's name

valueInfo(0) = Left$(name, nameLen)

' return a value corresponding to the value type

Select Case valueType
Case REG_DWORD
CopyMemory resLong, resBinary(0), 4
valueInfo(1) = resLong
Case REG_SZ, REG_EXPAND_SZ
' copy everything but the trailing null char

resString = Space$(dataLen - 1)
CopyMemory ByVal resString, resBinary(0), dataLen - 1
valueInfo(1) = resString
Case REG_BINARY
' shrink the buffer if necessary

If dataLen < UBound(resBinary) + 1 Then
ReDim Preserve resBinary(0 To dataLen - 1) As Byte
End If
valueInfo(1) = resBinary()
Case REG_MULTI_SZ
' copy everything but the 2 trailing null chars

resString = Space$(dataLen - 2)
CopyMemory ByVal resString, resBinary(0), dataLen - 2
valueInfo(1) = resString
Case Else
' Unsupported value type - do nothing

End Select

' add the array to the result collection

' the element's key is the value's name

EnumRegistryValues.Add valueInfo, valueInfo(0)

index = index + 1
Loop

' Close the key, if it was actually opened

If handle Then RegCloseKey handle

End Function