Изменения значений в реестре? "Attributes"=dword:a0900100

Option Explicit
'////////////////////////////////////////////
'// Модуль для работы с реестром           //
'// Copyright (c) 20.01.2022 by HackerVlad //
'// e-mail: vladislavpeshkov@yandex.ru     //
'// Версия 3.0                             //
'////////////////////////////////////////////
 
' Декларации API...
Private Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As Long
Private Declare Function RegCreateKeyEx Lib "advapi32" 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, ByRef lpSecurityAttributes As SECURITY_ATTRIBUTES, ByRef phkResult As Long, ByRef lpdwDisposition As Long) As Long
Private Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, ByRef phkResult As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, ByRef lpType As Long, ByVal lpData As String, ByRef lpcbData As Long) As Long
Private Declare Function RegSetValueEx Lib "advapi32" 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 RegSetDWORDValueEx Lib "advapi32" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, dwData As Long, Optional ByVal cbData As Long = 4) As Long
Private Declare Function RegOpenKey Lib "advapi32" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegDeleteKey Lib "advapi32" Alias "RegDeleteKeyW" (ByVal hKey As Long, ByVal lpSubKey As Long) As Long
Private Declare Function RegDeleteKeyEx Lib "advapi32" Alias "RegDeleteKeyExW" (ByVal hKey As Long, ByVal lpSubKey As Long, ByVal samDesired As Long, ByVal Reserved As Long) As Long
Private Declare Function RegDeleteValue Lib "advapi32" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long
Private Declare Function RegEnumKeyA Lib "advapi32" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As String, ByVal cbName As Long) As Long ' for 9x
Private Declare Function RegEnumKeyW Lib "advapi32" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As Long, ByVal cbName As Long) As Long ' for NT
Private Declare Function RegEnumValueA Lib "advapi32" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpValueName As String, lpcbValueName As Long, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long ' for 9x
Private Declare Function RegEnumValueW Lib "advapi32" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpValueName As Long, lpcbValueName As Long, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long ' for NT
Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long
Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long
Private Declare Function IsWow64Process Lib "kernel32" (ByVal hProc As Long, bWow64Process As Long) As Long
 
' Константы...
Private Const REG_SZ = 1
Private Const REG_EXPAND_SZ = 2
Private Const REG_DWORD = 4
Private Const REG_OPTION_NON_VOLATILE = 0
Private Const READ_CONTROL = &H20000
Private Const KEY_QUERY_VALUE = &H1
Private Const KEY_SET_VALUE = &H2
Private Const KEY_CREATE_SUB_KEY = &H4
Private Const KEY_ENUMERATE_SUB_KEYS = &H8
Private Const KEY_NOTIFY = &H10
Private Const KEY_CREATE_LINK = &H20
Private Const KEY_READ = KEY_QUERY_VALUE + KEY_ENUMERATE_SUB_KEYS + KEY_NOTIFY + READ_CONTROL
Private Const KEY_WRITE = KEY_SET_VALUE + KEY_CREATE_SUB_KEY + READ_CONTROL
Private Const KEY_EXECUTE = KEY_READ
Private 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
Private Const ERROR_NONE = 0
Private Const ERROR_BADKEY = 2
Private Const ERROR_ACCESS_DENIED = 8
Private Const ERROR_SUCCESS = 0
Private Const KEY_WOW64_64KEY = &H100
Private Const KEY_WOW64_32KEY = &H200
 
' Типы...
Private Type SECURITY_ATTRIBUTES
    nLength As Long
    lpSecurityDescriptor As Long
    bInheritHandle As Boolean
End Type
 
' Публично объявленный енум
Public Enum RootKeys
    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
 
' Обновляет ключ реестра
Public Function UpdateKey(KeyRoot As RootKeys, KeyName As String, SubKeyName As String, SubKeyValue As String, Optional reg64 As Boolean) As Boolean
    Dim rc As Long                                      ' Return Code
    Dim hKey As Long                                    ' Handle To A Registry Key
    Dim hDepth As Long                                  '
    Dim lpAttr As SECURITY_ATTRIBUTES                   ' Registry Security Type
    
    lpAttr.nLength = 50                                 ' Set Security Attributes To Defaults...
    lpAttr.lpSecurityDescriptor = 0                     ' ...
    lpAttr.bInheritHandle = True                        ' ...
    
    '------------------------------------------------------------
    '- Create/Open Registry Key...
    '------------------------------------------------------------
    rc = RegCreateKeyEx(KeyRoot, KeyName, _
                        0, REG_SZ, _
                        REG_OPTION_NON_VOLATILE, IIf(reg64, KEY_ALL_ACCESS Or KEY_WOW64_64KEY, KEY_ALL_ACCESS), lpAttr, _
                        hKey, hDepth)                   ' Create/Open //KeyRoot//KeyName
    
    If (rc <> ERROR_SUCCESS) Then GoTo CreateKeyError   ' Handle Errors...
    
    '------------------------------------------------------------
    '- Create/Modify Key Value...
    '------------------------------------------------------------
    If (SubKeyValue = "") Then SubKeyValue = " "        ' A Space Is Needed For RegSetValueEx() To Work...
    
    ' Create/Modify Key Value
    rc = RegSetValueEx(hKey, SubKeyName, _
                       0, REG_SZ, _
                       SubKeyValue, LenB(StrConv(SubKeyValue, vbFromUnicode)))
                       
    If (rc <> ERROR_SUCCESS) Then GoTo CreateKeyError   ' Handle Error
    '------------------------------------------------------------
    '- Close Registry Key...
    '------------------------------------------------------------
    rc = RegCloseKey(hKey)                              ' Close Key
    
    UpdateKey = True                                    ' Return Success
    Exit Function                                       ' Exit
CreateKeyError:
    UpdateKey = False                                   ' Set Error Return Code
    rc = RegCloseKey(hKey)                              ' Attempt To Close Key
End Function
 
' Считывает данные из реестра
Public Function GetKeyValue(KeyRoot As RootKeys, KeyName As String, SubKeyRef As String, Optional reg64 As Boolean) As String
    Dim i As Long
    Dim hKey As Long ' Handle To An Open Registry Key
    Dim sKeyVal As String
    Dim lKeyValType As Long ' Data Type Of A Registry Key
    Dim bufer As String
    Dim strlen As Long
    
    If RegOpenKeyEx(KeyRoot, KeyName, 0, IIf(reg64, KEY_ALL_ACCESS Or KEY_WOW64_64KEY, KEY_ALL_ACCESS), hKey) = ERROR_SUCCESS Then
        RegQueryValueEx hKey, SubKeyRef, 0, lKeyValType, ByVal 0&, strlen
        
        If strlen > 0 Then
            bufer = Space$(strlen)
            
            If RegQueryValueEx(hKey, SubKeyRef, 0, lKeyValType, bufer, strlen) = ERROR_SUCCESS Then
                If strlen > 0 Then
                    bufer = Left$(bufer, strlen - 1)
                    
                    Select Case lKeyValType                                    ' Search Data Types...
                        Case REG_SZ, REG_EXPAND_SZ                             ' String Registry Key Data Type
                            sKeyVal = bufer                                    ' Copy String Value
                        Case REG_DWORD                                         ' Double Word Registry Key Data Type
                            For i = Len(bufer) To 1 Step -1                    ' Convert Each Bit
                                sKeyVal = sKeyVal + Hex(Asc(Mid(bufer, i, 1))) ' Build Value Char. By Char.
                            Next
                            sKeyVal = Format$("&H" + sKeyVal)                  ' Convert Double Word To String
                    End Select
                    
                    GetKeyValue = sKeyVal                                      ' Return Value
                End If
            End If
        End If
        
        RegCloseKey hKey
    End If
End Function
 
' Удаляет ключ реестра
Public Function DeleteKey(KeyRoot As RootKeys, KeyName As String, Optional reg64 As Boolean) As Boolean
    Dim rc As Long
    
    If reg64 = False Then
        rc = RegDeleteKey(KeyRoot, StrPtr(KeyName))
    Else
        If IsWow64MyProcess = True Then
            rc = RegDeleteKeyEx(KeyRoot, StrPtr(KeyName), KEY_ALL_ACCESS Or KEY_WOW64_64KEY, 0)
        Else
            Exit Function
        End If
    End If
    
    If rc = ERROR_SUCCESS Then DeleteKey = True
End Function
 
' Создание списка ключей реестра
Public Function EnumKeys(KeyRoot As RootKeys, KeyName As String, RegKeys() As String, Optional reg64 As Boolean) As Boolean
    Dim hKey, curidx As Long
    Dim bufer As String
    Dim IsWindowsNT As Boolean
    Dim strlen As Long
    
    If RegOpenKeyEx(KeyRoot, KeyName, 0, IIf(reg64, KEY_ALL_ACCESS Or KEY_WOW64_64KEY, KEY_ALL_ACCESS), hKey) = ERROR_SUCCESS Then
        ReDim RegKeys(0)
        If StrComp(Environ("OS"), "Windows_NT", vbTextCompare) = 0 Then IsWindowsNT = True
        
        Do
            bufer = String$(2048, vbNullChar)
            
            If IsWindowsNT = True Then
                If RegEnumKeyW(hKey, curidx, StrPtr(bufer), 2048) <> ERROR_SUCCESS Then Exit Do
            Else
                If RegEnumKeyA(hKey, curidx, bufer, 2048) <> ERROR_SUCCESS Then Exit Do
            End If
            
            strlen = InStr(1, bufer, vbNullChar)
            If strlen > 0 Then bufer = Left$(bufer, strlen - 1)
            
            If Len(bufer) > 0 Then
                ReDim Preserve RegKeys(curidx)
                RegKeys(curidx) = bufer
                curidx = curidx + 1
                
                If EnumKeys <> True Then EnumKeys = True
            End If
        Loop
        
        RegCloseKey hKey
    End If
End Function
 
' Создание списка параметров ключа
Public Function EnumValues(KeyRoot As RootKeys, KeyName As String, RegValues() As String, Optional reg64 As Boolean) As Boolean
    Dim hKey, curidx As Long
    Dim bufer As String
    Dim IsWindowsNT As Boolean
    Dim strlen As Long
    
    If RegOpenKeyEx(KeyRoot, KeyName, 0, IIf(reg64, KEY_ALL_ACCESS Or KEY_WOW64_64KEY, KEY_ALL_ACCESS), hKey) = ERROR_SUCCESS Then
        ReDim RegValues(0)
        If StrComp(Environ("OS"), "Windows_NT", vbTextCompare) = 0 Then IsWindowsNT = True
        
        Do
            bufer = Space$(2048)
            strlen = 2048
            
            If IsWindowsNT = True Then
                If RegEnumValueW(hKey, curidx, StrPtr(bufer), strlen, 0, ByVal 0&, ByVal 0&, ByVal 0&) <> ERROR_SUCCESS Then Exit Do
            Else
                If RegEnumValueA(hKey, curidx, bufer, strlen, 0, ByVal 0&, ByVal 0&, ByVal 0&) <> ERROR_SUCCESS Then Exit Do
            End If
            
            If strlen > 0 Then
                bufer = Left$(bufer, strlen)
                
                If Len(bufer) > 0 Then
                    ReDim Preserve RegValues(curidx)
                    RegValues(curidx) = bufer
                    curidx = curidx + 1
                    
                    If EnumValues <> True Then EnumValues = True
                End If
            End If
        Loop
        
        RegCloseKey hKey
    End If
End Function
 
' Обновляет ключ реестра параметром DWORD
Public Function SetRegDWORD(hKey As RootKeys, lpszSubKey As String, sSetValue As String, ByVal dwValue As Long, Optional reg64 As Boolean) As Boolean
    On Error GoTo ErrorRoutineErr:
    
    Dim phkResult As Long
    Dim lResult As Long
    Dim SA As SECURITY_ATTRIBUTES
    Dim Create As Long
    
    ' Note: This function will create the key or
    ' value if it doesn't exist.
    ' Open or Create the key
    RegCreateKeyEx hKey, lpszSubKey, 0, "", REG_OPTION_NON_VOLATILE, IIf(reg64, KEY_ALL_ACCESS Or KEY_WOW64_64KEY, KEY_ALL_ACCESS), SA, phkResult, Create
    lResult = RegSetDWORDValueEx(phkResult, sSetValue, 0&, REG_DWORD, dwValue, 4)
    
    ' Close the key
    RegCloseKey phkResult
    
    ' Return SetRegValue Result
    SetRegDWORD = (lResult = ERROR_SUCCESS)
    Exit Function
    
ErrorRoutineErr::
  SetRegDWORD = False
End Function
 
' Удалить любой параметр, в том числе DWORD
Public Function DeleteRegValue(hKey As RootKeys, lpszSubKey As String, sValueName As String, Optional reg64 As Boolean) As Boolean
    On Error GoTo ErrorRoutineErr:
    
    Dim phkResult As Long
    Dim lResult As Long
    Dim SA As SECURITY_ATTRIBUTES
    Dim Create As Long
    
    ' Open or Create the key
    RegCreateKeyEx hKey, lpszSubKey, 0, "", REG_OPTION_NON_VOLATILE, IIf(reg64, KEY_ALL_ACCESS Or KEY_WOW64_64KEY, KEY_ALL_ACCESS), SA, phkResult, Create
    
    lResult = RegDeleteValue(phkResult, sValueName)
    RegCloseKey phkResult
    
    ' Return obtained value
    If lResult = ERROR_SUCCESS Then
        DeleteRegValue = True
    Else
        DeleteRegValue = False
    End If
    Exit Function
    
ErrorRoutineErr::
    DeleteRegValue = False
End Function
 
' Запущен ли мой процесс в 64-битной среде
Public Function IsWow64MyProcess() As Boolean
    Dim MyProcRunIs64 As Long
    Dim handle As Long
    
    handle = LoadLibrary("kernel32")
    
    If GetProcAddress(handle, "IsWow64Process") > 0 Then
        IsWow64Process -1, MyProcRunIs64
        If MyProcRunIs64 = 1 Then IsWow64MyProcess = True
    End If
    
    FreeLibrary handle
End Function

SetRegDWORD HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon", "AutoRestartShell", SetValue, IsWow64MyProcess