VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsRegEdit"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
'Used the Class builder for this class
'its purpose is to read-write to the registry
'You must FIRST SET the KEY and VALUENAME
'After that the value can be written to the HKEY
'otherwise an error will be raised.


'Enum for Registry HKeys
Public Enum REG_TOPLEVEL_KEYS
 HKEY_CLASSES_ROOT = &H80000000
 HKEY_CURRENT_CONFIG = &H80000005
 HKEY_CURRENT_USER = &H80000001
 HKEY_DYN_DATA = &H80000006
 HKEY_LOCAL_MACHINE = &H80000002
 HKEY_PERFORMANCE_DATA = &H80000004
 HKEY_USERS = &H80000003
End Enum

'Enum for Registry Data Types
Public Enum RegDataType
    REG_NONE = 0
    REG_SZ = 1
    REG_EXPAND_SZ = 2
    REG_BINARY = 3
    REG_DWORD_LITTLE_ENDIAN = 4
    REG_DWORD_BIG_ENDIAN = 5
    REG_LINK = 6
    REG_MULTI_SZ = 7
    REG_RESOURCE_LIST = 8
    REG_FULL_RESOURCE_DESCRIPTOR = 9
    REG_RESOURCE_REQUIREMENTS_LIST = 10
End Enum

'Enum for Registry Errors used by the ISReturnCodeError Function
Public Enum Reg_Errors
    ERROR_NONE = 0
    ERROR_BADDB = 1
    ERROR_BADKEY = 2
    ERROR_CANTOPEN = 3
    ERROR_CANTREAD = 4
    ERROR_CANTWRITE = 5
    ERROR_OUTOFMEMORY = 6
    ERROR_INVALID_PARAMETER = 7
    ERROR_ACCESS_DENIED = 8
    ERROR_INVALID_PARAMETERS = 87
    ERROR_NO_MORE_ITEMS = 259
End Enum

'Main constants used by API Call RegOpenKeyEx
Private Const KEY_ALL_ACCESS = &H3F
Private Const REG_OPTION_NON_VOLATILE = 0

'Win32 API Calls
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 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 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 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 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 RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long

Private mvarTopHKey As REG_TOPLEVEL_KEYS
Private mvarKeyName As String
Private mvarValueName As String
Private mvarRegCurrentValue As Variant
Private mvarValueDataType As RegDataType
Function RegistryReadValue() As Boolean
    Dim lpcbData As Long
    Dim lrc As Long
    Dim lType As Long
    Dim lValue As Long
    Dim sValue As String
    Dim hKey As Long

    On Error GoTo RegistryReadValueError
    

    lrc = RegOpenKeyEx(mvarTopHKey, mvarKeyName, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, hKey)
    If IsReturnCodeError(lrc) Then
        RegistryReadValue = False
        Exit Function
    End If

    lrc = RegQueryValueExNULL(hKey, mvarValueName, 0&, mvarValueDataType, 0&, lpcbData)
    If IsReturnCodeError(lrc) Then
        RegistryReadValue = False
        Exit Function
    End If

    Select Case mvarValueDataType
        Case REG_SZ
            sValue = String(lpcbData, 0)
            lrc = RegQueryValueExString(hKey, mvarValueName, 0&, mvarValueDataType, sValue, lpcbData)
            If IsReturnCodeError(lrc) = False Then
                mvarRegCurrentValue = Left$(sValue, lpcbData)
            Else
                mvarRegCurrentValue = Empty
            End If
        
        Case REG_DWORD_LITTLE_ENDIAN
            lrc = RegQueryValueExLong(hKey, mvarValueName, 0&, lType, lValue, lpcbData)
            If IsReturnCodeError(lrc) = False Then
                mvarRegCurrentValue = lValue
            Else
                mvarRegCurrentValue = 0
            End If
            
        Case Else
            mvarRegCurrentValue = "Data Type Not Supported"
            lrc = RegCloseKey(hKey)
            RegistryReadValue = False
            Exit Function
    End Select
    
    lrc = RegCloseKey(hKey)
    RegistryReadValue = Not (IsReturnCodeError(lrc))

    Exit Function

RegistryReadValueError:
    RegistryReadValue = False
    
End Function



Public Function RegistryWriteString(Optional sData As String) As Boolean
    Dim hKey As Long
    Dim lrc As Long
    Dim b As Boolean
    
    On Error GoTo ErrorHandler
        
    If IsMissing(sData) Or Len(sData) = 0 Then
        sData = mvarRegCurrentValue
    End If
    
    lrc = RegCreateKey(mvarTopHKey, mvarKeyName, hKey)
    If IsReturnCodeError(lrc) = False Then
        lrc = RegSetValueEx(hKey, mvarValueName, 0, REG_SZ, ByVal sData, Len(sData))
        RegistryWriteString = Not (IsReturnCodeError(lrc))
        lrc = RegCloseKey(hKey)
        RegistryWriteString = Not (IsReturnCodeError(lrc))
    End If

Exit Function

ErrorHandler:
    RegistryWriteString = False
    Exit Function
    
End Function



Private Function IsReturnCodeError(r As Reg_Errors) As Boolean
    Dim sMsg As String
    
    IsReturnCodeError = True
    Select Case r
        Case ERROR_NONE
            sMsg = "No Error"
            IsReturnCodeError = False
            Exit Function
        Case ERROR_BADDB
            sMsg = "Bad Or Missing Registry"
        Case ERROR_BADKEY
            sMsg = "Bad Or Missing Registry Key"
        Case ERROR_CANTOPEN
            sMsg = "Unable To open Registry Key"
        Case ERROR_CANTREAD
            sMsg = "Unable To Read Registry Key"
        Case ERROR_CANTWRITE
            sMsg = "Unable To Write Value To Registry Key"
        Case ERROR_OUTOFMEMORY
            sMsg = "Out Of Memory"
        Case ERROR_INVALID_PARAMETER
            sMsg = "Invalid Parameter"
        Case ERROR_ACCESS_DENIED
            sMsg = "Access To Registry Or Registry Key Has Been Denied"
        Case ERROR_INVALID_PARAMETERS
            sMsg = "Invalid Parameters"
        Case ERROR_NO_MORE_ITEMS
            sMsg = "No More Items"
    End Select
    
    Err.Raise -10000, "clsRegEdit", sMsg
    
End Function
Public Property Let ValueDataType(ByVal vData As RegDataType)
    mvarValueDataType = vData
End Property
Public Property Get ValueDataType() As RegDataType
    ValueDataType = mvarValueDataType
End Property
Public Property Let RegCurrentValue(ByVal vData As Variant)
    mvarRegCurrentValue = vData
End Property
Public Property Get RegCurrentValue() As Variant
    If IsObject(mvarRegCurrentValue) Then
        Set RegCurrentValue = mvarRegCurrentValue
    Else
        RegCurrentValue = mvarRegCurrentValue
    End If
End Property
Public Property Let ValueName(ByVal vData As String)
    mvarValueName = vData
End Property
Public Property Get ValueName() As String
    ValueName = mvarValueName
End Property
Public Property Let KeyName(ByVal vData As String)
    mvarKeyName = vData
End Property
Public Property Get KeyName() As String
    KeyName = mvarKeyName
End Property
Public Property Let TopHKey(ByVal vData As REG_TOPLEVEL_KEYS)
    mvarTopHKey = vData
End Property
Public Property Get TopHKey() As REG_TOPLEVEL_KEYS
    TopHKey = mvarTopHKey
End Property





