Retrieving values from Registry

[Harini]

Hello,

Can anyone tell me how I can retrieve the value of a key in HKEY_LOCAL_MACHINE\SOFTWARE\Sample\Date.

Thanks
Harini

[Sharathms]

Hi use this function

Const HKEY_LOCAL_MACHINE = &H80000002
Const KEY_ALL_ACCESS = &H2003F
Const KEY_READ = &H20019
private Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" (byval hKey as Long, byval lpSubKey as string, byval ulOptions as Long, byval samDesired as Long, byref phkResult as Long) as Long
private Declare Function RegQueryValueEx Lib "advapi32" Alias "RegQueryValueExA" (byval hKey as Long, byval lpValueName as string, byval lpReserved as Long, byref lpType as Long, byval lpData as string, byref lpcbData as Long) as Long
private Declare Function RegCloseKey Lib "advapi32" (byval hKey as Long) as Long

public Function GetKeyValue(KeyRoot as Long, KeyName as string, SubKeyRef as string, byref KeyVal as string) as Boolean
Dim i as Long ' Loop Counter
Dim rc as Long ' Return Code
Dim hKey as Long ' Handle to An Open Registry Key
Dim hDepth as Long '
Dim KeyValType as Long ' Data Type Of A Registry Key
Dim tmpVal as string ' Tempory Storage for A Registry Key Value
Dim KeyValSize as Long ' Size Of Registry Key Variable
'------------------------------------------------------------
' Open RegKey Under KeyRoot {HKEY_LOCAL_MACHINE...}
'------------------------------------------------------------
rc = RegOpenKeyEx(KeyRoot, KeyName, 0, KEY_READ, hKey) ' Open Registry Key


If (rc <> ERROR_SUCCESS) then GoTo GetKeyError ' Handle error...


tmpVal = string$(1024, 0) ' Allocate Variable Space
KeyValSize = 1024 ' Mark Variable Size


'------------------------------------------------------------
' Retrieve Registry Key Value...
'------------------------------------------------------------
rc = RegQueryValueEx(hKey, SubKeyRef, 0, KeyValType, tmpVal, KeyValSize) ' get/Create Key Value


If (rc <> ERROR_SUCCESS) then GoTo GetKeyError ' Handle Errors


tmpVal = VBA.Left(tmpVal, InStr(tmpVal, VBA.Chr(0)) - 1)
'------------------------------------------------------------
' Determine Key Value Type for Conversion...
'------------------------------------------------------------
Select Case KeyValType ' Search Data Types...
Case REG_SZ ' string Registry Key Data Type
KeyVal = tmpVal ' Copy string Value
Case REG_DWORD ' Double Word Registry Key Data Type
for i = len(tmpVal) to 1 step -1 ' Convert Each Bit
KeyVal = KeyVal + Hex(Asc(mid(tmpVal, i, 1))) ' Build Value Char. By Char.
next
KeyVal = Format$("&h" + KeyVal) ' Convert Double Word to string
End Select


GetKeyValue = true ' Return Success
rc = RegCloseKey(hKey) ' Close Registry Key
Exit Function ' Exit


GetKeyError: ' Cleanup After An error Has Occured...
KeyVal = "" ' set Return Val to empty string
GetKeyValue = false ' Return Failure
rc = RegCloseKey(hKey) ' Close Registry Key
End Function



'call this function like this..
Dim SysInfoPath as string

If GetKeyValue(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Shared Tools\MSINFO", "PATH", SysInfoPath) then
MsgBox SysInfoPath
End If

[Ghost308]

If you're comfortable with the windows API, the method Sharathms posted is as good as it gets... that is some nice vb code. If the API is a little daunting, there is an easier method using Windows Script Host objects that Iouri showed me in a post not too long ago...

http://www.codeguru.com/cgi-bin/bbs/wt/showpost.pl?Board=vb&Number=55521


Paste the code into a module on your project and watch it work its majic. Give Iouri lots of points too because this code rocks.

[Harini]

Hello,

Thanks for the prompt reply, but a null string is being retrieved when I use it for HKEY_LOCAL_MACHINE\SOFTWARE\Sample\Date.

The key is already present in the registry, I am not writing it using the code that you have mentioned.
The value in for Date is a string value and the value is present in the above path in the Registry.

Thanks
Harini

[Harini]

Hello,

I am sorry... it is working. I had to give HKLM\Software\Sample\Date\Date.

Thanks A Lot

Thanks
Harini

[michi]

Hi,
I have a function as below. Try to call RegReadValue("SOFTWARE\Sample", "Date", rvarResult, rstrError) .

Hope this helps.

'===========Module============
Option Explicit
'Key Types
Public Const HKEY_CLASSES_ROOT = &H80000000
Public Const HKEY_CURRENT_USER = &H80000001
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const HKEY_USERS = &H80000003
Public Const HKEY_PERFORMANCE_DATA = &H80000004

'Value Types
Public Const REG_SZ As Long = 1
Public Const REG_DWORD As Long = 4

'Constants
Public Const STANDARD_RIGHTS_ALL = &H1F0000
Public Const KEY_CREATE_LINK = &H20
Public Const KEY_CREATE_SUB_KEY = &H4
Public Const KEY_ENUMERATE_SUB_KEYS = &H8
Public Const KEY_EVENT = &H1
Public Const KEY_NOTIFY = &H10
Public Const KEY_QUERY_VALUE = &H1
Public Const KEY_SET_VALUE = &H2
Public Const KEYEVENTF_EXTENDEDKEY = &H1
Public Const KEYEVENTF_KEYUP = &H2
Public Const SYNCHRONIZE = &H100000
Public Const READ_CONTROL = &H20000
Public Const STANDARD_RIGHTS_READ = (READ_CONTROL)
Public Const STANDARD_RIGHTS_WRITE = (READ_CONTROL)
Public Const KEY_READ = ((STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) And (Not SYNCHRONIZE))
Public 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))
Public Const KEY_EXECUTE = (KEY_READ)
Public Const KEY_WRITE = ((STANDARD_RIGHTS_WRITE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY) And (Not SYNCHRONIZE))

'Error Constants
Public Const ERROR_NONE = 0

'Registry Declares
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 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 RegQueryValueExLong Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Long, 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 lpValue As String, ByVal cbData As Long) As Long
Private Declare Function RegSetValueExLong Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpValue As Long, ByVal cbData As Long) As Long

'*==========================================================================
'* Name: RegReadValue()
'* Purpose: This will return the contents of a registry "value". As in Root\Key\Key\Value
'*
'* Inputs:
'* strKeyName As String The name of the Key the value is located in.
'* strValueName As String The value name. E.G. "ConfigDBPath"
'* valResult As Variant The Returned contents of the value
'*
'* Outputs: Returned Error Number. If non-Zero then there was an error.
'* strError The error text if an error occured.
'* Will include API error messages.
'* Error Codes: Zero = Success NonZero = Error
'*-------------------------------------------------------------------------
'* Modifications:
'*=========================================================================
Public Function RegReadValue(strKeyName As String, strValueName As String, ByRef varResult As Variant, Optional strError As String) As Long

Dim lngRV As Long 'result of the API functions
Dim hKey As Long 'handle of opened key
Dim lngSize As Long 'Size of data type
Dim lngType As Long 'The data type of this value
Dim lngValue As Long 'Type cast result into a long
Dim strValue As String 'Type cast result into a string
Dim blnContinue As Boolean 'Continue execution or jump to cleanup section.

On Error GoTo ErrorTrap

'Start with assuming that we should continue execution
blnContinue = True

'Open the Key
lngRV = RegOpenKeyEx(HKEY_LOCAL_MACHINE, strKeyName, 0, KEY_READ, hKey)
If lngRV <> ERROR_NONE Then
blnContinue = False
End If

If blnContinue Then
' Determine the size and type of data to be read
lngRV = RegQueryValueExNULL(hKey, strValueName, 0&, lngType, 0&, lngSize)
If lngRV <> ERROR_NONE Then
blnContinue = False
End If
End If

If blnContinue Then
'Get the value
Select Case lngType
' For strings
Case REG_SZ:
strValue = String(lngSize, 0)
lngRV = RegQueryValueExString(hKey, strValueName, 0&, lngType, strValue, lngSize)
If lngRV = ERROR_NONE Then
varResult = Left$(strValue, lngSize)
Else
varResult = Empty
End If
' For DWORDS
Case REG_DWORD:
lngRV = RegQueryValueExLong(hKey, strValueName, 0&, lngType, lngValue, lngSize)
If lngRV = ERROR_NONE Then
varResult = lngValue
End If
' For Others
Case Else
'all other data types not supported
lngRV = -1
varResult = Empty
End Select

If lngRV <> ERROR_NONE Then
blnContinue = False
End If
End If 'blnContinue

If blnContinue Then
'Remove trailing NULL character if exists
If UCase(TypeName(varResult)) = "STRING" And Len(varResult) > 0 Then
If Right(varResult, 1) = Chr(0) Then
varResult = Left(varResult, Len(varResult) - 1)
End If
End If

'Close the key
lngRV = RegCloseKey(hKey)
End If 'blnContinue

'Cleanup
'-1 means data type not supported.
If lngRV <> ERROR_NONE Then
strError = "Unexpect error"
'Make sure the key is closed if an error occured
Call RegCloseKey(hKey)
End If

'Check for special error number
If lngRV = -1 Then
strError = "Unsupported data type " & lngType
End If

RegReadValue = lngRV
Exit Function
ErrorTrap:
RegReadValue = Err.Number
strError = Err.Description
End Function


'========Form===========
Private Sub Command1_Click()
Dim rvarResult As Variant
Dim rstrError As String
If RegReadValue("SOFTWARE\Sample", "Date", rvarResult, rstrError) <> 0 Then
MsgBox rstrError, , "Error"
Else
MsgBox rvarResult
End If
End Sub

Regards,

Michi
MCSE, MCDBA