如何在vba中枚举注册表键的键值名称、数据类型、数据？

我们之前介绍了如何在vba中用RegEnumValue遍历枚举注册表的键值名称？

该文指出用RegEnumValue函数枚举注册表的键值名称时，也能同时获得键值的数据类型和键值的数据。

但是获得的键值数据是二进制形式的。由于键值的数据类型有多种，对于REG_SZ、REG_EXPAND_SZ、REG_MULTI_SZ等类型的数据，获取的二进制形式的数据还需要用复杂的api函数去转换为在注册表中显示的结果。

为了简化过程，可以结合如何在vba中用WScript.WshShell读取注册表的键值数据？一文中介绍的读取键值数据的方法，来实现枚举任意注册表键的键值名称、数据类型和具体的数据内容。

比如要枚举注册表键HKEY_CURRENT_USER\Software\Microsoft\Office\15.0\Excel\Options的键值名称、数据类型和具体的数据内容，可以使用如下的代码：

Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, _
ByVal lpSubKey As String, phkResult As Long) As Long
Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Declare Function RegEnumValue Lib "advapi32.dll" Alias "RegEnumValueA" (ByVal hKey As Long, _
ByVal dwIndex As Long, ByVal lpValueName As String, lpcchValueName As Long, ByVal lpReserved As Long, _
lpType As Long, ByVal lpData As Long, lpcbData As Long) As Long
Public Enum ERegistryClassConstants
    HKEY_CLASSES_ROOT = &H80000000
    HKEY_CURRENT_USER = &H80000001
    HKEY_LOCAL_MACHINE = &H80000002
    HKEY_USERS = &H80000003
End Enum
Public Enum RegistryValueTypes
'Predefined Value Types
    REG_NONE = (0)                         'No value type
    REG_SZ = (1)                           'Unicode nul terminated string
    REG_EXPAND_SZ = (2)                    'Unicode nul terminated string w/enviornment var
    REG_BINARY = (3)                       'Free form binary
    REG_DWORD = (4)                        '32-bit number
    REG_DWORD_LITTLE_ENDIAN = (4)          '32-bit number (same as REG_DWORD)
    REG_DWORD_BIG_ENDIAN = (5)             '32-bit number
    REG_LINK = (6)                         'Symbolic Link (unicode)
    REG_MULTI_SZ = (7)                     'Multiple Unicode strings
    REG_RESOURCE_LIST = (8)                'Resource list in the resource map
    REG_FULL_RESOURCE_DESCRIPTOR = (9)     'Resource list in the hardware description
    REG_RESOURCE_REQUIREMENTS_LIST = (10)
    REG_QWORD = (11)                       '64-bit number
    REG_QWORD_LITTLE_ENDIAN = (11)         '64-bit number (same as REG_QWORD)
End Enum
Sub QQ1722187970()
    On Error Resume Next
    Dim sRootKey As String
    sRootKey = "HKEY_CURRENT_USER"
    '定义变量lhKey表示打开的注册表父键的句柄
    Dim lhKey As Long
    '定义变量i表示键值的索引
    Dim i As Long
    '定义变量lType表示键值的数据类型
    Dim lType As Long
    '定义字节数组存储键值的数据字节
    Dim bData() As Byte
    '定义变量lenbData表示键值的数据的字节数
    Dim lenbData As Long
    ReDim bData(1024) As Byte
    lenbData = 1024
    Dim subKey As String
    '定义变量sValueName表示键值的名称
    Dim sValueName As String
    '定义变量lenValueName表示键值的名称的字符长度
    Dim lenValueName As Long
    i = 0
    '先预置缓冲区
    sValueName = Space(1024)
    '先预置缓冲区的长度
    lenValueName = 1024
    subKey = "Software\Microsoft\Office\15.0\Excel\Options"
    RegOpenKey HKEY_CURRENT_USER, subKey, lhKey
    '第一次运行RegEnumValue，将dwIndex设置为0，然后逐次递增
    n = RegEnumValue(lhKey, i, sValueName, lenValueName, 0, lType, VarPtr(bData(0)), lenbData)
    '当n非0时，表示遍历结束
    Do Until n <> 0
        '提取实际的键值的名称
        sName = Left(sValueName, lenValueName)
        sType = GetKeyValueType(lType)
        vData = GetKeyValueData(sRootKey & "\" & subKey & "\" & sName)
        '如果返回的是二进制数据，则vData是数组，输出会报错，所以在开头加了 On Error Resume Next
        Debug.Print sName, sType, vData
        ''重置缓冲区的大小（这里是最关键的，每次枚举完一个键值，都需要重置缓冲区，否则会枚举不成功）
        sValueName = Space(1024)
        lenValueName = 1024
        lenbData = 1024
        i = i + 1
        n = RegEnumValue(lhKey, i, sValueName, lenValueName, 0, lType, VarPtr(bData(0)), lenbData)
    Loop
    RegCloseKey lhKey
End Sub
Function GetKeyValueType(ByVal iType As Integer) As String
    Select Case iType
        Case 0
        Case 1
            GetKeyValueType = "REG_SZ"
        Case 2
        GetKeyValueType = "REG_EXPAND_SZ"
        Case 3
        GetKeyValueType = "REG_BINARY"
        Case 4
        GetKeyValueType = "REG_DWORD"
        Case 5
        Case 6
        Case 7
        GetKeyValueType = "REG_MULTI_SZ"
        Case 8
        Case 9
        Case 10
    End Select
End Function
Function GetKeyValueData(ByVal sKeyValue As String)
    Dim oWShell
    Set oWShell = CreateObject("WScript.Shell")
    With oWShell
        GetKeyValueData = .RegRead(sKeyValue)
    End With
End Function

以上代码的关键点在于每调用一次RegEnumValue函数，都需要重置它的参数的缓冲区的大小，否则会出现枚举不成功。