Получение списка ключей в реестре

Программирование на Visual Basic, главный форум. Обсуждение тем программирования на VB 1—6.
Даже если вы плохо разбираетесь в VB и программировании вообще — тут вам помогут. В разумных пределах, конечно.
Правила форума
Темы, в которых будет сначала написано «что нужно сделать», а затем просьба «помогите», будут закрыты.
Читайте требования к создаваемым темам.
SeT
Постоялец
Постоялец
Аватара пользователя
 
Сообщения: 362
Зарегистрирован: 29.12.2004 (Ср) 13:11

Получение списка ключей в реестре

Сообщение SeT » 04.04.2009 (Сб) 13:05

Необходимо получить список ключей в конкретной папке

Нашел только функционал по получению значения заданного ключа:

Код: Выделить всё
Option Explicit

Public Const REG_SZ As Long = 1 ' Параметр String
Public Const REG_DWORD As Long = 4 ' DWord


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

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


В принципе функционал нужный, но до него нужно получить список находящихся ключей
01000100
Причиняет боль 0010
Виртуальная любовь 00100
Индустрия снов 0010

dr.MIG
Гуру
Гуру
Аватара пользователя
 
Сообщения: 1441
Зарегистрирован: 18.12.2004 (Сб) 9:53
Откуда: г.Ярославль

Re: Получение списка ключей в реестре

Сообщение dr.MIG » 04.04.2009 (Сб) 13:12

RegEnumKeyEx
Salus populi suprema lex

SeT
Постоялец
Постоялец
Аватара пользователя
 
Сообщения: 362
Зарегистрирован: 29.12.2004 (Ср) 13:11

Re: Получение списка ключей в реестре

Сообщение SeT » 04.04.2009 (Сб) 13:47

Нашел код
Код: Выделить всё
private Sub Command1_Click()
MsgBox DoesKeyExist(HKEY_LOCAL_MACHINE, "Software\Microsoft\Visual Basic")
Unload me
End Sub

private Function DoesKeyExist(Root as Long, Key as string)
Dim ft as FILETIME
Dim keyhandle&
Dim res&
Dim curidx&
Dim keyname$, classname$
Dim keylen&, classlen&
Dim msg$
Dim reserved&
res& = RegOpenKeyEx(Root, Key, 0, KEY_READ, keyhandle)
If res &lt;&gt; ERROR_SUCCESS then
MsgBox "Can't open key"
Exit Function
End If
Do
keylen& = 2000
classlen& = 2000
keyname$ = string$(keylen, 0)
classname$ = string$(classlen, 0)
res = RegEnumKeyEx(keyhandle, curidx, keyname$, keylen, reserved, classname$, classlen, ft)
curidx = curidx + 1
If res = ERROR_SUCCESS then msg$ = msg$ & Left$(keyname$, keylen) + vbCrLf
Loop While res = ERROR_SUCCESS

Call RegCloseKey(keyhandle)
DoesKeyExist = msg$
End Function

'
код для модуля
'
option Explicit

public Const SYNCHRONIZE = &H100000
public Const STANDARD_RIGHTS_READ = &H20000
public Const STANDARD_RIGHTS_WRITE = &H20000
public Const STANDARD_RIGHTS_EXECUTE = &H20000
public Const STANDARD_RIGHTS_REQUIRED = &HF0000
public Const STANDARD_RIGHTS_ALL = &H1F0000
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_READ = ((STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or _
KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) _
And (Not SYNCHRONIZE))
public Const KEY_WRITE = ((STANDARD_RIGHTS_WRITE Or KEY_SET_VALUE Or _
KEY_CREATE_SUB_KEY) And (Not SYNCHRONIZE))
public Const KEY_EXECUTE = (KEY_READ)
public Const KEY_ALL_ACCESS = ((STANDARD_RIGHTS_ALL Or KEY_QUERY_VALUE Or _
KEY_SET_VALUE Or KEY_CREATE_SUB_KEY Or _
KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY Or _
KEY_CREATE_LINK) And (Not SYNCHRONIZE))
public Const ERROR_SUCCESS = 0&


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 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
Declare Function RegCloseKey Lib "advapi32.dll" _
(byval hKey as Long) as Long

public Type FILETIME
dwLowDateTime as Long
dwHighDateTime as Long
End Type

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_PERFORMANCE_DATA = &H80000004


который по пути "HKEY_LOCAL_MACHINE\Software\Microsoft\Visual Basic" возвращает подпуть "6.0"

Мне нужно, что бы по пути, скажем "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Visual Basic\6.0\Helpfiles" выдавались все значения
01000100
Причиняет боль 0010
Виртуальная любовь 00100
Индустрия снов 0010

dr.MIG
Гуру
Гуру
Аватара пользователя
 
Сообщения: 1441
Зарегистрирован: 18.12.2004 (Сб) 9:53
Откуда: г.Ярославль

Re: Получение списка ключей в реестре

Сообщение dr.MIG » 04.04.2009 (Сб) 14:08

В том же API-Guide есть пример использования этой функции. Как раз то, что ты ищешь.
Salus populi suprema lex

SeT
Постоялец
Постоялец
Аватара пользователя
 
Сообщения: 362
Зарегистрирован: 29.12.2004 (Ср) 13:11

Re: Получение списка ключей в реестре

Сообщение SeT » 04.04.2009 (Сб) 14:17

Нашел. Большое спасибо.
Тему в OFF
01000100
Причиняет боль 0010
Виртуальная любовь 00100
Индустрия снов 0010


Вернуться в Visual Basic 1–6

Кто сейчас на конференции

Сейчас этот форум просматривают: Yandex-бот и гости: 43

    TopList