使用RegOpenKeyEx枚举通过注册表在64位办公室/ 64位窗口

Question

我已经看过各种解决方案，这无济于事。我在另一个网站上发布了这个消息，但是没有人提出这个答案。

主要目标是查看是否安装了MSQL ODBC驱动程序。我一直在使用RegOpenKeyEx枚举整个注册表。在64位窗口上使用32位Office没有问题。 但不能在64位Windows 64Bit Office上工作。

下面的代码显示了我尝试的许多事情。在32位办公室测试时，只有KEY_ALL_ACCESS的行才起作用。否则，其他线路都不能用于32位或64位。

是的，我的64位办公室的机器上，该项目（ “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 

Answer 1

你的指针大小的整数是在64位的所有错误的大小。您已经使用了Long这是一个32位数据类型，但您需要使用LongPtr，它与指针的大小相同。从documentation：

LongPtr变量存储为带符号的32位（4字节）数为在值从-2147483648〜2147483647（在32位系统长整数，在64位系统LONGLONG整数）在32位系统上;并在64位系统上签署了价值从-9,223,372,036,854,775,808到9,223,372,036,854,775,807的64位（8字节）数字。

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

你真的不应该使用KEY_ALL_ACCESS。除非你运行提升，否则这将不会成功，并且不需要升级以便读出HKLM。您需要使用按位或组合标志。您需要我们

KEY_READ Or KEY_WOW64_64KEY 

或

KEY_READ Or KEY_WOW64_32KEY 

Answer 2

为了结束这件事我已经改变了原来的约翰代码，以便它可以在关于32位和64位Office系统32位和64位系统。 由于代码示例格式化与'＃'有关的问题替换'〜！' '＃'。

常量HKEY_LOCAL_MACHINE = & H80000002 常量PROCESSOR_ARCHITECTURE_AMD64 = 9

〜！如果VBA7然后

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 

〜！否则

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 

〜！结束如果

类型FILETIME dwLowDateTime只要 dwHighDateTime只要 结束类型

功能CheckForMySQlDriverInstallTest（）为布尔

'*********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 

端功能

〜！如果VBA7然后 功能EnumKey （ByVal hKey As LongPtr，ByVal index As Long，ByRef key As String）As Long 〜！Else 功能EnumKey（BYVAL的hKey长，BYVAL指数长，为ByRef键作为字符串），只要 〜！结束如果

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 

端功能

功能IsOffice64Bit（）为布尔

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