-2
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: [email protected]
'
' 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
我看不出有什麼問題。 – Martin 2012-04-24 08:52:09