怎样对注册表进行改动

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 EnumPublic Enum RegMainKey
    HKEY_CLASSES_ROOT = &H80000000
    HKEY_CURRENT_USER = &H80000001
    HKEY_LOCAL_MACHINE = &H80000002
    HKEY_USERS = &H80000003
    HKEY_PERFORMANCE_DATA = &H80000004
    HKEY_CURRENT_CONFIG = &H80000005
    HKEY_DYN_DATA = &H80000006
End Enum
'
Const READ_CONTROL = &H20000
Const STANDARD_RIGHTS_READ = (READ_CONTROL)
Const STANDARD_RIGHTS_WRITE = (READ_CONTROL)
Const KEY_QUERY_VALUE = &H1
Const KEY_SET_VALUE = &H2
Const KEY_CREATE_SUB_KEY = &H4
Const KEY_ENUMERATE_SUB_KEYS = &H8
Const KEY_NOTIFY = &H10
Const KEY_CREATE_LINK = &H20
Const SYNCHRONIZE = &H100000
Const STANDARD_RIGHTS_ALL = &H1F0000
'----------------------------------------------------------------
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)
        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 FunctionFunction 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 FunctionPrivate 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

操作注册标的模块,我一直在用的，贴出来供大家研究^_^:
Option Explicit
'===================声明开始  =============================
Public Enum keyroot
  [HKEY_CLASSES_ROOT] = &H80000000
  [HKEY_CURRENT_CONFIG] = &H80000005
  [HKEY_CURRENT_USER] = &H80000001
  [HKEY_LOCAL_MACHINE] = &H80000002
  [HKEY_USERS] = &H80000003
  [HKEY_PERFORMANCE_DATA] = &H80000004
  [HKEY_DYN_DATA] = &H80000006
End EnumPublic Enum KeyType
  [REG_BINARY] = 3
  [REG_DWORD] = 4
  [REG_SZ] = 1
  [REG_EXPAND_SZ] = 2
  [REG_FULL_RESOURCE_DESCRIPTOR] = 9
  [REG_MULTI_SZ] = 7
End EnumPrivate Const KEY_ALL_ACCESS = &HF003F
Private Const KEY_ENUMERATE_SUB_KEYS = &H8
Private Const KEY_READ = &H20019
Private Const KEY_WRITE = &H20006
Private Const KEY_QUERY_VALUE = &H1
Private Const REG_FORCE_RESTORE As Long = 8&
Private Const TOKEN_QUERY As Long = &H8&
Private Const TOKEN_ADJUST_PRIVILEGES As Long = &H20&
Private Const SE_PRIVILEGE_ENABLED As Long = &H2
Private Const SE_RESTORE_NAME = "SeRestorePrivilege"
Private Const SE_BACKUP_NAME = "SeBackupPrivilege"Private Type SECURITY_ATTRIBUTES
  nLength As Long
  lpSecurityDescriptor As Long
  bInheritHandle As Boolean
End TypePrivate Type FILETIME
  dwLowDateTime As Long
  dwHighDateTime As Long
End TypePrivate Type LUID
  lowpart As Long
  highpart As Long
End TypePrivate Type LUID_AND_ATTRIBUTES
  pLuid As LUID
  Attributes As Long
End TypePrivate Type TOKEN_PRIVILEGES
  PrivilegeCount As Long
  Privileges As LUID_AND_ATTRIBUTES
End TypePrivate 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 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 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 RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long
Private Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) 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 RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegSaveKey Lib "advapi32.dll" Alias "RegSaveKeyA" (ByVal hKey As Long, ByVal lpFile As String, lpSecurityAttributes As Any) 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
Private Declare Function RegEnumKeyEx Lib "advapi32.dll" Alias "RegEnumKeyExA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As String, lpcbName As Long, lpReserved As Long, ByVal lpClass As String, lpcbClass As Long, lpftLastWriteTime As FILETIME) 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
Private Declare Function AdjustTokenPrivileges Lib "advapi32.dll" (ByVal TokenHandle As Long, ByVal DisableAllPriv As Long, NewState As TOKEN_PRIVILEGES, ByVal BufferLength As Long, PreviousState As TOKEN_PRIVILEGES, ReturnLength As Long) As Long                'Used to adjust your program's security privileges, can't restore without it!
Private Declare Function LookupPrivilegeValue Lib "advapi32.dll" Alias "LookupPrivilegeValueA" (ByVal lpSystemName As Any, ByVal lpName As String, lpLuid As LUID) As Long          'Returns a valid LUID which is important when making security changes in NT.
Private Declare Function OpenProcessToken Lib "advapi32.dll" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As Long
Private Declare Function GetCurrentProcess Lib "kernel32" () As LongPublic Function ExportRegKey(keyroot As keyroot, keypath As String, FileName As String) As Boolean

  On Error Resume Next
  Dim hKey As Long
  Dim ReturnValue As Long  If EnablePrivilege(SE_BACKUP_NAME) = False Then
    ExportRegKey = False
    Exit Function
  End If
  '=========打开键==========
  ReturnValue = RegOpenKeyEx(keyroot, keypath, 0&, KEY_ALL_ACCESS, hKey)
  If ReturnValue <> 0 Then

    ExportRegKey = False
    ReturnValue = RegCloseKey(hKey)
    Exit Function
  End If

  If Dir(FileName) <> "" Then Kill FileName
  '=========导出=============
  ReturnValue = RegSaveKey(hKey, FileName, ByVal 0&)
  If ReturnValue = 0 Then

    ExportRegKey = True
  Else

    ExportRegKey = False
  End If
  '=========关闭键============
  ReturnValue = RegCloseKey(hKey)
End Function

Public Function ImportRegKey(keyroot As keyroot, keypath As String, FileName As String) As Boolean  On Error Resume Next
  Dim hKey As Long
  Dim ReturnValue As Long
  If EnablePrivilege(SE_RESTORE_NAME) = False Then
    ImportRegKey = False
    Exit Function
  End If
  '=========打开键==========
  ReturnValue = RegOpenKeyEx(keyroot, keypath, 0&, KEY_ALL_ACCESS, hKey)
  If ReturnValue <> 0 Then

    ImportRegKey = False
    ReturnValue = RegCloseKey(hKey)
    Exit Function
  End If
  '==========导入=============
  ReturnValue = RegRestoreKey(hKey, FileName, REG_FORCE_RESTORE)
  If ReturnValue = 0 Then

    ImportRegKey = True
  Else

    ImportRegKey = False
  End If
    '=========关闭键============
  ReturnValue = RegCloseKey(hKey)
End FunctionPublic Function ReadRegKey(keyroot As keyroot, keypath As String, SubKey As String, Optional NoKeyFoundValue As String = "") As String
  '========读取键值===================
  On Error Resume Next
  Dim hKey As Long
  Dim ReturnValue As Long '返回值
  ReturnValue = RegOpenKeyEx(keyroot, keypath, 0, KEY_READ, hKey)
  If ReturnValue <> 0 Then
    '如果键不存在，返回默认值
    ReadRegKey = NoKeyFoundValue
    ReturnValue = RegCloseKey(hKey)
    Exit Function
  End If
  '获取键值
  ReadRegKey = GetSubKeyValue(hKey, SubKey)

  ReturnValue = RegCloseKey(hKey)
End Function
Public Function WriteRegKey(KeyType As KeyType, keyroot As keyroot, keypath As String, SubKey As String, SubKeyValue As String) As Boolean
'=============写入键值================================
  On Error Resume Next
  Dim hKey As Long
  Dim SecurityAttribute As SECURITY_ATTRIBUTES
  Dim NewKey As Long
  Dim ReturnValue As Long

  SecurityAttribute.nLength = Len(SecurityAttribute)  '结构大小
  SecurityAttribute.lpSecurityDescriptor = 0
  SecurityAttribute.bInheritHandle = True  '建立或打开键
  ReturnValue = RegCreateKeyEx(keyroot, keypath, 0, "", 0, KEY_WRITE, SecurityAttribute, hKey, NewKey)
  If ReturnValue <> 0 Then    WriteRegKey = False
    ReturnValue = RegCloseKey(hKey)
    Exit Function
  End If  '确定类型
  Select Case KeyType
    Case REG_SZ
      '===== * 2 可以解决中文字符的问题===========
      ReturnValue = RegSetValueEx(hKey, SubKey, 0, KeyType, ByVal SubKeyValue, Len(SubKeyValue) * 2)
    Case REG_DWORD
      ReturnValue = RegSetValueEx(hKey, SubKey, 0, KeyType, CLng(SubKeyValue), 4)
    Case REG_BINARY
      ReturnValue = RegSetValueEx(hKey, SubKey, 0, KeyType, CByte(SubKeyValue), 4)
  End Select  If ReturnValue = 0 Then
    WriteRegKey = True
  Else
    WriteRegKey = False
  End If  ReturnValue = RegCloseKey(hKey)
End Function
Public Function EnumerateRegKeys(keyroot As keyroot, keypath As String) As String

  On Error Resume Next
  Dim hKey As Long
  Dim ReturnValue As Long
  Dim Counter As Long
  Dim MyBuffer As String
  Dim MyBufferSize As Long
  Dim ClassNameBuffer As String
  Dim ClassNameBufferSize As Long
  Dim LastWrite As FILETIME    '打开
  ReturnValue = RegOpenKeyEx(keyroot, keypath, 0, KEY_ENUMERATE_SUB_KEYS, hKey)
  If ReturnValue <> 0 Then
    '键不存在返回默认值
    EnumerateRegKeys = ""
    ReturnValue = RegCloseKey(hKey)
    Exit Function
  End If
  Counter = 0
     '循环开始
  Do Until ReturnValue <> 0
    MyBuffer = Space(255)
    ClassNameBuffer = Space(255)
    MyBufferSize = 255
    ClassNameBufferSize = 255
    ReturnValue = RegEnumKeyEx(hKey, Counter, MyBuffer, MyBufferSize, ByVal 0, ClassNameBuffer, ClassNameBufferSize, LastWrite)
    If ReturnValue = 0 Then
      MyBuffer = Left$(MyBuffer, MyBufferSize)
      ClassNameBuffer = Left$(ClassNameBuffer, ClassNameBufferSize)
      EnumerateRegKeys = EnumerateRegKeys & MyBuffer & ","
    End If
    Counter = Counter + 1
  Loop

  If EnumerateRegKeys <> "" Then EnumerateRegKeys = Left$(EnumerateRegKeys, Len(EnumerateRegKeys) - 1)

  ReturnValue = RegCloseKey(hKey)
End Function
Public Function EnumerateRegKeyValues(keyroot As keyroot, keypath As String) As String

  On Error Resume Next
  Dim hKey As Long
  Dim ReturnValue As Long
  Dim Counter As Long
  Dim MyBuffer As String
  Dim MyBufferSize As Long
  Dim KeyType As KeyType  ReturnValue = RegOpenKeyEx(keyroot, keypath, 0, KEY_QUERY_VALUE, hKey)
  ' 检查错误
  If ReturnValue <> 0 Then
    EnumerateRegKeyValues = ""
    ReturnValue = RegCloseKey(hKey)
    Exit Function
  End If
  Counter = 0
  '循环开始
  Do Until ReturnValue <> 0
    MyBuffer = Space(255)
    MyBufferSize = 255
    ReturnValue = RegEnumValue(hKey, Counter, MyBuffer, MyBufferSize, 0, KeyType, ByVal 0&, ByVal 0&) 'ByteData(0), ByteDataSize)
    If ReturnValue = 0 Then
      MyBuffer = Left$(MyBuffer, MyBufferSize)
      EnumerateRegKeyValues = EnumerateRegKeyValues & MyBuffer & "*"
      EnumerateRegKeyValues = EnumerateRegKeyValues & GetSubKeyValue(hKey, MyBuffer) & ","
    End If
    Counter = Counter + 1
  Loop

  If EnumerateRegKeyValues <> "" Then EnumerateRegKeyValues = Left$(EnumerateRegKeyValues, Len(EnumerateRegKeyValues) - 1)

  ReturnValue = RegCloseKey(hKey)
End Function

Public Function DeleteRegKey(keyroot As keyroot, keypath As String, SubKey As String) As Boolean
  '在Win NT/2000 下所有子键必须先全部删除
  'Win 9x 子键可以全部删除
  On Error Resume Next
  Dim ReturnValue As Long  ReturnValue = RegDeleteKey(keyroot, keypath & "\" & SubKey)
  If ReturnValue = 0 Then
    DeleteRegKey = True
  Else
    DeleteRegKey = False
  End If
End Function
Public Function DeleteRegKeyValue(keyroot As keyroot, keypath As String, Optional SubKey As String = "") As Boolean
  '删除键的值
  On Error Resume Next
  Dim hKey As Long
  Dim ReturnValue As Long  '打开键
  ReturnValue = RegOpenKeyEx(keyroot, keypath, 0, KEY_ALL_ACCESS, hKey)

  If ReturnValue <> 0 Then
    DeleteRegKeyValue = False
    ReturnValue = RegCloseKey(hKey)
    Exit Function
  End If

  '检验正在删除的键
  If SubKey = "" Then SubKey = keypath
  '打开成功可以删除
  ReturnValue = RegDeleteValue(hKey, SubKey)

  If ReturnValue = 0 Then
    DeleteRegKeyValue = True
  Else
    DeleteRegKeyValue = False
  End If
  ReturnValue = RegCloseKey(hKey)
End Function
Private Function GetSubKeyValue(ByVal hKey As Long, ByVal SubKey As String) As String

  On Error Resume Next
  Dim ReturnValue As Long
  Dim KeyType As KeyType
  Dim MyBuffer As String
  Dim MyBufferSize As Long  '获取键信息
  ReturnValue = RegQueryValueEx(hKey, SubKey, 0, KeyType, ByVal 0, MyBufferSize)
  If ReturnValue = 0 Then
    Select Case KeyType

      Case REG_SZ
        '创建缓冲区
        MyBuffer = String(MyBufferSize, Chr$(0))

        ReturnValue = RegQueryValueEx(hKey, SubKey, 0, 0, ByVal MyBuffer, MyBufferSize)
        If ReturnValue = 0 Then

          GetSubKeyValue = Left$(MyBuffer, InStr(1, MyBuffer, Chr$(0)) - 1)
        End If

      Case REG_EXPAND_SZ
        '创建缓冲区
        MyBuffer = String(MyBufferSize, Chr$(0))

        ReturnValue = RegQueryValueEx(hKey, SubKey, 0, 0, ByVal MyBuffer, MyBufferSize)
        If ReturnValue = 0 Then

          GetSubKeyValue = Left$(MyBuffer, InStr(1, MyBuffer, Chr$(0)) - 1)
        End If      Case Else 'REG_DWORD 或者 REG_BINARY
        Dim MyNewBuffer As Long

        ReturnValue = RegQueryValueEx(hKey, SubKey, 0, 0, MyNewBuffer, MyBufferSize)
        If ReturnValue = 0 Then
          GetSubKeyValue = MyNewBuffer
        End If
    End Select
  End If
End Function
Private Function EnablePrivilege(seName As String) As Boolean

  On Error Resume Next
  Dim p_lngRtn As Long
  Dim p_lngToken As Long
  Dim p_lngBufferLen As Long
  Dim p_typLUID As LUID
  Dim p_typTokenPriv As TOKEN_PRIVILEGES
  Dim p_typPrevTokenPriv As TOKEN_PRIVILEGES  p_lngRtn = OpenProcessToken(GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES Or TOKEN_QUERY, p_lngToken)

  If p_lngRtn = 0 Then
    EnablePrivilege = False
    Exit Function
  End If

  If Err.LastDllError <> 0 Then
    EnablePrivilege = False
    Exit Function
  End If

  p_lngRtn = LookupPrivilegeValue(0&, seName, p_typLUID)
  If p_lngRtn = 0 Then
    EnablePrivilege = False
    Exit Function
  End If

  p_typTokenPriv.PrivilegeCount = 1
  p_typTokenPriv.Privileges.Attributes = SE_PRIVILEGE_ENABLED
  p_typTokenPriv.Privileges.pLuid = p_typLUID
  EnablePrivilege = (AdjustTokenPrivileges(p_lngToken, False, p_typTokenPriv, Len(p_typPrevTokenPriv), p_typPrevTokenPriv, p_lngBufferLen) <> 0)
End Function
Public Function DeleteAllKeys(ByVal sKeyRoot As keyroot, ByVal sKeyPath As String, ByVal sSubKey As String) As Boolean
'删除一个键及其下的所有值
'该函数适合所有的Windows操作系统Dim TempString As String
Dim TempArray() As String
Dim TempStringArray() As String
Dim i As Integer
Dim TotalPath As String
TotalPath = sKeyPath & "\" & sSubKeyTempString = EnumerateRegKeyValues(sKeyRoot, TotalPath)If TempString = "" Then GoTo LastTempArray = Split(TempString, ",")For i = LBound(TempArray) To UBound(TempArray)
  TempStringArray = Split(TempArray(i), "*")

  DeleteRegKeyValue sKeyRoot, TotalPath, TempStringArray(LBound(TempStringArray))

Next iLast:  DeleteRegKey sKeyRoot, sKeyPath, sSubKey
End Function

调试易

怎样对注册表进行改动

解决方案 »