VB 6 Помогите разобраться в работе с реестром на vb6

Кирилл

Команда форума
Администратор
Ассоциация VN
Сообщения
14,069
Реакции
5,784
Что это все значит на человеческом языке:

VB.NET / VBA:
Option Explicit On 'Включаем проверку переменных
Module mRegedit
Dim setRegString As Microsoft.Win32.RegistryKey 'Для записи
Dim getRegString As Microsoft.Win32.RegistryKey 'Для чтения
'********************************************************************************************************
'ЗАПИСЬ В РЕЕСТР
Public Function SaveSettingString(ByVal sFolder As String, ByVal sName As String, ByVal sValue As String)
'Записывается в ветку HKEY_LOCAL_MACHINE
setRegString = Microsoft.Win32.Registry.LocalMachine.CreateSubKey(sFolder)
setRegString.SetValue(sName, sValue, Microsoft.Win32.RegistryValueKind.String)
End Function
'********************************************************************************
'ЧИТАЕМ ИЗ РЕЕСТРА
Public Function OpenSettingString(ByVal sFolder As String, ByVal sName As String)
On Error GoTo ErrNotKey 'Перейти к ошибке
'Читаем из ветки HKEY_LOCAL_MACHINE
getRegString = Microsoft.Win32.Registry.LocalMachine.OpenSubKey(sFolder)
OpenSettingString = getRegString.GetValue(sName, Microsoft.Win32.RegistryValueKind.String)
Exit Function 'Выход из процедуры
ErrNotKey:
MsgBox("Ключь ненайден.", 16, "Error")
End Function
'*************************************************
'УДАЛЕНИЕ ИЗ РЕЕСТРА ПОЛНОСТЬЮ
Public Function DelSubKey(ByVal sFolder As String)
On Error GoTo ErrNotKey 'Перейти к ошибке
'Удаляется из ветки HKEY_LOCAL_MACHINE
Microsoft.Win32.Registry.LocalMachine.DeleteSubKey(sFolder) 'Удаляем указанную папку в реестре
Exit Function 'Выход из процедуры
ErrNotKey:
MsgBox("Ключь ненайден.", 16, "Error")
End Function
End Module
 
А что именно смущает? Код весьма хорошо комментирован.
Это написано на языке Visual Basic.NET, поэтому на Visual Basic 6 работать не будет.
 
Почему сюда
VB.NET / VBA:
idname = tbNameMenu.Text
     Set WshShell = CreateObject("WScript.Shell")

    WshShell.RegWrite "HKEY_CLASSES_ROOT\DesktopBackground\Shell\MiMenu\MUIVerb", "idname", "REG_SZ"

Записывается в параметр именно слово idname а не его значение в переменной?
 
Да,ты прав.

А вот тут не пойму:

VB.NET / VBA:
hive = HKEY_CLASSES_ROOT
        key = "DesktopBackground\Shell\KZNZDR"
        RegShell.RegDelete hive & "\" & key & "\"

Пробовал разными методами,и напрямую тоже,и через reg.exe почему то выдает ошибку скрипта

upload_2014-8-30_0-7-33.png


Прав не хватает?
 
Ты hive присваиваешь значение переменной HKEY_CLASSES_ROOT.
 
Кавычки не помогают,я уже пробовал.Я даже без переменной пробовал,напрямую раздел писать
 
Блин вот почему так работает удаление :
VB.NET / VBA:
Dim oShell, sr, hive, key, subkey, value, data

' Список доступных сокращений разделов:
' HKCU - HKEY_CURRENT_USER
' HKLM - HKEY_LOCAL_MACHINE
' HKCR - HKEY_CLASSES_ROOT
' HKEY_USERS (не поддерживает сокращения)
' HKEY_CURRENT_CONFIG (не поддерживает сокращения)

' Типы данных:
' REG_SZ
' REG_EXPAND_SZ
' REG_DWORD
' REG_BINARY

' раздел
hive = "HKCU"
' ключ (подраздел)
subkey = hive & "\Environment\my subkey"
' параметр
value = "my value"
' значение
data = "my data"

set oShell = CreateObject("WScript.Shell")

' создание в подразделе subkey параметра value со значением data
oShell.RegWrite subkey & "\" & value, data, "REG_SZ"


'удаление ключа subkey
oShell.RegDelete subkey & "\"


А вот так не работает:

VB.NET / VBA:
' раздел
    hive = "HKCR"
    ' ключ (подраздел)
    subkey = hive & "\DesktopBackground\Shell\KZNZDR"
    ' параметр
    value = "MUIVerb"
    ' значение
    data = idname
  
    Set RegShell = CreateObject("WScript.Shell")
  
    ' создание в подразделе subkey параметра value со значением data
    RegShell.RegWrite subkey & "\" & value, data, "REG_SZ"
  
    RegShell.RegWrite subkey & "\" & "Icon", "imageres.dll,104", "REG_SZ"
  
    ' запись в параметр по-умолчанию значения "my Default"
    'RegShell.RegWrite subkey & "\", "My Default", "REG_SZ"
' раздел
       
        RegShell.RegDelete subkey & "\"


??
Вот стоит поменять только одну строчку
\DesktopBackground\Shell\KZNZDR
И ситуация меняется,ну что за хрень...
 
Вообще-то записывать данные в раздел HKCR - это не очень хороший тон.
HKCR как ты знаешь - виртуальный раздел.
Откуда реестру знать, куда записывать в HKLM или в HKCU. Правильно - делать запись напрямую в нужный улей:
- HKEY_CURRENT_USER\Software\Classes
- HKEY_LOCAL_MACHINE\SOFTWARE\Classes (сюда естественно потребуются повышенные привилегии при запуске скрипта).

На счет метода RegDelete - обрати внимание, он не поддерживает удаление разделов вместе с подразделами.
Нужно сначала удалить все вложенные, а уж затем корневой.Кстати, если ты запускаешь скрипт напрямую из AkelPad-a по Ctrl+F5,
или из программы на Visual Basic 6,
то они работают от имени 32-разрядного процесса.

В 64-разрядной системе, запросы к разделам, имеющим разную битность, будут переадресовываться.
Для VB6 отключить переадресацию можно только используя Windows API функции и флаг KEY_WOW64_64KEY

Пример записи значения в 64-битную или 32-битную ветку реестра на выбор


Реализуется с помощью параметра samDesired функции RegOpenKeyEx.
Registry Key Security and Access Rights
Accessing an Alternate Registry View

VB.NET / VBA:
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 RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long

Private 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
    
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" _
        (ByVal hKey As Long, _
         ByVal lpValueName As String, _
         ByVal lpReserved As Long, _
         lpType As Long, _
         lpData As Any, _
         lpcbData As Long) As Long

Private Declare Function RegSetValueEx Lib "advapi32" Alias "RegSetValueExA" _
        (ByVal hKey As Long, _
        ByVal lpValueName As String, _
        ByVal Reserved As Long, _
        ByVal dwType As Long, _
        ByVal szData As String, _
        ByVal cbData As Long) As Long

Public Enum RegTypes
      RegNone = 0
      RegSZ = 1
      RegExpandSz = 2
      RegBinary = 3
      RegDword = 4
      RegDwordLittleEndian = 4
      RegDwordBigEndian = 5
      RegLink = 6
      RegMultiSz = 7
      RegResourceList = 8
      RegFullResourceDesc = 9
End Enum

Private Const HKEY_CLASSES_ROOT     As Long = &H80000000
Private Const HKEY_CURRENT_USER     As Long = &H80000001
Private Const HKEY_LOCAL_MACHINE    As Long = &H80000002
Private Const HKEY_USERS            As Long = &H80000003
Private Const HKEY_PERFORMANCE_DATA As Long = &H80000004
Private Const HKEY_CURRENT_CONFIG   As Long = &H80000005
Private Const HKEY_DYN_DATA         As Long = &H80000006

Private Const KEY_ALL_ACCESS        As Long = &HF003F
Private Const KEY_WRITE             As Long = &H20006
Private Const KEY_READ              As Long = &H20019
Private Const KEY_QUERY_VALUE       As Long = &H1
Private Const KEY_ENUMERATE_SUB_KEYS As Long = &H8
Private Const KEY_CREATE_SUB_KEY    As Long = &H4

'Registry Redirector Subsystem
'http://msdn.microsoft.com/en-us/library/windows/desktop/aa384129(v=vs.85).aspx
Private Const KEY_WOW64_64KEY       As Long = &H100 'Access a 64-bit key from either a 32-bit or 64-bit application.
Private Const KEY_WOW64_32KEY       As Long = &H200 'Access a 32-bit key from either a 32-bit or 64-bit application.
'Can be used by:
' - RegCreateKeyEx
' - RegDeleteKeyEx
' - RegOpenKeyEx

Private Sub Command1_Click()

        'Записываем новый ...
   
        Dim badRoot$, Ret_1&, Ret_2&
   
        badRoot = "HKEY_LOCAL_MACHINE\SOFTWARE\Classes\CLSID\" & badCLSID & "\TypeLib"
   
        'Записываем ключ в 32-битных ветвях
   
        Ret_1 = WriteKey(badRoot, "", Key2099, False)
   
        'Записываем ключ в 64-битных ветвях
   
        Ret_2 = WriteKey(badRoot, "", Key2099, True)
   
        MsgBox "32-битная ветка - " & IIf(Ret_1, "Успех.", "Ошибка.") & vbCrLf & _
               "64-битная ветка - " & IIf(Ret_2, "Успех.", "Ошибка.")
end sub


'Самоэлевация прав программы

Private Sub Form_Initialize()
    'Exit Sub 'Временно, пока не скомпилирую проект
    With CreateObject("WScript.Shell")
        On Error Resume Next
        .RegWrite "HKLM\isElevated", "", "REG_SZ"
        If Err <> 0 Then
            CreateObject("Shell.Application").ShellExecute App.Path & "\" & App.EXEName & ".exe", "1", "", "runas", 1
            End
          Else
            .RegDelete "HKLM\isElevated"
        End If
    End With
End Sub

Private Function GetHKey(ByVal HKeyName As String) As Long 'Получить хендл улья
    Dim pos As Long
    pos = InStr(HKeyName, "\")
    If pos <> 0 Then HKeyName = Left$(HKeyName, pos - 1)
    Select Case UCase(HKeyName)
        Case "HKEY_CLASSES_ROOT", "HKCR"
            GetHKey = HKEY_CLASSES_ROOT
        Case "HKEY_CURRENT_USER", "HKCU"
            GetHKey = HKEY_CURRENT_USER
        Case "HKEY_LOCAL_MACHINE", "HKLM"
            GetHKey = HKEY_LOCAL_MACHINE
        Case "HKEY_USERS", "HKU", "HKUS"
            GetHKey = HKEY_USERS
        Case "HKEY_PERFORMANCE_DATA"
            GetHKey = HKEY_PERFORMANCE_DATA
        Case "HKEY_CURRENT_CONFIG", "HKCC"
            GetHKey = HKEY_CURRENT_CONFIG
        Case "HKEY_DYN_DATA"
            GetHKey = HKEY_DYN_DATA
    End Select
End Function


Private Function WriteKey(rPath$, ParamName, ParamValue, Optional is64Node As Boolean = False)

        'Функция записывает значение в реестр.
        'Возвращает результат выполнения API-функции RegSetValueEx
        'Умеет использовать Registry Redirector SybSystem (в 64 или 32-битную ветку записывать данные)

        Dim Ret_1&, Ret_2&, sSubKey$, Hive$, hSubKey&, regAccess&
   
        Hive = Split(rPath, "\")(0)
        sSubKey = IIf(Len(Hive) = Len(rPath), "", Replace(rPath, Hive & "\", ""))
   
        If is64Node Then
            regAccess = KEY_QUERY_VALUE Or KEY_WRITE Or KEY_WOW64_64KEY
        Else
            regAccess = KEY_QUERY_VALUE Or KEY_WRITE Or KEY_WOW64_32KEY
        End If
   
        Ret_1 = RegOpenKeyEx(GetHKey(Hive), sSubKey, 0&, regAccess, hSubKey)

        Ret_2 = RegSetValueEx(hSubKey, ParamName, 0, RegTypes.RegSZ, ParamValue, Len(ParamValue) + 1)
   
        RegCloseKey hSubKey

        WriteKey = Ret_2

End Function

regAccess = KEY_QUERY_VALUE Or KEY_WRITE Or KEY_WOW64_32KEY
Указывает, чтобы приложения (вне зависимости от их разрядности) на 64-битной ОС обращались к 32-битным веткам реестра.

regAccess = KEY_QUERY_VALUE Or KEY_WRITE Or KEY_WOW64_64KEY
Указывает, чтобы приложения (вне зависимости от их разрядности) на 64-битной ОС обращались к 64-битным веткам реестра.[/QUOTE]
 
Последнее редактирование:
данные в раздел HKCR - это не очень хороший тон.

Точно,в этом была проблема.

На счет метода RegDelete - обрати внимание, он не поддерживает удаление разделов вместе с подразделами.
Да,в курсе.

Вроде поперло,спасибо.
 
Назад
Сверху Снизу