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

Кирилл

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

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
 

Dragokas

Very kind Developer
Команда форума
Супер-Модератор
Разработчик
Клуб переводчиков
Сообщения
6,717
Реакции
6,208
А что именно смущает? Код весьма хорошо комментирован.
Это написано на языке Visual Basic.NET, поэтому на Visual Basic 6 работать не будет.
 

Кирилл

Команда форума
Администратор
Ассоциация VN
Сообщения
14,306
Реакции
6,310
Почему сюда
VB.NET:
idname = tbNameMenu.Text
     Set WshShell = CreateObject("WScript.Shell")

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

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

Кирилл

Команда форума
Администратор
Ассоциация VN
Сообщения
14,306
Реакции
6,310
Да,ты прав.

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

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

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

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


Прав не хватает?
 

Dragokas

Very kind Developer
Команда форума
Супер-Модератор
Разработчик
Клуб переводчиков
Сообщения
6,717
Реакции
6,208
Ты hive присваиваешь значение переменной HKEY_CLASSES_ROOT.
 

Кирилл

Команда форума
Администратор
Ассоциация VN
Сообщения
14,306
Реакции
6,310
Кавычки не помогают,я уже пробовал.Я даже без переменной пробовал,напрямую раздел писать
 

Кирилл

Команда форума
Администратор
Ассоциация VN
Сообщения
14,306
Реакции
6,310
Блин вот почему так работает удаление :
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
И ситуация меняется,ну что за хрень...
 

Dragokas

Very kind Developer
Команда форума
Супер-Модератор
Разработчик
Клуб переводчиков
Сообщения
6,717
Реакции
6,208
Вообще-то записывать данные в раздел 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:
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]
 
Последнее редактирование:

Кирилл

Команда форума
Администратор
Ассоциация VN
Сообщения
14,306
Реакции
6,310
данные в раздел HKCR - это не очень хороший тон.

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

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

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