vba 在 64 位办公室/64 位 Windows 上使用 RegOpenKeyEx 枚举注册表

Using RegOpenKeyEx to enumerate through registry on 64bit office/64 bit Windows

提问by John Skolits

I've looked at various solutions for this to no avail. I posted this on another site, but no-one came up with the answer.

我已经为此查看了各种解决方案，但无济于事。我在另一个网站上发布了这个，但没有人想出答案。

The main objective is to see if MySQL ODBC driver has been installed. I've been doing this by enumerating through the registry using RegOpenKeyEx. No problem using 32 bit Office on 64 Bit Windows. But won't work on 64Bit Office on 64bit Windows.

主要目的是查看是否安装了 MySQL ODBC 驱动程序。我一直在通过使用 RegOpenKeyEx 枚举注册表来做到这一点。在 64 位 Windows 上使用 32 位 Office 没问题。但不适用于 64 位 Windows 上的 64 位 Office。

The code below shows the many things I tried. When testing on 32 bit office, only the line with KEY_ALL_ACCESS works. Otherwise, none of the other lines work for either 32 or 64 bit.

下面的代码显示了我尝试过的许多事情。在 32 位 office 上测试时，只有带有 KEY_ALL_ACCESS 的行有效。否则，其他行都不适用于 32 位或 64 位。

And yes, on my 64Bit Office machine, the item ("MySQL ODBC 5.2 ANSI Driver") is in the registry located at: "HKEY_LOCAL_MACHINE\SOFTWARE\ODBC\ODBCINST.INI"

是的，在我的 64 位 Office 计算机上，该项目（“MySQL ODBC 5.2 ANSI 驱动程序”）位于注册表中：“HKEY_LOCAL_MACHINE\SOFTWARE\ODBC\ODBCINST.INI”

Any ideas?

有任何想法吗？

   #If VBA7 Then

        Declare PtrSafe Function RegEnumKey Lib "advapi32.dll" Alias "RegEnumKeyA" ( _
          ByVal hkey As Long, ByVal dwIndex As Long, ByVal lpName As String, _
          ByVal cbName As Long) As Long

        Declare PtrSafe Function RegEnumKeyEx Lib "advapi32.dll" Alias "RegEnumKeyExA" ( _
          ByVal hkey As Long, ByVal dwIndex As Long, ByVal lpName As String, _
          lpcbName As Long, lpReserved As Long, ByVal lpClass As String, _
          lpcbClass As Long, lpftLastWriteTime As FILETIME) As Long

        Declare PtrSafe Function RegEnumValue Lib "advapi32.dll" Alias "RegEnumValueA" ( _
          ByVal hkey As Long, ByVal dwIndex As Long, ByVal lpValueName As String, _
          lpcbValueName As Long, lpReserved As Long, lpType As Long, _
          lpData As Byte, lpcbData As Long) As Long

#else

    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 Long

    Declare Function RegEnumKeyEx Lib "advapi32.dll" Alias "RegEnumKeyExA" ( _
           ByVal hkey As Long, ByVal dwIndex As Long, ByVal lpName As String, _
           lpcbName As Long, lpReserved As Long, ByVal lpClass As String, _
           lpcbClass As Long, lpftLastWriteTime As FILETIME) As Long

    Declare Function RegEnumValue Lib "advapi32.dll" Alias "RegEnumValueA" ( _
           ByVal hkey As Long, ByVal dwIndex As Long, ByVal lpValueName As String, _
           lpcbValueName As Long, lpReserved As Long, lpType As Long, _
           lpData As Byte, lpcbData As Long) As Long 

#End If


Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type    

Function CheckForMySQlDriverInstallTest() As Boolean

'*********BEGIN CODE HERE ********
Dim strKeyPath As String, key As String
Dim i As Long, lrc As Long
Dim hkey As Long, lRetval As Long

'Various key constants
Const KEY_ALL_ACCESS = &H3F
Const KEY_WOW64_64KEY As Long = &H100& '32 bit app to access 64 bit hive
Const KEY_WOW64_32KEY As Long = &H200& '64 bit app to access 32 bit hive
Const KEY_QUERY_VALUE = &H1


strKeyPath = "SOFTWARE\ODBC\ODBCINST.INI"

hkey = 0

'The line below works for 32bit office with the
' value of strKeyPath = "SOFTWARE\Wow6432Node\ODBC\ODBCINST.INI"

 lRetval = RegOpenKeyEx(HKEY_LOCAL_MACHINE, strKeyPath, 0, KEY_ALL_ACCESS, hkey)

'None of these work for 32 or 64 Office regardless of the strKeyPath used
'lRetval = RegOpenKeyEx(HKEY_LOCAL_MACHINE, strKeyPath, 0, KEY_WOW64_64KEY, hkey)
'lRetval = RegOpenKeyEx(HKEY_LOCAL_MACHINE, strKeyPath, 0, KEY_WOW64_32KEY, hkey)
'lRetval = RegOpenKeyEx(HKEY_LOCAL_MACHINE, strKeyPath, 0, KEY_QUERY_VALUE, hkey)

If (lRetval = 0) Then
    lrc = 0
    i = 0
    'Request all keys
    While lrc = 0
        lrc = EnumKey(hkey, i, key)
        Debug.Print key

        'If the version is found, set function to TRUE and exit
        If InStr(1, key, "MySQL ODBC 5.2 ANSI Driver") > 0 Then
            Exit Function
        End If

        If (lrc = 0) Then
            i = i + 1
        End If
    Wend
End If

If (hkey <> 0) Then
    RegCloseKey hkey
End If

End Function

Public Function EnumKey(ByVal hkey As Long, ByVal index As Long, ByRef key As String) As Long
Dim cch As Long
Dim lrc As Long
Dim ltype As Long
Dim lValue As Long
Dim szKeyName As String

cch = 260
szKeyName = String$(cch, 0)
lrc = RegEnumKey(hkey, index, szKeyName, cch)

If (lrc = 0) Then
    key = Left$(szKeyName, InStr(szKeyName, Chr$(0)) - 1)
End If

EnumKey = lrc
End Function

回答by David Heffernan

Your pointer sized integers are all the wrong size under 64 bit. You have used Long, which is a 32 bit data type, but you need to use LongPtr, which is the same size as a pointer. From the documentation:

您的指针大小的整数在 64 位以下都是错误的大小。您已经使用了Long，它是一种 32 位数据类型，但您需要使用LongPtr，它与指针的大小相同。从文档：

LongPtr (Long integer on 32-bit systems, LongLong integer on 64-bit systems) variables are stored as signed 32-bit (4-byte) numbers ranging in value from -2,147,483,648 to 2,147,483,647 on 32-bit systems; and signed 64-bit (8-byte) numbers ranging in value from -9,223,372,036,854,775,808 to 9,223,372,036,854,775,807 on 64-bit systems.

LongPtr（32 位系统上的长整数，64 位系统上的 LongLong 整数）变量存储为有符号的 32 位（4 字节）数字，32 位系统上的值范围从 -2,147,483,648 到 2,147,483,647；和有符号的 64 位（8 字节）数字，在 64 位系统上，其值范围从 -9,223,372,036,854,775,808 到 9,223,372,036,854,775,807。

So, all the HKEYparameters, and all the pointers, need to be declared as LongPtr.

因此，所有HKEY参数和所有指针都需要声明为LongPtr.

You really should not be using KEY_ALL_ACCESS. That won't succeed unless you are running elevated, and there's not need to elevate just to read out of HKLM. You need to combine the flags using bitwise or. You need to us

你真的不应该使用KEY_ALL_ACCESS. 除非您运行提升，否则这不会成功，并且不需要提升只是为了读取HKLM. 您需要使用按位或组合标志。你需要我们

KEY_READ Or KEY_WOW64_64KEY

or

或者

KEY_READ Or KEY_WOW64_32KEY

回答by Mill

To wrap this up I've altered John original code so that it works on both 32bit and 64bit systems regarding 32bit and 64bit Office systems. Since code sample formatting has issues with '#' replace '~!' by '#'.

总结一下，我已经修改了 John 的原始代码，以便它可以在 32 位和 64 位系统上使用 32 位和 64 位 Office 系统。由于代码示例格式存在问题，请用“#”替换“~!” 经过 '＃'。

Const HKEY_LOCAL_MACHINE = &H80000002
Const PROCESSOR_ARCHITECTURE_AMD64 = 9

~!If VBA7 Then

    Declare PtrSafe Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" _
          (ByVal hKey As LongPtr, ByVal lpSubKey As String, ByVal ulOptions As Long, _
          ByVal samDesired As Long, phkResult As LongPtr) As Long

    Declare PtrSafe Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As LongPtr) As Long

    Declare PtrSafe Function RegEnumKey Lib "advapi32.dll" Alias "RegEnumKeyA" ( _
          ByVal hKey As LongPtr, ByVal dwIndex As Long, ByVal lpName As String, _
          ByVal cbName As Long) As Long

    Declare PtrSafe Function RegEnumKeyEx Lib "advapi32.dll" Alias "RegEnumKeyExA" ( _
          ByVal hKey As LongPtr, ByVal dwIndex As Long, ByVal lpName As String, _
          lpcbName As Long, lpReserved As Long, ByVal lpClass As String, _
          lpcbClass As Long, lpftLastWriteTime As FILETIME) As Long

    Declare PtrSafe Function RegEnumValue Lib "advapi32.dll" Alias "RegEnumValueA" ( _
          ByVal hKey As LongPtr, ByVal dwIndex As Long, ByVal lpValueName As String, _
          lpcbValueName As Long, lpReserved As Long, lpType As Long, _
          lpData As Byte, lpcbData As Long) As Long

    Type SYSTEM_INFO
        wProcessorArchitecture As Integer
        wReserved As Integer
        dwPageSize As Long
        lpMinimumApplicationAddress As LongPtr
        lpMaximumApplicationAddress As LongPtr
        dwActiveProcessorMask As LongPtr
        dwNumberOrfProcessors As Long
        dwProcessorType As Long
        dwAllocationGranularity As Long
        wProcessorLevel As Integer
        wProcessorRevision As Integer
    End Type

    Declare PtrSafe Sub GetSystemInfo Lib "kernel32" (lpSystemInfo As SYSTEM_INFO)
    Declare PtrSafe Function GetCurrentProcess Lib "kernel32" () As LongPtr
    Declare PtrSafe Function IsWow64Process Lib "kernel32" ( _
           ByVal hProcess As LongPtr, _
           ByRef Wow64Process As Boolean) As Boolean

~!Else

    Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" _
           (ByVal lKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, _
           ByVal samDesired As Long, phkResult As Long) As Long

    Declare Function RegCloseKey Lib "advapi32" (ByVal lKey As Long) As Long

    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 Long

    Declare Function RegEnumKeyEx Lib "advapi32.dll" Alias "RegEnumKeyExA" ( _
           ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As String, _
           lpcbName As Long, lpReserved As Long, ByVal lpClass As String, _
           lpcbClass As Long, lpftLastWriteTime As FILETIME) As Long

    Declare Function RegEnumValue Lib "advapi32.dll" Alias "RegEnumValueA" ( _
           ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpValueName As String, _
           lpcbValueName As Long, lpReserved As Long, lpType As Long, _
           lpData As Byte, lpcbData As Long) As Long

    Type SYSTEM_INFO
        wProcessorArchitecture As Integer
        wReserved As Integer
        dwPageSize As Long
        lpMinimumApplicationAddress As Long
        lpMaximumApplicationAddress As Long
        dwActiveProcessorMask As Long
        dwNumberOrfProcessors As Long
        dwProcessorType As Long
        dwAllocationGranularity As Long
        dwReserved As Long
    End Type

    Declare Sub GetSystemInfo Lib "kernel32" (lpSystemInfo As SYSTEM_INFO)
    Declare Function GetCurrentProcess Lib "kernel32" () As Long
    Declare Function IsWow64Process Lib "kernel32" ( _
           ByVal hProcess As Long, _
           ByRef Wow64Process As Boolean) As Boolean

~!End If

Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type

Function CheckForMySQlDriverInstallTest() As Boolean

    '*********BEGIN CODE HERE ********
    Dim sKeyPath As String
    Dim sKey As String
    Dim i As Long
    Dim lrc As Long
    Dim lRetval As Long

    ~!If VBA7 Then
        Dim hKey As LongPtr
    ~!Else
        Dim hKey As Long
    ~!End If

    'Various sKey constants
    Const KEY_ALL_ACCESS = &H3F
    Const KEY_WOW64_64KEY As Long = &H100& '32 bit app to access 64 bit hive
    Const KEY_WOW64_32KEY As Long = &H200& '64 bit app to access 32 bit hive
    Const KEY_QUERY_VALUE = &H1

    ~!If Win64 Then
        '32 or 64 Office?
        If IsOffice64Bit Then
            sKeyPath = "SOFTWARE\ODBC\ODBCINST.INI"
        Else
            sKeyPath = "SOFTWARE\Wow6432Node\ODBC\ODBCINST.INI"
        End If
    ~!Else
        sKeyPath = "SOFTWARE\ODBC\ODBCINST.INI"
    ~!End If

    lRetval = RegOpenKeyEx(HKEY_LOCAL_MACHINE, sKeyPath, 0, KEY_ALL_ACCESS, hKey)

    'None of these work for 32 or 64 Office regardless of the sKeyPath used
    'lRetval = RegOpenKeyEx(HKEY_LOCAL_MACHINE, sKeyPath, 0, KEY_WOW64_64KEY, hkey)
    'lRetval = RegOpenKeyEx(HKEY_LOCAL_MACHINE, sKeyPath, 0, KEY_WOW64_32KEY, hkey)
    'lRetval = RegOpenKeyEx(HKEY_LOCAL_MACHINE, sKeyPath, 0, KEY_QUERY_VALUE, hkey)

    If (lRetval = 0) Then
        lrc = 0
        i = 0
        'Request all keys
        While lrc = 0
            lrc = EnumKey(hKey, i, sKey)
            Debug.Print sKey

            'If the version is found, set function to TRUE and exit
            If InStr(1, sKey, "MySQL ODBC 5.2 ANSI Driver") > 0 Then
                Exit Function
            End If

            If (lrc = 0) Then
                i = i + 1
            End If
        Wend
    End If

    If (hKey <> 0) Then
        RegCloseKey hKey
    End If

End Function

~!If VBA7 Then
Function EnumKey(ByVal hKey As LongPtr, ByVal index As Long, ByRef key As String) As Long
~!Else
Function EnumKey(ByVal hKey As Long, ByVal index As Long, ByRef key As String) As Long
~!End If

    Dim lcch As Long
    Dim lrc As Long
    Dim ltype As Long
    Dim lValue As Long
    Dim szKeyName As String

    lcch = 260
    szKeyName = String$(lcch, 0)
    lrc = RegEnumKey(hKey, index, szKeyName, lcch)

    If (lrc = 0) Then
        key = Left$(szKeyName, InStr(szKeyName, Chr$(0)) - 1)
    End If

    EnumKey = lrc

End Function

Function IsOffice64Bit() As Boolean

    Dim lpSystemInfo As SYSTEM_INFO

    Call GetSystemInfo(lpSystemInfo)
    If lpSystemInfo.wProcessorArchitecture = PROCESSOR_ARCHITECTURE_AMD64 Then
        Call IsWow64Process(GetCurrentProcess(), IsOffice64Bit)
        IsOffice64Bit = Not IsOffice64Bit
    End If

End Function