使用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