'*****下面先声明一些常量******************************************

Public Const HKEY_CLASSES_ROOT = &H80000000

Public Const HKEY_CURRENT_CONFIG = &H80000005

Public Const HKEY_CURRENT_USER = &H80000001

Public Const HKEY_DYN_DATA = &H80000006

Public Const HKEY_LOCAL_MACHINE = &H80000002

Public Const HKEY_USERS = &H80000003

Public Const REG_OPTION_NON_VOLATILE = 0

Public Const KEY_ALL_ACCESS = (&H20000 Or &H1 Or &H2 Or &H4 Or &H8 Or &H10 Or &H20) And (Not &H100000)

Public Const REG_SZ = 1

Public Const REG_DWORD = 4

'*****************************************************************

'*****下面声明注册表操作中用到的API函数****************************

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

Public 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

Public Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) 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 RegSetValueExLong Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpValue As Long, ByVal cbData As Long) As Long

Public 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 lpValue As String, ByVal cbData As Long) As Long

Public Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long

'*****************************************************************

'*****下面是我自己写的一些注册表操作中常用的一些函数**************

'*****新键注册表项

Public Function createnewkey(ip As Long, snewkeyname As String)

    Dim hnewkey As Long

    Dim retval As Long

    retval = RegCreateKey(ip, snewkeyname, hnewkey)

    If retval = 0 Then

            RegCloseKey (hnewkey) '关闭上面建立或打开的项

    End If

End Function

'实例：在HKEY_CURRENT_USER下建立项"xiaopeng"

'代码为 createnewkey HKEY_CURRENT_USER ,"xiaopeng"

'******************************************************************

'*******删除注册表项***********************************************

Public Function deletekey(ip As Long, skeyname As String)

    Dim hKey As Long

    Dim retval As Long

    retval = RegOpenKeyEx(ip, skeyname, 0, KEY_ALL_ACCESS, hKey)

    If retval = 0 Then

            RegDeleteKey ip, skeyname

    End If

End Function

'实例：删除上面建立的HKEY_CURRENT_USER下的项"xiaopeng"

'代码为 deletekey HKEY_CURRENT_USER ,"xiaopeng"

'******************************************************************

'********新建,设置数值名称*****************************************

Public Function setkeyvalue(ByVal ip As Long, ByVal keyname As String, ByVal valuename As String, ByVal valuesetting As Variant, ByVal valuetype As Long)

    Dim retval As Long

    Dim hKey As Long

    If RegOpenKeyEx(ip, keyname, 0, KEY_ALL_ACCESS, hKey) > 0 Then Exit Function

    Select Case valuetype

        Case REG_SZ

             RegSetValueExString hKey, valuename, 0&, REG_SZ, valuesetting, Len(valuesetting)

        Case REG_DWORD

             RegSetValueExLong hKey, valuename, 0, valuetype, valuesetting, 4

    End Select

    RegCloseKey (hKey)

End Function

'实例：在HKEY_CURRENT_USER下的项"xiaopeng"中建立名为"redice",键值为"is xiaopeng",类型为REG_SZ的新键

'代码为 setkeyvalue HKEY_CURRENT_USER ,"xiaopeng" ,"redice","is xiaopeng",REG_SZ

'又如:在HKEY_CURRENT_USER下的项"xiaopeng"中建立名为"ceshi",键值为2,类型为REG_DWORD的新键

'代码为"setkeyvalue HKEY_CURRENT_USER,"xiaopeng","ceshi",2,REG_DWORD

'******************************************************************

'*********删除数值名称*********************************************

Public Function deletevalue(ByVal ip As Long, ByVal keyname As String, ByVal valuename As String)

    Dim retval As Long

    Dim hKey As Long

    retval = RegOpenKeyEx(ip, keyname, 0, KEY_ALL_ACCESS, hKey)

    If retval > 0 Then

        Exit Function

    End If

    RegDeleteValue hKey, valuename

    RegCloseKey hKey

End Function

'实例：删除HKEY_CURRENT_USER下的项"xiaopeng"中名为"redice"的新键

'代码为 deletevalue HKEY_CURRENT_USER ,"xiaopeng","redice"

'******************************************************************

'**********查询已存在的数值内容************************************

Public Function getvalue(ByVal ip As Long, keyname As String, valuename As String) As String

    Dim retval As Long

    Dim hKey As Long

    Dim valuesetting As Variant

    Dim cddata As Long

    Dim lvalue As Long

    Dim svalue As String

    Dim lvaluetye As Long

    retval = RegOpenKeyEx(ip, keyname, 0, KEY_ALL_ACCESS, hKey)

    If retval > 0 Then

            getvalue = ""

            Exit Function

    End If

    retval = RegQueryValueEx(hKey, valuename, 0, lvaluetype, ByVal VBNullString, cddata)

    If retval <> 0 Then

                RegCloseKey hKey

        Exit Function

    End If

    Select Case lvaluetype

        Case REG_SZ

                svalue = String(cddata, Chr(0))

                RegQueryValueEx hKey, valuename, 0, lvaluetype, ByVal svalue, cddata

                valuesetting = Left$(svalue, cddata)

                getvalue = CStr(valuesetting)

        Case REG_DWORD

                RegQueryValueEx hKey, valuename, 0, lvaluetype, lvalue, cddata

                valuesetting = lvalue

                getvalue = CStr(valuesetting)

    End Select

End Function

'实例：获取HKEY_CURRENT_USER下的项"xiaopeng"中名为"redice"的新键的键值

'代码为 getvalue HKEY_CURRENT_USER ,"xiaopeng","redice"

'******************************************************

  回想从02年为CPCW编写IntelSetXP注册表智能设置程序以来，至今已有五个年头，五来年从网上得到大家多少资料已说不清，今才把自己的资料整理发给大家，以供需要时使用。
 下面代码可供大家尽情操作注册表。
'用于操作注册表的API函数定义    -begin-
Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
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
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, lpData As Any, ByVal cbData 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, lpData As Any, lpcbData As Long) As Long
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 RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long
'用于操作注册表的API函数定义    -end-
'用于操作注册表的常数定义   -begin-
'预定义的根结点
Public Const HKEY_CLASSES_ROOT = &H80000000
Public Const HKEY_CURRENT_CONFIG = &H80000005
Public Const HKEY_CURRENT_USER = &H80000001
Public Const HKEY_DYN_DATA = &H80000006
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const HKEY_PERFORMANCE_DATA = &H80000004
Public Const HKEY_USERS = &H80000003
'预定义的键值类型
Public Const REG_NONE = 0
Public Const REG_SZ = 1
Public Const REG_EXPAND_SZ = 2
Public Const REG_BINARY = 3
Public Const REG_DWORD = 4
Public Const REG_DWORD_LITTLE_ENDIAN = 4
Public Const REG_DWORD_BIG_ENDIAN = 5
Public Const REG_LINK = 6
Public Const REG_MULTI_SZ = 7
Public Const REG_RESOURCE_LIST = 8
Public Const REG_FULL_RESOURCE_DESCRIPTOR = 9
Public Const REG_RESOURCE_REQUIREMENTS_LIST = 10
#If WinNT Then
'打开注册文件的方式
Public Const KEY_EVENT = &H1
Public Const KEY_NOTIFY = &H10
Public Const KEY_QUERY_VALUE = &H1
Public Const KEY_SET_VALUE = &H2
Public Const KEY_CREATE_SUB_KEY = &H4
Public Const KEY_ENUMERATE_SUB_KEYS = &H8
Public Const KEY_CREATE_LINK = &H20
Public Const KEY_READ = ((STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) And (Not SYNCHRONIZE))
Public Const KEY_EXECUTE = (KEY_READ)
Public Const KEY_WRITE = ((STANDARD_RIGHTS_WRITE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY) And (Not SYNCHRONIZE))
Public 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))
#End If
'注册文件错误描述
Const ERROR_SUCCESS = 0&
Const ERROR_BADDB = 1009&
Const ERROR_BADKEY = 1010&
Const ERROR_CANTOPEN = 1011&
Const ERROR_CANTREAD = 1012&
Const ERROR_CANTWRITE = 1013&
Const ERROR_REGISTRY_RECOVERED = 1014&
Const ERROR_REGISTRY_CORRUPT = 1015&
Const ERROR_REGISTRY_IO_FAILED = 1016&
Const ERROR_NOT_REGISTRY_FILE = 1017&
Const ERROR_KEY_DELETED = 1018&
Const ERROR_NO_LOG_SPACE = 1019&
Const ERROR_KEY_HAS_CHILDREN = 1020&
Const ERROR_CHILD_MUST_BE_VOLATILE = 1021&
Const ERROR_RXACT_INVALID_STATE = 1369&
' 自定义注册文件错误
Const REGAGENT_NOKEY = -1002
Const REGAGENT_NOSUBKEY = -1003
Public glStatus As Long
'用于操作注册表的常数定义   -end-
Function gfsGetKeyStringValue(ByVal plKey As Long, ByVal psKey As String, ByVal psSubKey As String) As String
'功    能：从注册表中取得串值
'参    数：
'          输入:    plKey                   Long        根键名
'                   psKey                   String      主键名
'                   psSubKey                String      子键名
'          输出:    gfsGetKeyStringValue    String      取得的注册表串值
'          影响:    glStatus                Long        状态值
    Dim llKeyID         As Long         '打开键的ID
    Dim llBufferSize    As Long         '需读取串的串值长度
    Dim lsKeyValue      As String       '存放读取的串值
    
    '预先置为空
    gfsGetKeyStringValue = Empty
    
    glStatus = ERROR_SUCCESS        '假设成功
    
    '确定参数有效
    If Len(psKey) = 0 Then      '主键未设置（子键未设置则读默认值）
        glStatus = REGAGENT_NOKEY
        Exit Function
    End If
       
    '首先打开主键
    glStatus = RegOpenKey(plKey, psKey, llKeyID)
    
    If glStatus = ERROR_SUCCESS Then    '成功则取需读取字串的串值大小
        glStatus = RegQueryValueEx(llKeyID, psSubKey, 0&, REG_SZ, 0&, llBufferSize)
        If llBufferSize < 2 Then    '空值
            glStatus = RegCloseKey(llKeyID)
        Else    '有值，正式读取串值
            lsKeyValue = String(llBufferSize + 1, " ")
            glStatus = RegQueryValueEx(llKeyID, psSubKey, 0&, REG_SZ, ByVal lsKeyValue, llBufferSize)
            If glStatus = ERROR_SUCCESS Then
                gfsGetKeyStringValue = Left$(lsKeyValue, llBufferSize - 1)
            End If
            glStatus = RegCloseKey(llKeyID)
        End If
    End If
End Function
Function gflGetKeyBinaryValue(ByVal plKey As Long, ByVal psKey As String, ByVal psSubKey As String) As Long
'功    能：从注册表中取得二进制值
'参    数：
'          输入:    plKey                   Long        根键名
'                   psKey                   String      主键名
'                   psSubKey                String      子键名
'          输出:    gflGetKeyBinaryValue    Long        取得的注册表二进制值
'          影响:    glStatus                Long        状态值
    Dim llKeyID         As Long         '打开键的ID
    Dim llKeyValue      As Long         '存放读取的二进制值
    
    '预先置为空
    gflGetKeyBinaryValue = Empty
    
    glStatus = ERROR_SUCCESS        '假设成功
    
    '确定参数有效
    If Len(psKey) = 0 Then      '主键未设置（子键未设置则读默认值）
        glStatus = REGAGENT_NOKEY
        Exit Function
    End If
       
    '首先打开主键
    glStatus = RegOpenKey(plKey, psKey, llKeyID)
    
    If glStatus = ERROR_SUCCESS Then    '成功则取二进制值
        glStatus = RegQueryValueEx(llKeyID, psSubKey, 0&, REG_BINARY, llKeyValue, Len(llKeyValue))
        If glStatus = ERROR_SUCCESS Then
            gflGetKeyBinaryValue = llKeyValue
        End If
        glStatus = RegCloseKey(llKeyID)
    End If
End Function
Function gflGetKeyDwordValue(ByVal plKey As Long, ByVal psKey As String, ByVal psSubKey As String) As Long
'ok
'功    能：从注册表中取得双字值
'参    数：
'          输入:    plKey                   Long        根键名
'                   psKey                   String      主键名
'                   psSubKey                String      子键名
'          输出:    gflGetKeyDwordValue     Long        取得的注册表双字值
'          影响:    glStatus                Long        状态值
    Dim llKeyID         As Long         '打开键的ID
    Dim llKeyValue      As Long         '存放读取的双字值
    
    '预先置为空
    gflGetKeyDwordValue = Empty
    
    glStatus = ERROR_SUCCESS        '假设成功
    
    '确定参数有效
    If Len(psKey) = 0 Then      '主键未设置（子键未设置则读默认值）
        glStatus = REGAGENT_NOKEY
        Exit Function
    End If
       
    '首先打开主键
    glStatus = RegOpenKey(plKey, psKey, llKeyID)
    
    If glStatus = ERROR_SUCCESS Then    '成功则取双字值
        glStatus = RegQueryValueEx(llKeyID, psSubKey, 0&, REG_DWORD, llKeyValue, Len(llKeyValue))
        If glStatus = ERROR_SUCCESS Then
            gflGetKeyDwordValue = llKeyValue
        End If
        glStatus = RegCloseKey(llKeyID)
    End If
End Function
Sub gpvSetKeyStringValue(ByVal plKey As Long, ByVal psKey As String, ByVal psSubKey As String, ByVal psKeyValue As String)
'ok
'功    能：设置注册表中的串值
'参    数：
'          输入:    plKey                   Long        根键名
'                   psKey                   String      主键名
'                   psSubKey                String      子键名
'                   psKeyValue              String      要设置的串值
'          输出:    无
'          影响:    glStatus                Long        状态值
    Dim llKeyID         As Long         '打开键的ID
    
    glStatus = ERROR_SUCCESS        '假设成功
    
    '确定参数有效
    If Len(psKey) = 0 Then      '主键未设置（子键未设置则读默认值）
        glStatus = REGAGENT_NOKEY
        Exit Sub
    End If
    
    '首先打开主键
    glStatus = RegOpenKey(plKey, psKey, llKeyID)
    If glStatus = ERROR_SUCCESS Then    '成功则设置值
        If Len(psKeyValue) = 0 Then     '设为空值
            glStatus = RegSetValueEx(llKeyID, psSubKey, 0&, REG_SZ, 0&, 0&)
        Else        '设为正常值
            glStatus = RegSetValueEx(llKeyID, psSubKey, 0&, REG_SZ, ByVal psKeyValue, Len(psKeyValue) + 1)
        End If
        glStatus = RegCloseKey(llKeyID)
    End If
    
End Sub
Sub gpvSetKeyDwordValue(ByVal plKey As Long, ByVal psKey As String, ByVal psSubKey As String, ByVal plKeyValue As Long)
'ok
'功    能：设置注册表中的双字值
'参    数：
'          输入:    plKey                   Long        根键名
'                   psKey                   String      主键名
'                   psSubKey                String      子键名
'                   plKeyValue              Long        要设置双字值
'          输出:    无
'          影响:    glStatus                Long        状态值
    Dim llKeyID         As Long         '打开键的ID
    
    glStatus = ERROR_SUCCESS        '假设成功
    
    '确定参数有效
    If Len(psKey) = 0 Then      '主键未设置（子键未设置则读默认值）
        glStatus = REGAGENT_NOKEY
        Exit Sub
    End If
    
    '首先打开主键
    glStatus = RegOpenKey(plKey, psKey, llKeyID)
    
    If glStatus = ERROR_SUCCESS Then    '成功则设置值
        glStatus = RegSetValueEx(llKeyID, psSubKey, 0&, REG_DWORD, plKeyValue, Len(plKeyValue))
        glStatus = RegCloseKey(llKeyID)
    End If
    
End Sub
Sub gpvSetKeyBinaryValue(ByVal plKey As Long, ByVal psKey As String, ByVal psSubKey As String, ByVal plKeyValue As Long)
'ok
'功    能：设置注册表中的二进制值
'参    数：
'          输入:    plKey                   Long        根键名
'                   psKey                   String      主键名
'                   psSubKey                String      子键名
'                   plKeyValue              Long        要设置的二进制值
'          输出:    无
'          影响:    glStatus                Long        状态值
    Dim llKeyID         As Long         '打开键的ID
    
    glStatus = ERROR_SUCCESS        '假设成功
    
    '确定参数有效
    If Len(psKey) = 0 Then      '主键未设置（子键未设置则读默认值）
        glStatus = REGAGENT_NOKEY
        Exit Sub
    End If
    
    '首先打开主键
    glStatus = RegOpenKey(plKey, psKey, llKeyID)
    
    If glStatus = ERROR_SUCCESS Then    '成功则设置值
        glStatus = RegSetValueEx(llKeyID, psSubKey, 0&, REG_BINARY, plKeyValue, Len(plKeyValue))
        glStatus = RegCloseKey(llKeyID)
    End If
    
End Sub
Function gflCreateKey(ByVal plKey As Long, ByVal psKey As String) As Long
'ok
'功    能：创建注册表中的主键
'参    数：
'          输入:    plKey                   Long        根键名
'                   psKey                   String      主键名
'          输出:    gflCreateKey            Long        创建的主键ID
'          影响:    glStatus                Long        状态值
    Dim llKeyID     As Long     '键ID
    
    glStatus = ERROR_SUCCESS        '假设成功
    
    '确定参数有效
    If Len(psKey) = 0 Then      '主键未设置
        glStatus = REGAGENT_NOKEY
        Exit Function
    End If
        
    '创建主键
    glStatus = RegCreateKey(plKey, psKey, llKeyID)
    If glStatus = ERROR_SUCCESS Then
        gflCreateKey = llKeyID
    End If
    
End Function
Sub gpvDeleteKey(ByVal plKey As Long, ByVal psKey As String, ByVal psSubKey As String)
'ok
'功    能：删除注册表中的主键
'参    数：
'          输入:    plKey                   Long        根键名
'                   psKey                   String      主键名
'                   psSubKey                String      子键名
'          输出:    无
'          影响:    glStatus                Long        状态值
    Dim llKeyID     As Long     '键ID
    
    glStatus = ERROR_SUCCESS        '假设成功
如有需要，可QQ与我联系。398175615
    
    '确定参数有效
    If Len(psKey) = 0 Then      '主键未设置
        glStatus = REGAGENT_NOKEY
        Exit Sub
    End If
        
    '利用创建主键判断是否存在主键
    glStatus = RegCreateKey(plKey, psKey, llKeyID)
    glStatus = RegDeleteKey(llKeyID, ByVal psSubKey)
        
End Sub
Sub gpvDeleteKeyValue(ByVal plKey As Long, ByVal psKey As String, ByVal psSubKey As String)
'ok
'功    能：删除注册表中的键值
'参    数：
'          输入:    plKey                   Long        根键名
'                   psKey                   String      主键名
'                   psSubKey                String      子键名
'          输出:    无
'          影响:    glStatus                Long        状态值
    Dim llKeyID     As Long     '键ID
    
    glStatus = ERROR_SUCCESS        '假设成功
    
    '确定参数有效
    If Len(psKey) = 0 Then      '主键未设置
        glStatus = REGAGENT_NOKEY
        Exit Sub
    End If
        
    '利用创建主键判断是否存在主键
    glStatus = RegCreateKey(plKey, psKey, llKeyID)
    glStatus = RegDeleteValue(llKeyID, ByVal psSubKey)
        
End Sub
'Function gfsGetKeyStringValue(ByVal plKey As Long, ByVal psKey As String, ByVal psSubKey As String) As String
'功    能：从注册表中取得串值
'Function gflGetKeyBinaryValue(ByVal plKey As Long, ByVal psKey As String, ByVal psSubKey As String) As Long
'功    能：从注册表中取得二进制值
'Function gflGetKeyDwordValue(ByVal plKey As Long, ByVal psKey As String, ByVal psSubKey As String) As Long
'功    能：从注册表中取得双字值
'Sub gpvSetKeyStringValue(ByVal plKey As Long, ByVal psKey As String, ByVal psSubKey As String, ByVal psKeyValue As String)
'功    能：设置注册表中的串值
'Sub gpvSetKeyDwordValue(ByVal plKey As Long, ByVal psKey As String, ByVal psSubKey As String, ByVal plKeyValue As Long)
'功    能：设置注册表中的双字值
'Sub gpvSetKeyBinaryValue(ByVal plKey As Long, ByVal psKey As String, ByVal psSubKey As String, ByVal plKeyValue As Long)
'功    能：设置注册表中的二进制值
'Function gflCreateKey(ByVal plKey As Long, ByVal psKey As String) As Long
'功    能：创建注册表中的主键
'Sub gpvDeleteKey(ByVal plKey As Long, ByVal psKey As String, ByVal psSubKey As String)
'功    能：删除注册表中的主键
'Sub gpvDeleteKeyValue(ByVal plKey As Long, ByVal psKey As String, ByVal psSubKey As String)
'功    能：删除注册表中的键值
 

Option Explicit

' 
'注册表操作(SmRegCtr) 
' 
'/类型. 
Public Enum RegDataType
    '/REG_NONE = 0                     ' 未知类型 
    REG_SZ = 1                         ' Unicode字符串 
    '/REG_EXPAND_SZ = 2                ' Unicode字符串 
    REG_BINARY = 3                     ' 二进制 
    '/REG_DWORD = 4                    ' 双字节型. 
    '/REG_DWORD_LITTLE_ENDIAN = 4      ' 32-bit number (same as REG_DWORD) 
    '/REG_DWORD_BIG_ENDIAN = 5         ' 32-bit number 
End Enum

Public Enum RegMainKey
    HKEY_CLASSES_ROOT = 
    HKEY_CURRENT_USER = 
    HKEY_LOCAL_MACHINE = 
    HKEY_USERS = 
    HKEY_PERFORMANCE_DATA = 
    HKEY_CURRENT_CONFIG = 
    HKEY_DYN_DATA = 
End Enum
' 
Const READ_CONTROL = 
Const STANDARD_RIGHTS_READ = (READ_CONTROL)
Const STANDARD_RIGHTS_WRITE = (READ_CONTROL)
Const KEY_QUERY_VALUE = 
Const KEY_SET_VALUE = 
Const KEY_CREATE_SUB_KEY = 
Const KEY_ENUMERATE_SUB_KEYS = 
Const KEY_NOTIFY = 
Const KEY_CREATE_LINK = 
Const SYNCHRONIZE = 
Const STANDARD_RIGHTS_ALL = 
'---------------------------------------------------------------- 
Const KEY_READ = ((STANDARD_RIGHTS_READ Or _
   KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) _
   And (Not SYNCHRONIZE))
Const KEY_WRITE = ((STANDARD_RIGHTS_WRITE Or _
   KEY_SET_VALUE Or KEY_CREATE_SUB_KEY) And (Not SYNCHRONIZE))
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))
Const KEY_EXECUTE = ((KEY_READ) And (Not SYNCHRONIZE))
Const ERROR_SUCCESS = 0
'----------------------------------------------------------------- 
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey 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 RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long
Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult 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, lpData As Any, ByVal cbData 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 Any) 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
' 
'功能:取某键值下的所有项 
'函数:RegEnumKeyVal 
'参数:hKey RegMainKey枚举,subKey 子键路径名称. 
'返回值:String 字符串数组 
'例子: 
Public Function RegEnumKeyVal(hKey As RegMainKey, subKey As String) As String()

    Dim mhKey As Long, Cnt As Long, sSave As String
    Dim RevVal() As String
    
    On Error Resume Next
    
    RegOpenKey hKey, "Enum", mhKey
    Do
        sSave = String(255, 0)
        If RegEnumKeyEx(mhKey, Cnt, sSave, 255, 0, vbNullString, ByVal 0&, ByVal 0&) <> 0 Then Exit Do
        Cnt = Cnt + 1
    Loop
    RegCloseKey mhKey
    RegOpenKey hKey, subKey, mhKey
    Cnt = 0
    Do
        sSave = String(255, 0)
        If RegEnumValue(mhKey, Cnt, sSave, 255, 0, ByVal 0&, ByVal 0&, ByVal 0&) <> 0 Then Exit Do
        Cnt = Cnt + 1
        ReDim Preserve RevVal(Cnt - 1)
        RevVal(Cnt - 1) = StripTerminator(sSave)
    Loop
    RegCloseKey hKey
    RegEnumKeyVal = RevVal
End Function
    
' 
'功能:建立子键. 
'函数:RegCreatesubKey 
'参数:hKey RegMainKey枚举,subKey 子键名称. 
'返回值:0 成功,其它值 失败. 
'例子: 
Public Function RegCreatesubKey(hKey As RegMainKey, subKey As String) As Variant
       Dim Ret As Variant
       If Left$(subKey, 1) = "/" Then subKey = Right$(subKey, Len(subKey) - 1)
       If Right$(subKey, 1) = "/" Then subKey = Left$(subKey, Len(subKey) - 1)
       RegCreateKey hKey, subKey, Ret
       RegCreatesubKey = Ret
End Function

' 
'功能:删除子键. 
'函数:RegDeletesubKey 
'参数:hKey RegMainKey枚举,subKey 子键名称. 
'返回值:无 
'例子: 
Public Function RegDeletesubKey(hKey As RegMainKey, subKey As String)
       If Left$(subKey, 1) = "/" Then subKey = Right$(subKey, Len(subKey) - 1)
       If Right$(subKey, 1) = "/" Then subKey = Left$(subKey, Len(subKey) - 1)
       RegDeleteKey hKey, subKey
End Function

' 
'功能:保存值到注册表. 
'函数:RegSaveData 
'参数:hKey RegMainKey枚举,subKey 子键名称.ValName 值名称,KeyVal 值,ValType RegDataType枚举. 
'返回值:0 成功,其它值 失败. 
'例子: 

Public Function RegSaveData(hKey As RegMainKey, subKey As String, ValName As String, KeyVal As String, Optional ValType As RegDataType = REG_SZ) As Long
    Dim Ret As Long
    On Error Resume Next
    Ret = 0
    If Left$(subKey, 1) = "/" Then subKey = Right$(subKey, Len(subKey) - 1)
    If Right$(subKey, 1) = "/" Then subKey = Left$(subKey, Len(subKey) - 1)
    If ValType = RegDataType.REG_BINARY Then
       Ret = SaveStringLong(hKey, subKey, ValName, KeyVal)
    Else
       Ret = SaveString(hKey, subKey, ValName, KeyVal)
    End If
    RegSaveData = Ret
End Function

' 
'功能:取注册表中的值. 
'函数:RegGetVal 
'参数:hKey RegMainKey枚举,subKey 子键名称.ValName 值名称 
'返回值:成功,返回注册表中的值,失败 NULL 
'例子: 
Public Function RegGetVal(hKey As RegMainKey, subKey As String, ValName As String) As Variant
    Dim Ret As Variant
    If Left$(subKey, 1) = "/" Then subKey = Right$(subKey, Len(subKey) - 1)
    If Right$(subKey, 1) = "/" Then subKey = Left$(subKey, Len(subKey) - 1)
    Ret = GetString(hKey, subKey, ValName)
    RegGetVal = Ret
End Function

' 
'功能:删除注册表中的值. 
'函数:RegDelVal 
'参数:hKey RegMainKey枚举,subKey 子键名称.ValName 值名称 
'返回值:成功,返回注册表中的值,失败 NULL 
'例子: 
Public Function RegDelVal(hKey As RegMainKey, subKey As String, ValName As String)
       DelSetting hKey, subKey, ValName
End Function

'/=================================================================================== 

'/以下函数为功能函数. 
'/取注册表中的值. 
Function GetString(hKey As RegMainKey, subKey As String, ValName As String) As Variant
    On Error Resume Next
    Dim Ret As Variant
    RegOpenKey hKey, subKey, Ret
    GetString = RegQueryStringValue(Ret, ValName)
    RegCloseKey Ret
End Function

'/保存字符串. 
Function SaveString(hKey As RegMainKey, subKey As String, ValName As String, strData As String)
    Dim Ret As Variant
    Dim ReturnVal As Long
    On Error Resume Next
    RegCreateKey hKey, subKey, Ret
    ReturnVal = RegSetValueEx(Ret, ValName, 0, RegDataType.REG_SZ, ByVal strData, Len(strData))
    RegCloseKey Ret
End Function

'/保存值二进制值. 
Function SaveStringLong(hKey As RegMainKey, subKey As String, ValName As String, strData As String) As Variant
    Dim Ret As Variant
    On Error Resume Next
    RegCreateKey hKey, subKey, Ret
    RegSetValueEx Ret, ValName, 0, RegDataType.REG_BINARY, CByte(strData), 1
    RegCloseKey Ret
End Function

'/删除值 
Function DelSetting(hKey As RegMainKey, subKey As String, ValName As String)
    Dim Ret As Variant
    On Error Resume Next
    RegCreateKey hKey, subKey, Ret
    RegDeleteValue Ret, ValName
    RegCloseKey Ret
End Function

Function RegQueryStringValue(ByVal hKey As RegMainKey, ByVal ValName As String) As String
    Dim lResult As Long
    Dim lValueType As Long
    Dim strBuf As String
    Dim lDataBufSize As Long
    Dim strData As Long
    Dim RetVal As String
    
    On Error Resume Next
    
    lResult = RegQueryValueEx(hKey, ValName, 0, lValueType, ByVal 0, lDataBufSize)
    If lResult = 0 Then
        If lValueType = RegDataType.REG_SZ Then
            strBuf = String(lDataBufSize, Chr$(0))
            lResult = RegQueryValueEx(hKey, ValName, 0, 0, ByVal strBuf, lDataBufSize)
            If lResult = 0 Then
               RetVal = Left$(strBuf, InStr(1, strBuf, Chr$(0)) - 1)
            End If
        ElseIf lValueType = RegDataType.REG_BINARY Then
            lResult = RegQueryValueEx(hKey, ValName, 0, 0, strData, lDataBufSize)
            If lResult = 0 Then
               RetVal = strData
            End If
        End If
    End If
    RegQueryStringValue = RetVal
End Function

Private Function StripTerminator(sInput As String) As String
    Dim ZeroPos As Integer
    ZeroPos = InStr(1, sInput, vbNullChar)
    If ZeroPos > 0 Then
        StripTerminator = Left$(sInput, ZeroPos - 1)
    Else
        StripTerminator = sInput
    End If
End Function

 

Attribute VB_Name = "Reg_Operation"
'这是一个操作注册表的Bas文件,其中包含可以建立新键值,删除键值,查询键值的函数.Powered by barenx
Option Explicit
Option Base 0
Public Declare Function RegCloseKey()Function RegCloseKey Lib "advapi32.dll" (ByVal hkey As Long) As Long
Public Declare Function RegConnectRegistry()Function RegConnectRegistry Lib "advapi32.dll" Alias "RegConnectRegistryA" (ByVal lpMachineName As String, ByVal hkey As Long, phkResult As Long) As Long
Public Declare Function RegCreateKey()Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hkey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Public Declare Function RegCreateKeyEx()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
Public Declare Function RegDeleteKey()Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hkey As Long, ByVal lpSubKey As String) As Long
Public Declare Function RegDeleteValue()Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hkey As Long, ByVal lpValueName As String) As Long
Public Declare Function RegEnumKey()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 Declare Function RegEnumKeyEx()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
Public Declare Function RegEnumValue()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
Public Declare Function RegFlushKey()Function RegFlushKey Lib "advapi32.dll" (ByVal hkey As Long) As Long
Public Declare Function RegGetKeySecurity()Function RegGetKeySecurity Lib "advapi32.dll" (ByVal hkey As Long, ByVal SecurityInformation As Long, pSecurityDescriptor As SECURITY_DESCRIPTOR, lpcbSecurityDescriptor As Long) As Long
Public Declare Function RegLoadKey()Function RegLoadKey Lib "advapi32.dll" Alias "RegLoadKeyA" (ByVal hkey As Long, ByVal lpSubKey As String, ByVal lpFile As String) As Long
Public Declare Function RegNotifyChangeKeyValue()Function RegNotifyChangeKeyValue Lib "advapi32.dll" (ByVal hkey As Long, ByVal bWatchSubtree As Long, ByVal dwNotifyFilter As Long, ByVal hEvent As Long, ByVal fAsynchronus As Long) As Long
Public Declare Function RegOpenKey()Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hkey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Public Declare Function RegOpenKeyEx()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
Public Declare Function RegQueryInfoKey()Function RegQueryInfoKey Lib "advapi32.dll" Alias "RegQueryInfoKeyA" (ByVal hkey As Long, ByVal lpClass As String, lpcbClass As Long, ByVal lpReserved As Long, lpcSubKeys As Long, lpcbMaxSubKeyLen As Long, lpcbMaxClassLen As Long, lpcValues As Long, lpcbMaxValueNameLen As Long, lpcbMaxValueLen As Long, lpcbSecurityDescriptor As Long, lpftLastWriteTime As FILETIME) As Long
Public Declare Function RegQueryValue()Function RegQueryValue Lib "advapi32.dll" Alias "RegQueryValueA" (ByVal hkey As Long, ByVal lpSubKey As String, ByVal lpValue As String, lpcbValue As Long) As Long
Public Declare Function RegQueryValueEx()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 RegReplaceKey()Function RegReplaceKey Lib "advapi32.dll" Alias "RegReplaceKeyA" (ByVal hkey As Long, ByVal lpSubKey As String, ByVal lpNewFile As String, ByVal lpOldFile As String) As Long
Public Declare Function RegRestoreKey()Function RegRestoreKey Lib "advapi32.dll" Alias "RegRestoreKeyA" (ByVal hkey As Long, ByVal lpFile As String, ByVal dwFlags As Long) As Long
Public Declare Function RegSaveKey()Function RegSaveKey Lib "advapi32.dll" Alias "RegSaveKeyA" (ByVal hkey As Long, ByVal lpFile As String, lpSecurityAttributes As SECURITY_ATTRIBUTES) As Long
Public Declare Function RegSetKeySecurity()Function RegSetKeySecurity Lib "advapi32.dll" (ByVal hkey As Long, ByVal SecurityInformation As Long, pSecurityDescriptor As SECURITY_DESCRIPTOR) As Long
Public Declare Function RegSetValue()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
Public Declare Function RegSetValueEx()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 RegUnLoadKey()Function RegUnLoadKey Lib "advapi32.dll" Alias "RegUnLoadKeyA" (ByVal hkey As Long, ByVal lpSubKey As String) As Long
Public Type FILETIME
        dwLowDateTime As Long
        dwHighDateTime As Long
End Type

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

Public Type ACL
        AclRevision As Byte
        AceCount As Integer
        Sbz2 As Integer
        AclSize As Integer
        Sbz1 As Byte
End Type

Public Type SECURITY_DESCRIPTOR
        Revision As Byte
        Sacl As ACL
        Dacl As ACL
        Owner As Long
        Group As Long
        Control As Long
        Sbz1 As Byte
End Type
Public Const REG_BINARY = 3
Public Const REG_CREATED_NEW_KEY = &H1
Public Const REG_DWORD_BIG_ENDIAN = 5
Public Const REG_DWORD_LITTLE_ENDIAN = 4
Public Const REG_EXPAND_SZ = 2
Public Const REG_FORCE_RESTORE = (&H8)
Public Const REG_FULL_RESOURCE_DESCRIPTOR = 9
Public Const REG_KEY_INSTDEV = ("Installed")
Public Const REG_LINK = 6
Public Const REG_NONE = 0
Public Const REG_MULTI_SZ = 7
Public Const REG_NOTIFY_CHANGE_ATTRIBUTES = &H2
Public Const REG_NOTIFY_CHANGE_LAST_SET = &H4
Public Const REG_NOTIFY_CHANGE_NAME = &H1
Public Const REG_NOTIFY_CHANGE_SECURITY = &H8
Public Const REG_NO_LAZY_FLUSH = &H4
Public Const REG_OPENED_EXISTING_KEY = &H2
Public Const REG_OPTION_BACKUP_RESTORE = 4
Public Const REG_OPTION_CREATE_LINK = 2
Public Const REG_OPTION_NON_VOLATILE = 0
Public Const REG_OPTION_OPEN_LINK = &H8
Public Const REG_OPTION_RESERVED = 0
Public Const REG_OPTION_VOLATILE = 1
Public Const REG_QWORD = 11
Public Const REG_QWORD_LITTLE_ENDIAN = 11
Public Const REG_REFRESH_HIVE = &H2
Public Const REG_RESOURCE_LIST = 8
Public Const REG_RESOURCE_REQUIREMENTS_LIST = 10
Public Const REG_RESTORE_LOG_KEY = "RegRestoreLogFile"
Public Const MORE_ROWS = -1
Public Const REG_ROW = MORE_ROWS
Public Const REG_SAVE_LOG_KEY = "RegSaveLogFile"
Public Const REG_SZ = 1
Public Const REG_WHOLE_HIVE_VOLATILE = &H1
Public 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)
Public 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)

Public Const HKEY_CLASSES_ROOT = &H80000000
Public Const HKEY_CURRENT_CONFIG = &H80000005
Public Const HKEY_CURRENT_USER = &H80000001
Public Const HKEY_DYN_DATA = &H80000006
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const HKEY_PERFORMANCE_DATA = &H80000004
Public Const HKEY_USERS = &H80000003

Public Const ERROR_SUCCESS = 0&
Public Const ERROR_NONE = 0
Public Const ERROR_BADDB = 1
Public Const ERROR_BADKEY = 2
Public Const ERROR_CANTOPEN = 3
Public Const ERROR_CANTREAD = 4
Public Const ERROR_CANTWRITE = 5
Public Const ERROR_OUTOFMEMORY = 6
Public Const ERROR_INVALID_PARAMETER = 7
Public Const ERROR_ACCESS_DENIED = 8
Public Const ERROR_INVALID_PARAMETERS = 87
Public Const ERROR_NO_MORE_ITEMS = 259&

Public Const BUFFER_SIZE As Long = 255

Public Const READ_CONTROL = &H20000
Public Const SYNCHRONIZE = &H100000

Public Const STANDARD_RIGHTS_ALL = &H1F0000
Public Const STANDARD_RIGHTS_EXECUTE = (READ_CONTROL)
Public Const STANDARD_RIGHTS_READ = (READ_CONTROL)
Public Const STANDARD_RIGHTS_REQUIRED = &HF0000
Public Const STANDARD_RIGHTS_WRITE = (READ_CONTROL)

Public Const KEY_CREATE_LINK = &H20
Public Const KEY_CREATE_SUB_KEY = &H4
Public Const KEY_ENUMERATE_SUB_KEYS = &H8
Public Const KEY_EVENT = &H1
Public Const KEY_LENGTH_MASK = &HFFFF0000
Public Const KEY_NOTIFY = &H10
Public Const KEY_QUERY_VALUE = &H1
Public Const KEY_SET_VALUE = &H2
Public Const KEY_READ = ((STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) And (Not SYNCHRONIZE))
Public Const KEY_EXECUTE = (KEY_READ)
Public Const KEY_WRITE = ((STANDARD_RIGHTS_WRITE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY) And (Not SYNCHRONIZE))
Public 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))

'*************************************************************************************

Public Function RegDelAllSubVal()Function RegDelAllSubVal(ByVal hKeyR As Long, ByVal mKey As String, Optional ByVal Flush As Boolean = False) As Boolean
  On Error Resume Next
  Dim hkey As Long, Cnt As Long
  Dim sName As String, Ret As Long: sName = Space(BUFFER_SIZE)
  Dim sData(BUFFER_SIZE) As Byte, RetData As Long
  Dim Namespace (NameSpace() As String: ReDim Namespace (NameSpace(1)
  
  If RegOpenKeyEx(ByVal hKeyR, ByVal mKey, ByVal 0&, KEY_ALL_ACCESS, hkey) = ERROR_SUCCESS Then
    Cnt = 0: Ret = BUFFER_SIZE: RetData = BUFFER_SIZE
    If RegEnumValue(hkey, Cnt, sName, Ret, ByVal 0&, ByVal 0&, sData(0), RetData) <> ERROR_NO_MORE_ITEMS Then
      Do
        ReDim Preserve Namespace (NameSpace(Cnt)
        Namespace (NameSpace(Cnt) = Left$(sName, Ret)
        Cnt = Cnt + 1: Ret = BUFFER_SIZE: RetData = BUFFER_SIZE
      Loop While RegEnumValue(hkey, Cnt, sName, Ret, ByVal 0&, ByVal 0&, sData(0), RetData) <> ERROR_NO_MORE_ITEMS
    
      For Cnt = 0 To UBound(Namespace )NameSpace)
        Call RegDeleteValue(ByVal hkey, Namespace (NameSpace(Cnt))
      Next Cnt
    End If
    Cnt = 0:  Ret = BUFFER_SIZE:  RetData = BUFFER_SIZE
    RegDelAllSubVal = (RegEnumValue(hkey, Cnt, sName, Ret, ByVal 0&, ByVal 0&, sData(0), RetData) = ERROR_NO_MORE_ITEMS)
    If Flush Then RegFlushKey hkey
    RegCloseKey hkey
  Else
    RegDelAllSubVal = False
  End If
End Function

Public Function RegDelAllSubKey()Function RegDelAllSubKey(ByVal hKeyRoot As Long, ByVal mKey1 As String, Optional ByVal Flush As Boolean = False) As Boolean ', mKey2 As String
  On Error Resume Next
  Dim hkey As Long, Ret As Long, Cnt As Long
  Dim i As Long, t As FILETIME
  Dim sName As String: sName = Space(BUFFER_SIZE)
  Dim Namespace (NameSpace() As String: ReDim Namespace (NameSpace(1)
  Call RegDelAllSubVal(ByVal hKeyRoot, ByVal mKey1, False)
  If RegOpenKeyEx(ByVal hKeyRoot, ByVal mKey1, ByVal 0&, KEY_ALL_ACCESS, hkey) = ERROR_SUCCESS Then
    RegDelAllSubKey = True: Cnt = 0: Ret = BUFFER_SIZE
    If RegEnumKeyEx(hkey, Cnt, sName, Ret, ByVal 0&, vbNullString, i, t) <> ERROR_NO_MORE_ITEMS Then
      Do
        ReDim Preserve Namespace (NameSpace(Cnt)
        Namespace (NameSpace(Cnt) = Left$(sName, Ret)
        Cnt = Cnt + 1: Ret = BUFFER_SIZE
      Loop While RegEnumKeyEx(hkey, Cnt, sName, Ret, ByVal 0&, vbNullString, i, t) <> ERROR_NO_MORE_ITEMS
      
      For Cnt = LBound(Namespace )NameSpace) To UBound(Namespace )NameSpace)
        Call RegDelAllSubKey(ByVal hKeyRoot, ByVal mKey1 & "" & Namespace (NameSpace(Cnt))
      Next Cnt
    End If
    RegDelAllSubKey = (RegDeleteKey(ByVal hKeyRoot, ByVal mKey1) = ERROR_SUCCESS)
    If Flush Then RegFlushKey hkey
    RegCloseKey hkey
  Else
    RegDelAllSubKey = False
  End If
End Function

Public Function RegDelSingleValue()Function RegDelSingleValue(ByVal mKeyRoot As Long, ByVal sKeyName As String, ByVal sValueName As String) As Long
  On Error Resume Next
  Dim hkey As Long
  If RegOpenKeyEx(mKeyRoot, ByVal sKeyName, ByVal 0&, KEY_ALL_ACCESS, hkey) = ERROR_SUCCESS Then
    RegDelSingleValue = RegDeleteValue(hkey, ByVal sValueName)
    Call RegCloseKey(hkey)
  Else
    RegDelSingleValue = ERROR_CANTOPEN
  End If
End Function

Public Function RegSetSingleValue()Function RegSetSingleValue(ByVal mKeyRoot As Long, ByVal sKeyName As String, ByVal sValueName As String, ByVal sValueType As Long, ByVal sValue As String) As Long
  On Error Resume Next
  Dim hkey As Long
  If RegCreateKey(mKeyRoot, sKeyName, hkey) = ERROR_SUCCESS Then
    RegSetSingleValue = RegSetValueEx(hkey, ByVal sValueName, ByVal 0&, ByVal sValueType, ByVal sValue, ByVal Len(sValue))
    Call RegCloseKey(hkey)
  Else
    RegSetSingleValue = ERROR_CANTOPEN
  End If
End Function