user3389372
user3389372

Reputation: 21

VB6 reading registry entry but no data returned

newly signed up desperate user here.

I left the programming business quite a while ago but now and then get asked to make some enhancements etc.

I want to use the registry to store some file locations so the user doesn't have to specify them all the time. I want to store them under HKEY_LOCAL_MACHINE because there are multiple users.

I have got the key created using RegCreateKeyEx, and a value has been entered into the key, with RegSetValueExString, so there is a key under HKEY_LOCAL_MACHINE called SUPPLIERFILE and it has the value "C:\Documents and Settings.." etc.

However when I use RegQueryValueExString it doesn't work: the lpValue string is empty, although the cbdata does contain the length of the string I was expecting to find there. The error retured is 234, ERROR_MORE_DATA.

I have tried using RegGetValue, because I thought maybe a non-null terminated string was the problem, but I haven't got RegGetValue in the api dll.

Any suggestions would be gratefully received, even along the lines of how to terminate a string with a null. Thanks, Steve

Upvotes: 1

Views: 3583

Answers (3)

Ayush joshi
Ayush joshi

Reputation: 325

you should check first, if the Registry is really do exist or not. By error handling, we can check for the Registry key Entry.

Private Function RegOSInfo(RegPath As String, RegKey As String) As String
On Error GoTo ErrHandler


   Dim osName As String
   Dim Reg As Object
   Set Reg = CreateObject("WScript.Shell")
   RegOSInfo = Reg.RegRead(RegPath & "\" & RegKey)


ErrHandler:
  RegOSInfo = "-555"  'custom Error Code, Registry key doesn't exist
End Function

you can handle the Custom error code according to your need.

Upvotes: 0

jac
jac

Reputation: 9726

Your error indicates you have not initialized a large enough string buffer for the API function to use, but without your code, ??? I pulled the code below from a registry utility class I use. I think I have included all the API declarations, and constants used, as well as a method to translate returned errors to something helpful.

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

Upvotes: 1

MarkJ
MarkJ

Reputation: 30408

Quick answer: try the GetRegStringValue$ code here

In case you (or others) want to know more

When you call that API, as with many windows APIs you are supposed to provide a buffer (string) to hold the registry value, and you are supposed to pass in the maximum size of your buffer.

MSDN explains

If the buffer specified by lpData parameter is not large enough to hold the data, the function returns ERROR_MORE_DATA and stores the required buffer size in the variable pointed to by lpcbData. In this case, the contents of the lpData buffer are undefined.

You need to allocate a buffer (probably fill your string with spaces) and pass in the size in lpData.

Upvotes: 0

Related Questions