Planet Source Code Jumbo …e CD Visual Basic 1 to 7/4_2005-2006.ISO/data/Zips/SDS!_-_Sec1986884132006.psc/clsLightning.cls

Text File | 2006-04-13 | 63KB | 1,984 lines

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsLightning"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

'***************************************************************************************
'*  Lightning!   1.6.5 Standalone Registry Control Class                               *
'*                                                                                     *
'*  Created:     November 13, 2005                                                     *
'*  Updated:     April 12, 2006                                                        *
'*  Purpose:     Comprehensive Registry Control Class                                  *
'*  Functions:   (listed)                                                              *
'*  Revision:    1.6.5                                                                 *
'*  Compile:     Native                                                                *
'*  Referenced:  Throughout Project                                                    *
'*  Author:      John Underhill (Steppenwolfe)                                         *
'*                                                                                     *
'***************************************************************************************

'/~  List of exposed functions ~/

'/~  Value Types ~/
'/~  Access_Check - Test user access rights
'/~  Read_BEndian - read a big endian value
'/~  Write_BEndian - write a big_endian value
'/~  Read_Binary - read a binary value
'/~  Write_Binary - write a binary value
'/~  Read_Dword - read a dword value
'/~  Write_Dword - write a dword value
'/~  Read_Link - read a binary link value
'/~  Write_Link - write a binary link value
'/~  List_Data - list all data blocks in a subkeys values
'/~  List_Values - puts all of a keys values into a collection
'/~  Read_LEndian - read a little endian value
'/~  Write_LEndian - write a little_endian value
'/~  Read_Multi - read a multi_sz value
'/~  Write_Multi - write a multi_sz value
'/~  Read_MultiCN - reads a multi value and splits into a collection
'/~  Write_MultiCN - converts a collection into a multi_sz value
'/~  Write_Qword - write a 64bit dword number
'/~  Read_Qword - read a 64bit dword number
'/~  Read_ResDescriptor - read hardware resource description (hex)binary
'/~  Write_ResDescriptor = write hardware resource description (hex)binary
'/~  Read_ResourceList - read a hardware resource list (hex)binary
'/~  Write_ResourceList - write to a hardware resource list (hex)binary
'/~  Read_ResRequired - read a hardware resource requirements list (hex)binary
'/~  Write_ResRequired - write to a hardware resource requirements list (hex)binary
'/~  Read_String - read a string(sz) or expanded string(expand_sz)
'/~  Write_String - write a string value
'/~  Write_Expanded - write an expanded string value

'/~  Key Related Functions ~/
'/~  List_Keys - puts all subkeys under specified branch into a collection
'/~  Key_Exists - test if key exists
'/~  Create_Key - create a new key
'/~  Delete_Key - delete a key

'/~  Value Related Functions ~/
'/~  Write_Value - write value types: 1)sz 2)expand_sz 3)multi_sz 4)binary 5)dword 6)little_endian 7)big_endian
'/~  Delete_Value - delete a value
'/~  Search_Value - search for a value under the key

'/~  Conversion Routines ~/
'/~  Make_LEndian16 - convert integer to 16bit little_endian
'/~  Make_LEndian32 - convert long to 32bit little_endian
'/~  Make_BEndian32 - convert long to big endian format

'/~  Error Logging ~/
'/~  Get_Error - interprets errors passed from dll
'/~  Log_Error - sends errors to a log file

Public Event ErrorCond(ByVal sRoutine As String, ByVal sKey As String, ByVal sError As String)

'/* time structure
Private Type FILETIME
    dwLowDateTime                              As Long
    dwHighDateTime                             As Long
End Type

'/* security structure
Private Type SECURITY_ATTRIBUTES
    nLength                                    As Long
    lpSecurityDescriptor                       As Long
    bInheritHandle                             As Boolean
End Type

'key constants
Public Enum HKEY_Type
    HKEY_CLASSES_ROOT = &H80000000
    HKEY_CURRENT_USER = &H80000001
    HKEY_LOCAL_MACHINE = &H80000002
    HKEY_USERS = &H80000003
    HKEY_PERFORMANCE_DATA = &H80000004
    HKEY_CURRENT_CONFIG = &H80000005
    HKEY_DYN_DATA = &H80000006
End Enum

'/* value types
Public Enum Reg_Type
    REG_NONE = 0                            '/* No value type
    REG_SZ = 1                              '/* Unicode NULL terminated string
    REG_EXPAND_SZ = 2                       '/* Unicode NULL terminated string
    REG_BINARY = 3                          '/* Binary data
    REG_DWORD = 4                           '/* 32-bit number
    REG_DWORD_LITTLE_ENDIAN = 4             '/* 32-bit number
    REG_DWORD_BIG_ENDIAN = 5                '/* 32-bit number, high byte first
    REG_LINK = 6                            '/* Unicode symbolic link
    REG_MULTI_SZ = 7                        '/* Array of Unicode strings
    REG_RESOURCE_LIST = 8                   '/* Hardware resource description
    REG_FULL_RESOURCE_DESCRIPTOR = 9        '/* Hardware resource description
    REG_RESOURCE_REQUIREMENTS_LIST = 10     '/* Resource requirements
    REG_QWORD_LITTLE_ENDIAN = 11            '/* 64bit dword value
End Enum

'/* access paramaters
Private Const KEY_ALL_ACCESS               As Long = &HF003F
Private Const KEY_CREATE_LINK              As Long = &H20
Private Const KEY_CREATE_SUB_KEY           As Long = &H4
Private Const KEY_ENUMERATE_SUB_KEYS       As Long = &H8
Private Const KEY_EXECUTE                  As Long = &H20019
Private Const KEY_NOTIFY                   As Long = &H10
Private Const KEY_QUERY_VALUE              As Long = &H1
Private Const KEY_READ                     As Long = &H20019
Private Const KEY_SET_VALUE                As Long = &H2
Private Const KEY_WRITE                    As Long = &H20006
Private Const REG_OPTION_NON_VOLATILE      As Long = &H0
Private Const REG_ERR_OK                   As Long = &H0
Private Const REG_ERR_NOT_EXIST            As Long = &H1
Private Const REG_ERR_NOT_STRING           As Long = &H2
Private Const REG_ERR_NOT_DWORD            As Long = &H4

'/* error handling
Private Const ERROR_NONE                   As Long = &H0
Private Const ERROR_BADDB                  As Long = &H1
Private Const ERROR_BADKEY                 As Long = &H2
Private Const ERROR_CANTOPEN               As Long = &H3
Private Const ERROR_CANTREAD               As Long = &H4
Private Const ERROR_CANTWRITE              As Long = &H5
Private Const ERROR_OUTOFMEMORY            As Long = &H6
Private Const ERROR_ARENA_TRASHED          As Long = &H7
Private Const ERROR_ACCESS_DENIED          As Long = &H8
Private Const ERROR_INVALID_PARAMETERS     As Long = &H57
Private Const ERROR_MORE_DATA              As Long = &HEA
Private Const ERROR_NO_MORE_ITEMS          As Long = &H103

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, _
                                                                     Source As Any, _
                                                                     ByVal Length 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 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 Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, _
                                                                                ByVal lpSubKey As String) As Long

Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, _
                                                                                    ByVal lpValueName As String) As Long

Private Declare Function RegCreatekey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, _
                                                                                ByVal lpSubKey As String, _
                                                                                phkResult 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, _
                                                                                    lpSecurityAttributes As SECURITY_ATTRIBUTES, _
                                                                                    phkResult As Long, _
                                                                                    lpdwDisposition As Long) As Long

Private Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, _
                                                                                  ByVal lpValueName As String, _
                                                                                  ByVal Reserved As Long, _
                                                                                  ByVal dwType As Long, _
                                                                                  lpData As Any, _
                                                                                  ByVal cbData As Long) As Long

Private Declare Function RegEnumKeyEx Lib "advapi32.dll" Alias "RegEnumKeyExA" (ByVal hKey As Long, _
                                                                                ByVal dwIndex As Long, _
                                                                                ByVal lpName As String, _
                                                                                lpcbName As Long, _
                                                                                lpReserved As Long, _
                                                                                ByVal lpClass As String, _
                                                                                lpcbClass As Long, _
                                                                                lpftLastWriteTime As FILETIME) As Long

Private Declare Function RegEnumValue Lib "advapi32.dll" Alias "RegEnumValueA" (ByVal hKey As Long, _
                                                                                ByVal dwIndex As Long, _
                                                                                ByVal lpValueName As String, _
                                                                                lpcbValueName As Long, _
                                                                                ByVal lpReserved As Long, _
                                                                                lpType As Long, _
                                                                                lpData As Byte, _
                                                                                lpcbData As Long) As Long

Private m_bIntercept    As Boolean
Private m_bLogging      As Boolean
Private m_bNotify       As Boolean


Public Property Let p_Intercept(PropVal As Boolean)
'/* enable error interception
    m_bIntercept = PropVal
End Property

Public Property Let p_Logging(PropVal As Boolean)
'/* enable error logging
    m_bLogging = PropVal
End Property

Public Property Let p_Notify(PropVal As Boolean)
'/* enable error notification
    m_bNotify = PropVal
End Property


'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
'                                              PROCESSING CORE
'<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<


Public Function Access_Test(ByVal RootKey As HKEY_Type, _
                            ByVal SubKey As String) As Boolean

'/* test user access

Dim lHKey           As Long
Dim lRetVal         As Long
Dim lDeposit        As Long
Dim tSecAttrib      As SECURITY_ATTRIBUTES

On Error GoTo Handler

    '/* security attributes
    With tSecAttrib
        .nLength = Len(tSecAttrib)
        .lpSecurityDescriptor = 0
        .bInheritHandle = 1
    End With

    '/* open key
    lRetVal = RegCreateKeyEx(RootKey, SubKey, 0, "", 0, KEY_WRITE, tSecAttrib, lHKey, lDeposit)
    If lRetVal = ERROR_NONE Then
        Access_Test = True
    End If

Handler:
    If lRetVal <> 0 Then
        If m_bIntercept Then
            Error_State lRetVal, "Access_Test", SubKey
        End If
    End If
    lRetVal = RegCloseKey(lHKey)
    On Error GoTo 0

End Function

Public Function Read_BEndian(ByVal RootKey As HKEY_Type, _
                             ByVal SubKey As String, _
                             ByVal Value As Variant) As String

'/* read an big_endian value
Dim lHKey           As Long
Dim lRetVal         As Long
Dim sBuffer         As String
Dim slength         As Long

On Error GoTo Handler

    '/* open root key
    lRetVal = RegOpenKeyEx(RootKey, SubKey, 0, KEY_ALL_ACCESS, lHKey)
    If Not lRetVal = ERROR_NONE Then GoTo Handler

    '/* create a buffer
    sBuffer = Space$(255)
    slength = 255

    '/* query key for string value
    lRetVal = RegQueryValueEx(lHKey, Value, 0, REG_DWORD_BIG_ENDIAN, ByVal sBuffer, slength)

    '/* remove null terminator and add value
    If lRetVal = ERROR_NONE Then
        sBuffer = Left$(sBuffer, slength - 1)
        Read_BEndian = sBuffer
    End If

Handler:
    '/* close key and set result
    If lRetVal <> 0 Then
        If m_bIntercept Then
            Error_State lRetVal, "Read_BEndian", SubKey
        End If
    End If
    lRetVal = RegCloseKey(lHKey)
    On Error GoTo 0

End Function

Public Sub Write_BEndian(ByVal RootKey As HKEY_Type, _
                         ByVal SubKey As String, _
                         ByVal Value As String, _
                         ByVal vData As Variant)

'/* write a big endian value (32b number)
Dim lHKey           As Long
Dim lRetVal         As Long
Dim lDeposit        As Long
Dim tSecAttrib      As SECURITY_ATTRIBUTES

On Error GoTo Handler

    '/* required security structure
    With tSecAttrib
        .nLength = Len(tSecAttrib)
        .lpSecurityDescriptor = 0
        .bInheritHandle = 1
    End With

    '/* open key and test access
    lRetVal = RegCreateKeyEx(RootKey, SubKey, 0, "", 0, KEY_WRITE, tSecAttrib, lHKey, lDeposit)
    If Not lRetVal = ERROR_NONE Then GoTo Handler

    '/* write value, set error, and close key
    lRetVal = RegSetValueEx(lHKey, Value, 0&, REG_DWORD_BIG_ENDIAN, vData, 4)

Handler:
    If lRetVal <> 0 Then
        If m_bIntercept Then
            Error_State lRetVal, "Write_BEndian", SubKey
        End If
    End If
    lRetVal = RegCloseKey(lHKey)
    On Error GoTo 0

End Sub

Public Function Read_Binary(ByVal RootKey As HKEY_Type, _
                            ByVal SubKey As String, _
                            ByVal Value As Variant) As Variant

'/* read a binary value
Dim lHKey           As Long
Dim lRetVal         As Long
Dim byBuffer()      As Byte
Dim lBuffersize     As Long
Dim sTemp           As String
Dim i               As Long

On Error GoTo Handler

    '/* open root key and test for value type
    lRetVal = RegOpenKeyEx(RootKey, SubKey, 0, KEY_ALL_ACCESS, lHKey)
    If Not lRetVal = ERROR_NONE Then GoTo Handler

    '/* get buffer size
    lRetVal = RegQueryValueEx(lHKey, Value, 0&, REG_BINARY, ByVal 0&, lBuffersize)

    '/* read into buffer
    If lRetVal = ERROR_NONE Then
        ReDim byBuffer(lBuffersize - 1) As Byte
        lRetVal = RegQueryValueEx(lHKey, Value, 0&, REG_BINARY, byBuffer(0), lBuffersize)
        '/* format value
        For i = 0 To UBound(byBuffer)
            sTemp = sTemp & Format$(Trim$(Hex$(byBuffer(i))), "0#")
        Next i
        '/* set value
        Read_Binary = LTrim$(sTemp)
    End If

Handler:
    '/* set error and close key
    If lRetVal <> 0 Then
        If m_bIntercept Then
            Error_State lRetVal, "Read_Binary", SubKey
        End If
    End If
    lRetVal = RegCloseKey(lHKey)
    On Error GoTo 0

End Function

Public Sub Write_Binary(ByVal RootKey As HKEY_Type, _
                        ByVal SubKey As String, _
                        ByVal Value As Variant, _
                        ByRef bData() As Byte)

'/* write a binary value
Dim lHKey           As Long
Dim lRetVal         As Long
Dim lDeposit        As Long
Dim tSecAttrib      As SECURITY_ATTRIBUTES

On Error GoTo Handler

    '/* security structure
    With tSecAttrib
        .nLength = Len(tSecAttrib)
        .lpSecurityDescriptor = 0
        .bInheritHandle = 1
    End With

    '/* test access
    lRetVal = RegCreateKeyEx(RootKey, SubKey, 0, "", 0, KEY_WRITE, tSecAttrib, lHKey, lDeposit)
    If Not lRetVal = ERROR_NONE Then GoTo Handler

    '/* write binary, set error, and close
    lRetVal = RegSetValueEx(lHKey, Value, 0&, REG_BINARY, bData(0), UBound(bData) + 1)

Handler:
    If lRetVal <> 0 Then
        If m_bIntercept Then
            Error_State lRetVal, "Write_Binary", SubKey
        End If
    End If
    lRetVal = RegCloseKey(lHKey)
    On Error GoTo 0

End Sub

Public Function Read_DWord(ByVal RootKey As HKEY_Type, _
                           ByVal SubKey As String, _
                           ByVal Value As Variant) As Long

'/* read a dword value
Dim lHKey           As Long
Dim lRetVal         As Long
Dim lBuffer         As Long

On Error GoTo Handler

    '/* open root key
    lRetVal = RegOpenKeyEx(RootKey, SubKey, 0, KEY_ALL_ACCESS, lHKey)
    If Not lRetVal = ERROR_NONE Then GoTo Handler

    '/* query value
    lRetVal = RegQueryValueEx(lHKey, Value, 0, REG_DWORD, lBuffer, 4)

    '/* set value
    If lRetVal = ERROR_NONE Then
        Read_DWord = lBuffer
    Else
        Read_DWord = 0
    End If

Handler:
    '/* close key
    If lRetVal <> 0 Then
        If m_bIntercept Then
            Error_State lRetVal, "Write_Binary", SubKey
        End If
    End If
    lRetVal = RegCloseKey(lHKey)
    On Error GoTo 0

End Function

Public Sub Write_DWord(ByVal RootKey As HKEY_Type, _
                       ByVal SubKey As String, _
                       ByVal Value As String, _
                       ByVal lData As Long)

'/* write a DWORD value
Dim lHKey           As Long
Dim lRetVal         As Long
Dim lDeposit        As Long
Dim tSecAttrib      As SECURITY_ATTRIBUTES

On Error GoTo Handler

    '/* required security structure
    With tSecAttrib
        .nLength = Len(tSecAttrib)
        .lpSecurityDescriptor = 0
        .bInheritHandle = 1
    End With

    '/* open key and test access
    lRetVal = RegCreateKeyEx(RootKey, SubKey, 0, "", 0, KEY_WRITE, tSecAttrib, lHKey, lDeposit)
    If Not lRetVal = ERROR_NONE Then GoTo Handler

    '/* write value, set error, and close key
    lRetVal = RegSetValueEx(lHKey, Value, 0&, REG_DWORD, lData, 4)

Handler:
    If lRetVal <> 0 Then
        If m_bIntercept Then
            Error_State lRetVal, "Write_DWord", SubKey
        End If
    End If
    lRetVal = RegCloseKey(lHKey)
    On Error GoTo 0

End Sub

Public Function Read_Link(ByVal RootKey As HKEY_Type, _
                          ByVal SubKey As String, _
                          ByVal Value As Variant) As Variant

'/* read a link value
Dim lHKey               As Long
Dim lRetVal             As Long
Dim byBuffer()          As Byte
Dim lBuffersize         As Long

On Error GoTo Handler

    '/* open root key and test for value type
    lRetVal = RegOpenKeyEx(RootKey, SubKey, 0, KEY_ALL_ACCESS, lHKey)
    If Not lRetVal = ERROR_NONE Then GoTo Handler

    '/* get buffer size
    lRetVal = RegQueryValueEx(lHKey, Value, 0&, REG_LINK, ByVal 0&, lBuffersize)

    '/* read into buffer
    If lRetVal = ERROR_NONE Then
        ReDim byBuffer(lBuffersize - 1) As Byte
        lRetVal = RegQueryValueEx(lHKey, Value, 0&, REG_LINK, byBuffer(0), lBuffersize)
        '/* set value
        Read_Link = byBuffer
    End If

Handler:
    '/* set error and close key
    If lRetVal <> 0 Then
        If m_bIntercept Then
            Error_State lRetVal, "Read_Link", SubKey
        End If
    End If
    lRetVal = RegCloseKey(lHKey)
    On Error GoTo 0

End Function

Public Sub Write_Link(ByVal RootKey As HKEY_Type, _
                      ByVal SubKey As String, _
                      ByVal Value As Variant, _
                      ByRef bData() As Byte)

'/* write a link value
Dim lHKey           As Long
Dim lRetVal         As Long
Dim lDeposit        As Long
Dim tSecAttrib      As SECURITY_ATTRIBUTES

On Error GoTo Handler

    '/* security structure
    With tSecAttrib
        .nLength = Len(tSecAttrib)
        .lpSecurityDescriptor = 0
        .bInheritHandle = 1
    End With

    '/* test access
    lRetVal = RegCreateKeyEx(RootKey, SubKey, 0, "", 0, KEY_WRITE, tSecAttrib, lHKey, lDeposit)
    If Not lRetVal = ERROR_NONE Then GoTo Handler

    '/* write link, set error, and close
    lRetVal = RegSetValueEx(lHKey, Value, 0&, REG_LINK, bData(0), UBound(bData) + 1)

Handler:
    If lRetVal <> 0 Then
        If m_bIntercept Then
            Error_State lRetVal, "Write_Link", SubKey
        End If
    End If
    lRetVal = RegCloseKey(lHKey)
    On Error GoTo 0

End Sub

Public Function Read_LEndian(ByVal RootKey As HKEY_Type, _
                             ByVal SubKey As String, _
                             ByVal Value As Variant) As Long

'/* read a dword value
Dim lHKey           As Long
Dim lRetVal         As Long
Dim lBuffer         As Long

On Error GoTo Handler

    '/* open root key
    lRetVal = RegOpenKeyEx(RootKey, SubKey, 0, KEY_ALL_ACCESS, lHKey)
    If Not lRetVal = ERROR_NONE Then GoTo Handler

    '/* query value
    lRetVal = RegQueryValueEx(lHKey, Value, 0, REG_DWORD_LITTLE_ENDIAN, lBuffer, 4)

    '/* set value
    If lRetVal = ERROR_NONE Then
        Read_LEndian = lBuffer
    Else
        Read_LEndian = 0
    End If

Handler:
    '/* close key
    If lRetVal <> 0 Then
        If m_bIntercept Then
            Error_State lRetVal, "Read_LEndian", SubKey
        End If
    End If
    lRetVal = RegCloseKey(lHKey)
    On Error GoTo 0

End Function

Public Sub Write_LEndian(ByVal RootKey As HKEY_Type, _
                         ByVal SubKey As String, _
                         ByVal Value As String, _
                         ByVal vData As Variant)

'/* write a little endian value (same as dword)

Dim lHKey           As Long
Dim lRetVal         As Long
Dim lDeposit        As Long
Dim tSecAttrib      As SECURITY_ATTRIBUTES

On Error GoTo Handler

    '/* required security structure
    With tSecAttrib
        .nLength = Len(tSecAttrib)
        .lpSecurityDescriptor = 0
        .bInheritHandle = 1
    End With

    '/* open key and test access
    lRetVal = RegCreateKeyEx(RootKey, SubKey, 0, "", 0, KEY_WRITE, tSecAttrib, lHKey, lDeposit)
    If Not lRetVal = ERROR_NONE Then GoTo Handler

    '/* write value, set error, and close key
    lRetVal = RegSetValueEx(lHKey, Value, 0&, REG_DWORD_LITTLE_ENDIAN, vData, 4)

Handler:
    If lRetVal <> 0 Then
        If m_bIntercept Then
            Error_State lRetVal, "Write_LEndian", SubKey
        End If
    End If
    lRetVal = RegCloseKey(lHKey)
    On Error GoTo 0

End Sub

Public Function Read_Multi(ByVal RootKey As HKEY_Type, _
                           ByVal SubKey As String, _
                           ByVal Value As String) As String

'/* read a multi_sz value

Dim lHKey           As Long
Dim lRetVal         As Long
Dim sBuffer         As String
Dim Length          As Long
Dim resString       As String
Dim resBinary()     As Byte

On Error GoTo Handler

    '/* open root key
    lRetVal = RegOpenKeyEx(RootKey, SubKey, 0, &HF003F, lHKey)
    If lRetVal = ERROR_NONE Then
        '/* get buffer size
        Length = 1024
        ReDim resBinary(0 To Length - 1) As Byte
        lRetVal = RegQueryValueEx(lHKey, Value, 0, &H7, resBinary(0), Length)
        '/* if more data, resize our byte array
        If lRetVal = &HEA Then
            ReDim resBinary(0 To Length - 1) As Byte
            lRetVal = RegQueryValueEx(lHKey, Value, 0, &H7, resBinary(0), Length)
        End If
        '/* read into buffer
        If lRetVal = ERROR_NONE Then
            resString = Space$(Length - 2)
            CopyMemory ByVal resString, resBinary(0), Length - 2
            sBuffer = resString
            If Len(Trim_Null(sBuffer)) > 0 Then
                Read_Multi = resString
            End If
        End If
    End If

Handler:
    '/* set error and close key
    If lRetVal <> 0 Then
        If m_bIntercept Then
            Error_State lRetVal, "Read_Multi", SubKey
        End If
    End If
    lRetVal = RegCloseKey(lHKey)
    On Error GoTo 0

End Function

Public Sub Write_Multi(ByVal RootKey As HKEY_Type, _
                       ByVal SubKey As String, _
                       ByVal Value As String, _
                       ByVal sData As String)

'/* write a multi-sz value
Dim lHKey           As Long
Dim lRetVal         As Long
Dim lDeposit        As Long
Dim tSecAttrib      As SECURITY_ATTRIBUTES

On Error GoTo Handler

    '/* security structure
    With tSecAttrib
        .nLength = Len(tSecAttrib)
        .lpSecurityDescriptor = 0
        .bInheritHandle = 1
    End With

    '/* test access
    lRetVal = RegCreateKeyEx(RootKey, SubKey, 0, "", 0, &H20006, tSecAttrib, lHKey, lDeposit)
    If Not lRetVal = ERROR_NONE Then GoTo Handler

    '/* write multi, set error, and close key
    lRetVal = RegSetValueEx(lHKey, Value, 0, &H7, ByVal sData, Len(sData))

Handler:
    If lRetVal <> 0 Then
        If m_bIntercept Then
            Error_State lRetVal, "Write_Multi", SubKey
        End If
    End If
    lRetVal = RegCloseKey(lHKey)
    On Error GoTo 0

End Sub

Public Function Read_MultiCN(ByVal RootKey As HKEY_Type, _
                             ByVal SubKey As String, _
                             ByVal KeyVal As String) As Collection

'//process multi_sz value
'//and return collection
Dim aTemp()         As String
Dim cTemp           As New Collection
Dim sTemp           As String
Dim l               As Long
Dim lReturn         As Long

On Error GoTo Handler

    Set cTemp = New Collection
    '//get multi string
    sTemp = Read_Multi(RootKey, SubKey, KeyVal)
    If Len(sTemp) = 0 Then GoTo Handler

    '//get values and add to collection
    aTemp = Split(sTemp, vbNullChar)
    For l = 0 To UBound(aTemp)
        cTemp.Add aTemp(l)
    Next l

Handler:
    '//test for error
    If Not lReturn = 0 Then
        If m_bIntercept Then
            Error_State lReturn, "Read_MultiCN", SubKey
        End If
    Else
        '//set collection and release library
        Set Read_MultiCN = cTemp
        Set cTemp = Nothing
    End If

End Function

Public Sub Write_MultiCN(ByVal RootKey As HKEY_Type, _
                         ByVal SubKey As String, _
                         ByVal KeyVal As String, _
                         ByVal DataSet As Collection)

'//process a collection and
'//write to registry as a
'//multi_sz entry
Dim sTemp           As String
Dim sValue          As String
Dim cTemp           As New Collection
Dim l               As Long
Dim lRetVal         As Long
Dim Item            As Variant

On Error GoTo Handler

    For Each Item In DataSet
        sTemp = sTemp & Item & vbNullChar
    Next
    '//add terminating null char
    sTemp = sTemp & vbNullChar
    '//write to registry
    Write_Multi RootKey, SubKey, KeyVal, sTemp

Handler:
    On Error GoTo 0

End Sub

Public Function Read_QWord(ByVal RootKey As HKEY_Type, _
                           ByVal SubKey As String, _
                           ByVal Value As Variant) As Currency

'/* read a qword value
Dim lHKey           As Long
Dim lRetVal         As Long
Dim lBuffer         As Long

On Error GoTo Handler

    '/* open root key
    lRetVal = RegOpenKeyEx(RootKey, SubKey, 0, KEY_ALL_ACCESS, lHKey)
    If Not lRetVal = ERROR_NONE Then GoTo Handler

    '/* query value
    lRetVal = RegQueryValueEx(lHKey, Value, 0, REG_QWORD_LITTLE_ENDIAN, lBuffer, 4)
    '/* set value
    If lRetVal = ERROR_NONE Then
        Read_QWord = lBuffer
    Else
        Read_QWord = 0
    End If

Handler:
    '/* close key
    If lRetVal <> 0 Then
        If m_bIntercept Then
            Error_State lRetVal, "Read_QWord", SubKey
        End If
    End If
    lRetVal = RegCloseKey(lHKey)
    On Error GoTo 0

End Function

Public Sub Write_QWord(ByVal RootKey As HKEY_Type, _
                            ByVal SubKey As String, _
                            ByVal Value As String, _
                            ByVal cData As Currency)

'/* write a DWORD value
Dim lHKey           As Long
Dim lRetVal         As Long
Dim lDeposit        As Long
Dim tSecAttrib      As SECURITY_ATTRIBUTES

On Error GoTo Handler

    '/* required security structure
    With tSecAttrib
        .nLength = Len(tSecAttrib)
        .lpSecurityDescriptor = 0
        .bInheritHandle = 1
    End With

    '/* open key and test access
    lRetVal = RegCreateKeyEx(RootKey, SubKey, 0, "", 0, KEY_WRITE, tSecAttrib, lHKey, lDeposit)
    If Not lRetVal = ERROR_NONE Then GoTo Handler

    '/* write value, set error, and close key
    lRetVal = RegSetValueEx(lHKey, Value, 0&, REG_QWORD_LITTLE_ENDIAN, cData, 4)

Handler:
    If lRetVal <> 0 Then
        If m_bIntercept Then
            Error_State lRetVal, "Write_QWord", SubKey
        End If
    End If
    lRetVal = RegCloseKey(lHKey)
    On Error GoTo 0

End Sub

Public Function Read_ResourceList(ByVal RootKey As HKEY_Type, _
                                  ByVal SubKey As String, _
                                  ByVal Value As Variant) As Variant

'/* read a resource list value(binary)
Dim lHKey           As Long
Dim lRetVal         As Long
Dim byBuffer()      As Byte
Dim lBuffersize     As Long

On Error GoTo Handler

    '/* open root key and test for value type
    lRetVal = RegOpenKeyEx(RootKey, SubKey, 0, KEY_ALL_ACCESS, lHKey)
    If Not lRetVal = ERROR_NONE Then GoTo Handler

    '/* get buffer size
    lRetVal = RegQueryValueEx(lHKey, Value, 0&, REG_RESOURCE_LIST, ByVal 0&, lBuffersize)

    '/* read into buffer
    If lRetVal = ERROR_NONE Then
        ReDim byBuffer(lBuffersize - 1) As Byte
        lRetVal = RegQueryValueEx(lHKey, Value, 0&, REG_RESOURCE_LIST, byBuffer(0), lBuffersize)
        '/* set value
        Read_ResourceList = byBuffer
    End If

Handler:
    '/* set error and close key
    If lRetVal <> 0 Then
        If m_bIntercept Then
            Error_State lRetVal, "Read_ResourceList", SubKey
        End If
    End If
    lRetVal = RegCloseKey(lHKey)
    On Error GoTo 0

End Function

Public Sub Write_ResourceList(ByVal RootKey As HKEY_Type, _
                              ByVal SubKey As String, _
                              ByVal Value As Variant, _
                              ByRef bData() As Byte)

'/* write a resource list value(binary)
Dim lHKey           As Long
Dim lRetVal         As Long
Dim lDeposit        As Long
Dim tSecAttrib      As SECURITY_ATTRIBUTES

On Error GoTo Handler

    '/* security structure
    With tSecAttrib
        .nLength = Len(tSecAttrib)
        .lpSecurityDescriptor = 0
        .bInheritHandle = 1
    End With

    '/* test access
    lRetVal = RegCreateKeyEx(RootKey, SubKey, 0, "", 0, KEY_WRITE, tSecAttrib, lHKey, lDeposit)
    If Not lRetVal = ERROR_NONE Then GoTo Handler

    '/* write resource, set error, and close
    lRetVal = RegSetValueEx(lHKey, Value, 0&, REG_RESOURCE_LIST, bData(0), UBound(bData) + 1)

Handler:
    If lRetVal <> 0 Then
        If m_bIntercept Then
            Error_State lRetVal, "Write_ResourceList", SubKey
        End If
    End If
    lRetVal = RegCloseKey(lHKey)
    On Error GoTo 0

End Sub

Public Function Read_ResDescriptor(ByVal RootKey As HKEY_Type, _
                                   ByVal SubKey As String, _
                                   ByVal Value As Variant) As Variant

'/* read a resource list value(binary)
Dim lHKey           As Long
Dim lRetVal         As Long
Dim byBuffer()      As Byte
Dim lBuffersize     As Long

On Error GoTo Handler

    '/* open root key and test for value type
    lRetVal = RegOpenKeyEx(RootKey, SubKey, 0, KEY_ALL_ACCESS, lHKey)
    If Not lRetVal = ERROR_NONE Then GoTo Handler

    '/* get buffer size
    lRetVal = RegQueryValueEx(lHKey, Value, 0&, REG_FULL_RESOURCE_DESCRIPTOR, ByVal 0&, lBuffersize)

    '/* read into buffer
    If lRetVal = ERROR_NONE Then
        ReDim byBuffer(lBuffersize - 1) As Byte
        lRetVal = RegQueryValueEx(lHKey, Value, 0&, REG_FULL_RESOURCE_DESCRIPTOR, byBuffer(0), lBuffersize)
        '/* set value
        Read_ResDescriptor = byBuffer
    End If

Handler:
    '/* set error and close key
    If lRetVal <> 0 Then
        If m_bIntercept Then
            Error_State lRetVal, "Read_ResDescriptor", SubKey
        End If
    End If
    lRetVal = RegCloseKey(lHKey)
    On Error GoTo 0

End Function

Public Sub Write_ResDescriptor(ByVal RootKey As HKEY_Type, _
                               ByVal SubKey As String, _
                               ByVal Value As Variant, _
                               ByRef bData() As Byte)

'/* write a resource list value(binary)
Dim lHKey           As Long
Dim lRetVal         As Long
Dim lDeposit        As Long
Dim tSecAttrib      As SECURITY_ATTRIBUTES

On Error GoTo Handler

    '/* security structure
    With tSecAttrib
        .nLength = Len(tSecAttrib)
        .lpSecurityDescriptor = 0
        .bInheritHandle = 1
    End With

    '/* test access
    lRetVal = RegCreateKeyEx(RootKey, SubKey, 0, "", 0, KEY_WRITE, tSecAttrib, lHKey, lDeposit)
    If Not lRetVal = ERROR_NONE Then GoTo Handler

    '/* write resource, set error, and close
    lRetVal = RegSetValueEx(lHKey, Value, 0&, REG_FULL_RESOURCE_DESCRIPTOR, bData(0), UBound(bData) + 1)

Handler:
    If lRetVal <> 0 Then
        If m_bIntercept Then
            Error_State lRetVal, "Read_ResDescriptor", SubKey
        End If
    End If
    lRetVal = RegCloseKey(lHKey)
    On Error GoTo 0

End Sub

Public Function Read_ResRequired(ByVal RootKey As HKEY_Type, _
                                 ByVal SubKey As String, _
                                 ByVal Value As Variant) As Variant

'/* read a resource requirements value(binary)
Dim lHKey           As Long
Dim lRetVal         As Long
Dim byBuffer()      As Byte
Dim lBuffersize     As Long

On Error GoTo Handler

    '/* open root key and test for value type
    lRetVal = RegOpenKeyEx(RootKey, SubKey, 0, KEY_ALL_ACCESS, lHKey)
    If Not lRetVal = ERROR_NONE Then GoTo Handler

    '/* get buffer size
    lRetVal = RegQueryValueEx(lHKey, Value, 0&, REG_RESOURCE_REQUIREMENTS_LIST, ByVal 0&, lBuffersize)

    '/* read into buffer
    If lRetVal = ERROR_NONE Then
        ReDim byBuffer(lBuffersize - 1) As Byte
        lRetVal = RegQueryValueEx(lHKey, Value, 0&, REG_RESOURCE_REQUIREMENTS_LIST, byBuffer(0), lBuffersize)
        '/* set value
        Read_ResRequired = byBuffer
    End If

Handler:
    '/* set error and close key
    If lRetVal <> 0 Then
        If m_bIntercept Then
            Error_State lRetVal, "Read_ResRequired", SubKey
        End If
    End If
    lRetVal = RegCloseKey(lHKey)
    On Error GoTo 0

End Function

Public Sub Write_ResRequired(ByVal RootKey As HKEY_Type, _
                             ByVal SubKey As String, _
                             ByVal Value As Variant, _
                             ByRef bData() As Byte)

'/* write a resource requirements value(binary)
Dim lHKey           As Long
Dim lRetVal         As Long
Dim lDeposit        As Long
Dim tSecAttrib      As SECURITY_ATTRIBUTES

On Error GoTo Handler

    '/* security structure
    With tSecAttrib
        .nLength = Len(tSecAttrib)
        .lpSecurityDescriptor = 0
        .bInheritHandle = 1
    End With

    '/* test access
    lRetVal = RegCreateKeyEx(RootKey, SubKey, 0, "", 0, KEY_WRITE, tSecAttrib, lHKey, lDeposit)
    If Not lRetVal = ERROR_NONE Then GoTo Handler

    '/* write resource, set error, and close
    lRetVal = RegSetValueEx(lHKey, Value, 0&, REG_RESOURCE_REQUIREMENTS_LIST, bData(0), UBound(bData) + 1)

Handler:
    If lRetVal <> 0 Then
        If m_bIntercept Then
            Error_State lRetVal, "Write_ResRequired", SubKey
        End If
    End If
    lRetVal = RegCloseKey(lHKey)
    On Error GoTo 0

End Sub

Public Function Read_String(ByVal RootKey As HKEY_Type, _
                            ByVal SubKey As String, _
                            ByVal Value As String) As String

'/* read an SZ value
Dim lHKey           As Long
Dim lRetVal         As Long
Dim sBuffer         As String
Dim slength         As Long

On Error GoTo Handler

    '/* open root key
    lRetVal = RegOpenKeyEx(RootKey, SubKey, 0, KEY_ALL_ACCESS, lHKey)
    If Not lRetVal = ERROR_NONE Then GoTo Handler

    '/* create a buffer
    sBuffer = Space$(255)
    slength = 255
    '/* query key for string value
    lRetVal = RegQueryValueEx(lHKey, Value, 0, REG_SZ, ByVal sBuffer, slength)

    '/* read string into buffer
    If lRetVal = ERROR_NONE Then
        sBuffer = Left$(sBuffer, slength - 1)
        Read_String = sBuffer
    End If

Handler:
    '/* close key and set result
    If lRetVal <> 0 Then
        If m_bIntercept Then
            Error_State lRetVal, "Read_String", SubKey
        End If
    End If
    lRetVal = RegCloseKey(lHKey)
    On Error GoTo 0

End Function

Public Sub Write_String(ByVal RootKey As HKEY_Type, _
                        ByVal SubKey As String, _
                        ByVal Value As String, _
                        ByVal Data As String)

'/* write an SZ value
Dim lHKey           As Long
Dim lRetVal         As Long
Dim lDeposit        As Long
Dim tSecAttrib      As SECURITY_ATTRIBUTES

On Error GoTo Handler

    '/* security attributes
    With tSecAttrib
        .nLength = Len(tSecAttrib)
        .lpSecurityDescriptor = 0
        .bInheritHandle = 1
    End With

    '/* open key
    lRetVal = RegCreateKeyEx(RootKey, SubKey, 0, "", 0, KEY_WRITE, tSecAttrib, lHKey, lDeposit)
    If Not lRetVal = ERROR_NONE Then GoTo Handler

    '/* write string, set error, and close
    lRetVal = RegSetValueEx(lHKey, Value, 0, REG_SZ, ByVal Data, Len(Data))

Handler:
    If lRetVal <> 0 Then
        If m_bIntercept Then
            Error_State lRetVal, "Write_String", SubKey
        End If
    End If
    lRetVal = RegCloseKey(lHKey)
    On Error GoTo 0

End Sub

Public Sub Write_Expanded(ByVal RootKey As HKEY_Type, _
                          ByVal SubKey As String, _
                          ByVal Value As String, _
                          ByVal sData As String)

'/* write an SZ value
Dim lHKey           As Long
Dim lRetVal         As Long
Dim lDeposit        As Long
Dim tSecAttrib      As SECURITY_ATTRIBUTES

On Error GoTo Handler

    '/* security attributes
    With tSecAttrib
        .nLength = Len(tSecAttrib)
        .lpSecurityDescriptor = 0
        .bInheritHandle = 1
    End With

    '/* open key
    lRetVal = RegCreateKeyEx(RootKey, SubKey, 0, "", 0, KEY_WRITE, tSecAttrib, lHKey, lDeposit)
    If Not lRetVal = ERROR_NONE Then GoTo Handler

    '/* write string, set error, and close
    lRetVal = RegSetValueEx(lHKey, Value, 0, REG_EXPAND_SZ, ByVal sData, Len(sData))

Handler:
    If lRetVal <> 0 Then
        If m_bIntercept Then
            Error_State lRetVal, "Write_Expanded", SubKey
        End If
    End If
    lRetVal = RegCloseKey(lHKey)
    On Error GoTo 0

End Sub

Public Function Key_Exist(ByVal RootKey As HKEY_Type, _
                          ByVal SubKey As String) As Boolean

'/* check for key
Dim lHKey           As Long
Dim lRetVal         As Long

On Error GoTo Handler

    '/* if 0 returned, key is valid
    lRetVal = RegOpenKeyEx(RootKey, SubKey, 0, KEY_QUERY_VALUE, lHKey)
    If lRetVal = ERROR_NONE Then
        Key_Exist = True
    End If

Handler:
    RegCloseKey lHKey
    On Error GoTo 0

End Function

Public Function Value_Exist(ByVal RootKey As HKEY_Type, _
                            ByVal SubKey As String, _
                            ByVal Value As String) As Boolean

'/* read an SZ value
Dim lHKey           As Long
Dim lRetVal         As Long
Dim sBuffer         As String
Dim slength         As Long
Dim DataType        As Long

On Error GoTo Handler

    '/* open root key
    lRetVal = RegOpenKeyEx(RootKey, SubKey, 0, KEY_ALL_ACCESS, lHKey)
    If lRetVal = ERROR_NONE Then
        '/* create a buffer
        sBuffer = Space$(255)
        slength = 255
        '/* query key for string value
        lRetVal = RegQueryValueEx(lHKey, Value, 0, DataType, ByVal sBuffer, slength)
        '/* read string into buffer
        If lRetVal = ERROR_NONE Then
            Value_Exist = True
        End If
    End If

Handler:
    '/* close key and set result
    lRetVal = RegCloseKey(lHKey)
    On Error GoTo 0

End Function

Public Function Create_Key(ByVal RootKey As HKEY_Type, _
                           ByVal SubKey As String) As Boolean

'/* create a new key
Dim lHKey           As Long
Dim lRetVal         As Long

On Error GoTo Handler

    '/* create the key
    lRetVal = RegCreatekey(RootKey, SubKey, lHKey)

Handler:
    '/* set error and close
    Create_Key = (lRetVal = 0)
    lRetVal = RegCloseKey(lHKey)
    On Error GoTo 0

End Function

Public Function Delete_Key(ByVal RootKey As HKEY_Type, _
                           ByVal SubKey As String) As Boolean

'/* delete a key
Dim lRetVal         As Long

On Error GoTo Handler

    '/* delete key
    lRetVal = RegDeleteKey(RootKey, SubKey)
    '/* set error
    Delete_Key = (lRetVal = 0)

Handler:
    On Error GoTo 0

End Function

Public Function Delete_Value(ByVal RootKey As HKEY_Type, _
                             ByVal SubKey As String, _
                             ByVal Value As Variant) As Boolean

'/* delete a value
Dim lRetVal         As Long
Dim handle          As Long

On Error GoTo Handler

    '/* open key
    lRetVal = RegOpenKeyEx(RootKey, SubKey, 0, KEY_ALL_ACCESS, handle)

    '/* exit on error
    If Not lRetVal = ERROR_NONE Then GoTo Handler

    '/* delete value
    lRetVal = RegDeleteValue(handle, Value)
    Delete_Value = (lRetVal = 0)

Handler:
    '/* set error and close key
    If lRetVal <> 0 Then
        If m_bIntercept Then
            Error_State lRetVal, "Delete_Value", SubKey
        End If
    End If
    lRetVal = RegCloseKey(handle)
    On Error GoTo 0

End Function

Public Function List_Keys(ByVal RootKey As HKEY_Type, _
                          ByVal SubKey As String) As Collection

'/* list all keys and add to collection
Dim KeyName         As String
Dim keylen          As Long
Dim classname       As String
Dim classlen        As Long
Dim lastwrite       As FILETIME
Dim lHKey           As Long
Dim lRetVal         As Long
Dim Index           As Long
Dim cTemp           As New Collection

On Error GoTo Handler

    Set cTemp = New Collection
    '/* open key
    lRetVal = RegOpenKeyEx(RootKey, SubKey, 0, KEY_ENUMERATE_SUB_KEYS, lHKey)
    If Not lRetVal = ERROR_NONE Then
        Set List_Keys = Nothing
        GoTo Handler
    End If
    Index = 0

    '/* loop through keys and add to collection
    Do
        KeyName = Space$(255)
        keylen = 255
        classname = Space$(255)
        classlen = 255
        lRetVal = RegEnumKeyEx(lHKey, Index, KeyName, keylen, ByVal 0, classname, classlen, lastwrite)
        If lRetVal = ERROR_NONE Then
            KeyName = Left$(KeyName, keylen)
            cTemp.Add KeyName
        End If
        Index = Index + 1
    Loop Until Not lRetVal = 0

Handler:
    '/* set collection and close
    If cTemp.Count > 0 Then
        Set List_Keys = cTemp
    Else
        If m_bIntercept Then
            Error_State lRetVal, "List_Keys", SubKey
        End If
        Set List_Keys = Nothing
    End If
    Set cTemp = Nothing
    lRetVal = RegCloseKey(lHKey)
    On Error GoTo 0

End Function

Public Function ColList_Keys(ByVal RootKey As HKEY_Type, _
                             ByVal SubKey As String) As Collection

'/* list all keys and add to collection
Dim KeyName         As String
Dim keylen          As Long
Dim classname       As String
Dim classlen        As Long
Dim lastwrite       As FILETIME
Dim lHKey           As Long
Dim lRetVal         As Long
Dim Index           As Long
Dim cTemp           As New Collection

On Error GoTo Handler

    Set ColList_Keys = New Collection
    '/* open key
    lRetVal = RegOpenKeyEx(RootKey, SubKey, 0, KEY_ENUMERATE_SUB_KEYS, lHKey)
    If Not lRetVal = ERROR_NONE Then GoTo Handler

    Index = 0

    '/* loop through keys and add to collection
    Do
        KeyName = Space$(255)
        keylen = 255
        classname = Space$(255)
        classlen = 255
        lRetVal = RegEnumKeyEx(lHKey, Index, KeyName, keylen, ByVal 0, classname, classlen, lastwrite)
        If lRetVal = ERROR_NONE Then
            KeyName = Left$(KeyName, keylen)
            ColList_Keys.Add KeyName
        End If
        Index = Index + 1
    Loop Until lRetVal <> 0

Handler:
    '/* set collection and close
    If cTemp.Count > 0 Then
        Set ColList_Keys = cTemp
    Else
        If m_bIntercept Then
            Error_State lRetVal, "List_Keys", SubKey
        End If
        Set ColList_Keys = Nothing
    End If
    Set cTemp = Nothing
    lRetVal = RegCloseKey(lHKey)
    On Error GoTo 0

End Function

Public Function List_Values(ByVal RootKey As HKEY_Type, _
                            ByVal SubKey As String) As Collection

'/* list all values and add to a collection
Dim Value           As String
Dim ValueLen        As Long
Dim DataType        As Long
Dim Data(0 To 254)  As Byte
Dim DataLen         As Long
Dim lHKey           As Long
Dim Index           As Long
Dim lRetVal         As Long
Dim cTemp           As New Collection

On Error GoTo Handler

    Set cTemp = New Collection
    '/* open key
    lRetVal = RegOpenKeyEx(RootKey, SubKey, 0, KEY_QUERY_VALUE, lHKey)
    If Not lRetVal = ERROR_NONE Then GoTo Handler

    Index = 0
    '/* loop through values and add to collection
    Do
        DataLen = 255
        Value = Space$(255)
        ValueLen = 255
        lRetVal = RegEnumValue(lHKey, Index, Value, ValueLen, 0, DataType, Data(0), DataLen)
        If lRetVal = ERROR_NONE Then
            Value = Left$(Value, ValueLen)
            Select Case DataType
            Case REG_SZ, REG_EXPAND_SZ
                cTemp.Add Value
            Case REG_MULTI_SZ
                cTemp.Add Value
            Case REG_DWORD, REG_DWORD_LITTLE_ENDIAN
                cTemp.Add Value
            Case REG_BINARY
                cTemp.Add Value
            End Select
        End If
        Index = Index + 1
    Loop Until Not lRetVal = 0

    '/* set error, collection, and close key
    Set List_Values = cTemp
    Set cTemp = Nothing
    lRetVal = RegCloseKey(lHKey)

Exit Function

Handler:
    If lRetVal <> 0 Then
        If m_bIntercept Then
            Error_State lRetVal, "Delete_Value", SubKey
        End If
        Set List_Values = Nothing
    End If
    On Error GoTo 0

End Function

Public Function List_Data(ByVal RootKey As HKEY_Type, _
                          ByVal SubKey As String) As Collection

'/* list all data for values in a subkey
Dim Value           As String
Dim ValueLen        As Long
Dim DataType        As Long
Dim Data(0 To 254)  As Byte
Dim DataLen         As Long
Dim lHKey           As Long
Dim Index           As Long
Dim lRetVal         As Long
Dim cTemp           As New Collection

On Error GoTo Handler

    Set cTemp = New Collection
    '/* open key
    lRetVal = RegOpenKeyEx(RootKey, SubKey, 0, KEY_QUERY_VALUE, lHKey)
    If Not lRetVal = ERROR_NONE Then GoTo Handler

    Index = 0
    '/* loop through values and add to collection
    Do
        DataLen = 255
        Value = Space$(255)
        ValueLen = 255
        lRetVal = RegEnumValue(lHKey, Index, Value, ValueLen, 0, DataType, Data(0), DataLen)
        If lRetVal = ERROR_NONE Then
            Value = Left$(Value, ValueLen)
            Select Case DataType
            Case REG_SZ, REG_EXPAND_SZ
                cTemp.Add Read_String(RootKey, SubKey, Value), Value
            Case REG_MULTI_SZ
                cTemp.Add Read_Multi(RootKey, SubKey, Value), Value
            Case REG_DWORD, REG_DWORD_LITTLE_ENDIAN
                cTemp.Add Read_DWord(RootKey, SubKey, Value), Value
            Case REG_BINARY
                cTemp.Add Read_Binary(RootKey, SubKey, Value), Value
            End Select
        End If
        Index = Index + 1
    Loop Until Not lRetVal = 0

    '/* set error, collection, and close key
    Set List_Data = cTemp
    Set cTemp = Nothing
    lRetVal = RegCloseKey(lHKey)

Exit Function

Handler:
    If lRetVal <> 0 Then
        If m_bIntercept Then
            Error_State lRetVal, "Delete_Value", SubKey
        End If
        Set List_Data = Nothing
    End If
    On Error GoTo 0

End Function


'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
'                                           PERIPHERAL ROUTINES
'<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

Public Function Search_Value(ByVal RootKey As HKEY_Type, _
                             ByVal KeyVal As String, _
                             ByVal SearchVal As String) As Boolean

'/* search for a value
Dim Item            As Variant
Dim lReturn         As Long

On Error GoTo Handler

    '/* enumerate values and compare
    '/* to search item
    For Each Item In List_Values(RootKey, KeyVal)
        If LCase$(Item) = SearchVal Then
            Search_Value = True
            Exit For
        End If
    Next Item

    '/* log errors
    If Not lReturn = 0 Then Get_Error lReturn

Handler:
On Error GoTo 0

End Function

Public Function Value_Exists(ByVal RootKey As HKEY_Type, _
                             ByVal SubKey As String, _
                             ByVal KeyVal As String) As Boolean

'/* test for key
On Error GoTo Handler

    '/* if no error then key exists
    If Value_Exist(RootKey, SubKey, KeyVal) Then
        Value_Exists = True
    End If

Handler:
On Error GoTo 0

End Function

Public Sub Write_Value(ByVal RootKey As HKEY_Type, _
                            ByVal SubKey As String, _
                            ByVal KeyVal As String, _
                            ByVal ValData As String, _
                            ByVal DataType As Integer)

'/* create a new value with data
'/* supports sz, multi_sz, expand_sz
'/* binary, dword, little_endian
'/* big_endian and link
Dim j               As Integer
Dim lData           As Long
Dim MByte()         As Byte
Dim Btemp()         As String
Dim lReturn         As Long

On Error GoTo Handler

        Select Case DataType
            Case 1
                '/* sz
                Write_String RootKey, SubKey, KeyVal, ValData

            Case 2
                '/* expand_sz
                Write_Expanded RootKey, SubKey, KeyVal, ValData

            Case 3
                '/* multi_sz
                Write_Multi RootKey, SubKey, KeyVal, ValData

            Case 4
                '/* binary
                Btemp() = Split(ValData, " ")
                For j = 0 To UBound(Btemp) - 1
                    ReDim Preserve MByte(j)
                    MByte(j) = CByte(Btemp(j))
                Next j
                Write_Binary RootKey, SubKey, KeyVal, MByte

            Case 5
                '/* dword
                lData = CLng(ValData)
                Write_DWord RootKey, SubKey, KeyVal, lData

            Case 6
                '/* little_endian
                Write_LEndian RootKey, SubKey, KeyVal, lData

            Case 7
                '/* big_endian
                Write_BEndian RootKey, SubKey, KeyVal, lData
        End Select

    Erase Btemp
    Erase MByte

Handler:
On Error GoTo 0

End Sub

Public Function Trim_Null(Item As String) As String

'/* trim nulls

Dim pos             As Integer

On Error GoTo Handler
    '/* trim nulls for sz_multi
    pos = InStr(Item, vbNullChar)
    If pos Then
        Item = Left$(Item, pos - 1)
    End If
    Trim_Null = Item

Handler:
    On Error GoTo 0

End Function

'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
'                                           CONVERSION ROUTINES
'<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

'/*  Thanks go out to actorics.de PSC submission

Private Function Low_Byte(ByVal iNum As Integer) As Byte

On Error GoTo Handler

    Low_Byte = iNum And &HFF

Handler:
    On Error GoTo 0

End Function

Private Function High_Byte(ByVal iNum As Integer) As Byte

On Error GoTo Handler

    High_Byte = (iNum And &HFF00&) \ 256

Handler:
    On Error GoTo 0

End Function

Private Function Make_Word(ByVal bLow As Byte, ByVal bHigh As Byte) As Integer

On Error GoTo Handler

    If bHigh And &H80 Then
        Make_Word = ((bHigh * 256&) + bLow) Or &HFFFF0000
    Else
        Make_Word = (bHigh * 256) + bLow
    End If

Handler:
    On Error GoTo 0

End Function

Public Function Make_LEndian16(ByVal iVal As Integer) As Integer
'/* create a 16bit little_endian
On Error GoTo Handler

Dim B(1)            As Byte

    B(0) = Low_Byte(iVal)
    B(1) = High_Byte(iVal)
    Make_LEndian16 = Make_Word(B(1), B(0))

Handler:
    On Error GoTo 0

End Function

Public Function Make_LEndian32(lVal As Long) As String
'/* create 32bit little_endian

Dim b0              As Byte
Dim B1              As Byte
Dim B2              As Byte
Dim b3              As Byte

On Error GoTo Handler

    b0 = (lVal And &HFF&)
    B1 = (lVal And &HFF00&) \ &H100&
    B2 = (lVal And &HFF0000) \ &H10000
    b3 = (lVal And &H7F000000) \ &H1000000 - 128 * (lVal < 0)
    Make_LEndian32 = Chr(b0) & Chr(B1) & Chr(B2) & Chr(b3)

Handler:
    On Error GoTo 0

End Function

Public Function Make_BEndian32(lVal As Long) As String
'/* create 32bit big_endian

Dim b0              As Byte
Dim B1              As Byte
Dim B2              As Byte
Dim b3              As Byte

On Error GoTo Handler

    b0 = (lVal And &HFF&)
    B1 = (lVal And &HFF00&) \ &H100&
    B2 = (lVal And &HFF0000) \ &H10000
    b3 = (lVal And &H7F000000) \ &H1000000 - 128 * (lVal < 0)
    Make_BEndian32 = Chr(b3) & Chr(B2) & Chr(B1) & Chr(b0)

Handler:
    On Error GoTo 0

End Function

Public Function Convert_Unicode(ByVal sWord As String) As Variant
'/* convert ascii to unicode

On Error GoTo Handler

    Convert_Unicode = StrConv(sWord, vbUnicode)

Handler:
    On Error GoTo 0

End Function

Public Function Convert_Byte(ByVal sVal As String) As Byte
'/* convert string to byte array

Dim bVal()          As Byte
Dim i               As Long

On Error GoTo Handler

    ReDim bVal(0 To Len(sVal))
    For i = 0 To UBound(bVal())
        bVal(i) = Mid$(sVal, i, 1)
    Next i

Handler:
    On Error GoTo 0

End Function

Public Function Convert_Curr(ByVal sValue As String) As Currency

Dim l               As Long
Dim Negative        As Boolean

    sValue = Trim$(sValue)
    If Left$(sValue, 1) = "-" Then
        Negative = True
        sValue = Mid$(sValue, 2)
    End If

    l = Len(sValue)
    If l < 4 Then
        Convert_Curr = CCur(IIf(Negative, "-0.", "0.") & Right$("0000" & sValue, 4))
    Else
        Convert_Curr = CCur(IIf(Negative, "-", "") & Left$(sValue, l - 4) & "." & Right$(sValue, 4))
    End If

End Function

Public Function Convert_Text(ByVal cValue As Currency) As String

Dim Temp            As String
Dim l               As Long

    Temp = Format$(cValue, "#.0000")
    l = Len(Temp)
    Temp = Left$(Temp, l - 5) & Right$(Temp, 4)

    Do While Len(Temp) > 1 And Left$(Temp, 1) = "0"
        Temp = Mid$(Temp, 2)
    Loop

    Do While Len(Temp) > 2 And Left$(Temp, 2) = "-0"
        Temp = "-" & Mid$(Temp, 3)
    Loop

    Temp = Temp / 10000
    Convert_Text = Temp

End Function


'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
'                                           ERROR LOGGING
'<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<


Private Sub Error_State(ByVal lErrNum As Long, _
                        ByVal sRoutine As String, _
                        ByVal sKey As String)

'/* send the error to log,
'/* and raise notification

Dim sErrDesc        As String

    sErrDesc = Get_Error(lErrNum)
    If m_bIntercept Then
        Log_Error "Description: " + sErrDesc + " Routine: " + " Location: " + sKey
    End If
    If m_bNotify Then
        RaiseEvent ErrorCond(sRoutine, sKey, sErrDesc)
    End If

End Sub

Private Function Get_Error(ByVal lErrNum As Long) As String
'/* interpret registry errors

On Error GoTo Handler

    Select Case lErrNum
    Case 1
        Get_Error = "Error: " & lErrNum & " Bad Database. The database is invalid"
    Case 2
        Get_Error = "Error: " & lErrNum & " Bad Key Name. Key is corrupt or does not exist"
    Case 3
        Get_Error = "Error: " & lErrNum & " Key Locked. The key requested does not exist"
    Case 4
        Get_Error = "Error: " & lErrNum & " Failed Read. The key requested can not be read accessed"
    Case 5
        Get_Error = "Error: " & lErrNum & " Failed Write. The key requested can not be write accessed"
    Case 6
        Get_Error = "Error: " & lErrNum & " Out Of Memory. The process has exceeded its memory allocation"
    Case 7
        Get_Error = "Error: " & lErrNum & " Work Area Invalid. The process work area appears to be corrupt"
    Case 8
        Get_Error = "Error: " & lErrNum & " Access Is Denied. Access to this key has been denied"
    Case 87
        Get_Error = "Error: " & lErrNum & " Invalid Parameters. The call parameters passed are invalid"
    Case 234
        Get_Error = "Error: " & lErrNum & " More Data. The container has more data"
    Case 259
        Get_Error = "Error: " & lErrNum & " No More Items. No more items for this query"
    Case Else
        Get_Error = "Error: An Unknown Error has occured"
    End Select

Handler:
    On Error GoTo 0

End Function

Private Sub Log_Error(ByVal ErrDesc As String)
'/* log errors

On Error Resume Next

    '/* write to log
    Open App.Path & "\err.log" For Append As #1
        Print #1, CStr(Now) & vbTab & ErrDesc
    Close #1

On Error GoTo 0

End Sub