使用RegOpenKeyEx在64位office / 64位Windows上通过注册表进行枚举

时间:2013-12-09 20:21:49

标签: vba winapi registry

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

主要目标是查看是否已安装MySQL ODBC驱动程序。我一直在使用RegOpenKeyEx通过注册表进行枚举。在64位Windows上使用32位Office没问题。 但是不能在64位Windows上运行64Bit Office。

下面的代码展示了我尝试的很多东西。在32位局上测试时,只有KEY_ALL_ACCESS行才有效。否则,其他所有行都不适用于32位或64位。

是的,在我的64位Office计算机上,项目(“MySQL ODBC 5.2 ANSI驱动程序”)位于以下注册表中:“HKEY_LOCAL_MACHINE \ SOFTWARE \ ODBC \ ODBCINST.INI”

有什么想法吗?

   #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

2 个答案:

答案 0 :(得分:2)

指针大小的整数在64位下都是错误的大小。您使用的是Long,这是一种32位数据类型,但您需要使用LongPtr,它与指针的大小相同。来自documentation

  

LongPtr(32位系统上的长整数,64位系统上的LongLong整数)变量存储为32位系统上带符号的32位(4字节)数字,范围从-2,147,483,648到2,147,483,647;并在64位系统上签署了64位(8字节)数字,范围从-9,223,372,036,854,775,808到9,223,372,036,854,775,807。

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

你真的不应该使用KEY_ALL_ACCESS。除非你正在升级,否则不会成功,并且不需要提升只读出HKLM。您需要使用按位或组合标记。你需要我们

KEY_READ Or KEY_WOW64_64KEY

KEY_READ Or KEY_WOW64_32KEY

答案 1 :(得分:0)

为了解决这个问题,我改变了John原始代码,使其适用于32位和64位Office系统的32位和64位系统。 由于代码示例格式设置存在问题,因为#&#39;#&#39;替换&#39;〜!&#39;通过&#39;#&#39;。

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