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

'APIs to open/close the registry
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 RegConnectRegistry Lib "advapi32.dll" _
        Alias "RegConnectRegistryA" _
        (ByVal lpMachineName As String, _
        ByVal hKey As Long, _
        phkResult As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" _
        (ByVal hKey As Long) As Long

'APIs to get/set values in the registry
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 RegQueryValueExString Lib "advapi32.dll" _
        Alias "RegQueryValueExA" (ByVal hKey As Long, _
        ByVal lpValueName As String, ByVal lpReserved As Long, _
        lpType As Long, lpData As String, _
        lpcbData 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 Long, ByVal cbData 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 lpData As String, ByVal cbData As Long) As Long
Private Declare Function RegDeleteValue Lib "advapi32.dll" _
        Alias "RegDeleteValueA" _
        (ByVal hKey As Long, _
        ByVal lpValueName As String) As Long

'Enumerators
Private Declare Function RegEnumKeyEx Lib "advapi32.dll" _
        Alias "RegEnumKeyExA" _
        (ByVal hKey As Long, ByVal dwIndex As Long, _
        ByVal lpName As String, lpcbName As Long, _
        ByVal 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
        
'APIs to create/remove keys
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 RegDeleteKey Lib "advapi32.dll" _
        Alias "RegDeleteKeyA" _
        (ByVal hKey As Long, ByVal lpSubKey As String) As Long

'Error codes
Private Const ERROR_SUCCESS = 0

'Registry constants
Private Const REG_BINARY = 3
Private Const REG_CREATED_NEW_KEY = &H1
Private Const REG_DWORD = 4
Private Const REG_DWORD_BIG_ENDIAN = 5
Private Const REG_DWORD_LITTLE_ENDIAN = 4
Private Const REG_EXPAND_SZ = 2
Private Const REG_FULL_RESOURCE_DESCRIPTOR = 9
Private Const REG_LINK = 6
Private Const REG_MULTI_SZ = 7
Private Const REG_NONE = 0
Private Const REG_NOTIFY_CHANGE_ATTRIBUTES = &H2
Private Const REG_NOTIFY_CHANGE_LAST_SET = &H4
Private Const REG_NOTIFY_CHANGE_NAME = &H1
Private Const REG_NOTIFY_CHANGE_SECURITY = &H8
Private Const REG_OPENED_EXISTING_KEY = &H2
Private Const REG_OPTION_BACKUP_RESTORE = 4
Private Const REG_OPTION_CREATE_LINK = 2
Private Const REG_OPTION_NON_VOLATILE = 0
Private Const REG_OPTION_RESERVED = 0
Private Const REG_OPTION_VOLATILE = 1
Private Const REG_REFRESH_HIVE = &H2
Private Const REG_RESOURCE_LIST = 8
Private Const REG_RESOURCE_REQUIREMENTS_LIST = 10
Private Const REG_SZ = 1
Private Const REG_WHOLE_HIVE_VOLATILE = &H1
Private Const REG_LEGAL_CHANGE_FILTER = (REG_NOTIFY_CHANGE_NAME Or REG_NOTIFY_CHANGE_ATTRIBUTES Or REG_NOTIFY_CHANGE_LAST_SET Or REG_NOTIFY_CHANGE_SECURITY)
Private Const REG_LEGAL_OPTION = (REG_OPTION_RESERVED Or REG_OPTION_NON_VOLATILE Or REG_OPTION_VOLATILE Or REG_OPTION_CREATE_LINK Or REG_OPTION_BACKUP_RESTORE)

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

'FILETIME structure for use with RegEnumKeyEx
Private Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type

Private Type SECURITY_ATTRIBUTES
    nLength As Long
    lpSecurityDescriptor As Long
    bInheritHandle As Long
End Type

'Enum for reg data types, for easy rememberence
Public Enum RegDataTypes
    eREG_BINARY = 3
    eREG_DWORD = 4
    eREG_DWORD_BIG_ENDIAN = 5
    eREG_DWORD_LITTLE_ENDIAN = 4
    eREG_EXPAND_SZ = 2
    eREG_MULTI_SZ = 7
    eREG_SZ = 1
End Enum


'This enum makes it easier than remembering constants
'It will help make the class function more like what
'the user is used to in RegEdit and RegEdt32.
Public Enum HKEYs
    eHKEY_CLASSES_ROOT = &H80000000
    eHKEY_CURRENT_USER = &H80000001
    eHKEY_LOCAL_MACHINE = &H80000002
    eHKEY_USERS = &H80000003
    eHKEY_PERFORMANCE_DATA = &H80000004
    eHKEY_CURRENT_CONFIG = &H80000005
    eHKEY_DYN_DATA = &H80000006
End Enum

Public Function CreateKey(PredefinedKey As HKEYs, KeyName As String, Optional ByVal CompName As String = vbNullString) As Boolean
    Dim hNewKey As Long
    Dim lpSecurityAttributes As SECURITY_ATTRIBUTES
    Dim rc As Long
    Dim srvKey As Long
    
    On Error GoTo handler
    
    'Make sure there is no backslash preceding the branch
    If Left$(KeyName, 1) = "\" Then
        KeyName = Right$(KeyName, Len(KeyName) - 1)
    End If

    'Create the branch
    rc = RegConnectRegistry(CompName, PredefinedKey, srvKey)
    If rc = ERROR_SUCCESS Then
        rc = RegCreateKeyEx(srvKey, _
                KeyName, _
                0&, _
                vbNullString, _
                REG_OPTION_NON_VOLATILE, _
                KEY_ALL_ACCESS, _
                lpSecurityAttributes, _
                hNewKey, _
                rc)
        
        If rc = ERROR_SUCCESS Then
        
            'Close the registry
            rc = RegCloseKey(hNewKey)
            rc = RegCloseKey(srvKey)
            'Return the result code
            CreateKey = True
        Else
            CreateKey = False
        End If
    Else
        CreateKey = False
    End If
    
    'Bypass the error handler
    Exit Function

handler:
    CreateKey = False
End Function


Public Function DeleteKey(PredefinedKey As HKEYs, KeyName As String, Optional ByVal CompName As String) As Boolean
    Dim rc As Long
    Dim srvKey As Long
    On Error GoTo handler
    
    'Make sure there is no backslash preceding the branch
    If Left$(KeyName, 1) = "\" Then
        KeyName = Right$(KeyName, Len(KeyName) - 1)
    End If

    'Call the API
    rc = RegConnectRegistry(CompName, PredefinedKey, srvKey)
    If rc = ERROR_SUCCESS Then
        rc = RegDeleteKey(srvKey, KeyName)
        If rc = ERROR_SUCCESS Then
            'Return result code
            DeleteKey = True
        Else
            DeleteKey = False
        End If
    End If
    'Bypass the error handler
    Exit Function

handler:
    DeleteKey = False
End Function

Public Function ListSubKey(PredefinedKey As HKEYs, KeyName As String, Index As Long, Optional ByVal CompName As String = vbNullString) As String
    Dim rc As Long
    Dim srvKey As Long
    Dim hKey As Long
    Dim dwIndex As Long
    Dim lpName As String
    Dim lpcbName As Long
    Dim lpReserved As Long
    Dim lpftLastWriteTime As FILETIME
    Dim i As Integer
    
    On Error GoTo handler
    
    'Make sure there is no backslash preceding the branch
    If Left$(KeyName, 1) = "\" Then
        KeyName = Right$(KeyName, Len(KeyName) - 1)
    End If
    
    'Attempt to open the registry
    rc = RegConnectRegistry(CompName, PredefinedKey, srvKey)
    If rc = ERROR_SUCCESS Then
        rc = RegOpenKeyEx(PredefinedKey, KeyName, _
                0, KEY_ALL_ACCESS, hKey)
                
        If rc = ERROR_SUCCESS Then
            'Allocate buffers for lpName
            lpcbName = 255: lpName = String$(lpcbName, Chr(0))
                        
            'Get the subkey
            rc = RegEnumKeyEx(hKey, Index, lpName, _
                    lpcbName, lpReserved, vbNullString, _
                    0, lpftLastWriteTime)
                    
            If rc = ERROR_SUCCESS Then
                'Return the result
                ListSubKey = Left$(lpName, lpcbName)
            Else
                ListSubKey = ""
            End If
                
            'Close the registry
            RegCloseKey hKey
            RegCloseKey srvKey
        End If
    End If
    'Bypass the error handler
    Exit Function

handler:
    ListSubKey = ""
End Function

Public Function SetValue(PredefinedKey As HKEYs, KeyName As String, ValueName As String, _
        Value As Variant, Optional ValueType As RegDataTypes = 1, Optional CompName As String = vbNullString) As Boolean
    Dim rc As Long
    Dim hKey As Long
    Dim lpType As Long
    Dim lpcbData As Long
    Dim lpData As String
    Dim srvKey As Long
    On Error GoTo handler
    
    'Make sure there is no backslash preceding the branch
    If Left$(KeyName, 1) = "\" Then
        KeyName = Right$(KeyName, Len(KeyName) - 1)
    End If
    
    'first call the create key so that if the key is not present, it will get created
    CreateKey PredefinedKey, KeyName
    
    'Open the registry
    rc = RegConnectRegistry(CompName, PredefinedKey, srvKey)
    If rc = ERROR_SUCCESS Then
        rc = RegOpenKeyEx(srvKey, _
                KeyName, _
                0, _
                KEY_ALL_ACCESS, _
                hKey)
    
        If rc = ERROR_SUCCESS Then
            'Create a buffer so we can retrieve the data type of
            'the key. We'll need this to determine which API
            'we should call.
            lpcbData = 255
            lpData = String(lpcbData, Chr(0))
            
            'Get the value type first.
            'It will be returned via lpType argument
            rc = RegQueryValueEx(hKey, _
                ValueName, _
                0, lpType, _
                ByVal lpData, _
                lpcbData)
            
            If rc = ERROR_SUCCESS Then
                Select Case lpType
                    Case REG_SZ
                        'Use a string data type
                        rc = RegSetValueExString(hKey, _
                            ValueName, _
                            0, _
                            REG_SZ, _
                            CStr(Value), _
                            Len(Value) + 1)
                    Case REG_DWORD
                        'Use a DWORD data type
                        rc = RegSetValueEx(hKey, _
                            ValueName, _
                            0, _
                            REG_DWORD, _
                            CLng(Value), _
                            lpcbData)
                End Select
            Else
                'if the key not present create a key depending upon the value type provided
                Select Case ValueType
                    Case eREG_DWORD
                        'Use a DWORD data type
                        rc = RegSetValueEx(hKey, _
                            ValueName, _
                            0&, _
                            REG_DWORD, _
                            CLng(Value), _
                            4)
                    Case eREG_SZ
                        'Use a string data type
                        rc = RegSetValueExString(hKey, _
                            ValueName, _
                            0, _
                            REG_SZ, _
                            ByVal CStr(Value), _
                            Len(CStr(Value)) + 1)
                End Select
            End If
            
            'Close the registry
            RegCloseKey hKey
            RegCloseKey srvKey
        End If
    End If
    'Return the result code
    SetValue = True
    
    'Bypass the error handler
    Exit Function

handler:
    SetValue = False
End Function


Public Function GetValue(PredefinedKey As HKEYs, ByVal KeyName As String, ByVal ValueName As String, Optional ByVal CompName As String = vbNullString) As Variant
    Dim rc As Long
    Dim hKey As Long
    Dim lpData As String
    Dim lpDataDWORD As Long
    Dim lpcbData As Long
    Dim lpType As Long
    Dim srvKey As Long
    On Error GoTo handler
    
    'Make sure there is no backslash preceding the branch
    If Left$(KeyName, 1) = "\" Then
        KeyName = Right$(KeyName, Len(KeyName) - 1)
    End If
    
    'Attempt to open the registry
    rc = RegConnectRegistry(CompName, PredefinedKey, srvKey)
    If rc = ERROR_SUCCESS Then
        rc = RegOpenKeyEx(srvKey, KeyName, _
                0, KEY_ALL_ACCESS, hKey)
        
        If rc = ERROR_SUCCESS Then
            'Create a buffer so we can retrieve the data type of
            'the key. We'll need this to determine which API
            'we should call.
            lpcbData = 255
            lpData = String(lpcbData, Chr(0))
            
            'Get the value type first.
            'It will be returned via lpType argument
            rc = RegQueryValueEx(hKey, _
                ValueName, _
                0, lpType, _
                ByVal lpData, _
                lpcbData)
                
            If rc = ERROR_SUCCESS Then
                'Then read the value using the
                'appropriate data type...
                Select Case lpType
                    Case REG_SZ
                        rc = RegQueryValueExString(hKey, _
                            ValueName, _
                            0, lpType, _
                            ByVal lpData, _
                            lpcbData)
                        
                        'Return the value
                        If rc = 0 Then
                            GetValue = Left$(lpData, lpcbData - 1)
                        Else
                            GetValue = ""
                        End If
                    Case REG_DWORD
                        rc = RegQueryValueEx(hKey, _
                            ValueName, _
                            0, lpType, _
                            lpDataDWORD, _
                            lpcbData)
                        
                        'Return the value
                        If rc = 0 Then
                            GetValue = CLng(lpDataDWORD)
                        Else
                            GetValue = 0
                        End If
                End Select
            End If
            
            'Close the registry
            RegCloseKey hKey
            RegCloseKey srvKey
        End If
    End If
    'Bypass the error handler
    Exit Function

handler:
    'Return a null value
    GetValue = Null
    
End Function

'function to delete a vlue from the registry
Public Function DeleteValue(PredefinedKey As HKEYs, KeyName As String, ValueName As String, Optional ByVal CompName As String) As Long
On Error GoTo errHandler
Dim rc As Long
Dim hKey As Long
Dim srvKey As Long

    'Make sure there is no backslash preceding the branch
    If Left$(KeyName, 1) = "\" Then
        KeyName = Right$(KeyName, Len(KeyName) - 1)
    End If
    
    'Attempt to open the registry
    rc = RegConnectRegistry(CompName, PredefinedKey, srvKey)
    If rc = ERROR_SUCCESS Then
        rc = RegOpenKeyEx(srvKey, KeyName, _
                0, KEY_ALL_ACCESS, hKey)
        
        'if the key has been sucessfully open
        If rc = ERROR_SUCCESS Then
            rc = RegDeleteValue(hKey, ValueName)
            If rc = ERROR_SUCCESS Then
                DeleteValue = 0
            Else
                DeleteValue = rc
            End If
        End If
    End If
    'if all's well exit function
    Exit Function

'rudimentary error handler
errHandler:
    DeleteValue = 1
End Function


Public Function ListSubValue(PredefinedKey As HKEYs, KeyName As String, Index As Long, Optional ByVal CompName As String = vbNullString) As String
    Dim rc As Long
    Dim hKey As Long
    Dim dwIndex As Long
    Dim lpName As String
    Dim lpcbName As Long
    Dim lpReserved As Long
    Dim lpftLastWriteTime As FILETIME
    Dim i As Integer
    Dim srvKey As Long
    On Error GoTo handler

    'Make sure there is no backslash preceding the branch
    If Left$(KeyName, 1) = "\" Then
        KeyName = Right$(KeyName, Len(KeyName) - 1)
    End If
    'Attempt to open the registry
    rc = RegConnectRegistry(CompName, PredefinedKey, srvKey)
    If rc = ERROR_SUCCESS Then
        rc = RegOpenKeyEx(srvKey, KeyName, _
                0, KEY_ALL_ACCESS, hKey)
                
        If rc = ERROR_SUCCESS Then
            'Allocate buffers for lpName
            lpcbName = 255: lpName = String$(lpcbName, Chr(0))
            
            rc = RegEnumValue(hKey, Index, lpName, lpcbName, 0, ByVal 0&, ByVal 0&, ByVal 0&)
    
            If rc = ERROR_SUCCESS Then
                'Return the result
                ListSubValue = Left(lpName, lpcbName)
            Else
                ListSubValue = ""
            End If
    
            'Close the registry
            RegCloseKey hKey
            RegCloseKey srvKey
        End If
    End If
    'Bypass the error handler
    Exit Function

handler:
    ListSubValue = ""
End Function