Сканирование ветки реестра на то, какие содержатся внутри переменные - 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

ИИ поможет Вам:


  • решить любую задачу по программированию
  • объяснить код
  • расставить комментарии в коде
  • и т.д
Попробуйте бесплатно

Оцени полезность:

10   голосов , оценка 4.1 из 5
Похожие ответы