Option Explicit

'Константы основных веток реестра
Public Const HKEY_CLASSES_ROOT = &H80000000
Public Const HKEY_CURRENT_USER = &H80000001
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const HKEY_USERS = &H80000003
Public Const HKEY_CURRENT_CONFIG = &H80000005
Public Const HKEY_DYN_DATA = &H80000006

'Registry Specific Access Rights
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_NOTIFY = &H10
Public Const KEY_CREATE_LINK = &H20
Public Const KEY_ALL_ACCESS = &H3F

'Open/Create Options
Public Const REG_OPTION_NON_VOLATILE =  0 &
Public Const REG_OPTION_VOLATILE = &H1

'Key creation/open disposition
Public Const REG_CREATED_NEW_KEY = &H1
Public Const REG_OPENED_EXISTING_KEY = &H2

'Masks for the predefined standard access types
Public Const STANDARD_RIGHTS_ALL = &H1F0000
Public Const SPECIFIC_RIGHTS_ALL = &HFFFF

'Define severity codes
Public Const ERROR_SUCCESS =  0 &
Public Const ERROR_ACCESS_DENIED =  5 
Public Const ERROR_NO_MORE_ITEMS =  259 

'Predefined Value Types

'No value type
Public Const REG_NONE = ( 0 )
'Unicode nul terminated string
Public Const REG_SZ = ( 1 )
'Unicode nul terminated string w/enviornment var
Public Const REG_EXPAND_SZ = ( 2 )
'Free form binary
Public Const REG_BINARY = ( 3 )
'32-bit number
Public Const REG_DWORD = ( 4 )
'32-bit number (same as REG_DWORD)
Public Const REG_DWORD_LITTLE_ENDIAN = ( 4 )
'32-bit number
Public Const REG_DWORD_BIG_ENDIAN = ( 5 )
'Symbolic Link (unicode)
Public Const REG_LINK = ( 6 )
'Multiple Unicode strings
Public Const REG_MULTI_SZ = ( 7 )
'Resource list in the resource map
Public Const REG_RESOURCE_LIST = ( 8 )
'Resource list in the hardware description
Public Const REG_FULL_RESOURCE_DESCRIPTOR = ( 9 )
Public Const REG_RESOURCE_REQUIREMENTS_LIST = ( 10 )

'Structures Needed For Registry Prototypes
Type SECURITY_ATTRIBUTES
    nLength As Long
    lpSecurityDescriptor As Long
    bInheritHandle As Boolean
End Type

Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type

'API-функции
Public Declare Function RegCloseKey Lib "advapi32" ( _
ByVal hKey As Long) As Long

Public 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, _
lpSecurityAttributes As SECURITY_ATTRIBUTES, _
phkResult As Long, _
lpdwDisposition 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 RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" ( _
ByVal hKey As Long, _
ByVal lpValueName As String) As Long

Public 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

Public 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, _
ByVal lpData As String, _
lpcbData As Long) As Long
                                      
Public Declare Function RegOpenKeyEx Lib "advapi32" 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 RegQueryValueEx Lib "advapi32" Alias "RegQueryValueExA" ( _
ByVal hKey As Long, _
ByVal lpValueName As String, _
ByVal lpReserved As Long, _
ByRef lpType As Long, _
ByVal szData As String, _
ByRef lpcbData As Long) As Long

Public Declare Function RegSetValueEx Lib "advapi32" Alias "RegSetValueExA" ( _
ByVal hKey As Long, _
ByVal lpValueName As String, _
ByVal Reserved As Long, _
ByVal dwType As Long, _
ByVal szData As String, _
ByVal cbData As Long) As Long

'Объявление внутренних переменных
Private Create As Long
'

'Создание подраздела

Public Function CreateRegKey( _
hKey As Long, _
sSubKey As String, _
NewSubKey As String) As Boolean

    On Error GoTo ErrorRoutineErr:

    Dim phkResult As Long
    Dim SA As SECURITY_ATTRIBUTES

    CreateRegKey = (RegCreateKeyEx(hKey, sSubKey & "\" & _
    NewSubKey,  0 , "", REG_OPTION_NON_VOLATILE, _
    KEY_ALL_ACCESS, SA, phkResult, Create) = ERROR_SUCCESS)

    RegCloseKey phkResult
    
    Exit Function

ErrorRoutineErr:
    MsgBox$ _
    "Ошибка: <" & Err.Number & "> - " & Err.Description, vbExclamation + vbOKOnly, _
    "Созданиие подраздела"
    
    CreateRegKey = False

End Function

'Создание параметра и присвоение ему значения

Public Function SetRegValue( _
hKey As Long, _
sSubKey As String, _
ByVal sSetValue As String, _
ByVal sValue As String) As Boolean

    On Error GoTo ErrorRoutineErr
    
    Dim phkResult As Long
    Dim lResult As Long
    Dim SA As SECURITY_ATTRIBUTES

    RegCreateKeyEx hKey, sSubKey,  0 , "", _
                   REG_OPTION_NON_VOLATILE, _
                   KEY_ALL_ACCESS, SA, phkResult, Create

    lResult = RegSetValueEx(phkResult, sSetValue,  0 , _
                            REG_SZ, sValue, CLng(Len(sValue) +  1 ))

    RegCloseKey phkResult

    SetRegValue = (lResult = ERROR_SUCCESS)
    Exit Function

ErrorRoutineErr:
    MsgBox$ _
    "Ошибка: <" & Err.Number & "> - " & Err.Description, vbExclamation + vbOKOnly, _
    "Созданиие параметра"
    
    SetRegValue = False

End Function

'Удаление параметра

Public Sub DeleteValue( _
hKey As Long, _
sSubKey As String, _
sValue As String)

    Dim phkResult As Long
    Dim SA As SECURITY_ATTRIBUTES

    RegCreateKeyEx hKey, sSubKey, _
                    0 , "", REG_OPTION_NON_VOLATILE, _
                   KEY_ALL_ACCESS, SA, phkResult, Create

    If RegDeleteValue(phkResult, sValue) = ERROR_SUCCESS Then
        MsgBox$ "Параметр удален"
    Else
        MsgBox$ "Не могу удалить параметр"
    End If

    RegCloseKey phkResult
    
End Sub

'Удаление подраздела

Public Sub DeleteKey( _
hKey As Long, _
sSubKey As String, _
sKey As String)

    Dim phkResult As Long
    Dim SA As SECURITY_ATTRIBUTES

    RegCreateKeyEx hKey, sSubKey,  0 , _
                   "", REG_OPTION_NON_VOLATILE, _
                   KEY_ALL_ACCESS, SA, phkResult, Create

    If RegDeleteKey(phkResult, sKey) = ERROR_SUCCESS Then
        MsgBox$ "Подраздел удален"
    Else
        RegCloseKey phkResult
        MsgBox$ "Не могу удалить подраздел"
    End If
    
End Sub

'Получение значения параметра

Public Function GetValue( _
hKey As Long, _
sSubKey As String, _
sKey As String, _
sDefault As String) As Variant

    On Error GoTo ErrorRoutineErr

    Dim phkResult As Long
    Dim lResult As Long
    Dim sBuffer As String
    Dim lBuffSize As Long

    'Создаём буфер
    sBuffer = Space( 255 )
    lBuffSize = Len(sBuffer)

    RegOpenKeyEx hKey, sSubKey,  0 ,  1 , phkResult
    lResult = RegQueryValueEx(phkResult, sKey,  0 , _
                               0 , sBuffer, lBuffSize)
    RegCloseKey phkResult

    If lResult = ERROR_SUCCESS Then
        GetValue = Left(sBuffer, lBuffSize -  1 )
    Else
        GetValue = sDefault
    End If
    Exit Function

ErrorRoutineErr::
    MsgBox$ "Ошибка: <" & Err.Number & "> - " & Err.Description, _
           vbExclamation + vbOKOnly, "Получение параметра"
    GetValue = ""

End Function

Sub Reg_Реестр_добавить()

    Dim hKey As String
    'имя основного раздела, куда добавляем
    hKey = HKEY_LOCAL_MACHINE
    Dim SubKey As String
    'имя ветки в основном разделе, куда добавляем
    SubKey = "System\CurrentControlSet\Control"

    Dim NewSubKey As String
    'название добавляемого подраздела должно начинаться с "\"
    NewSubKey = "\" & "StorageDevicePolicies"

CreateRegKey(hKey, sSubKey, NewSubKey) As Boolean

End Sub