Option Explicit

Public Enum ERROR
    ERROR_SUCCESS = 0&
    ERROR_BADDB = 1009&
    ERROR_BADKEY = 1010&
    ERROR_CANTOPEN = 1011&
    ERROR_CANTREAD = 1012&
    ERROR_CANTWRITE = 1013&
    ERROR_OUTOFMEMORY = 14&
    ERROR_INVALID_PARAMETER = 87&
    ERROR_ACCESS_DENIED = 5&
    ERROR_NO_MORE_ITEMS = 259&
    ERROR_MORE_DATA = 234&
End Enum

Public Enum KEYTYPE
    REG_SZ = 1&
    REG_EXPAND_SZ = 2&
    REG_BINARY = 3
    REG_DWORD = 4&
End Enum

Public Enum MAINKEY
    HKEY_CURRENT_USER = &H80000001
    HKEY_LOCAL_MACHINE = &H80000002
    HKEY_CLASSES_ROOT = &H80000000
    HKEY_CURRENT_CONFIG = &H80000005
    HKEY_USERS = &H80000003
End Enum

Private Const READ_CONTROL = &H20000
Private Const WRITE_DAC = &H40000
Private Const WRITE_OWNER = &H80000

Private Const STANDARD_RIGHTS_READ = (READ_CONTROL)
Private Const STANDARD_RIGHTS_WRITE = (READ_CONTROL)
Private Const STANDARD_RIGHTS_ALL = &H1F0000
Private Const STANDARD_RIGHTS_EXECUTE = (READ_CONTROL)

Private Const SYNCHRONIZE = &H100000

Public Enum KEYMODE
    KEY_QUERY_VALUE = &H1
    KEY_NOTIFY = &H10
    KEY_CREATE_LINK = &H20
    KEY_CREATE_SUB_KEY = &H4
    KEY_ENUMERATE_SUB_KEYS = &H8
    KEY_EVENT = &H1     '  Event contains key event record
    KEY_SET_VALUE = &H2
    KEY_READ = ((STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) And (Not SYNCHRONIZE))
    KEY_WRITE = ((STANDARD_RIGHTS_WRITE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY) And (Not SYNCHRONIZE))
    KEY_EXECUTE = ((KEY_READ) And (Not SYNCHRONIZE))
    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))
End Enum

Private Type SECURITY_ATTRIBUTES
    nLength As Long
    lpSecurityDescriptor As Long
    bInheritHandle As Long
End Type
Private Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type

Private Declare Function RegEnumValue Lib "advapi32.dll" Alias "RegEnumValueA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpValueName As String, lpcbValueName As Long, lpReserved As Long, lpType As Long, lpData As Byte, lpcbData 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, ByVal lpReserved As Long, ByVal lpClass As String, lpcbClass As Long, lpftLastWriteTime As FILETIME) 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 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 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 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
Private Declare Function RegSetValueExA Lib "advapi32.dll" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByRef lpData As Long, ByVal cbData 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 RegSaveKey Lib "advapi32.dll" Alias "RegSaveKeyA" (ByVal hKey As Long, ByVal lpFile As String, ByVal lpSecurityAttributes As Long) As Long
Private Declare Function RegRestoreKey Lib "advapi32.dll" Alias "RegRestoreKeyA" (ByVal hKey As Long, ByVal lpFile As String, ByVal dwFlags As Long) As Long

Public Function GetValue(ByVal hKey As MAINKEY, ByVal subKey As String, ByVal keyItem As String, ByRef keyValue As Variant) As Long
    Dim kLength As Long, kBuffer As String * 255, kHandle As Long, kType As Long, kData As Long
    Dim rtn As Long
    '取得KEY的句柄
    rtn = RegOpenKeyEx(hKey, subKey, 0, KEY_READ, kHandle)
    If rtn <> ERROR.ERROR_SUCCESS Then
        GetValue = rtn
        Exit Function
    End If
   
    '取得KEY的类型
    rtn = RegQueryValueEx(kHandle, keyItem, 0, kType, ByVal 0, kLength)
    GetValue = rtn
    If rtn <> ERROR.ERROR_SUCCESS Then
        Exit Function
    End If
   
    '根据KEY的类型取值
    Select Case kType
        Case KEYTYPE.REG_SZ     '字符串
            rtn = RegQueryValueEx(kHandle, keyItem, 0, kType, ByVal kBuffer, kLength)
            GetValue = rtn
            If rtn <> ERROR.ERROR_SUCCESS Then
                Exit Function
            End If
            keyValue = Left(kBuffer, InStr(kBuffer, Chr(0)) - 1)
           
        Case KEYTYPE.REG_EXPAND_SZ  '字符串
            rtn = RegQueryValueEx(kHandle, keyItem, 0, kType, ByVal kBuffer, kLength)
            GetValue = rtn
            If rtn <> ERROR.ERROR_SUCCESS Then
               Exit Function
            End If
            keyValue = Left(kBuffer, InStr(kBuffer, Chr(0)) - 1)
           
        Case KEYTYPE.REG_DWORD      '双字
            rtn = RegQueryValueEx(kHandle, keyItem, 0, kType, kData, kLength)
            GetValue = rtn
            If rtn <> ERROR.ERROR_SUCCESS Then
                Exit Function
            End If
            keyValue = kData
        Case KEYTYPE.REG_BINARY     '二进制
            rtn = RegQueryValueEx(kHandle, keyItem, 0, kType, kData, kLength)
            GetValue = rtn
            If rtn <> ERROR.ERROR_SUCCESS Then
                Exit Function
            End If
            keyValue = kData
    End Select
    RegCloseKey kHandle
End Function

Public Function DeleteValue(ByVal hKey As MAINKEY, ByVal subKey As String, keyItem As String) As Long
    Dim kHandle As Long, rtn As Long
    rtn = RegOpenKeyEx(hKey, subKey, 0, KEYMODE.KEY_WRITE, kHandle)
    DeleteValue = rtn
    If rtn <> ERROR.ERROR_SUCCESS Then
        Exit Function
    End If
   
    rtn = RegDeletevalue(kHandle, keyItem)
    DeleteValue = rtn
    If rtn <> ERROR.ERROR_SUCCESS Then
        Exit Function
    End If
   
    RegCloseKey kHandle
   
End Function

Public Function DeleteKey(ByVal hKey As MAINKEY, ByVal subKey As String, ByVal delKey As String) As Long
    Dim kHandle As Long, rtn As Long
    rtn = RegOpenKeyEx(hKey, subKey, 0, KEYMODE.KEY_WRITE, kHandle)
    DeleteKey = rtn
    If rtn <> ERROR.ERROR_SUCCESS Then
        Exit Function
    End If
   
    rtn = RegDeleteKey(kHandle, delKey)
    DeleteKey = rtn
    If rtn <> ERROR.ERROR_SUCCESS Then
        Exit Function
    End If
   
    RegCloseKey kHandle
   
End Function

Public Function AddValue(ByVal hKey As MAINKEY, ByVal subKey As String, ByVal KItem As String, ByVal vType As KEYTYPE, ByVal Value As Variant) As Long
    Dim kHandle As Long, rtn As Long, cResult As Long
   
    Dim sa As SECURITY_ATTRIBUTES
    sa.nLength = Len(sa)
    sa.lpSecurityDescriptor = 0
    sa.bInheritHandle = True
   
    rtn = RegOpenKeyEx(hKey, subKey, 0, KEYMODE.KEY_WRITE, kHandle)
    If rtn <> ERROR.ERROR_SUCCESS Then
        rtn = RegCreateKeyEx(hKey, subKey, 0, "", 0, KEYMODE.KEY_WRITE, sa, kHandle, cResult)
        AddValue = rtn
        If rtn <> ERROR.ERROR_SUCCESS Then
            Exit Function
        End If
    End If
   
    Select Case vType
    Case KEYTYPE.REG_BINARY
        rtn = RegSetValueExA(kHandle, KItem, 0, vType, Value, Len(Value))
        AddValue = rtn
        If rtn <> ERROR_SUCCESS Then
            Exit Function
        End If
    Case KEYTYPE.REG_DWORD
        rtn = RegSetValueExA(kHandle, KItem, 0, vType, Value, 4)
        AddValue = rtn
        If rtn <> ERROR.ERROR_SUCCESS Then
            Exit Function
        End If
    Case KEYTYPE.REG_EXPAND_SZ
        Value = StrConv(Value, vbUnicode)
        rtn = RegSetValueEx(kHandle, KItem, 0, vType, StrConv(Value, vbFromUnicode), Len(Value))
        AddValue = rtn
        If rtn <> ERROR.ERROR_SUCCESS Then
            Exit Function
        End If
    Case KEYTYPE.REG_SZ
        Value = StrConv(Value, vbUnicode)
        rtn = RegSetValueEx(kHandle, KItem, 0, vType, StrConv(Value, vbFromUnicode), Len(Value))
        AddValue = rtn
        If rtn <> ERROR.ERROR_SUCCESS Then
            Exit Function
        End If
    End Select
   
    RegCloseKey kHandle
End Function