Для этого можно использовать такой код:

Private Type SECURITY_ATTRIBUTES

nLength As Long

lpSecurityDescriptor As Long

bInheritHandle As Boolean

End Type

Private Type FILETIME

dwLowDateTime As Long

dwHighDateTime As Long

End Type

Private Const REG_NONE = 0 ' No value type

Private Const REG_SZ = 1 ' Unicode nul terminated string

Private Const REG_EXPAND_SZ = 2 ' Unicode nul terminated string

Private Const REG_BINARY = 3 ' Free form binary

Private Const REG_DWORD = 4 ' 32-bit number

Private Const HKEY_CLASSES_ROOT = &H80000000

Private Const HKEY_CURRENT_USER = &H80000001

Private Const HKEY_LOCAL_MACHINE = &H80000002

Private Const HKEY_USERS = &H80000003

Private Const HKEY_PERFORMANCE_DATA = &H80000004

Private Const HKEY_CURRENT_CONFIG = &H80000005

Private Const HKEY_DYN_DATA = &H80000006

Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) 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, lpSecurityAttributes As SECURITY_ATTRIBUTES, phkResult As Long, lpdwDisposition 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 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 ' Note that if you Public 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, lpData As Any, ByVal cbData As Long) As Long ' Note that if you Public Declare the lpData parameter as String, you must pass it By Value.

Private Function RegWrite(Path As String, Optional Value As Variant = "", Optional TypeValue As Long = REG_SZ) As Long

Dim SA As SECURITY_ATTRIBUTES

On Error GoTo ErrorDesc

HK = StrToSect(Left(Path, InStr(Path, "\") - 1))

Way = Mid(Path, InStr(Path, "\") + 1, InStrRev(Path, "\") - InStr(Path, "\") - 1)

nKey = IIf(Right(Path, 1) = "\", "", Mid(Path, InStrRev(Path, "\") + 1, Len(Path) - InStrRev(Path, "\")))

g = RegCreateKeyEx(HK, Way, 0, "", 0&, &H3F, SA, j, 0)

If g <> 0 Then Err.Raise g

Select Case TypeValue

Case REG_SZ: g = RegSetValueEx(j, nKey, 0, REG_SZ, ByVal CStr(Value), CLng(Len(Value)))

Case REG_BINARY: g = RegSetValueEx(j, nKey, 0, REG_BINARY, ByVal CStr(Value), CLng(Len(Value)))

Case REG_DWORD: g = RegSetValueEx(j, nKey, 0, REG_DWORD, CLng(Value), CLng(4))

End Select

If g <> 0 Then Err.Raise g

g = RegCloseKey(j)

RegWrite = g

Exit Function

ErrorDesc:

RegWrite = Err.Number

g = RegCloseKey(HK)

End Function

Private Function StrToSect(Str1) As Long

On Error Resume Next

Select Case Str1

Case "HKCU": StrToSect = HKEY_CURRENT_USER

Case "HKLM": StrToSect = HKEY_LOCAL_MACHINE

Case "HKCR": StrToSect = HKEY_CLASSES_ROOT

Case "HKCC": StrToSect = HKEY_CURRENT_CONFIG

Case "HKDD": StrToSect = HKEY_DYN_DATA

Case "HKPD": StrToSect = HKEY_PERFORMANCE_DATA

Case "HKU": StrToSect = HKEY_USERS

End Select

End Function

Public Sub CreateExplorerButton(Path As String)

RegKey = "HKLM\Software\Microsoft\Internet Explorer\Extensions\{10954C80-4F0F-11d3-B17C-00C0DFE39736}\"

Cmd = "c:\your program path\You_program_name.exe -key1 -key2"

RegWrite(RegKey & "ButtonText", "ButtonText")

RegWrite(RegKey & "MenuText", "Tools Menu Item")

RegWrite(RegKey & "MenuStatusBar", "Run Script")

RegWrite(RegKey & "ClSid", "{1FBA04EE-3024-11d2-8F1F-0000F87ABD16}")

RegWrite(RegKey & "Default Visible", "Yes")

RegWrite(RegKey & "Exec", Cmd)

RegWrite(RegKey & "HotIcon", ",1")

RegWrite(RegKey & "Icon", ",1")

End Sub

Код записи в реестр, конечно, довольно большой, просто я его взял из своего старого проекта, где он должен был выполнять намного более универсальные действия...

Ответить