VB6读取注册表项，但没有返回数据

Question

新注册绝望的用户在这里。

我离开了节目业务前一段，但现在再和要求进行一些增强等

我想用注册表来存储一些文件的位置，因此用户不必指定它们每时每刻。我想将它们存储在HKEY_LOCAL_MACHINE下，因为有多个用户。

我有使用RegCreateKeyEx创建的键，和值已进入键，与RegSetValueExString，所以有一个键下HKEY_LOCAL_MACHINE称为SUPPLIERFILE，它的值为“C：\ Documents和设置。”等

但是，当我使用RegQueryValueExString它不起作用：lpValue字符串是空的，虽然cbdata确实包含我期望在那里找到的字符串的长度。返回的错误是234，ERROR_MORE_DATA。

我试过使用RegGetValue，因为我想也许一个非null终止的字符串是问题，但我没有在api DLL的RegGetValue。

任何建议都会被感激地收到，即使沿着如何终止一个空字符串的方式。 谢谢， 史蒂夫

Answer 1

快速回答：尝试GetRegStringValue $代码here

如果您（或他人）想了解更多

当你调用API，与很多Windows的API你是应该提供一个缓冲区（字符串）来保存注册表值，并且您应该传递缓冲区的最大大小。

MSDN explains

如果参数lpData所指向的缓冲器不是足够大以容纳所述数据，则该函数返回ERROR_MORE_DATA并存储在变量中的所需的缓冲区大小由参数lpcbData指向。在这种情况下，lpData缓冲区的内容未定义。

你需要分配一个缓冲区（可能用空格填充你的字符串）并在lpData中传递大小。

Answer 2

你的错误表明你还没有初始化足够大的字符串缓冲区供API函数使用，但没有你的代码，???我从我使用的注册表实用程序类中提取下面的代码。我想我已经包含了所有的API声明和常量，以及将返回的错误转化为有用的方法。

Public Enum RegRootKey 
    HKEY_CLASSES_ROOT = &H80000000 
    HKEY_CURRENT_CONFIG = &H80000005 
    HKEY_CURRENT_USER = &H80000001 
    HKEY_DYN_DATA = &H80000006 
    HKEY_LOCAL_MACHINE = &H80000002 
    HKEY_PERFORMANCE_DATA = &H80000004 
    HKEY_USERS = &H80000003 
End Enum 

'the following declare is used to return windows error descriptions 
Private Declare Function FormatMessage Lib "Kernel32" Alias "FormatMessageA" (ByVal dwFlags As Long, lpSource As Any, ByVal dwMessageId As Long, ByVal dwLanguageId As Long, ByVal lpBuffer As String, ByVal nSize As Long, Arguments As Long) As Long 
Private Const FORMAT_MESSAGE_FROM_SYSTEM = &H1000 
Private Const FORMAT_MESSAGE_IGNORE_INSERTS = &H200 

'key constants 
Private Const ERROR_NO_MORE_ITEMS = 259& 
Private Const ERROR_MORE_DATA = 234 
Private Const ERROR_SUCCESS = 0& 
Private Const SYNCHRONIZE = &H100000 
Private Const READ_CONTROL = &H20000 
Private Const READ_WRITE = 2 
Private Const READAPI = 0 
Private Const STANDARD_RIGHTS_ALL = &H1F0000 
Private Const STANDARD_RIGHTS_REQUIRED = &HF0000 
Private Const STANDARD_RIGHTS_EXECUTE = (READ_CONTROL) 
Private Const STANDARD_RIGHTS_READ = (READ_CONTROL) 
Private Const STANDARD_RIGHTS_WRITE = (READ_CONTROL) 
Private Const KEY_NOTIFY = &H10 
Private Const KEY_QUERY_VALUE = &H1 
Private Const KEY_CREATE_LINK = &H20 
Private Const KEY_CREATE_SUB_KEY = &H4 
Private Const KEY_ENUMERATE_SUB_KEYS = &H8 
Private Const KEY_EVENT = &H1 
Private Const KEY_SET_VALUE = &H2 
Private Const KEY_ALL_ACCESS = ((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 = ((STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) And (Not SYNCHRONIZE)) 
Private Const KEY_EXECUTE = ((KEY_READ) And (Not SYNCHRONIZE)) 
Private Const KEY_WRITE = ((STANDARD_RIGHTS_WRITE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY) And (Not SYNCHRONIZE)) 
Private Const REG_OPTION_NON_VOLATILE = 0 
Private Const REG_SZ = 1       ' Unicode nul terminated string 
Private Const REG_BINARY = 3 
Private Const REG_DWORD = 4 
Private Const REG_MULTI_SZ = 7     ' Multiple Unicode strings 
Private Const REG_NONE = 0      ' No value type 
Private Const KEY_WOW64_64KEY As Long = &H100& '32 bit app to access 64 bit hive 
Private Const KEY_WOW64_32KEY As Long = &H200& '64 bit app to access 32 bit hive 

'API declarations 
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long 
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData 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 RootKeyName Lib "advapi32.dll" Alias "RootKeyNameA" (ByVal lphKey As RegRootKey) As String 


Public Function GetStringValue(ByVal hKeyRoot As RegRootKey, ByVal hKeySubKey As String, ByVal ValueName As String, Optional ByVal Default As String) As String 
    Dim strReturn As String 
    Dim strBuffer As String 
    Dim lngType As Long 
    Dim lngBufLen As Long 
    Dim lngRst As Long 
    Dim hKeyHandle As Long 

    On Error GoTo errGetStringValue 

    'just to avoid any errors in calling functions using a ubound to check the contents 
    strBuffer = String(255, vbNullChar) 
    lngBufLen = Len(strBuffer) 

    lngRst = RegOpenKeyEx(hKeyRoot, hKeySubKey, 0, KEY_READ Or KEY_WOW64_64KEY, hKeyHandle) 
    If hKeyHandle <> 0 Then 
     If StrComp(ValueName, "default", vbTextCompare) = 0 Then 
      lngRst = RegQueryValueEx(hKeyHandle, "", ByVal 0&, lngType, ByVal strBuffer, lngBufLen) 
     Else 
      lngRst = RegQueryValueEx(hKeyHandle, ValueName, ByVal 0&, lngType, ByVal strBuffer, lngBufLen) 
     End If 
    End If 

    If lngRst = 0 Then 
     If lngType = REG_SZ Then 
      If lngBufLen > 0 Then 
       strReturn = Left$(strBuffer, lngBufLen - 1) 
      Else 
       strReturn = Default 
      End If 
     Else 
      Err.Raise 1, App.EXEName, FormatClassError(1) 
     End If 
    ElseIf lngRst = 2 Then  'the key does not exists so return the default 
     strReturn = Default 
    Else 'if the return is non-zero there was an error 
     Err.Raise lngRst, App.EXEName, "There was an error reading the " & RootKeyName(hKeyRoot) & "\" & _ 
      hKeySubKey & " registry key, " & LCase$(FormatClassError(lngRst)) 
    End If 

    If hKeyHandle <> 0 Then 
     lngRst = RegCloseKey(hKeyHandle) 
     hKeyHandle = 0 
    End If 

    GetStringValue = strReturn 

    Exit Function 

errGetStringValue: 
    If hKeyHandle <> 0 Then 
     lngRst = RegCloseKey(hKeyHandle) 
     hKeyHandle = 0 
    End If 
    Err.Raise Err.Number, Err.Source & ":GetStringValue", Err.Description 

End Function 

Private Function FormatClassError(ByVal ErrorNumber As Long) As String 
    Dim strReturn As String 
    Dim strBuffer As String 
    Dim lngBufLen As Long 
    Dim lngRst As Long 

    On Error Resume Next 

    'initialize the buffer to to API function 
    strBuffer = String(1024, vbNullChar) 
    lngBufLen = Len(strBuffer) 

    'make the call to the API function 
    lngRst = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM Or FORMAT_MESSAGE_IGNORE_INSERTS, ByVal 0&, ErrorNumber, ByVal 0&, strBuffer, lngBufLen, ByVal 0&) 

    'if the return value is <> 0 then we have a valid message 
    If lngRst <> 0 Then 
     strReturn = Left$(strBuffer, lngRst) 
    Else 
     'make another call to the API function with the last dll error 
     lngRst = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM Or FORMAT_MESSAGE_IGNORE_INSERTS, ByVal 0&, Err.LastDllError, ByVal 0&, strBuffer, lngBufLen, ByVal 0&) 
     If lngRst <> 0 Then 
      strReturn = Left$(strBuffer, lngRst) 
     Else 
      strReturn = "Unable to retrieve error description." 
     End If 
    End If 

    'return the result 
    FormatClassError = strReturn 

End Function