Attribute VB_Name = "ModRegistry"
Enum RegHive
    HKEY_CLASSES_ROOT = &H80000000
    HKEY_CURRENT_USER = &H80000001
    HKEY_LOCAL_MACHINE = &H80000002
    HKEY_USERS = &H80000003
    HKEY_CURRENT_CONFIG = &H80000005
    HKEY_DYN_DATA = &H80000006
End Enum

Enum RegType
    REG_SZ = 1 'Unicode nul terminated string
    REG_BINARY = 3 'Free form binary
    REG_DWORD = 4 '32-bit number
End Enum

Public Const ERROR_SUCCESS = 0&
Public Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Public Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Public Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long
Public Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long
Public Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Public 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
Public 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
Public Declare Function RegEnumKey Lib "advapi32.dll" Alias "RegEnumKeyA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As String, ByVal cbName As Long) As Long

Public Function DelRegValue(ByVal hKey As RegHive, ByVal strPath As String, ByVal strValue As String)
Dim hCurKey As Long
Dim lRegResult As Long
    lRegResult = RegOpenKey(hKey, strPath, hCurKey)
    lRegResult = RegDeleteValue(hCurKey, strValue)
    lRegResult = RegCloseKey(hCurKey)
End Function

Public Function DelRegKey(ByVal hKey As RegHive, ByVal strPath As String) As Long
Dim lRegResult As Long
    lRegResult = RegDeleteKey(hKey, strPath)
    DelRegKey = lRegResult
End Function

Public Function CreateRegKey(hKey As RegHive, strPath As String)
Dim hCurKey As Long
Dim lRegResult As Long
    lRegResult = RegCreateKey(hKey, strPath, hCurKey)
        If lRegResult <> ERROR_SUCCESS Then
            'there is a problem
        End If
    lRegResult = RegCloseKey(hCurKey)
End Function
Public Function GetRegString(hKey As RegHive, strPath As String, strValue As String, Optional Default As String) As String
Dim hCurKey As Long
Dim lResult As Long
Dim lValueType As Long
Dim strBuffer As String
Dim lDataBufferSize As Long
Dim intZeroPos As Integer
Dim lRegResult As Long
    'Set up default value
    If Not IsEmpty(Default) Then
        GetRegString = Default
    Else
        GetRegString = ""
    End If
    lRegResult = RegOpenKey(hKey, strPath, hCurKey)
    lRegResult = RegQueryValueEx(hCurKey, strValue, 0&, lValueType, ByVal 0&, lDataBufferSize)
    If lRegResult = ERROR_SUCCESS Then
        If lValueType = REG_SZ Then
            strBuffer = String(lDataBufferSize, " ")
            lResult = RegQueryValueEx(hCurKey, strValue, 0&, 0&, ByVal strBuffer, lDataBufferSize)
            intZeroPos = InStr(strBuffer, Chr$(0))
                If intZeroPos > 0 Then
                    GetRegString = Left$(strBuffer, intZeroPos - 1)
                Else
                    GetRegString = strBuffer
                End If
        End If
    Else
        'there is a problem
    End If
    lRegResult = RegCloseKey(hCurKey)
End Function

Public Function SaveRegString(hKey As RegHive, strPath As String, strValue As String, strData As String)
Dim hCurKey As Long
Dim lRegResult As Long
    lRegResult = RegCreateKey(hKey, strPath, hCurKey)
    lRegResult = RegSetValueEx(hCurKey, strValue, 0, REG_SZ, ByVal strData, Len(strData))
    If lRegResult <> ERROR_SUCCESS Then
        'there is a problem
    End If
    lRegResult = RegCloseKey(hCurKey)
End Function

Public Function GetRegLong(ByVal hKey As RegHive, ByVal strPath As String, ByVal strValue As String, Optional Default As Long) As Long
Dim lRegResult As Long
Dim lValueType As Long
Dim lBuffer As Long
Dim lDataBufferSize As Long
Dim hCurKey As Long
    'Set up default value
    If Not IsEmpty(Default) Then
        GetRegLong = Default
    Else
        GetRegLong = 0
    End If
    lRegResult = RegOpenKey(hKey, strPath, hCurKey)
    lDataBufferSize = 4 '4 bytes = 32 bits = long
    lRegResult = RegQueryValueEx(hCurKey, strValue, 0&, lValueType, lBuffer, lDataBufferSize)
    If lRegResult = ERROR_SUCCESS Then
        If lValueType = REG_DWORD Then
            GetRegLong = lBuffer
        End If
    Else
        'there is a problem
    End If
    lRegResult = RegCloseKey(hCurKey)
End Function

Public Function SaveRegLong(ByVal hKey As RegHive, ByVal strPath As String, ByVal strValue As String, ByVal lData As Long)
Dim hCurKey As Long
Dim lRegResult As Long
    lRegResult = RegCreateKey(hKey, strPath, hCurKey)
    lRegResult = RegSetValueEx(hCurKey, strValue, 0&, REG_DWORD, lData, 4)
    If lRegResult <> ERROR_SUCCESS Then
        'there is a problem
    End If
    lRegResult = RegCloseKey(hCurKey)
End Function

Public Function GetRegByte(ByVal hKey As RegHive, ByVal strPath As String, ByVal strValueName As String, Optional Default As Variant) As Variant
Dim lValueType As Long
Dim byBuffer() As Byte
Dim lDataBufferSize As Long
Dim lRegResult As Long
Dim hCurKey As Long
    If Not IsEmpty(Default) Then
        If VarType(Default) = vbArray + vbByte Then
            GetRegByte = Default
        Else
            GetRegByte = 0
        End If
    Else
        GetRegByte = 0
    End If
    lRegResult = RegOpenKey(hKey, strPath, hCurKey)
    lRegResult = RegQueryValueEx(hCurKey, strValueName, 0&, lValueType, ByVal 0&, lDataBufferSize)
    If lRegResult = ERROR_SUCCESS Then
        If lValueType = REG_BINARY Then
            ReDim byBuffer(lDataBufferSize - 1) As Byte
            lRegResult = RegQueryValueEx(hCurKey, strValueName, 0&, lValueType, byBuffer(0), lDataBufferSize)
            GetRegByte = byBuffer
        End If
    Else
        'there is a problem
    End If
    lRegResult = RegCloseKey(hCurKey)
End Function

Public Function SaveRegByte(ByVal hKey As RegHive, ByVal strPath As String, ByVal strValueName As String, ByVal lData As Byte)
Dim lRegResult As Long
Dim hCurKey As Long
    lRegResult = RegCreateKey(hKey, strPath, hCurKey)
    lRegResult = RegSetValueEx(hCurKey, strValueName, 0&, REG_BINARY, lData, 1)
    lRegResult = RegCloseKey(hCurKey)
End Function

Public Function CopyRegByte(ByVal From_hKey As RegHive, ByVal From_strPath As String, _
    ByVal From_strKeyName As String, ByVal To_strPath As String, _
    Optional ByVal To_hKey As RegHive, Optional ByVal To_strKeyName As String)

    If To_hKey = 0 Then
        To_hKey = From_hKey
    Else
        To_hKey = To_hKey
    End If
    If To_strKeyName = "" Then
        To_strKeyName = From_strKeyName
    Else
        To_strKeyName = To_strKeyName
    End If
    
Dim mybytes As Variant
    mybytes = GetRegByte(From_hKey, From_strPath, From_strKeyName)
    thelen = UBound(mybytes)
    Dim x() As Byte
    ReDim x(thelen)
    For i = 0 To UBound(mybytes)
        x(i) = mybytes(i)
    Next i
    rslt = SaveRegByte(To_hKey, To_strPath, To_strKeyName, x)
End Function

Public Function CopyRegString(ByVal From_hKey As RegHive, ByVal From_strPath As String, _
    ByVal From_strKeyName As String, ByVal To_strPath As String, _
    Optional ByVal To_hKey As RegHive, Optional ByVal To_strKeyName As String)
        
    If To_hKey = 0 Then
        To_hKey = From_hKey
    Else
        To_hKey = To_hKey
    End If
    If To_strKeyName = "" Then
        To_strKeyName = From_strKeyName
    Else
        To_strKeyName = To_strKeyName
    End If
        
    Dim mystring As String
    mystring = GetRegString(From_hKey, From_strPath, From_strKeyName)
    rslt = SaveRegString(To_hKey, To_strPath, To_strKeyName, mystring)
    
End Function

Public Function CopyRegLong(ByVal hKey As RegHive, ByVal From_strPath As String, _
    ByVal From_strKeyName As String, ByVal To_strPath As String, _
    Optional ByVal To_hKey As RegHive, Optional ByVal To_strKeyName As String)
        
    If To_hKey = 0 Then
        To_hKey = From_hKey
    Else
        To_hKey = To_hKey
    End If
    If To_strKeyName = "" Then
        To_strKeyName = From_strKeyName
    Else
        To_strKeyName = To_strKeyName
    End If
        
    Dim mylong As Long
    mylong = GetRegLong(From_hKey, From_strPath, From_strKeyName)
    rslt = SaveRegLong(To_hKey, To_strPath, To_strKeyName, mylong)
    
End Function
Public Function GetRegSubKeyList(ByVal hKey As RegHive, ByVal strPath As String)
On Error Resume Next
Dim lResult As Long, lKeyValue As Long, lDataTypeValue As Long, lValueLength As Long
Dim sValue As String, td As Double, i As Long, Ret As Boolean, tmprst()
Do Until Ret = True
    lResult = RegOpenKey(hKey, strPath, lKeyValue)
    sValue = Space$(2048)
    lValueLength = Len(sValue)
    lResult = RegEnumKey(lKeyValue, i, sValue, lValueLength)
    If (lResult = 0) And (Err.Number = 0) Then
        ReDim Preserve tmprst(i)
        tmprst(i) = Left$(sValue, InStr(sValue, Chr(0)) - 1)
    Else
       Ret = True
    End If
    lResult = RegCloseKey(lKeyValue)
    i = i + 1
Loop
GetRegSubKeyList = tmprst
End Function