Attribute VB_Name = "modRegistryFunctions"
Option Explicit

Public Const HKEY_CLASSES_ROOT = &H80000000
Public Const HKEY_CURRENT_USER = &H80000001
Public Const HKEY_LOCAL_MACHINE = &H80000002
Private Const REG_SZ = 1

Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Declare Function RegQueryValue Lib "advapi32.dll" Alias "RegQueryValueA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal lpValue As String, lpcbValue As Long) As Long
Declare Function RegQueryValueEx 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         ' Note that if you declare the lpData parameter as String, you must pass it By Value.
Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long
Declare Function RegSetValue Lib "advapi32.dll" Alias "RegSetValueA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal dwType As Long, ByVal lpData As String, ByVal cbData As Long) As Long
Declare Function RegSetValueEx 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         ' Note that if you declare the lpData parameter as String, you must pass it By Value.
Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long

Public Function OpenKey(hKey As Long, sSubKey As String, Optional bCreate As Boolean = False, Optional bNoErrorMessage As Boolean = False) As Long
    Dim nRes As Long
    Dim hResKey As Long
    
    nRes = RegOpenKey(hKey, sSubKey, hResKey)
    
    If hResKey = 0 Then
        If Not bCreate Then
            If Not bNoErrorMessage Then
                MsgBox "Could not open registry key!", vbCritical
            End If
            Exit Function
        Else
            nRes = RegCreateKey(hKey, sSubKey, hResKey)
            If hResKey = 0 Then
                If Not bNoErrorMessage Then
                    MsgBox "Could not create registry key!", vbCritical
                End If
                OpenKey = hResKey
                Exit Function
            End If
        End If
    End If
    
    OpenKey = hResKey
End Function

Public Function SetKeyDefaultValue(hKey As Long, sSubKey As String, sValue As String) As Long
    Dim nRes As Long
    Dim sTemp As String * 256
    Dim nLen As Long
    
    sTemp = sValue & Chr(0)
    nLen = Len(sValue)
    
    nRes = RegSetValue(hKey, sSubKey, REG_SZ, sTemp, nLen)
    
    If nRes <> 0 Then
        MsgBox "Could not write to registry!", vbCritical
        SetKeyDefaultValue = nRes
        Exit Function
    End If
    
    SetKeyDefaultValue = nRes
End Function

Public Function SetKeyValue(hKey As Long, sName As String, sValue As String) As Long
    Dim nRes As Long
    Dim sTemp As String * 256
    Dim nLen As Long
    
    sTemp = sValue & Chr(0)
    nLen = Len(sValue)
    
    nRes = RegSetValueEx(hKey, sName, 0, REG_SZ, sTemp, nLen)
    
    If nRes <> 0 Then
        MsgBox "Could not write to registry!", vbCritical
        SetKeyValue = nRes
        Exit Function
    End If
    
    SetKeyValue = nRes
End Function

Public Function GetKeyDefaultValue(hKey As Long, sSubKey As String, sValue As String, Optional bIgnoreFailure As Boolean = False) As Long
    Dim sTemp As String * 256
    Dim nLen As Long
    Dim nRes As Long
    
    nLen = 256
    nRes = RegQueryValue(hKey, sSubKey, sTemp, nLen)
    
    If nRes = 0 Then
        sValue = Left(sTemp, nLen - 1)
    ElseIf nRes <> 0 And Not bIgnoreFailure Then
        MsgBox "Could not read from registry!", vbCritical
        sValue = ""
        GetKeyDefaultValue = nRes
        Exit Function
    End If
    
    GetKeyDefaultValue = nRes
End Function

Public Function GetKeyValue(hKey As Long, sName As String, sValue As String, Optional bIgnoreFailure As Boolean = False) As Long
    Dim sTemp As String * 256
    Dim nLen As Long
    Dim nRes As Long
    
    nLen = 256
    nRes = RegQueryValueEx(hKey, sName, 0, REG_SZ, sTemp, nLen)
    
    If nRes = 0 Then
        sValue = Left(sTemp, nLen - 1)
    ElseIf nRes <> 0 And Not bIgnoreFailure Then
        MsgBox "Could not read from registry!", vbCritical
        GetKeyValue = nRes
        Exit Function
    End If
    
    GetKeyValue = nRes
End Function

Public Function DeleteKeyValue(hKey As Long, sName As String, Optional bIgnoreFailure As Boolean = False) As Long
    Dim nRes As Long
    
    nRes = RegDeleteValue(hKey, sName)
    
    If nRes <> 0 And Not bIgnoreFailure Then
        MsgBox "Could not delete registry key value!", vbCritical
        DeleteKeyValue = nRes
        Exit Function
    End If
    
    DeleteKeyValue = nRes
End Function

Public Function DeleteKey(hKey As Long, sSubKey As String) As Long
    Dim nRes As Long
    
    nRes = RegDeleteKey(hKey, sSubKey)
    
    If nRes <> 0 Then
        MsgBox "Could not delete registry key!", vbCritical
        DeleteKey = nRes
        Exit Function
    End If
    
    DeleteKey = nRes
End Function

Public Function CloseKey(hKey As Long) As Long
    Dim nRes As Long
    
    nRes = RegCloseKey(hKey)
    
    If nRes <> 0 Then
        MsgBox "Could not close registry key!", vbCritical
        CloseKey = nRes
    End If
    
    hKey = 0
    
    CloseKey = nRes
End Function


