Vb6 从注册表读取字符串将返回部分数据

导致问题，因为有时会返回部分结果。例如，如果在Windows 7注册表编辑器中查看该值，则值数据显示为“True”，而函数GetStringSetting最近间歇性启动时仅返回“Tru”

这可以通过简单地打开和关闭注册表中的“值”对话框来解决

我想这个问题可能是太模糊使用过时的技术，但忍不住要问，如果有人有类似的问题，因为这个问题影响我的免费软件产品

some_variable = GetStringSetting(HKEY_CURRENT_USER, "myApp", "mySection", myKey, defaultValue )

'*******************************************************************************
'模块：MRegistry
作者：菲尔·弗雷塞尔
创建日期：2000年7月14日
版权所有：版权所有2000 Frez Systems Limited。版权所有。
'
"说明:
'获取字符串并将其保存到注册表
'
'这是'免费'软件，有以下限制：
'
'您不能将此代码作为'示例'或'演示'重新分发。然而，你是自由的
'在您自己的代码中使用源代码，但您不能声称您创建了
'示例代码。明确禁止出售此源代码或从中获利
'而不是通过您自己的代码获得的知识或增强的价值。
'
“使用此软件的风险也由您自行承担。代码如下所示：
没有任何形式的保证或保证。
'
'您是否希望根据提供的附加模块委托一些衍生作品
“在这里，或任何咨询工作，请随时与我们联系。
'
"网址:http://www.frez.co.uk
“电子邮件：sales@frez.co.uk
'
“修改历史记录：
'1.0 2000年7月14日
菲尔·弗雷塞尔
"初版"
'*******************************************************************************
公共枚举注册表设置
HKEY_当前_用户=&H80000001
HKEY_本地_机器=&H8000002
结束枚举
Private Const BASE_KEY As String=“SOFTWARE”
私用Const REG_SZ长=1
私有常量错误\u无，因为长=0
Private Const ERROR\u KEY\u不存在，因为Long=2
Private Const READ_CONTROL As Long=&H20000
私有常量标准权限读取长度=（读取控制）
私人建筑标准权利所有长度=&H1F0000
Private Const KEY_QUERY_值为Long=&H1
Private Const KEY_SET_值为Long=&H2
私有常量密钥\u创建\u子密钥长度=&H4
私用常量密钥\u枚举\u子密钥，长度=&H8
Private Const KEY_NOTIFY As Long=&H10
Private Const KEY_CREATE_链接长度=&H20
私有常量同步长度=&H100000
Private Const KEY\u ALL\u访问长度=（（标准权限\u ALL或_
键\查询\值或_
键设置值或_
键\u创建\u子键\u键或_
密钥\枚举\子密钥\或_
按键通知或_
键（创建链接）_
和（不同步））
私有常量密钥读取长度=（（标准权限）读取或_
键\查询\值或_
密钥\枚举\子密钥\或_
钥匙（通知）_
和（不同步））
私有声明函数RegCloseKey Lib“advapi32.dll”（ByVal hKey作为Long）作为Long
私有声明函数RegCreateKeyEx_
Lib“advapi32.dll”别名“RegCreateKeyExA”_
（ByVal hKey，只要_
ByVal lpSubKey作为字符串_
拜瓦尔保留了很久_
ByVal lpClass作为字符串_
只要_
拜瓦尔·萨姆林，只要_
ByVal lpSecurityAttributes，只要_
phkResult只要_
LPDW配置为长）为长
私有声明函数RegOpenKeyEx_
Lib“advapi32.dll”别名“RegOpenKeyExA”_
（ByVal hKey，只要_
ByVal lpSubKey作为字符串_
顺便说一句，只要有选择_
拜瓦尔·萨姆林，只要_
phkResult As Long）As Long
私有声明函数RegOpenKey_
Lib“advapi32.dll”别名“RegOpenKeyA”_
（ByVal lngRootKey，只要_
ByVal lpSubKey作为字符串_
phkResult As Long）As Long
私有声明函数RegQueryValueExString_
Lib“advapi32.dll”别名“RegQueryValueExA”_
（ByVal hKey，只要_
ByVal lpValueName作为字符串_
拜瓦尔：只要_
只要_
ByVal lpData作为字符串_
lpcbData As Long）As Long
私有声明函数RegQueryValueExNULL_
Lib“advapi32.dll”别名“RegQueryValueExA”_
（ByVal hKey，只要_
ByVal lpValueName作为字符串_
拜瓦尔：只要_
只要_
ByVal lpData，只要_
lpcbData As Long）As Long
私有声明函数RegSetValueExString_
Lib“advapi32.dll”别名“RegSetValueExA”_
（ByVal hKey，只要_
ByVal lpValueName作为字符串_
拜瓦尔保留了很久_
ByVal dwType，只要_
ByVal lpData作为字符串_
ByVal cbData As Long）As Long
'专用声明函数RegOpenKeyEx Lib“advapi32.dll”别名“RegOpenKeyExA”_
（ByVal hKey，只要_
ByVal lpSubKey作为字符串_
顺便说一句，只要有选择_
拜瓦尔·萨姆林，只要_
phkResult As Long）As Long
'专用声明函数RegCloseKey Lib“advapi32.dll”_
（ByVal hKey，只要）只要
专用声明函数RegSetValueEx Lib“advapi32.dll”别名“RegSetValueExA”_
（ByVal hKey，只要_
ByVal lpValueName作为字符串_
拜瓦尔保留了很久_
ByVal dwType，只要_
如有任何数据_
ByVal cbData As Long）As Long
专用声明函数RegDeleteKey Lib“advapi32.dll”别名“RegDeleteKeyA”_
（ByVal lngRootKey，只要_
ByVal lpSubKey（作为字符串）一样长
专用声明函数RegDeleteValue Lib“advapi32.dll”别名“RegDeleteValueA”_
（ByVal lngRootKey，只要，
'*******************************************************************************
' 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