Как работать с реестром

[RayShade]

Visual Basic имеет встроенные операторы и функции для работы с Системным Реестром (в дальнешем - реестр), он позволяет записывать, считывать и удалять данные только в разделе ключа HKEY_CURRENT_USER Software VB and VBA Program Setting.



Операторы:



Оператор SaveSetting – позволяет производить запись запись данных (автоматически создает подключи).



Синтаксис:





SaveSetting VBKeyName, Section, Key, Setting



Где:





SaveSetting имя самого оператора:





VBKeyName строковое значение, которое является именем внутреннего

подраздела VB and VBA Program Setting (иными словами,

создаваемая Вами главная папка);



Section строковое значение, которое является именем внутреннего

подраздела VBKeyName (иными словами, создаваемая Вами

папка находящаяся в Вашей главной папке. Таких Section -

папок у Вас может быть несколько.);



Key строковое значение, которое является именем параметра в

созданном, внутреннем подразделе Section (иными словами,

имя данных в созданной Вами Section - папке. Таких Key –



параметров у Вас может буть несколько.);



Setting строковое значение, которое Вы хотите присвоить созданному

Вами параметру;



Оператор DeleteSetting – позволяет удалять параметры и внутренние подразделы.



Синтаксис:



DeleteSetting VBKeyName, Section, Key



Где:



DeleteSetting имя самого оператора





VBKeyName строковое значение, которое является именем внутреннего

подраздела VB and VBA Program Setting (иными словами,

созданная Вами главная папка);



Section строковое значение, которое является именем внутреннего

подраздела VBKeyName (иными словами, одна из созданных

Вами папок находящихся в Вашей главной папке.);



Key строковое значение, которое является именем параметра в

удаляемом, внутреннем подразделе Section (иными словами,

имя удаляемых данных);



Если Вы захотите удалить сразу весь подраздел, а не некоторые параметры, то для этого используйте следующий синтаксис оператора DeleteSetting :



DeleteSetting VBKeyName, Section



Или, если Вы захотите удалить целиком созданный Вами внутренний подраздел VB and VBA Program Setting используйте следующий синтаксис оператора DeleteSetting :



DeleteSetting VBKeyName



Внимание!!! Пользуйтесь оператором DeleteSetting очень осторожно!



Функции



Функция GetSetting() – позволяет получить значения определенного параметра.



Синтаксис



MySet = GetSetting ( VBKeyName, Section, Key [, Default ] )



Где:



MySet строка для хранения возвращаемого функцией GetSetting значения;



GetSetting имя самой функции;





VBKeyName строковое значение, которое является именем внутреннего подраздела

VB and VBA Program Setting (иными словами, созданная Вами

главная папка);



Section строковое значение, которое является именем внутреннего подраздела

VBKeyName (иными словами, имя папки находящаяся в Вашей

главной папке.);



Key строковое значение, которое является именем параметра в созданном,

внутреннем подразделе Section (иными словами, имя данных

в Section - папке.);



Setting строковое значение, которое Вы хотите считать из данного параметра;



[ Default ] необязательный аргумент, представляющий строковое значение,

которое будет возвращено функцией в случае ошибки

(если такого параметра нет);



Функциа GetAllSettings() – позволяет получить массив значений из определенного подраздела.



Синтаксис:



MySet = GetAllSettings ( VBKeyName, Section)



Где:



MySet строка для хранения возвращаемого функцией GetAllSettings

значения;



GetAllSettings имя самой функции;





VBKeyName строковое значение, которое является именем внутреннего

подраздела VB and VBA Program Setting (иными словами,

созданная Вами главная папка);



Section строковое значение, которое является именем внутреннего

подраздела VBKeyName (иными словами, имя папки

находящаяся в Вашей главной папке.);



Обработать массив значений и получить информацию в удобном виде можно следующим образом:



Dim intSettings As Integer



MySet = GetAllSettings(App.Title, "PortSettings")



For intSettings = LBound(MySet, 1) To UBound(MySet, 1)



Debug.Print MySet(intSettings, 0), MySet(intSettings, 1)



Next intSettings



End Sub





Чтение/Запись данных в системный реестр (API):



Объявите все константы и API-функции в отдельном модуле. Там же создайте функцию по созданию ключа, функцию записи в него данных, функцию считывания данных , функцию удаления данных из ключа и функцию удаления самого ключа.



Option Explicit



Public Const REG_SZ As Long = 1

Public Const REG_DWORD As Long = 4





Public Const HKEY_LOCAL_MACHINE = &H80000002

Public Const HKEY_CLASSES_ROOT = &H80000000



Public Const HKEY_CURRENT_USER = &H80000001

Public Const HKEY_USERS = &H80000003





Public Const ERROR_NONE = 0

Public Const ERROR_BADDB = 1

Public Const ERROR_BADKEY = 2

Public Const ERROR_CANTOPEN = 3

Public Const ERROR_CANTREAD = 4

Public Const ERROR_CANTWRITE = 5

Public Const ERROR_OUTOFMEMORY = 6

Public Const ERROR_INVALID_PARAMETER = 7

Public Const ERROR_ACCESS_DENIED = 8



Public Const ERROR_INVALID_PARAMETERS = 87

Public Const ERROR_NO_MORE_ITEMS = 259



Public Const KEY_ALL_ACCESS = &H3F



Public Const REG_OPTION_NON_VOLATILE = 0



Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long



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, ByVal lpSecurityAttributes As Long, phkResult As Long, lpdwDisposition As Long) As Long



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



Declare Function RegQueryValueExString Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As String, lpcbData As Long) As Long



Declare Function RegQueryValueExLong Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Long

, lpcbData As Long) As Long



Declare Function RegQueryValueExNULL Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As Long, lpcbData As Long) As Long



Declare Function RegSetValueExString Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByVal lpValue As String, ByVal cbData As Long) As Long



Declare Function RegSetValueExLong Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpValue As Long, ByVal cbData As Long) As Long



Declare Function RegDeleteKey& Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String)



Declare Function RegDeleteValue& Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long

, ByVal lpValueName As String)





Создание нового ключа (подключа)



Public Function CreateNewKey(lPredefinedKey As Long, sNewKeyName As String)



Dim hNewKey As Long

Dim lRetVal As Long



lRetVal = RegCreateKeyEx(lPredefinedKey, sNewKeyName, 0&, vbNullString, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, 0&, hNewKey, lRetVal)



RegCloseKey (hNewKey)



End Function





Запись данных в ключ





Public Function SetKeyValue(lPredefinedKey As Long, sKeyName As String, sValueName As String, vValueSetting As Variant, lValueType As Long)



Dim lRetVal As Long



Dim hKey As Long



lRetVal = RegOpenKeyEx(lPredefinedKey, sKeyName, 0, KEY_ALL_ACCESS, hKey)

lRetVal = SetValueEx(hKey, sValueName, lValueType, vValueSetting)



RegCloseKey (hKey)



End Function



Public Function SetValueEx(ByVal hKey As Long, sValueName As String, lType As Long, vValue As Variant) As Long



Dim lValue As Long

Dim sValue As String



Select Case lType





Case REG_SZ

sValue = vValue

SetValueEx = RegSetValueExString(hKey, sValueName, 0&, lType, sValue, Len(sValue))



Case REG_DWORD

lValue = vValue

SetValueEx = RegSetValueExLong(hKey, sValueName, 0&, lType, lValue, 4)



End Select



End Function





Возвращает значения записанные в ключе



Public Function QueryValue(lPredefinedKey As Long, sKeyName As String, sValueName As String)



Dim lRetVal As Long

Dim hKey As Long

Dim vValue As Variant



lRetVal = RegOpenKeyEx(lPredefinedKey, sKeyName, 0, KEY_ALL_ACCESS, hKey)

lRetVal = QueryValueEx(hKey, sValueName, vValue)



QueryValue = vValue

RegCloseKey (hKey)



End Function



Function QueryValueEx(ByVal lhKey As Long, ByVal szValueName As String, vValue As Variant) As Long



Dim cch As Long

Dim lrc As Long

Dim lType As Long

Dim lValue As Long

Dim sValue As String



On Error GoTo QueryValueExError



'Определение размера и типа считываемых данных



lrc = RegQueryValueExNULL(lhKey, szValueName, 0&, lType, 0&, cch)



If lrc <> ERROR_NONE Then MsgBox "Данных (ключа) не существует!", vbExclamation, Form1.Caption



Select Case lType



'Для символьных

Case REG_SZ:

sValue = String(cch, 0)

lrc = RegQueryValueExString(lhKey, szValueName, 0&, lType, sValue, cch)

If lrc = ERROR_NONE Then



vValue = Left$(sValue, cch)



Else

vValue = Empty



End If



'Для числовых

Case REG_DWORD:



lrc = RegQueryValueExLong(lhKey, szValueName, 0&, lType, lValue, cch)



If lrc = ERROR_NONE Then vValue = lValue



'Для остальных не поддержанных типов данных

Case Else

lrc = -1



End Select



QueryValueExExit:

QueryValueEx = lrc

Exit Function



QueryValueExError:



Resume QueryValueExExit



End Function





Удаление значений ключа



Public Function DeleteValue(lPredefinedKey As Long, sKeyName As String, sValueName As String)



Dim lRetVal As Long

Dim hKey As Long



lRetVal = RegOpenKeyEx(lPredefinedKey, sKeyName, 0, KEY_ALL_ACCESS, hKey)

lRetVal = RegDeleteValue(hKey, sValueName)



RegCloseKey (hKey)



End Function





Удаление ключа



Public Function DeleteKey(lPredefinedKey As Long, sKeyName As String)



Dim lRetVal As Long



lRetVal = RegDeleteKey(lPredefinedKey, sKeyName)



End Function



Вызов функций из модуля осуществляется следующим образом:



Создание ключа



CreateNewKey HKEY_LOCAL_MACHINE, "VB6"



'Можно создать и подключи

'CreateNewKey HKEY_LOCAL_MACHINE, "VB6RegistryKey"



Запись данных в ключ



SetKeyValue HKEY_LOCAL_MACHINE, "VB6", "Program", "Ваши данные", REG_SZ



Считывание данных



Dim Variable As Variant



Variable = QueryValue(HKEY_LOCAL_MACHINE, "VB6", "Program")



Удаление данных из ключа



DeleteValue HKEY_LOCAL_MACHINE, "VB6", "Program"



Удаление ключа



DeleteKey HKEY_LOCAL_MACHINE, "VB6"



Внимание! Соблюдайте осторожность, что бы не удалить главный ключ реестра Windows.