Реестр, получить все параметры и значения опр. ветки

[Алексей К.]

HKEY_CURRENT_USER\SOFTWARE\1C\1Cv7\7.7\Titles
как осуществить сабж для указанной ветки?
GetAllSettings("HKEY_CURRENT_USER\SOFTWARE\1C\1Cv7\7.7", "Titles")
не работает

[lister]

Получить перечисление параметров, а затем значение каждого параметра...

Пример в API-Guide, раздел Registry

[Konst_One]

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

Attribute VB_Name = "mReg"
Option Explicit
'---------------------------------------------------------------------------------------
' Module    : mReg
' DateTime  : 01.03.2004 13:00
' Author    : ©Konst Popov, 2004
' Purpose   : Registry operations
'---------------------------------------------------------------------------------------

Public Const gKeyRecent = "Software\Microsoft\Visual Basic\6.0\RecentFiles"

Public Enum HKEY_TYPE
    HKEY_CURRENT_USER = &H80000001
    HKEY_LOCAL_MACHINE = &H80000002
    HKEY_CLASSES_ROOT = 1
End Enum

Public 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 = &H1F0037
Private Const KEY_QUERY_VALUE = &H1
Private Const KEY_SET_VALUE = &H2
Private Const KEY_CREATE_SUB_KEY = &H4
Private Const READ_CONTROL = &H20000
Private Const STANDARD_RIGHTS_WRITE = (READ_CONTROL)
Private Const SYNCHRONIZE = &H100000
Private Const KEY_WRITE = ((STANDARD_RIGHTS_WRITE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY) And (Not SYNCHRONIZE))

Public Function RegGetKeyValue(KeyRoot As HKEY_TYPE, KeyName As String, ValueName As String, Optional DefaultValue As String = "") As String
Dim Result As Long, hKey As Long, Value As String, Length As Long
  Result = RegOpenKeyEx(KeyRoot, KeyName, 0, KEY_QUERY_VALUE, hKey)
  If Result = ERROR_SUCCESS Then
    Value = String(1024, "0")
    Length = 1023
    Result = RegQueryValueEx(hKey, ValueName, 0, 0, Value, Length)
    RegCloseKey hKey
  End If
  If Result = ERROR_SUCCESS And Length > 0 Then RegGetKeyValue = Left(Value, Length - 1) Else RegGetKeyValue = DefaultValue
  If RegGetKeyValue = " " Then RegGetKeyValue = DefaultValue
End Function

Public Sub RegSetKeyValue(KeyRoot As HKEY_TYPE, KeyName As String, ValueName As String, ValueData As String)
Dim Result As Long, hKey As Long, Value As String, Length As Long, disposition As Long
  Result = RegCreateKeyEx(KeyRoot, KeyName, 0&, vbNullString, 0&, KEY_WRITE, 0&, hKey, disposition)
  If Result = ERROR_SUCCESS Then
    Value = ValueData
    If Len(Value) = 0 Then Value = " "
    Length = Len(Value)
    Result = RegSetValueEx(hKey, ValueName, 0&, REG_SZ, ByVal Value, Length)
    RegCloseKey hKey
  End If
  If Result <> ERROR_SUCCESS Then Err.Raise vbObjectError, "RegSetKeyValue", "Error " & Result & ", Line " & Erl
End Sub

Public Function RegGetSetting(Section As String, Key As String, Optional DefaultValue As String = "") As String
  RegGetSetting = RegGetKeyValue(HKEY_LOCAL_MACHINE, Section, Key, DefaultValue)
End Function

Public Sub RegSaveSetting(Section As String, Key As String, ByVal Value As String)
  RegSetKeyValue HKEY_LOCAL_MACHINE, Section, Key, Value
End Sub

Public Sub RegDelKey(ByVal Section As String, ByVal Key As String)
Dim Result As Long, hKey As Long
 
    Result = RegOpenKeyEx(HKEY_LOCAL_MACHINE, Section, 0, KEY_WRITE, hKey)
    If Result = ERROR_SUCCESS Then
        Result = RegDeleteValue(hKey, Key)
        RegCloseKey hKey
    End If
    If Result <> ERROR_SUCCESS Then Err.Raise Result, "RegDelKey", "Error " & Result & ", Line " & Erl
End Sub

Public Function DeleteAllKeys_(ByVal KeyRoot As HKEY_TYPE, ByVal Section As String, ByVal KeyName As String) As Long
Dim lRegErr As Long
Dim sKey As String
Dim Result As Long
Dim hKey As Long
Dim hSubKey As Long
Dim i As Long

    lRegErr = RegOpenKey(KeyRoot, Section & "\" & KeyName, hKey)
    If lRegErr <> ERROR_NONE Then
        GoTo lb_out
    End If
    i = 0
    Do
        lRegErr = EnumKey(hKey, i, sKey)
        If lRegErr = ERROR_NO_MORE_ITEMS Then
            lRegErr = ERROR_NONE
            Exit Do
        ElseIf lRegErr <> ERROR_NONE Then
            Exit Do
        End If
        lRegErr = RegDeleteKey(hKey, sKey)
        If lRegErr <> ERROR_NONE Then
            Exit Do
        End If
        i = i + 1
    Loop
lb_out:
    RegCloseKey hKey
    DeleteAllKeys_ = lRegErr

End Function

Private Function EnumKey(ByVal hKey As Long, ByVal lSubKey As Long, rsSubKey As String) As Long
Const nBufMax = 1024
Dim sResultBuf As String * nBufMax
Dim nResultLen As Integer
Dim lRegErr As Long
 
  lRegErr = RegEnumKey(hKey, lSubKey, sResultBuf, nBufMax)

  If lRegErr = 0 Then
    nResultLen = InStr(sResultBuf, Chr$(0))
    If nResultLen <> 0 Then
      rsSubKey = Left$(sResultBuf, nResultLen - 1)
    Else
      rsSubKey = 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 GetAllValues(ByVal KeyRoot As HKEY_TYPE, ByVal KeyName As String) As Variant
Dim lRegErr As Long
Dim hKey As Long
Dim arr As Variant

    lRegErr = RegOpenKey(KeyRoot, KeyName, hKey)
    If lRegErr <> ERROR_NONE Then
        Exit Function
    End If
    GetAllValues = EnumKeys(hKey, ktValue)

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
                    EnumKeys = aValues
                End If
        End Select
    End If

End Function

Private Function TruncateAtNull(ByVal strText As String) As String
' Returns the specified string truncated at the first null character
    Dim lLen As Long
   
    lLen = InStr(strText, Chr$(0))
    If lLen < 1 Then
        TruncateAtNull = strText
    Else
        TruncateAtNull = Left$(strText, lLen - 1)
    End If
End Function

[Алексей К.]

Спасибо за инфу, заюзал modRegistry.bas от Gserg`a
http://bbs.vbstreets.ru/viewtopic.php?t=9666
модераторам: закиньте его пожалуйста в кирпичи, упомяните в FAQ - хорошая штука, многим пригодится!