EnumRegistryValuesEx – Get all values under a registry key, with related data and type

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 LongPrivate Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As _    LongPrivate Declare Function RegQueryValueEx Lib "advapi32.dll" Alias _    "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, _    ByVal lpReserved As Long, lpType As Long, lpData As Any, _    lpcbData As Long) As LongPrivate Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (dest As _    Any, source As Any, ByVal numBytes 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 LongPrivate 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 LongConst KEY_READ = &H20019  ' ((READ_CONTROL Or KEY_QUERY_VALUE Or                           ' KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) And (Not                           ' SYNCHRONIZE))Const REG_SZ = 1Const REG_EXPAND_SZ = 2Const REG_BINARY = 3Const REG_DWORD = 4Const REG_MULTI_SZ = 7Const ERROR_MORE_DATA = 234                          'Enumerate values under a given registry key.'Returns a collection, where each element of the collection is a 3-element array'of Variants: element(0) is the value name, element(1) is the value's value,'  element(2) is the type of data typeFunction EnumRegistryValuesEx(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 2) As Variant    Dim retVal As Long        ' initialize the result    Set EnumRegistryValuesEx = 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                valueInfo(2) = vbLong            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                valueInfo(2) = vbString            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()                valueInfo(2) = vbArray + vbByte            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                valueInfo(2) = vbString            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        EnumRegistryValuesEx.Add valueInfo, valueInfo(0)                index = index + 1    Loop       ' Close the key, if it was actually opened    If handle Then RegCloseKey handle        End Function

Share the Post:
Share on facebook
Share on twitter
Share on linkedin

Overview

Recent Articles: