Сканирование ветки реестра на то, какие содержатся внутри переменные - VB
Формулировка задачи:
Подскажите плз. Мне нужно просканировать ветвь на то, какие содержаться внутри переменные и их значения (по-моему это так называется :-)). Допустим есть ветвь HKLM/Software..../Run. В ней мне нужно узнать все что здесь есть.. Как ? Спасибо..
Решение задачи: «Сканирование ветки реестра на то, какие содержатся внутри переменные»
textual
Листинг программы
Attribute VB_Name = 'mReg' Option Explicit Public Const gKeyName = '...' Public Const gKeySession = 'SOFTWARE...' Public Enum HKEY_TYPE HKEY_CURRENT_USER = &H80000001 HKEY_LOCAL_MACHINE = &H80000002 HKEY_CLASSES_ROOT = 1 End Enum Private Enum KeyTypeENUM ktKey ktValue End Enum Private 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 Private Declare Function RegEnumKey Lib 'advapi32.dll' Alias 'RegEnumKeyA' (ByVal hKey As Long, ByVal iSubKey As Long, ByVal szBuffer As String, ByVal cbBuf As Long) As Long Private Declare Function RegDeleteValue Lib 'advapi32.dll' Alias 'RegDeleteValueA' (ByVal hKey As Long, ByVal lpValueName As String) As Long Private Declare Function RegDeleteKey Lib 'advapi32.dll' Alias 'RegDeleteKeyA' (ByVal hKey As Long, ByVal lpSubKey As String) As Long Private 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 Private Declare Function RegOpenKey Lib 'advapi32.dll' Alias 'RegOpenKeyA' (ByVal hKey As Long, ByVal szSubKey As String, hkeyResult As Long) As Long Private 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 Private Declare Function RegQueryInfoKey Lib 'advapi32.dll' Alias 'RegQueryInfoKeyA' (ByVal hKey As Long, ByVal lpClass As String, lpcbClass As Long, ByVal lpReserved As Long, lpcSubKeys As Long, lpcbMaxSubKeyLen As Long, lpcbMaxClassLen As Long, lpcValues As Long, lpcbMaxValueNameLen As Long, lpcbMaxValueLen As Long, lpcbSecurityDescriptor As Long, ByVal lpftLastWriteTime As Long) As Long Private Declare Function RegQueryValueEx 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 ' Note that if you declare the lpData parameter as String, you must pass it By Value. Private Declare Function RegSetValueEx Lib 'advapi32.dll' Alias 'RegSetValueExA' (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByVal lpData As String, ByVal cbData As Long) As Long ' Note that if you declare the lpData parameter as String, you must pass it By Value. Private Declare Function RegCloseKey Lib 'advapi32.dll' (ByVal hKey As Long) As Long Private Const ERROR_SUCCESS = 0& Private Const ERROR_NONE = ERROR_SUCCESS Private Const ERROR_BADDB = 1 Private Const ERROR_BADKEY = 2 Private Const ERROR_CANTOPEN = 3 Private Const ERROR_CANTREAD = 4 Private Const ERROR_CANTWRITE = 5 Private Const ERROR_OUTOFMEMORY = 6 Private Const ERROR_INVALID_PARAMETER = 7 Private Const ERROR_ACCESS_DENIED = 8 Private Const ERROR_NO_MORE_ITEMS = 259 Private Const REG_SZ = 1& Private Const KEY_EVENT = &H1 ' Event contains key event record Private Const KEY_NOTIFY = &H10 Private Const KEY_ALL_ACCESS = &H1F0 y = sResultBuf End If Else rsSubKey = '' End If EnumKey = lRegErr End Function Public Function DeleteAllValues(ByVal KeyRoot As HKEY_TYPE, ByVal Section As String, ByVal KeyName As String) As Long Dim lRegErr As Long Dim hKey As Long Dim i As Long Dim arr As Variant lRegErr = RegOpenKey(KeyRoot, Section & ' ' & KeyName, hKey) If lRegErr <> ERROR_NONE Then GoTo lb_out End If arr = EnumKeys(hKey, ktValue) If UBound(arr) = -1 Then GoTo lb_out Else For i = LBound(arr) To UBound(arr) Debug.Print arr(i, 0) & '=' & arr(i, 1) lRegErr = RegDeleteValue(hKey, arr(i, 0)) If lRegErr <> ERROR_NONE Then Exit For End If Next i End If lb_out: RegCloseKey hKey DeleteAllValues = lRegErr End Function Public Function DeleteAllKeys(ByVal KeyRoot As HKEY_TYPE, ByVal Section As String, ByVal KeyName As String) As Long Dim lRegErr As Long Dim hKey As Long Dim i As Long Dim arr As Variant lRegErr = RegOpenKey(KeyRoot, Section & ' ' & KeyName, hKey) If lRegErr <> ERROR_NONE Then GoTo lb_out End If arr = EnumKeys(hKey, ktKey) If UBound(arr) = -1 Then GoTo lb_out Else For i = LBound(arr) To UBound(arr) Debug.Print arr(i) lRegErr = RegDeleteKey(hKey, arr(i)) If lRegErr <> ERROR_NONE Then Exit For End If Next i End If lb_out: RegCloseKey hKey DeleteAllKeys = lRegErr End Function Public Function EnumKeys(ByVal hKey As Long, ByVal KeyType As KeyTypeENUM) As Variant ' Iterate over all the values in this key Const nBufMax = 1024 Dim strClass As String * nBufMax Dim cbClass As Long, cSubKeys As Long, cbMaxSubKeyLen As Long, cbMaxClassLen As Long, lReserved As Long Dim cValues As Long, cbMaxValueNameLen As Long, cbMaxValueLen As Long, cbSecurityDescriptor As Long Dim cbData As Long, cbValueName As Long, lType As Long Dim strKey As String, strData As String * nBufMax, strValueName As String * nBufMax Dim aValues() As String Dim i As Long cbClass = LenB(StrConv(strClass, vbFromUnicode)) If RegQueryInfoKey(hKey, strClass, cbClass, lReserved, cSubKeys, cbMaxSubKeyLen, cbMaxClassLen, cValues, cbMaxValueNameLen, _ cbMaxValueLen, cbSecurityDescriptor, 0) = ERROR_SUCCESS Then Select Case KeyType Case ktValue If cValues > 0 Then ReDim aValues(0 To cValues - 1, 0 To 1) For i = 0 To cValues - 1 cbValueName = LenB(StrConv(strValueName, vbFromUnicode)) cbData = LenB(StrConv(strData, vbFromUnicode)) If RegEnumValue(hKey, i, strValueName, cbValueName, 0, lType, strData, cbData) = ERROR_SUCCESS Then aValues(i, 0) = TruncateAtNull(strValueName) aValues(i, 1) = TruncateAtNull(strData) End If Next EnumKeys = aValues End If Case ktKey If cSubKeys > 0 Then ReDim aValues(0 To cValues - 1) cbValueName = LenB(StrConv(strValueName, vbFromUnicode)) For i = 0 To cSubKeys - 1 If RegEnumKey(hKey, i, strValueName, cbValueName) = ERROR_SUCCESS Then aValues(i) = TruncateAtNull(strValueName) End If Next
ИИ поможет Вам:
- решить любую задачу по программированию
- объяснить код
- расставить комментарии в коде
- и т.д