some_variable = GetStringSetting(HKEY_CURRENT_USER, "myApp", "mySection", myKey, defaultValue )
会导致问题,因为有时会返回部分结果。例如,如果在Windows 7中查看值,则注册表编辑器值数据显示为“True”,而函数GetStringSetting最近并间歇性地启动,仅返回“Tru”。
只需打开和关闭注册表中的值对话框即可解决此问题。
我猜这个问题可能过于模糊,使用过时的技术,但不禁要问是否有人有类似的问题,因为这个问题会影响我的免费软件产品。
'*******************************************************************************
' MODULE: MRegistry
' AUTHOR: Phil Fresle
' CREATED: 14-Jul-2000
' COPYRIGHT: Copyright 2000 Frez Systems Limited. All Rights Reserved.
'
' DESCRIPTION:
' Get and save strings to the registry
'
' This is 'free' software with the following restrictions:
'
' You may not redistribute this code as a 'sample' or 'demo'. However, you are free
' to use the source code in your own code, but you may not claim that you created
' the sample code. It is expressly forbidden to sell or profit from this source code
' other than by the knowledge gained or the enhanced value added by your own code.
'
' Use of this software is also done so at your own risk. The code is supplied as
' is without warranty or guarantee of any kind.
'
' Should you wish to commission some derivative work based on the add-in provided
' here, or any consultancy work, please do not hesitate to contact us.
'
' Web Site: http://www.frez.co.uk
' E-mail: sales@frez.co.uk
'
' MODIFICATION HISTORY:
' 1.0 14-Jul-2000
' Phil Fresle
' Initial Version
'*******************************************************************************
Public Enum REG_SETTINGS
HKEY_CURRENT_USER = &H80000001
HKEY_LOCAL_MACHINE = &H80000002
End Enum
Private Const BASE_KEY As String = "SOFTWARE"
Private Const REG_SZ As Long = 1
Private Const ERROR_NONE As Long = 0
Private Const ERROR_KEY_DOES_NOT_EXIST As Long = 2
Private Const READ_CONTROL As Long = &H20000
Private Const STANDARD_RIGHTS_READ As Long = (READ_CONTROL)
Private Const STANDARD_RIGHTS_ALL As Long = &H1F0000
Private Const KEY_QUERY_VALUE As Long = &H1
Private Const KEY_SET_VALUE As Long = &H2
Private Const KEY_CREATE_SUB_KEY As Long = &H4
Private Const KEY_ENUMERATE_SUB_KEYS As Long = &H8
Private Const KEY_NOTIFY As Long = &H10
Private Const KEY_CREATE_LINK As Long = &H20
Private Const SYNCHRONIZE As Long = &H100000
Private Const KEY_ALL_ACCESS As Long = ((STANDARD_RIGHTS_ALL Or _
KEY_QUERY_VALUE Or _
KEY_SET_VALUE Or _
KEY_CREATE_SUB_KEY Or _
KEY_ENUMERATE_SUB_KEYS Or _
KEY_NOTIFY Or _
KEY_CREATE_LINK) _
And (Not SYNCHRONIZE))
Private Const KEY_READ As Long = ((STANDARD_RIGHTS_READ Or _
KEY_QUERY_VALUE Or _
KEY_ENUMERATE_SUB_KEYS Or _
KEY_NOTIFY) _
And (Not SYNCHRONIZE))
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegCreateKeyEx _
Lib "advapi32.dll" Alias "RegCreateKeyExA" _
(ByVal hKey As Long, _
ByVal lpSubKey As String, _
ByVal Reserved As Long, _
ByVal lpClass As String, _
ByVal dwOptions As Long, _
ByVal samDesired As Long, _
ByVal lpSecurityAttributes As Long, _
phkResult As Long, _
lpdwDisposition As Long) As Long
Private Declare Function RegOpenKeyEx _
Lib "advapi32.dll" Alias "RegOpenKeyExA" _
(ByVal hKey As Long, _
ByVal lpSubKey As String, _
ByVal ulOptions As Long, _
ByVal samDesired As Long, _
phkResult As Long) As Long
Private Declare Function RegOpenKey _
Lib "advapi32.dll" Alias "RegOpenKeyA" _
(ByVal lngRootKey As Long, _
ByVal lpSubKey As String, _
phkResult As Long) As Long
Private Declare Function RegQueryValueExString _
Lib "advapi32.dll" Alias "RegQueryValueExA" _
(ByVal hKey As Long, _
ByVal lpValueName As String, _
ByVal lpReserved As Long, _
lpType As Long, _
ByVal lpData As String, _
lpcbData As Long) As Long
Private Declare Function RegQueryValueExNULL _
Lib "advapi32.dll" Alias "RegQueryValueExA" _
(ByVal hKey As Long, _
ByVal lpValueName As String, _
ByVal lpReserved As Long, _
lpType As Long, _
ByVal lpData As Long, _
lpcbData As Long) As Long
Private Declare Function RegSetValueExString _
Lib "advapi32.dll" Alias "RegSetValueExA" _
(ByVal hKey As Long, _
ByVal lpValueName As String, _
ByVal Reserved As Long, _
ByVal dwType As Long, _
ByVal lpData As String, _
ByVal cbData As Long) As Long
'Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" _
(ByVal hKey As Long, _
ByVal lpSubKey As String, _
ByVal ulOptions As Long, _
ByVal samDesired As Long, _
phkResult As Long) As Long
'Private Declare Function RegCloseKey Lib "advapi32.dll" _
(ByVal hKey As Long) As Long
Private Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" _
(ByVal hKey As Long, _
ByVal lpValueName As String, _
ByVal Reserved As Long, _
ByVal dwType As Long, _
lpData As Any, _
ByVal cbData As Long) As Long
Private Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" _
(ByVal lngRootKey As Long, _
ByVal lpSubKey As String) As Long
Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" _
(ByVal lngRootKey As Long, _
ByVal lpValueName As String) As Long
'private Const HKEY_CURRENT_USER = &H80000001
'private Const HKEY_LOCAL_MACHINE = &H80000002
Private Const KEY_WRITE = &H20006
'private Const REG_SZ = 1
Private m_lngRetVal As Long
'*******************************************************************************
' GetStringSetting (FUNCTION)
'
' DESCRIPTION:
' Own version of VB's GetSetting to retrieve strings under
' HKEY_LOCAL_MACHINE\SOFTWARE instead of
' HKEY_CURRENT_USER\Software\VB and VBA Program Settings
'
' PARAMETERS:
' (In) - sAppName - String - The first level
' (In) - sSection - String - The second level
' (In) - sKey - String - The key in the second level
' (In) - sDefault - String -
'
' RETURN VALUE:
' String - The value stored in the key or sDefault if not found
'*******************************************************************************
Public Function GetStringSetting(ByVal sRegistry As Long, _
ByVal sAppName As String, _
ByVal sSection As String, _
ByVal sKey As String, _
Optional ByVal sDefault As String) As String
Dim lRetVal As Long
Dim sFullKey As String
Dim lHandle As Long
Dim lType As Long
Dim lLength As Long
Dim sValue As String
Dim lErrNumber As Long
Dim sErrDescription As String
Dim sErrSource As String
On Error GoTo ERROR_HANDLER
If Trim(sAppName) = "" Then
Err.Raise vbObjectError + 1000, , "AppName may not be empty"
End If
If Trim(sSection) = "" Then
Err.Raise vbObjectError + 1001, , "Section may not be empty"
End If
If Trim(sKey) = "" Then
Err.Raise vbObjectError + 1002, , "Key may not be empty"
End If
sFullKey = BASE_KEY & "\" & Trim(sAppName) & "\" & Trim(sSection)
' Open up the key
lRetVal = RegOpenKeyEx(sRegistry, sFullKey, 0, KEY_READ, lHandle)
If lRetVal <> ERROR_NONE Then
If lRetVal = ERROR_KEY_DOES_NOT_EXIST Then
GetStringSetting = sDefault
Exit Function
Else
Err.Raise vbObjectError + 2000 + lRetVal, , _
"Could not open registry section"
End If
End If
' Get size and type
lRetVal = RegQueryValueExNULL(lHandle, sKey, 0, lType, 0, lLength)
If lRetVal <> ERROR_NONE Then
GetStringSetting = sDefault
Exit Function
End If
' Is it stored as a string in the registry?
If lType = REG_SZ Then
sValue = String(lLength, 0)
If lLength = 0 Then
GetStringSetting = ""
Else
lRetVal = RegQueryValueExString(lHandle, sKey, 0, lType, _
sValue, lLength)
If lRetVal = ERROR_NONE Then
GetStringSetting = Left(sValue, lLength - 1)
Else
GetStringSetting = sDefault
End If
End If
Else
Err.Raise vbObjectError + 2000 + lType, , _
"Registry data not a string"
End If
TIDY_UP:
On Error Resume Next
RegCloseKey lHandle
If lErrNumber <> 0 Then
On Error GoTo 0
Err.Raise lErrNumber, sErrSource, sErrDescription
End If
Exit Function
ERROR_HANDLER:
lErrNumber = Err.Number
sErrSource = Err.Source
sErrDescription = Err.Description
Resume TIDY_UP
End Function
答案 0 :(得分:1)
可能是由于:
如果数据具有REG_SZ,REG_MULTI_SZ或REG_EXPAND_SZ类型,该字符串可能未与正确的终止空字符一起存储。因此,即使函数返回ERROR_SUCCESS,应用程序也应确保在使用之前正确终止字符串;否则,它可能会覆盖缓冲区。 (请注意,REG_MULTI_SZ字符串应该有两个终止空字符。)应用程序可以确保字符串正确终止的一种方法是使用RegGetValue,如果需要,它会添加终止空字符。