나는에서 가져온 것이 오래된 코드가 여기에 내가 MS 액세스의 32 개 비트 및 64 비트 버전의 코드가 작동을 만들기 위해 노력하고 레지스트리에서 값을 읽습니다.
'********Code Start**************
'This code was originally written by Terry Kreft
' and Dev Ashish.
'It is not to be altered or distributed,
'except as part of an application.
'You are free to use it in any application,
'provided the copyright notice is left unchanged.
'
'Code Courtesy of
'Dev Ashish & Terry Kreft
'
Public Const HKEY_CLASSES_ROOT = &H80000000
Public Const HKEY_CURRENT_USER = &H80000001
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const HKEY_USERS = &H80000003
Public Const HKEY_PERFORMANCE_DATA = &H80000004
Public Const HKEY_CURRENT_CONFIG = &H80000005
Public Const HKEY_DYN_DATA = &H80000006
Private Const STANDARD_RIGHTS_READ = &H20000
Private Const KEY_QUERY_VALUE = &H1&
Private Const KEY_ENUMERATE_SUB_KEYS = &H8&
Private Const KEY_NOTIFY = &H10&
Private Const SYNCHRONIZE = &H100000
Private Const KEY_READ = ((STANDARD_RIGHTS_READ Or _
KEY_QUERY_VALUE Or _
KEY_ENUMERATE_SUB_KEYS Or _
KEY_NOTIFY) And _
(Not SYNCHRONIZE))
Private Const MAXLEN = 256
Private Const ERROR_SUCCESS = &H0&
Const REG_NONE = 0
Const REG_SZ = 1
Const REG_EXPAND_SZ = 2
Const REG_BINARY = 3
Const REG_DWORD = 4
Const REG_DWORD_LITTLE_ENDIAN = 4
Const REG_DWORD_BIG_ENDIAN = 5
Const REG_LINK = 6
Const REG_MULTI_SZ = 7
Const REG_RESOURCE_LIST = 8
Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Private Declare Function apiRegOpenKeyEx Lib "advapi32.dll" _
Alias "RegOpenKeyExA" (ByVal hKey As Long, _
ByVal lpSubKey As String, ByVal ulOptions As Long, _
ByVal samDesired As Long, ByRef phkResult As Long) _
As Long
Private Declare Function apiRegCloseKey Lib "advapi32.dll" _
Alias "RegCloseKey" (ByVal hKey As Long) As Long
Private Declare Function apiRegQueryValueEx Lib "advapi32.dll" _
Alias "RegQueryValueExA" (ByVal hKey As Long, _
ByVal lpValueName As String, ByVal lpReserved As Long, _
ByRef lpType As Long, lpData As Any, _
ByRef lpcbData As Long) As Long
Private Declare Function apiRegQueryInfoKey Lib "advapi32.dll" _
Alias "RegQueryInfoKeyA" (ByVal hKey As Long, _
ByVal lpClass As String, ByRef lpcbClass As Long, _
ByVal lpReserved As Long, ByRef lpcSubKeys As Long, _
ByRef lpcbMaxSubKeyLen As Long, _
ByRef lpcbMaxClassLen As Long, _
ByRef lpcValues As Long, _
ByRef lpcbMaxValueNameLen As Long, _
ByRef lpcbMaxValueLen As Long, _
ByRef lpcbSecurityDescriptor As Long, _
ByRef lpftLastWriteTime As FILETIME) As Long
Function fReturnRegKeyValue(ByVal lngKeyToGet As Long, _
ByVal strKeyName As String, _
ByVal strValueName As String) _
As String
Dim lnghKey As Long
Dim strClassName As String
Dim lngClassLen As Long
Dim lngReserved As Long
Dim lngSubKeys As Long
Dim lngMaxSubKeyLen As Long
Dim lngMaxClassLen As Long
Dim lngValues As Long
Dim lngMaxValueNameLen As Long
Dim lngMaxValueLen As Long
Dim lngSecurity As Long
Dim ftLastWrite As FILETIME
Dim lngType As Long
Dim lngData As Long
Dim lngTmp As Long
Dim strRet As String
Dim varRet As Variant
Dim lngRet As Long
On Error GoTo fReturnRegKeyValue_Err
'Open the key first
lngTmp = apiRegOpenKeyEx(lngKeyToGet, _
strKeyName, 0&, KEY_READ, lnghKey)
'Are we ok?
If Not (lngTmp = ERROR_SUCCESS) Then Err.Raise _
lngTmp + vbObjectError
lngReserved = 0&
strClassName = String$(MAXLEN, 0): lngClassLen = MAXLEN
'Get boundary values
lngTmp = apiRegQueryInfoKey(lnghKey, strClassName, _
lngClassLen, lngReserved, lngSubKeys, lngMaxSubKeyLen, _
lngMaxClassLen, lngValues, lngMaxValueNameLen, _
lngMaxValueLen, lngSecurity, ftLastWrite)
'How we doin?
If Not (lngTmp = ERROR_SUCCESS) Then Err.Raise _
lngTmp + vbObjectError
'Now grab the value for the key
strRet = String$(MAXLEN - 1, 0)
lngTmp = apiRegQueryValueEx(lnghKey, strValueName, _
lngReserved, lngType, ByVal strRet, lngData)
Select Case lngType
Case REG_SZ
lngTmp = apiRegQueryValueEx(lnghKey, strValueName, _
lngReserved, lngType, ByVal strRet, lngData)
varRet = Left(strRet, lngData - 1)
Case REG_DWORD
lngTmp = apiRegQueryValueEx(lnghKey, strValueName, _
lngReserved, lngType, lngRet, lngData)
varRet = lngRet
Case REG_BINARY
lngTmp = apiRegQueryValueEx(lnghKey, strValueName, _
lngReserved, lngType, ByVal strRet, lngData)
varRet = Left(strRet, lngData)
End Select
'All quiet on the western front?
If Not (lngTmp = ERROR_SUCCESS) Then Err.Raise _
lngTmp + vbObjectError
fReturnRegKeyValue_Exit:
fReturnRegKeyValue = varRet
lngTmp = apiRegCloseKey(lnghKey)
Exit Function
fReturnRegKeyValue_Err:
varRet = "Error: Key or Value Not Found."
Resume fReturnRegKeyValue_Exit
End Function
'********Code End**************
#If Win64
선언 된 모든 함수를 PtrSafe
다음 과 같이 추가 하고 변경 해야한다는 것을 이해했기 때문에 다음을 시도 했습니다 .
Option Compare Database
Option Explicit
'********Code Start**************
'This code was originally written by Terry Kreft
' and Dev Ashish.
'It is not to be altered or distributed,
'except as part of an application.
'You are free to use it in any application,
'provided the copyright notice is left unchanged.
'
'Code Courtesy of
'Dev Ashish & Terry Kreft
'http://www.mvps.org/access/api/api0015.htm
Public Const HKEY_CLASSES_ROOT = &H80000000
Public Const HKEY_CURRENT_USER = &H80000001
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const HKEY_USERS = &H80000003
Public Const HKEY_PERFORMANCE_DATA = &H80000004
Public Const HKEY_CURRENT_CONFIG = &H80000005
Public Const HKEY_DYN_DATA = &H80000006
Private Const STANDARD_RIGHTS_READ = &H20000
Private Const KEY_QUERY_VALUE = &H1&
Private Const KEY_ENUMERATE_SUB_KEYS = &H8&
Private Const KEY_NOTIFY = &H10&
Private Const SYNCHRONIZE = &H100000
Private Const KEY_READ = ((STANDARD_RIGHTS_READ Or _
KEY_QUERY_VALUE Or _
KEY_ENUMERATE_SUB_KEYS Or _
KEY_NOTIFY) And _
(Not SYNCHRONIZE))
Private Const MAXLEN = 256
Private Const ERROR_SUCCESS = &H0&
Const REG_NONE = 0
Const REG_SZ = 1
Const REG_EXPAND_SZ = 2
Const REG_BINARY = 3
Const REG_DWORD = 4
Const REG_DWORD_LITTLE_ENDIAN = 4
Const REG_DWORD_BIG_ENDIAN = 5
Const REG_LINK = 6
Const REG_MULTI_SZ = 7
Const REG_RESOURCE_LIST = 8
Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
#If Win64 Then
Private Declare PtrSafe Function apiRegOpenKeyEx Lib "advapi32.dll" _
Alias "RegOpenKeyExA" (ByVal hKey As LongPtr, _
ByVal lpSubKey As String, ByVal ulOptions As Long, _
ByVal samDesired As LongPtr, ByRef phkResult As LongPtr) _
As Long
Private Declare PtrSafe Function apiRegCloseKey Lib "advapi32.dll" _
Alias "RegCloseKey" (ByVal hKey As LongPtr) As Long
Private Declare PtrSafe Function apiRegQueryValueEx Lib "advapi32.dll" _
Alias "RegQueryValueExA" (ByVal hKey As LongPtr, _
ByVal lpValueName As String, ByVal lpReserved As LongPtr, _
ByRef lpType As LongPtr, lpData As Any, _
ByRef lpcbData As LongPtr) As Long
Private Declare PtrSafe Function apiRegQueryInfoKey Lib "advapi32.dll" _
Alias "RegQueryInfoKeyA" (ByVal hKey As LongPtr, _
ByVal lpClass As String, ByRef lpcbClass As LongPtr, _
ByVal lpReserved As LongPtr, ByRef lpcSubKeys As LongPtr, _
ByRef lpcbMaxSubKeyLen As LongPtr, _
ByRef lpcbMaxClassLen As LongPtr, _
ByRef lpcValues As LongPtr, _
ByRef lpcbMaxValueNameLen As LongPtr, _
ByRef lpcbMaxValueLen As LongPtr, _
ByRef lpcbSecurityDescriptor As LongPtr, _
ByRef lpftLastWriteTime As FILETIME) As Long
#Else
Private Declare Function apiRegOpenKeyEx Lib "advapi32.dll" _
Alias "RegOpenKeyExA" (ByVal hKey As Long, _
ByVal lpSubKey As String, ByVal ulOptions As Long, _
ByVal samDesired As Long, ByRef phkResult As Long) _
As Long
Private Declare Function apiRegCloseKey Lib "advapi32.dll" _
Alias "RegCloseKey" (ByVal hKey As Long) As Long
Private Declare Function apiRegQueryValueEx Lib "advapi32.dll" _
Alias "RegQueryValueExA" (ByVal hKey As Long, _
ByVal lpValueName As String, ByVal lpReserved As Long, _
ByRef lpType As Long, lpData As Any, _
ByRef lpcbData As Long) As Long
Private Declare Function apiRegQueryInfoKey Lib "advapi32.dll" _
Alias "RegQueryInfoKeyA" (ByVal hKey As Long, _
ByVal lpClass As String, ByRef lpcbClass As Long, _
ByVal lpReserved As Long, ByRef lpcSubKeys As Long, _
ByRef lpcbMaxSubKeyLen As Long, _
ByRef lpcbMaxClassLen As Long, _
ByRef lpcValues As Long, _
ByRef lpcbMaxValueNameLen As Long, _
ByRef lpcbMaxValueLen As Long, _
ByRef lpcbSecurityDescriptor As Long, _
ByRef lpftLastWriteTime As FILETIME) As Long
#End If
Function fReturnRegKeyValue(ByVal lngKeyToGet As Long, _
ByVal strKeyName As String, _
ByVal strValueName As String) _
As String
#If Win64 Then
Dim lnghKey As LongPtr
Dim lngClassLen As LongPtr
Dim lngReserved As LongPtr
Dim lngSubKeys As LongPtr
Dim lngMaxSubKeyLen As LongPtr
Dim lngMaxClassLen As LongPtr
Dim lngValues As LongPtr
Dim lngMaxValueNameLen As LongPtr
Dim lngMaxValueLen As LongPtr
Dim lngSecurity As LongPtr
Dim lngType As LongPtr
Dim lngRet As LongPtr
'Dim lngData As LongPtr
#Else
Dim lnghKey As Long
Dim lngClassLen As Long
Dim lngReserved As Long
Dim lngSubKeys As Long
Dim lngMaxSubKeyLen As Long
Dim lngMaxClassLen As Long
Dim lngValues As Long
Dim lngMaxValueNameLen As Long
Dim lngMaxValueLen As Long
Dim lngSecurity As Long
Dim lngType As Long
Dim lngRet As Long
'Dim lngData As Long
#End If
'Dim lngData As Long
Dim lngTmp As Long
Dim strClassName As String
Dim ftLastWrite As FILETIME
Dim strRet As String
Dim varRet As Variant
On Error GoTo fReturnRegKeyValue_Err
'Open the key first
lngTmp = apiRegOpenKeyEx(lngKeyToGet, _
strKeyName, 0&, KEY_READ, lnghKey)
'Are we ok?
If Not (lngTmp = ERROR_SUCCESS) Then Err.Raise _
lngTmp + vbObjectError
lngReserved = 0&
strClassName = String$(MAXLEN, 0): lngClassLen = MAXLEN
'Get boundary values
lngTmp = apiRegQueryInfoKey(lnghKey, strClassName, _
lngClassLen, lngReserved, lngSubKeys, lngMaxSubKeyLen, _
lngMaxClassLen, lngValues, lngMaxValueNameLen, _
lngMaxValueLen, lngSecurity, ftLastWrite)
'How we doin?
If Not (lngTmp = ERROR_SUCCESS) Then Err.Raise _
lngTmp + vbObjectError
'Now grab the value for the key
strRet = String$(MAXLEN - 1, 0)
lngTmp = apiRegQueryValueEx(lnghKey, strValueName, _
lngReserved, lngType, ByVal strRet, lngData)
Select Case lngType
Case REG_SZ
lngTmp = apiRegQueryValueEx(lnghKey, strValueName, _
lngReserved, lngType, ByVal strRet, lngData)
varRet = Left(strRet, lngData - 1)
Case REG_DWORD
lngTmp = apiRegQueryValueEx(lnghKey, strValueName, _
lngReserved, lngType, lngRet, lngData)
varRet = lngRet
Case REG_BINARY
lngTmp = apiRegQueryValueEx(lnghKey, strValueName, _
lngReserved, lngType, ByVal strRet, lngData)
varRet = Left(strRet, lngData)
End Select
'All quiet on the western front?
If Not (lngTmp = ERROR_SUCCESS) Then Err.Raise _
lngTmp + vbObjectError
fReturnRegKeyValue_Exit:
fReturnRegKeyValue = varRet
lngTmp = apiRegCloseKey(lnghKey)
Exit Function
fReturnRegKeyValue_Err:
varRet = "Error: Key or Value Not Found."
Resume fReturnRegKeyValue_Exit
End Function
나는 변수에 붙어 lngData
있습니다. 설정 방법을 잘 모르겠습니다. Win64에 대해 LongPtr로 설정하면 행에 유형 불일치 오류가 발생합니다 varRet = Left(strRet, lngData - 1)
. 항상 Long으로 남겨두면 줄에 ByRef Argument Type Mismatch가 나타납니다.lngTmp = apiRegQueryValueEx(lnghKey, strValueName, lngReserved, lngType, ByVal strRet, lngData)
모든 Long 인수가 LongPtr 이어야하는 것은 아닙니다 .
Private Declare PtrSafe Function apiRegOpenKeyEx Lib "advapi32.dll" _
Alias "RegOpenKeyExA" (ByVal hKey As LongPtr, _
ByVal lpSubKey As String, ByVal ulOptions As Long, _
ByVal samDesired As Long, ByRef phkResult As LongPtr) _
As Long
Private Declare PtrSafe Function apiRegCloseKey Lib "advapi32.dll" _
Alias "RegCloseKey" (ByVal hKey As LongPtr) As Long
Private Declare PtrSafe Function apiRegQueryValueEx Lib "advapi32.dll" _
Alias "RegQueryValueExA" (ByVal hKey As LongPtr, _
ByVal lpValueName As String, ByVal lpReserved As LongPtr, _
ByRef lpType As Long, lpData As Any, _
ByRef lpcbData As Long) As Long
Private Declare PtrSafe Function apiRegQueryInfoKey Lib "advapi32.dll" _
Alias "RegQueryInfoKeyA" (ByVal hKey As LongPtr, _
ByVal lpClass As String, ByRef lpcbClass As Long, _
ByVal lpReserved As LongPtr, ByRef lpcSubKeys As Long, _
ByRef lpcbMaxSubKeyLen As Long, _
ByRef lpcbMaxClassLen As Long, _
ByRef lpcValues As Long, _
ByRef lpcbMaxValueNameLen As Long, _
ByRef lpcbMaxValueLen As Long, _
ByRef lpcbSecurityDescriptor As Long, _
ByRef lpftLastWriteTime As FILETIME) As Long
이 기사는 인터넷에서 수집됩니다. 재 인쇄 할 때 출처를 알려주십시오.
침해가 발생한 경우 연락 주시기 바랍니다[email protected] 삭제
몇 마디 만하겠습니다