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

Тема в разделе "Visual Basic 6 / Сценарии VBScript, JScript", создана пользователем Kиpилл, 28 авг 2014.

  1. Kиpилл
    Оффлайн

    Kиpилл Команда форума Администратор

    Лучший автор месяца

    Сообщения:
    12.208
    Симпатии:
    4.977
    Что это все значит на человеческом языке:

    Код (vb.net):
    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
     
    akok нравится это.
  2. Dragokas
    Оффлайн

    Dragokas Very kind Developer Команда форума Супер-Модератор Разработчик Клуб переводчиков

    Сообщения:
    4.477
    Симпатии:
    4.306
    А что именно смущает? Код весьма хорошо комментирован.
    Это написано на языке Visual Basic.NET, поэтому на Visual Basic 6 работать не будет.
     
  3. Kиpилл
    Оффлайн

    Kиpилл Команда форума Администратор

    Лучший автор месяца

    Сообщения:
    12.208
    Симпатии:
    4.977
    А,вот почему)
    В одном букваре видел.
     
  4. Kиpилл
    Оффлайн

    Kиpилл Команда форума Администратор

    Лучший автор месяца

    Сообщения:
    12.208
    Симпатии:
    4.977
    Почему сюда
    Код (vb.net):
    idname = tbNameMenu.Text
         Set WshShell = CreateObject("WScript.Shell")

        WshShell.RegWrite "HKEY_CLASSES_ROOT\DesktopBackground\Shell\MiMenu\MUIVerb", "idname", "REG_SZ"
    Записывается в параметр именно слово idname а не его значение в переменной?
     
  5. glax24
    Оффлайн

    glax24 Разработчик

    Сообщения:
    2.000
    Симпатии:
    1.450
    потому что в кавычках
     
    Kиpилл нравится это.
  6. Kиpилл
    Оффлайн

    Kиpилл Команда форума Администратор

    Лучший автор месяца

    Сообщения:
    12.208
    Симпатии:
    4.977
    Да,ты прав.

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

    Код (vb.net):
    hive = HKEY_CLASSES_ROOT
            key = "DesktopBackground\Shell\KZNZDR"
            RegShell.RegDelete hive & "\" & key & "\"
    Пробовал разными методами,и напрямую тоже,и через reg.exe почему то выдает ошибку скрипта

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

    Прав не хватает?
     
    akok нравится это.
  7. glax24
    Оффлайн

    glax24 Разработчик

    Сообщения:
    2.000
    Симпатии:
    1.450
    Если hive строка то значение должно быть в кавычках.
     
  8. Dragokas
    Оффлайн

    Dragokas Very kind Developer Команда форума Супер-Модератор Разработчик Клуб переводчиков

    Сообщения:
    4.477
    Симпатии:
    4.306
    Ты hive присваиваешь значение переменной HKEY_CLASSES_ROOT.
     
    akok нравится это.
  9. Kиpилл
    Оффлайн

    Kиpилл Команда форума Администратор

    Лучший автор месяца

    Сообщения:
    12.208
    Симпатии:
    4.977
    Кавычки не помогают,я уже пробовал.
    --- Объединённое сообщение, 29 авг 2014 ---
    Я даже без переменной пробовал,напрямую раздел писать
     
    akok нравится это.
  10. Kиpилл
    Оффлайн

    Kиpилл Команда форума Администратор

    Лучший автор месяца

    Сообщения:
    12.208
    Симпатии:
    4.977
    Блин вот почему так работает удаление :
    Код (vb.net):
    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):
    ' раздел
        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
    И ситуация меняется,ну что за хрень...
     
    akok нравится это.
  11. Dragokas
    Оффлайн

    Dragokas Very kind Developer Команда форума Супер-Модератор Разработчик Клуб переводчиков

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

    На счет метода RegDelete - обрати внимание, он не поддерживает удаление разделов вместе с подразделами.
    Нужно сначала удалить все вложенные, а уж затем корневой.
    --- Объединённое сообщение, 30 авг 2014, Дата первоначального сообщения: 30 авг 2014 ---
    Кстати, если ты запускаешь скрипт напрямую из 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):
    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]
     
    Последнее редактирование: 9 сен 2014
    akok, Kиpилл и glax24 нравится это.
  12. Kиpилл
    Оффлайн

    Kиpилл Команда форума Администратор

    Лучший автор месяца

    Сообщения:
    12.208
    Симпатии:
    4.977
    Точно,в этом была проблема.

    Да,в курсе.

    Вроде поперло,спасибо.
     

Поделиться этой страницей