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.
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.
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_CURR ENT_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
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
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("HKC U\Software \Test")
End Sub
Private Function CheckIfRegValueExists(strV alueKey As String) As Boolean
Dim Shell As Object
Dim strTemp As String
Set Shell = CreateObject("WScript.Shel l")
On Error Resume Next
strTemp = Shell.RegRead(strValueKey)
CheckIfRegValueExists = Not (Err.Number = -2147024894)
Set Shell = Nothing
'On Error GoTo 0
End Function
Private Sub Form_Load()
MsgBox CheckIfRegValueExists("HKC
End Sub
Private Function CheckIfRegValueExists(strV
Dim Shell As Object
Dim strTemp As String
Set Shell = CreateObject("WScript.Shel
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.
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.
ASKER
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!
Anyway, perfect, exactly what I was looking for. Nice one!
ASKER
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. 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 mean the (Default) value under any key? For me, they are all (Value not set) in regedit already. Give me an example.
ASKER
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.
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("HKE Y_CURRENT_ USER\Testi ng\") 'True because it picks up the default value of the key. If the default is "not set" then false.
MsgBox CheckIfRegValueExists("HKE Y_CURRENT_ USER\Testi ng\test") 'False because there is no test string value
MsgBox CheckIfRegValueExists("HKE Y_CURRENT_ USER\Testi ng") 'False because without a backslash, tries to read as a string value, and it's really a key.
End Sub
Private Function CheckIfRegValueExists(strV alueKey As String) As Boolean
Dim Shell As Object
Dim strTemp As String
Set Shell = CreateObject("WScript.Shel l")
On Error Resume Next
strTemp = Shell.RegRead(strValueKey)
CheckIfRegValueExists = Not (Err.Number = -2147024894)
Set Shell = Nothing
'On Error GoTo 0
End Function
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("HKE
MsgBox CheckIfRegValueExists("HKE
MsgBox CheckIfRegValueExists("HKE
End Sub
Private Function CheckIfRegValueExists(strV
Dim Shell As Object
Dim strTemp As String
Set Shell = CreateObject("WScript.Shel
On Error Resume Next
strTemp = Shell.RegRead(strValueKey)
CheckIfRegValueExists = Not (Err.Number = -2147024894)
Set Shell = Nothing
'On Error GoTo 0
End Function
ASKER
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.
ASKER
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?
ASKER
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.
As I said I have got round the issue another way (irrelevant for this forum) and your solution is working a treat, thanks.
(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
' 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