Модуль с декларациями API-функций, констант и типов.
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
Public Const REG_NONE = (0)'No value type
Public Const REG_SZ = (1)'Unicode nul terminated string
Public Const REG_EXPAND_SZ = (2)'Unicode nul terminated string w/enviornment var
Public Const REG_BINARY = (3)'Free form binary
Public Const REG_DWORD = (4)'32-bit number
Public Const REG_DWORD_LITTLE_ENDIAN = (4)'32-bit number (same as REG_DWORD)
Public Const REG_DWORD_BIG_ENDIAN = (5)'32-bit number
Public Const REG_LINK = (6)'Symbolic Link (unicode)
Public Const REG_MULTI_SZ = (7)'Multiple Unicode strings
Public Const REG_RESOURCE_LIST = (8)'Resource list in the resource map
Public Const REG_FULL_RESOURCE_DESCRIPTOR = (9)'Resource list in the hardware description
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