我为此寻找各种解决方案无济于事。我在另一个网站上发布了这个,但没有人想出答案。
主要目标是查看是否已安装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
答案 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