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 работать не будет.
idname = tbNameMenu.Text
Set WshShell = CreateObject("WScript.Shell")
WshShell.RegWrite "HKEY_CLASSES_ROOT\DesktopBackground\Shell\MiMenu\MUIVerb", "idname", "REG_SZ"
потому что в кавычкахПочему сюда
hive = HKEY_CLASSES_ROOT
key = "DesktopBackground\Shell\KZNZDR"
RegShell.RegDelete hive & "\" & key & "\"
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 & "\"
' раздел
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 & "\"
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
данные в раздел HKCR - это не очень хороший тон.
Да,в курсе.На счет метода RegDelete - обрати внимание, он не поддерживает удаление разделов вместе с подразделами.
We use cookies and similar technologies for the following purposes:
Do you accept cookies and these technologies?
We use cookies and similar technologies for the following purposes:
Do you accept cookies and these technologies?