Code:
Attribute VB_Name = "Registry"
' {group:DJAddIn}
'
' Description:
' This is a fairly general implementation of an
'  interface to the Win32 registry.
'
' Remarks:
' This is a fairly general implementation of an
'  interface to the Win32 registry.

Option Explicit

' These are documented in the Win32 Docs...

' {secret}
Public Const HKEY_CLASSES_ROOT = &H80000000
' {secret}
Public Const HKEY_LOCAL_MACHINE = &H80000002

Private Const ERROR_SUCCESS = 0&
Private Const ERROR_NO_MORE_ITEMS = 259&

Private Const REG_SZ = 1
Private Const REG_BINARY = 3
Private Const REG_DWORD = 4

Private Declare Function OSRegOpenKey Lib "advapi32" Alias "RegOpenKeyA" _
  (ByVal hkey As Long, ByVal lpszSubKey As String, phkResult As Long) As Long
Private Declare Function OSRegQueryValueEx Lib "advapi32" Alias "RegQueryValueExA" _
  (ByVal hkey As Long, ByVal lpszValueName As String, ByVal dwReserved As Long, _
   lpdwType As Long, lpbData As Any, cbData As Long) As Long
Private Declare Function OSRegCloseKey Lib "advapi32" Alias "RegCloseKey" _
  (ByVal hkey As Long) As Long
Private Declare Function OSRegEnumKey Lib "advapi32" Alias "RegEnumKeyA" _
  (ByVal hkey As Long, ByVal iSubKey As Long, _
   ByVal lpszName As String, ByVal cchName As Long) As Long
Private Declare Function OSRegEnumValue Lib "advapi32" Alias "RegEnumValueA" _
  (ByVal hkey As Long, ByVal iSubKey As Long, ByVal valueName As String, vnLen As Long, _
   ByVal reserved As Long, dtype As Long, lpbData As Any, dataSize As Long) As Long

' Description: Opens a key in the registry.
'
' Arguments:
'  hkey - An open registry key (as returned by this
'         call, that is) or one of HKEY_LOCAL_MACHINE
'         et. al.
'  relKeyName - A path to the subkey (of hkey) to open.
'
' Results:
'  The newly opened key or 0 if an error happened.
Public Function OpenKey(ByVal hkey As Long, ByVal relKeyName As String) As Long
  Dim key As Long
  Dim rc As Long

  rc = OSRegOpenKey(hkey, relKeyName, key)
  If (rc = ERROR_SUCCESS) Then
    OpenKey = key
  Else
    OpenKey = 0
  End If
End Function


' Description: This fetches a value from the registry.
'
' Remarks:
' Note: The caller is responsible for making sure
'       that result is of the expected type.
'
' Arguments:
'   hkey - the key which the value comes from.
'   valName - the value to get
'   value - a variant that will be filled by
'           whatever value was in the registry.
'
' Returns:
'   *True* on success, *False* otherwise.
Public Function QueryValue(ByVal hkey As Long, ByVal valName As String, value) As Boolean
  Dim rc As Long
  Dim t As Long
  Dim dataLen As Long
  Dim data As String
  Dim l As Long

  rc = OSRegQueryValueEx(hkey, valName, 0&, t, ByVal 0&, dataLen)
  QueryValue = False
  If rc <> ERROR_SUCCESS Then
    Debug.Print "Registry.QueryValue: Failed to get type"
    Exit Function
  End If
  
  Select Case t
  Case REG_SZ
    data = String(dataLen, " ")
    rc = OSRegQueryValueEx(hkey, valName, 0&, 0&, ByVal data, dataLen)
    If rc = ERROR_SUCCESS Then
      value = StripTerminator(data)
    Else
      Debug.Print "Registry.QueryValue: Failed to get string value"
      Exit Function
    End If
  Case REG_DWORD
    dataLen = 4
    rc = OSRegQueryValueEx(hkey, valName, 0&, 0&, l, dataLen)
    If rc = ERROR_SUCCESS Then
      value = l
    Else
      Debug.Print "Registry.QueryValue: Failed to get DWORD value"
      Exit Function
    End If
    
  Case Else
    Debug.Print "Registry.QueryValue: Can't figure out the type"
    Exit Function
  End Select
  QueryValue = True
End Function

' Description: Closes a registry key
'
' Arguments:
'   hkey - The handle of the key
'
' Remarks:
'   This closes the registry key, hkey.  It should be a value
'     returned by OpenKey.
Public Sub CloseKey(ByVal hkey)
  OSRegCloseKey (hkey)
End Sub

' Description: Gets rid of a bogus trailing null character
'
' Arguments:
'  strString - The string containing the bogus character
'
' Return Value:
'  The string with the null removed.
'
' Remarks:
'  I haven't the slightest why this should be ncessary, but
'  the example I saw did it, so what the heck.
Private Function StripTerminator(ByVal strString As String) As String
    Dim intZeroPos As Integer

    intZeroPos = InStr(strString, Chr$(0))
    If intZeroPos > 0 Then
        StripTerminator = Left$(strString, intZeroPos - 1)
    Else
        StripTerminator = strString
    End If
End Function