Attribute VB_Name = "mReg"
'**************************************************************************************************************
'* 本模塊提供了一些對注冊表進行操作的函數
'* 警告: 操作注冊表是非常危險的, 使用本模塊中的任何函數都要慎重!!!
'*
'* 版權: LPP軟件工作室
'* 作者: 盧培培
'**************************************************************************************************************

Option Explicit

Option Compare Text

'---------------------------------------------------------------
'- 注冊表 API 聲明...
'---------------------------------------------------------------
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
' RegCloseKey釋放指向特定注冊關鍵字的句柄

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
' RegCreateKeyExA創建特定的注冊關鍵字。如果關鍵字在注冊表中已經存在,這個函數會打開它。
' 這個函數的遠程應用接口版本已經存在,叫做CeRegCreateKeyEx.

Private Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long
' RegDeleteKeyA從特定的注冊表關鍵字中刪除一個指定的子健。如果這個子鍵不含有任何子鍵，那么它將被刪除。
' 這個函數的遠程應用接口版本已經存在,叫做CeRegDeleteKey.

Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long
' RegDeleteValueA從特定的注冊表關鍵字中刪除一個指定的值。
' 這個函數的遠程應用接口版本已經存在,叫做CeRegDeleteValue。

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
' RegOpenKeyExA打開指定的關鍵字。

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
' RegQueryValueExAT得到了于一個已經打開的注冊表關鍵字相關的特定值的類型和數值。

Private Declare Function RegRestoreKey Lib "advapi32.dll" Alias "RegRestoreKeyA" (ByVal hKey As Long, ByVal lpFile As String, ByVal dwFlags As Long) As Long
' RegRestoreKeyA讀取特定文件的注冊表信息，并將它拷貝到一個特定關鍵字中。
' 這個注冊表信息可以是一個關鍵字和多層的子關鍵字。

Private Declare Function RegSaveKey Lib "advapi32.dll" Alias "RegSaveKeyA" (ByVal hKey As Long, ByVal lpFile As String, lpSecurityAttributes As SECURITY_ATTRIBUTES) As Long
' RegSaveKey將特定的關鍵字和她的所有子關鍵字保存到一個新文件中。

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
' RegSetValueEx為一個注冊表關鍵字賦予某種指定類型的值。

Private Declare 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
' RegQueryInfoKey返回特定注冊表關鍵字的信息。

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
' RegEnumValue枚舉打開的注冊表關鍵字的值。
' 這個函數每一次被調用時，為這個關鍵字拷貝一個索引值名稱和數據塊。

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
' RegEnumKeyEx枚舉特定打開注冊表關鍵字的子關鍵字。
' 這個函數每一次調用時返回關于一個子關鍵字的信息。
' 不象RegEnumKey，RegEnumKeyEx返回子鍵的類名和上一次修改的時間。

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!
' The AdjustTokenPrivileges能夠使特定訪問標志有效或無效。
' 使得某個訪問口令有效或無效需要TOKEN_ADJUST_PRIVILEGES權限。

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.
' LookupPrivilegeValue返回某一個指定系統使用的本地唯一標示符（locally unique identifier ，LUID），以表示本地需要的特定權限名。

Private Declare Function OpenProcessToken Lib "advapi32.dll" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As Long
' OpenProcessToken打開與某個進程相關的訪問令牌。

Private Declare Function GetCurrentProcess Lib "kernel32" () As Long
' GetCurrentProcess返回當前進程的偽句柄。

'---------------------------------------------------------------
'- 注冊表 Api 常數...
'---------------------------------------------------------------
' 注冊表創建類型值...
Const REG_OPTION_NON_VOLATILE = 0        ' 當系統重新啟動時，關鍵字被保留

' 注冊表關鍵字安全選項...
Const READ_CONTROL = &H20000
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 KEY_READ = KEY_QUERY_VALUE + KEY_ENUMERATE_SUB_KEYS + KEY_NOTIFY + READ_CONTROL
Const KEY_WRITE = KEY_SET_VALUE + KEY_CREATE_SUB_KEY + READ_CONTROL
Const KEY_EXECUTE = KEY_READ
Const KEY_ALL_ACCESS = KEY_QUERY_VALUE + KEY_SET_VALUE + KEY_CREATE_SUB_KEY + KEY_ENUMERATE_SUB_KEYS + KEY_NOTIFY + KEY_CREATE_LINK + READ_CONTROL
                     
' 返回值...
Const ERROR_NONE = 0
Const ERROR_BADKEY = 2
Const ERROR_ACCESS_DENIED = 8
Const ERROR_SUCCESS = 0

' 有關導入/導出的常量
Const REG_FORCE_RESTORE As Long = 8&
Const TOKEN_QUERY As Long = &H8&
Const TOKEN_ADJUST_PRIVILEGES As Long = &H20&
Const SE_PRIVILEGE_ENABLED As Long = &H2
Const SE_RESTORE_NAME = "SeRestorePrivilege"
Const SE_BACKUP_NAME = "SeBackupPrivilege"

'---------------------------------------------------------------
'- 注冊表類型...
'---------------------------------------------------------------
Private Type SECURITY_ATTRIBUTES
    nLength As Long
    lpSecurityDescriptor As Long
    bInheritHandle As Boolean
End Type

Private Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type

Private Type LUID
    lowpart As Long
    highpart As Long
End Type

Private Type LUID_AND_ATTRIBUTES
    pLuid As LUID
    Attributes As Long
End Type

Private Type TOKEN_PRIVILEGES
    PrivilegeCount As Long
    Privileges As LUID_AND_ATTRIBUTES
End Type

'---------------------------------------------------------------
'- 自定義枚舉類型...
'---------------------------------------------------------------
' 注冊表數據類型...
Public Enum ValueType
    REG_SZ = 1                         ' 字符串值
    REG_EXPAND_SZ = 2                  ' 可擴充字符串值
    REG_BINARY = 3                     ' 二進制值
    REG_DWORD = 4                      ' DWORD值
    REG_MULTI_SZ = 7                   ' 多字符串值
End Enum

' 注冊表關鍵字根類型...
Public Enum KeyRoot
    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

Private hKey As Long                   ' 注冊表打開項的句柄
Private i As Long, j As Long           ' 循環變量
Private Success As Long                ' API函數的返回值, 判斷函數調用是否成功

'-------------------------------------------------------------------------------------------------------------
'- 新建注冊表關鍵字并設置注冊表關鍵字的值...
'- 如果 ValueName 和 Value 都缺省, 則只新建 KeyName 空項, 無子鍵...
'- 如果只缺省 ValueName 則將設置指定 KeyName 的默認值
'- 參數說明: KeyRoot--根類型, KeyName--子項名稱, ValueName--值項名稱, Value--值項數據, ValueType--值項類型
'-------------------------------------------------------------------------------------------------------------
Public Function SetKeyValue(KeyRoot As KeyRoot, KeyName As String, Optional ValueName As String, Optional Value As Variant = "", Optional ValueType As ValueType = REG_SZ) As Boolean
    Dim lpAttr As SECURITY_ATTRIBUTES                   ' 注冊表安全類型
    lpAttr.nLength = 50                                 ' 設置安全屬性為缺省值...
    lpAttr.lpSecurityDescriptor = 0                     ' ...
    lpAttr.bInheritHandle = True                        ' ...
    
    ' 新建注冊表關鍵字...
    Success = RegCreateKeyEx(KeyRoot, KeyName, 0, ValueType, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, lpAttr, hKey, 0)
    If Success <> ERROR_SUCCESS Then SetKeyValue = False: RegCloseKey hKey: Exit Function
    
    ' 設置注冊表關鍵字的值...
    If IsMissing(ValueName) = False Then
    ' Returns a Boolean value indicating whether an optional Variant argument has been passed to a procedure.
        
        Select Case ValueType
            Case REG_SZ, REG_EXPAND_SZ, REG_MULTI_SZ
                Success = RegSetValueEx(hKey, ValueName, 0, ValueType, ByVal CStr(Value), LenB(StrConv(Value, vbFromUnicode)) + 1)
            Case REG_DWORD
                If CDbl(Value) <= 4294967295# And CDbl(Value) >= 0 Then
                    Dim sValue As String
                    sValue = DoubleToHex(Value)
                    Dim dValue(3) As Byte
                    dValue(0) = Format("&h" & Mid(sValue, 7, 2))
                    dValue(1) = Format("&h" & Mid(sValue, 5, 2))
                    dValue(2) = Format("&h" & Mid(sValue, 3, 2))
                    dValue(3) = Format("&h" & Mid(sValue, 1, 2))
                    Success = RegSetValueEx(hKey, ValueName, 0, ValueType, dValue(0), 4)
                Else
                    Success = ERROR_BADKEY
                End If
            Case REG_BINARY
                On Error Resume Next
                Success = 1                             ' 假設調用API不成功(成功返回0)
                ReDim tmpValue(UBound(Value)) As Byte
                For i = 0 To UBound(tmpValue)
                    tmpValue(i) = Value(i)
                Next i
                Success = RegSetValueEx(hKey, ValueName, 0, ValueType, tmpValue(0), UBound(Value) + 1)
        End Select
    End If
    
    If Success <> ERROR_SUCCESS Then SetKeyValue = False: RegCloseKey hKey: Exit Function
    
    ' 關閉注冊表關鍵字...
    RegCloseKey hKey
    SetKeyValue = True                                       ' 返回函數值
End Function

'-------------------------------------------------------------------------------------------------------------
'- 獲得已存在的注冊表關鍵字的值...
'- 如果 ValueName="" 則返回 KeyName 項的默認值...
'- 如果指定的注冊表關鍵字不存在, 則返回空串...
'- 參數說明: KeyRoot--根類型, KeyName--子項名稱, ValueName--值項名稱, ValueType--值項類型
'-------------------------------------------------------------------------------------------------------------
Public Function GetKeyValue(KeyRoot As KeyRoot, KeyName As String, ValueName As String, Optional ValueType As Long) As String
    Dim TempValue As String                             ' 注冊表關鍵字的臨時值
    Dim Value As String                                 ' 注冊表關鍵字的值
    Dim ValueSize As Long                               ' 注冊表關鍵字的值的實際長度
    TempValue = Space(1024)                             ' 存儲注冊表關鍵字的臨時值的緩沖區
    ValueSize = 1024                                    ' 設置注冊表關鍵字的值的默認長度
    
    ' 打開一個已存在的注冊表關鍵字...
    RegOpenKeyEx KeyRoot, KeyName, 0, KEY_ALL_ACCESS, hKey
    
    ' 獲得已打開的注冊表關鍵字的值...
    RegQueryValueEx hKey, ValueName, 0, ValueType, ByVal TempValue, ValueSize
    
    ' 返回注冊表關鍵字的的值...
    Select Case ValueType                                                        ' 通過判斷關鍵字的類型, 進行處理
        Case REG_SZ, REG_MULTI_SZ, REG_EXPAND_SZ
            TempValue = Left$(TempValue, ValueSize - 1)                          ' 去掉TempValue尾部空格
            Value = TempValue
        Case REG_DWORD
            ReDim dValue(3) As Byte
            RegQueryValueEx hKey, ValueName, 0, REG_DWORD, dValue(0), ValueSize
            For i = 3 To 0 Step -1
                Value = Value + String(2 - Len(Hex(dValue(i))), "0") + Hex(dValue(i))   ' 生成長度為8的十六進制字符串
            Next i