Option Explicit

Type SECURITY_ATTRIBUTES

nLength As Long

lpSecurityDescriptor As Long

bInheritHandle As Boolean

End Type

Public Declare Function RegCloseKey Lib "advapi32" (ByVal _

HKey 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 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 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, "", 0&, &H3F, _

SA, phkResult, Create) = 0&

RegCloseKey phkResult

Exit Function

ErrorRoutineErr::

MsgBox "Ошибка: - " & 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, "", 0&, &H3F, SA, phkResult, Create

lResult = RegSetValueEx(phkResult, sSetValue, 0, (1), sValue, _

CLng(Len(sValue) + 1))

RegCloseKey phkResult

SetRegValue = (lResult = 0&

Exit Function

ErrorRoutineErr::

MsgBox "Ошибка: - " & Err.Description, vbExclamation + vbOKOnly, "Созданиие параметра"

SetRegValue = False

End Function

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 = 0& Then GetValue = Left(sBuffer, lBuffSize - 1) Else GetValue = sDefault

Exit Function

ErrorRoutineErr::

MsgBox "Ошибка: - " & Err.Description, vbExclamation + vbOKOnly, "Получение параметра"

GetValue = ""

End Function

Public Function DeleteKey(HKey As Long, sSubKey As String) _

As Boolean

On Error GoTo OOups

Dim phkResult As Long

DeleteKey = (RegDeleteKey(HKey, sSubKey) = 0&

RegCloseKey phkResult

Exit Function

OOups:

MsgBox "Ошибка: - " & Err.Description, vbExclamation + vbOKOnly, "Созданиие подраздела"

DeleteKey = False

End Function

' Call DeleteKey (Ветвь, "Путь") ' Удалить Ключ

' Call SetRegValue(Ветвь, "Путь", "Имя_параметра", "Значение_параметра")

' ^^^^^^^^^^^^^^^Создать Ключ^^^^^^^^^^^^^^^

' Value = GetValue(Ветвь, "Путь", "sKey", "sDefaut")

Работает -- проверено. Что надо -- спрашивай!!!