Link to home
Start Free TrialLog in
Avatar of NewsInternationalLtd
NewsInternationalLtd

asked on

VB6, Test for existence on string value in the registry.

Does anyone have a very simple (well short, anyway) bit of VB6 code which I can use to test whether any string exists under a certain key in the registry?
EG
HKCU\Software\Test {any string value that exists in here}

I don't even need to be able to return the string in question, a simple boolean result would be fine.
Thank you.
Avatar of Dirk Haest
Dirk Haest
Flag of Belgium image

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 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 Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (dest As _
    Any, source As Any, ByVal numBytes As Long)

Const KEY_READ = &H20019  ' ((READ_CONTROL Or KEY_QUERY_VALUE Or
                          ' KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) And (Not
                          ' SYNCHRONIZE))

Const REG_SZ = 1
Const REG_EXPAND_SZ = 2
Const REG_BINARY = 3
Const REG_DWORD = 4
Const REG_MULTI_SZ = 7
Const ERROR_MORE_DATA = 234

' Read a Registry value
'
' Use KeyName = "" for the default value
' If the value isn't there, it returns the DefaultValue
' argument, or Empty if the argument has been omitted
'
' Supports DWORD, REG_SZ, REG_EXPAND_SZ, REG_BINARY and REG_MULTI_SZ
' REG_MULTI_SZ values are returned as a null-delimited stream of strings
' (VB6 users can use SPlit to convert to an array of string)

Function GetRegistryValue(ByVal hKey As Long, ByVal KeyName As String, _
    ByVal ValueName As String, Optional DefaultValue As Variant) As Variant
    Dim handle As Long
    Dim resLong As Long
    Dim resString As String
    Dim resBinary() As Byte
    Dim length As Long
    Dim retVal As Long
    Dim valueType As Long
   
    ' Prepare the default result
    GetRegistryValue = IIf(IsMissing(DefaultValue), Empty, DefaultValue)
   
    ' Open the key, exit if not found.
    If RegOpenKeyEx(hKey, KeyName, 0, KEY_READ, handle) Then
        Exit Function
    End If
   
    ' prepare a 1K receiving resBinary
    length = 1024
    ReDim resBinary(0 To length - 1) As Byte
   
    ' read the registry key
    retVal = RegQueryValueEx(handle, ValueName, 0, valueType, resBinary(0), _
        length)
    ' if resBinary was too small, try again
    If retVal = ERROR_MORE_DATA Then
        ' enlarge the resBinary, and read the value again
        ReDim resBinary(0 To length - 1) As Byte
        retVal = RegQueryValueEx(handle, ValueName, 0, valueType, resBinary(0), _
            length)
    End If
   
    ' return a value corresponding to the value type
    Select Case valueType
        Case REG_DWORD
            CopyMemory resLong, resBinary(0), 4
            GetRegistryValue = resLong
        Case REG_SZ, REG_EXPAND_SZ
            ' copy everything but the trailing null char
            resString = Space$(length - 1)
            CopyMemory ByVal resString, resBinary(0), length - 1
            GetRegistryValue = resString
        Case REG_BINARY
            ' resize the result resBinary
            If length <> UBound(resBinary) + 1 Then
                ReDim Preserve resBinary(0 To length - 1) As Byte
            End If
            GetRegistryValue = resBinary()
        Case REG_MULTI_SZ
            ' copy everything but the 2 trailing null chars
            resString = Space$(length - 2)
            CopyMemory ByVal resString, resBinary(0), length - 2
            GetRegistryValue = resString
        Case Else
            RegCloseKey handle
            Err.Raise 1001, , "Unsupported value type"
    End Select
   
    ' close the registry key
    RegCloseKey handle
End Function

dim RegString as string
RegString = GetRegistryValue("HKCU", "SoftWare", "Test")
if instr(regstring, "mystringtofind")>0 then
Avatar of NewsInternationalLtd
NewsInternationalLtd

ASKER

Thanks, but Is this really the shortest way of doing something so simple? I have come accross this a few times but the whole point was to find a solution which only took a few lines of code. I'm certain this is possible.
Text1.Text = GetRegistryValue(HKEY_CURRENT_USER, "software/Test", "<something")
The only thing you can do is use API's to read the registry in vb6. I'm not sure if there are other alternatives. (I haven't used and seen such alternatives)
ASKER CERTIFIED SOLUTION
Avatar of PaulHews
PaulHews
Flag of Canada image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
This looks exactly what I want. Trouble is I'm getting a blank screen displaying nothing. This is what I have done. Any ideas?

Private Sub Form_Load()
MsgBox CheckIfRegValueExists("HKCU\Software\Test")
End Sub
Private Function CheckIfRegValueExists(strValueKey As String) As Boolean
    Dim Shell As Object
    Dim strTemp As String
   
    Set Shell = CreateObject("WScript.Shell")
    On Error Resume Next
    strTemp = Shell.RegRead(strValueKey)
     CheckIfRegValueExists = Not (Err.Number = -2147024894)

     Set Shell = Nothing
   'On Error GoTo 0
End Function
>Trouble is I'm getting a blank screen displaying nothing.

Your form loads but the message box doesn't display and there's no run time error?  Put a breakpoint on your msgbox and trace it through.  See what's happening.
Not sure what was happening there but I closed VB and reopened it and the code magically started working....
Anyway, perfect, exactly what I was looking for. Nice one!
One more thing.
Currently this will display TRUE if the value "(default)" is not removed. This is despite no obvious value being associated with it. However if you press delete over the "(default)" value then this turns to 'value not set' and the script above will give FALSE.
Do you know a way to remove the value of (default)? I can't figure it out, I think there maybe some special character that represents it.
>Currently this will display TRUE if the value "(default)" is not removed.
You mean the (Default) value under any key?  For me, they are all (Value not set) in regedit already.  Give me an example.
You are correct, by default (default) is set to (Value Not Set).
However, in my application there are times when this value is simply blank eg
Instead of:
Name                                       Type              Data
(Default)                                  REG_SZ         (Value Not Set)

I get:
Name                                       Type              Data
(Default)                                  REG_SZ        

This is nothing to do with your code, this just happens to be the case once in a while for one reason or another. If I was to press delete over it, the DATA value would change to (Value not set). However I am at a loss how to delete this value programmatically.
The only time it will return true for the default value is when you pass it the path of a key rather than a value:

For example, if you have a key named HKCU\Testing with a default value with a set value, then these will return this way:

Private Sub Form_Load()
    MsgBox CheckIfRegValueExists("HKEY_CURRENT_USER\Testing\")  'True because it picks up the default value of the key.  If the default is "not set" then false.
    MsgBox CheckIfRegValueExists("HKEY_CURRENT_USER\Testing\test") 'False because there is no test string value
    MsgBox CheckIfRegValueExists("HKEY_CURRENT_USER\Testing") 'False because without a backslash, tries to read as a string value, and it's really a key.
End Sub
Private Function CheckIfRegValueExists(strValueKey As String) As Boolean
    Dim Shell As Object
    Dim strTemp As String
   
    Set Shell = CreateObject("WScript.Shell")
    On Error Resume Next
    strTemp = Shell.RegRead(strValueKey)
     CheckIfRegValueExists = Not (Err.Number = -2147024894)

     Set Shell = Nothing
   'On Error GoTo 0
End Function
I agree, but the problem I have is that I have a load of Strings under a key which get processed and as they do so, they get deleted. The reason I need this is to ensure there are no more strings to be processed. If (default) is set to nothing (as opposed to (Value not set) then this gives me a false positive. I can set (default) to (value not set) if I simply run .reg file containing '@=-' but I just want a way to do this in vbs.
I have managed to circumvent the issue another way so don't spend too much time thinking about it if indeed you are! It would be interesting to know though as I've not been able to locate anyone who knows the answer yet. I suspect it maybe impossible.
Is it an option to just delete the key and recreate?
No because the key contains several strings which need processing.
As I said I have got round the issue another way (irrelevant for this forum) and your solution is working a treat, thanks.