Author: Calvin Smith
http://www.CalvinSmithSoftware.com/codedisk/sneakpeek.htm

The following code will allow a developer to programmatically
query the registry for various entries without hard-coding


'We need the following API declarations first...

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 Any, _
     ByRef lpcbData As Long) As Long

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 RegCloseKey Lib "advapi32" (ByVal hKey As Long) As Long

'Add more keys here, if needed
Public Const HKEY_CLASSES_ROOT = &H80000000
Public Const HKEY_CURRENT_USER = &H80000001
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const HKEY_USERS = &H80000003

' Reg Key Security Options...
Public Const READ_CONTROL = &H20000
Public Const KEY_QUERY_VALUE = &H1
Public Const KEY_SET_VALUE = &H2
Public Const KEY_CREATE_SUB_KEY = &H4
Public Const KEY_ENUMERATE_SUB_KEYS = &H8
Public Const KEY_NOTIFY = &H10
Public Const KEY_CREATE_LINK = &H20
Public Const KEY_ALL_ACCESS = KEY_QUERY_VALUE + KEY_SET_VALUE + _
          KEY_CREATE_SUB_KEY + KEY_ENUMERATE_SUB_KEYS + _
          KEY_NOTIFY + KEY_CREATE_LINK + READ_CONTROL

Public Const STANDARD_RIGHTS_READ = &H20000
Public Const SYNCHRONIZE = &H100000

Public Const KEY_READ = ((STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) And (Not SYNCHRONIZE))

Public Const ERROR_SUCCESS = 0

Function GetRegistryEntry(lAnyKeyRoot As Long, _
KeyName As String, SubKeyRef As String) As Variant

On Error GoTo ErrorHandling_Err

' ---------------------------------------------------------------------------------
' Author: Calvin Smith - JobForCalvin@Yahoo.com
' Environment(s): MS Access (32-bit) / Visual Basic (32-bit)
' ---------------------------------------------------------------------------------
'
'   *****************************************
'   * Courtesy code from my CodeDisk© product
'   *****************************************
   '
   ' ----------------------------------------------------------------------------
   ' Purpose: Example of how to query the Registry for a subkey value
   '
   ' Accepts: lAnyKeyRoot, KeyName, and SubKeyRef
   '
   ' Returns: The value of the subkey that is being queried
   '
   ' Example:
   '        GetRegistryEntry(HKEY_LOCAL_MACHINE,"HARDWARE\DESCRIPTION\SYSTEM","SystemBiosDate")
   ' ----------------------------------------------------------------------------
   '
Dim lRetVal As Long
Dim hKey As Long
Dim KeyValType As Long
Dim strTmpVal As String
Dim KeyValSize As Long

'------------------------------------------------------------
' Open the root key (i.e. HKEY_LOCAL_MACHINE)
'------------------------------------------------------------
lRetVal& = RegOpenKeyEx(lAnyKeyRoot&, KeyName, 0, KEY_READ, hKey)

If (lRetVal& <> ERROR_SUCCESS) Then GoTo ErrorHandling_Err

strTmpVal = String$(1024, 0)

KeyValSize = 1024

'------------------------------------------------------------
' Retrieve the registry key value
'------------------------------------------------------------
lRetVal& = RegQueryValueEx(hKey, SubKeyRef, 0, _
         KeyValType, strTmpVal, KeyValSize)

If (lRetVal& <> ERROR_SUCCESS) Then GoTo ErrorHandling_Err

'------------------------------------------------------------
' Win95 adds a null terminated string and NT does not.
' So, we strip it off below, if necessary
'------------------------------------------------------------

    If (Asc(Mid(strTmpVal, KeyValSize, 1)) = 0) Then
        strTmpVal = Left(strTmpVal, KeyValSize - 1)
    Else
        strTmpVal = Left(strTmpVal, KeyValSize)
    End If

    GetRegistryEntry = strTmpVal

    lRetVal& = RegCloseKey(hKey)

    Exit Function

ErrorHandling_Exit:
   Exit Function

ErrorHandling_Err:

   If Err Then
       'Trap your error(s) here, if any!
       GetRegistryEntry = False
       lRetVal& = RegCloseKey(hKey)
       Resume ErrorHandling_Exit
   End If

End Function