Как встроить адресную строку в стандартный редактор реестра Windows 7 или Windows XP

Option Explicit
' *------------------------------------------------------*
' | Программа RegEditJumpHacking                         |
' | Версия 2.0                                           |
' | Автор идеи: testuser2                                |
' | Copyright (c) 07.07.2023 by HackerVlad and The Trick |
' | e-mail: vladislavpeshkov@ya.ru                       |
' *------------------------------------------------------*
 
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hWnd As Long, lpdwProcessId As Long) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function WaitForInputIdle Lib "user32" (ByVal hProcess As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageW" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function SendMessageTimeout Lib "user32" Alias "SendMessageTimeoutW" (ByVal hWnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long, ByVal fuFlags As Long, ByVal uTimeout As Long, lpdwResult As Long) As Long
Private Declare Function CreateCaret Lib "user32" (ByVal hWnd As Long, ByVal hBitmap As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function ShowCaret Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWndParent As Long, ByVal hWndChildAfter As Long, ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function MoveWindow Lib "user32" (ByVal hWnd As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
Private Declare Function ClientToScreen Lib "user32" (ByVal hWnd As Long, ByRef lpPoint As POINTAPI) As Long
Private Declare Function GetParent Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function CreateWindowEx Lib "user32" Alias "CreateWindowExW" (ByVal dwExStyle As Long, ByVal lpClassName As Long, ByVal lpWindowName As Long, ByVal dwStyle As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As Long, ByVal hMenu As Long, ByVal hInstance As Long, lpParam As Long) As Long
Private Declare Function Wow64EnableWow64FsRedirection Lib "kernel32.dll" (ByVal IsEnable As Boolean) As Boolean
Private Declare Function IsWow64Process Lib "kernel32" (ByVal hProc As Long, bWow64Process As Long) As Long
Private Declare Function UpdateWindow Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function IsWindow Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function DestroyWindow Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function SetFocusAPI Lib "user32" Alias "SetFocus" (ByVal hWnd As Long) As Long
Private Declare Function DestroyCaret Lib "user32" () As Long
 
' Для прозрачности
Private Declare Function MapWindowPoints Lib "user32" (ByVal hWndFrom As Long, ByVal hwndTo As Long, lppt As Any, ByVal cPoints As Long) As Long
Private Declare Function SetBrushOrgEx Lib "gdi32" (ByVal hdc As Long, ByVal nXOrg As Long, ByVal nYOrg As Long, lppt As Any) As Long
Private Declare Function CreatePatternBrush Lib "gdi32" (ByVal hBitmap As Long) As Long
 
Private Const INFINITE = -1
Private Const PROCESS_QUERY_INFORMATION = 1024
Private Const PROCESS_VM_OPERATION = &H8
Private Const WS_CHILD          As Long = &H40000000
Private Const WS_VISIBLE        As Long = &H10000000
Private Const WS_EX_CLIENTEDGE  As Long = &H200&
Private Const ES_AUTOHSCROLL As Long = &H80&
Private Const ES_MULTILINE As Long = &H4&
Private Const SMTO_ABORTIFHUNG = &H2
Private Const WM_SETTEXT = &HC
Private Const WM_GETTEXT = &HD
Private Const WM_CHAR = &H102
Private Const WM_KILLFOCUS = &H8
Private Const WM_SETFOCUS = &H7
Private Const EM_SETSEL = &HB1
 
' Для прозрачности
Private Const WM_CTLCOLORBTN As Long = &H135
Private Const WM_CTLCOLORSTATIC As Long = &H138
Dim hBackBrush  As Long ' Фоновая кисть
 
Private Type POINTAPI
    x As Long
    y As Long
End Type
 
Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type
 
Dim MyProcRunIs64 As Long
Dim hwndText1 As Long
 
Private WithEvents m_cFormHook As CTrickSubclass
Private WithEvents m_cTextHook As CTrickSubclass
Private WithEvents m_cTextBoxInRegEditHook As CTrickSubclass
 
Public Sub ChangeWindowsRegEdit(Optional CreateTextBox As Boolean)
    Dim rctSysTreeView32 As RECT
    Dim rctSysListView32 As RECT
    Dim rctRegEdit As RECT
    Dim ScreenXYCoordinates As POINTAPI
    Dim WidthCaption As Long
    Dim HeightCaption As Long
    Dim newWidth1 As Long
    Dim newHeight1 As Long
    Dim newWidth2 As Long
    Dim newHeight2 As Long
    Dim LeftSysListView32 As Long
    Dim WidthTextBox As Long
    
    GetWindowRect hSysTreeView32, rctSysTreeView32
    GetWindowRect hSysListView32, rctSysListView32
    
    GetWindowRect hRegEdit, rctRegEdit
    ClientToScreen hRegEdit, ScreenXYCoordinates
    
    WidthCaption = ScreenXYCoordinates.x - rctRegEdit.Left ' Высота заголовка окна regedit'а + меню (если есть)
    HeightCaption = ScreenXYCoordinates.y - rctRegEdit.Top ' Ширина границы рамки окна regedit'а
    
    newWidth1 = rctSysTreeView32.Right - rctRegEdit.Left - WidthCaption
    newHeight1 = rctSysTreeView32.Bottom - rctRegEdit.Top - HeightCaption
    
    LeftSysListView32 = rctSysListView32.Left - rctRegEdit.Left - WidthCaption
    
    newWidth2 = rctSysListView32.Right - rctRegEdit.Left - WidthCaption - LeftSysListView32
    newHeight2 = rctSysListView32.Bottom - rctRegEdit.Top - HeightCaption
    
    MoveWindow hSysTreeView32, 0, 25, newWidth1, newHeight1 - 25, True
    MoveWindow hSysListView32, LeftSysListView32, 25, newWidth2, newHeight2 - 25, True
    
    WidthTextBox = rctRegEdit.Right - rctRegEdit.Left - (WidthCaption * 2)
    
    If CreateTextBox = True Then
        If IsWindow(hwndTextBox) = 0 Then
            hwndTextBox = CreateWindowEx(WS_EX_CLIENTEDGE, StrPtr("Edit"), ByVal 0&, WS_CHILD Or WS_VISIBLE Or ES_MULTILINE Or _
            ES_AUTOHSCROLL, 0, 0, WidthTextBox, 25, hRegEdit, 0&, 0&, ByVal 0&)
            SetDefaultFontWindow hwndTextBox
        End If
    Else
        MoveWindow hwndTextBox, 0, 0, WidthTextBox, 25, True
    End If
    
    UpdateWindow hRegEdit
End Sub
 
Private Sub SetDefaultWindowsRegEdit()
    Dim rctSysTreeView32 As RECT
    Dim rctSysListView32 As RECT
    Dim rctRegEdit As RECT
    Dim ScreenXYCoordinates As POINTAPI
    Dim WidthCaption As Long
    Dim HeightCaption As Long
    Dim newWidth1 As Long
    Dim newHeight1 As Long
    Dim newWidth2 As Long
    Dim newHeight2 As Long
    Dim LeftSysListView32 As Long
    
    GetWindowRect hSysTreeView32, rctSysTreeView32
    GetWindowRect hSysListView32, rctSysListView32
    
    GetWindowRect hRegEdit, rctRegEdit
    ClientToScreen hRegEdit, ScreenXYCoordinates
    
    WidthCaption = ScreenXYCoordinates.x - rctRegEdit.Left
    HeightCaption = ScreenXYCoordinates.y - rctRegEdit.Top
    
    newWidth1 = rctSysTreeView32.Right - rctRegEdit.Left - WidthCaption
    newHeight1 = rctSysTreeView32.Bottom - rctRegEdit.Top - HeightCaption
    
    LeftSysListView32 = rctSysListView32.Left - rctRegEdit.Left - WidthCaption
    
    newWidth2 = rctSysListView32.Right - rctRegEdit.Left - WidthCaption - LeftSysListView32
    newHeight2 = rctSysListView32.Bottom - rctRegEdit.Top - HeightCaption
    
    MoveWindow hSysTreeView32, 0, 0, newWidth1, newHeight1, True
    MoveWindow hSysListView32, LeftSysListView32, 0, newWidth2, newHeight2, True
End Sub
 
Private Sub Check1_Click()
    If Check1.Value = 1 Then
        ChangeWindowsRegEdit True
        
        If hEvent > 0 Then Unhook
        Hook
    Else
        DestroyWindow hwndTextBox
        Unhook
        
        SetDefaultWindowsRegEdit
    End If
End Sub
 
Private Sub Command1_Click()
    Dim TextBoxText As String
    
    If hRegEdit > 0 Then
        TextBoxText = String$(2048, vbNullChar)
        SendMessageTimeout hwndText1, WM_GETTEXT, 2048, StrPtr(TextBoxText), SMTO_ABORTIFHUNG, 5000, 0
        TextBoxText = Replace(TextBoxText, vbNullChar, vbNullString)
        
        If IsProcess64bit(hRegEdit) = True Then
            RegJump64 TextBoxText
        Else
            RegJump32 TextBoxText
        End If
    End If
End Sub
 
Private Sub Command2_Click()
    Dim pid As Long
    Dim hProcess As Long
    
    If IsSubclassed = True Then
        Command1_Click
        Exit Sub
    End If
    
    ' Найти окно редактора реестра
    hRegEdit = FindWindow("RegEdit_RegEdit", vbNullString)
    
    If hRegEdit = 0 Then
        If MyProcRunIs64 = 1 Then
            If Option1.Value = True Then
                Wow64EnableWow64FsRedirection False ' Выключить перенаправление с System32 на SYSWOW64
                Shell Environ("windir") & "\regedit.exe", vbNormalFocus
                Wow64EnableWow64FsRedirection True ' Включить перенаправление обратно (установить по умолчанию)
            Else
                Shell Environ("windir") & "\regedit.exe", vbNormalFocus
            End If
        Else
            Shell Environ("windir") & "\regedit.exe", vbNormalFocus
        End If
        
        Do ' Ожидаем появления окна
            hRegEdit = FindWindow("RegEdit_RegEdit", vbNullString)
        Loop While hRegEdit = 0 ' Выполнять цикл до тех пор пока не будет найдено искомое окно
    End If
    
    If hRegEdit > 0 Then
        ' Найти дерево SysTreeView32 в окне редактора реестра
        hSysTreeView32 = FindWindowEx(hRegEdit, ByVal 0&, "SysTreeView32", vbNullString)
        
        ' Найти листвиев hSysListView32 в окне редактора реестра
        hSysListView32 = FindWindowEx(hRegEdit, ByVal 0&, "SysListView32", vbNullString)
        
        If Check1.Value = 1 Then
            ChangeWindowsRegEdit True
            
            ' Подождать окончательной загрузки программы regedit и установить фокус на новое текстовое поле (адресную строку)
            GetWindowThreadProcessId hRegEdit, pid ' Вычисляем PID процесса regedit
            hProcess = OpenProcess(PROCESS_QUERY_INFORMATION Or PROCESS_VM_OPERATION, 0, pid) ' Открываем процесс
            WaitForInputIdle hProcess, INFINITE ' Ожидаем окончательной загрузки программы regedit
            CloseHandle hProcess
            MyWait 1 ' В отличии от Sleep не сбивает фокус и не замораживает поток
            SetFocusAPI hwndTextBox
            
            If IsSubclassed = False Then
                ' Отсубклассировать текстовое поле внутри редактора реестра
                Set m_cTextBoxInRegEditHook = New CTrickSubclass
                m_cTextBoxInRegEditHook.Hook hwndTextBox
                IsSubclassed = True
            End If
            
            If hEvent > 0 Then Unhook
            Hook
        End If
    End If
End Sub
 
Private Sub Form_Initialize()
    InitCommonControlsXP
End Sub
 
Private Sub Form_Load()
    Dim TextInTextBox As String
    
    IsWow64Process -1, MyProcRunIs64
    
    If MyProcRunIs64 = 0 Then
        Option1.Visible = False
        Option2.Visible = False
    End If
    
    SetDefaultFontWindow Command1.hWnd
    SetDefaultFontWindow Command2.hWnd
    
    Top = 300
    Left = Screen.Width / 2 - Me.Width / 2
    
    hwndText1 = CreateWindowEx(WS_EX_CLIENTEDGE, StrPtr("Edit"), ByVal 0&, WS_CHILD Or WS_VISIBLE Or ES_MULTILINE Or _
    ES_AUTOHSCROLL, 408, 32, 449, 33, Me.hWnd, 0&, 0&, ByVal 0&)
    SetDefaultFontWindow hwndText1
    TextInTextBox = "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Run"
    SendMessage hwndText1, WM_SETTEXT, 0, StrPtr(TextInTextBox)
    
    Set m_cFormHook = New CTrickSubclass
    Set m_cTextHook = New CTrickSubclass
    m_cFormHook.Hook Me.hWnd
    m_cTextHook.Hook hwndText1
    
    ' Для прозрачности
    hBackBrush = CreatePatternBrush(Me.Picture.handle)
End Sub
 
Private Sub Form_Unload(Cancel As Integer)
    DestroyWindow hwndTextBox
    Unhook
    SetDefaultWindowsRegEdit
    modX64Call.Uninitialize
End Sub
 
' Отсубклассировать форму
Private Sub m_cFormHook_WndProc(ByVal hWnd As stdole.OLE_HANDLE, ByVal lMsg As Long, ByVal wParam As Long, ByVal lParam As Long, lRet As Long, bDefCall As Boolean)
    Select Case lMsg
        ' Для прозрачности
        Case WM_CTLCOLORSTATIC, WM_CTLCOLORBTN
            Dim pts(1) As Long
            
            ' Получаем координаты элемента
            MapWindowPoints lParam, Me.hWnd, pts(0), 1
            
            ' Сдвигаем точку отсчета координат кисти, чтобы она совпадала с фоновом изображением под контролом
            SetBrushOrgEx wParam, -pts(0), -pts(1), ByVal 0&
            
            ' Возвращаем кисть
            lRet = hBackBrush
            
            bDefCall = False
    End Select
End Sub
 
' Отсубклассировать текстовое поле внутри редактора реестра
Private Sub m_cTextBoxInRegEditHook_WndProc(ByVal hWnd As stdole.OLE_HANDLE, ByVal lMsg As Long, ByVal wParam As Long, ByVal lParam As Long, lRet As Long, bDefCall As Boolean)
    Select Case lMsg
        Case WM_CHAR
            CreateCaret hWnd, 0, 0, 15
            ShowCaret hWnd
            
            If wParam = 13 Then ' Если нажата клавиша Enter
                Dim TextBoxText As String
                
                DestroyCaret
                
                lRet = 0
                bDefCall = False
                
                TextBoxText = String$(2048, vbNullChar)
                
                SendMessageTimeout hwndTextBox, WM_GETTEXT, 2048, StrPtr(TextBoxText), SMTO_ABORTIFHUNG, 5000, 0
                TextBoxText = Replace(TextBoxText, vbNullChar, vbNullString)
                
                If IsProcess64bit(hRegEdit) = True Then
                    RegJump64 TextBoxText
                Else
                    RegJump32 TextBoxText
                End If
                
                SetFocusAPI hSysTreeView32
            End If
            
            If wParam = 1 And lParam = 1966081 Then ' Если нажаты клавишы Ctrl+A
                lRet = 0
                bDefCall = False
                SendMessage hWnd, EM_SETSEL, 0, -1 ' Выделить всё
            End If
            
        Case WM_SETFOCUS
            CreateCaret hWnd, 0, 0, 15
            ShowCaret hWnd
            
        Case WM_KILLFOCUS
            DestroyCaret
    End Select
End Sub
 
' Отсубклассировать текстовое поле
Private Sub m_cTextHook_WndProc(ByVal hWnd As stdole.OLE_HANDLE, ByVal lMsg As Long, ByVal wParam As Long, ByVal lParam As Long, lRet As Long, bDefCall As Boolean)
    Select Case lMsg
        Case WM_CHAR
            If wParam = 13 Then ' Если нажата клавиша Enter
                lRet = 0
                bDefCall = False
                Command1_Click
            End If
            
            If wParam = 1 And lParam = 1966081 Then ' Если нажаты клавишы Ctrl+A
                lRet = 0
                bDefCall = False
                SendMessage hWnd, EM_SETSEL, 0, -1 ' Выделить всё
            End If
    End Select
End Sub

Private Declare Function RegisterApplicationRestart Lib "kernel32" (ByVal pszCommandline As Long, ByVal dwFlags As Long) As Long
 
Dim RestartCmd As String
 
'RestartCmd = путь к файлу для запуска который будет автоматически открыт (то что после .exe) команда перезапуска
 
RegisterApplicationRestart StrPtr(RestartCmd), -2147483640 ' -2147483640 это хак, чтобы не ждать 60 сек. для регистрации

Private Declare Function ExtractIconEx Lib "shell32" Alias "ExtractIconExW" (ByVal lpszFile As Long, ByVal nIconIndex As Long, phiconLarge As Long, phiconSmall As Long, ByVal nIcons As Long) As Long
Private Declare Function DestroyIcon Lib "user32" (ByVal hIcon As Long) As Long
 
Private Const ICON_SMALL = 0
Private Const ICON_BIG = 1
Private Const WM_SETICON = &H80
 
Dim hIconSmall As Long
Dim hIconLarge As Long

    Dim IconPath As String
    
    IconPath = AppPath & "\" & App.EXEName & ".exe"
 
    ExtractIconEx StrPtr(IconPath), 0, hIconLarge, hIconSmall, 1 ' Загрузить и большую и маленькую иконку
    SendMessage hWnd, WM_SETICON, ICON_SMALL, hIconSmall ' Установить маленькую иконку
    SendMessage hWnd, WM_SETICON, ICON_BIG, hIconLarge ' Установить большую иконку

hEvent = SetWinEventHook(EVENT_MIN, EVENT_MAX, 0, AddressOf WinEventProc, 0, 0, 0) ' Устанавливаем хук

hEvent = SetWinEventHook(EVENT_MIN, EVENT_MAX, 0, AddressOf WinEventProc, pid, 0, 0) ' Устанавливаем хук

' Начать захват
Public Sub Hook()
    Dim pid As Long
    
    GetWindowThreadProcessId hRegEdit, pid ' Вычисляем PID процесса regedit
    hEvent = SetWinEventHook(EVENT_MIN, EVENT_MAX, 0, AddressOf WinEventProc, pid, 0, 0) ' Устанавливаем хук
End Sub

Option Explicit
Private Declare Function SetWinEventHook Lib "user32" (ByVal eventMin As Long, ByVal eventMax As Long, ByVal hmodWinEventProc As Long, ByVal pfnWinEventProc As Long, ByVal idProcess As Long, ByVal idThread As Long, ByVal dwFlags As Long) As Long
Private Declare Function UnhookWinEvent Lib "user32" (ByVal hWinEventHook As Long) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hWnd As Long, lpdwProcessId As Long) As Long
 
Private Const EVENT_OBJECT_LOCATIONCHANGE As Long = &H800B&
Private Const EVENT_OBJECT_DESTROY As Long = &H8001&
Private Const EVENT_MIN = &H1
Private Const EVENT_MAX = &H7FFFFFFF
 
Global hEvent As Long
Global hRegEdit As Long
Global hSysTreeView32 As Long
Global hSysListView32 As Long
Global hwndTextBox As Long
Global IsSubclassed As Boolean
Global AutoHide As Boolean
 
' Начать захват
Public Sub Hook()
    Dim pid As Long
    
    GetWindowThreadProcessId hRegEdit, pid ' Вычисляем PID процесса regedit
    hEvent = SetWinEventHook(EVENT_MIN, EVENT_MAX, 0, AddressOf WinEventProc, pid, 0, 0) ' Устанавливаем хук
End Sub
 
' Закончить захват
Public Sub Unhook()
    UnhookWinEvent hEvent ' Снимаем хук
End Sub
 
' Здесь будем отлавливать события окна RegEdit вместо стандартного субклассирования окна (которое не фурычит в 64-битных процессах)
Private Sub WinEventProc(ByVal hWinEventHook As Long, ByVal dwEvent As Long, ByVal hWnd As Long, ByVal idObject As Long, ByVal idChild As Long, ByVal dwEventThread As Long, ByVal dwmsEventTime As Long)
    Dim TextBoxText As String
    
    If hWnd = hSysTreeView32 Then
        If dwEvent = EVENT_OBJECT_LOCATIONCHANGE Then ' Если изменились размеры окна
            Form1.ChangeWindowsRegEdit
        End If
    End If
    
    If hWnd = hRegEdit Then
        If dwEvent = EVENT_OBJECT_DESTROY Then ' Если закрывается редактор реестра
            IsSubclassed = False
            Unhook
            If AutoHide = True Then Unload Form1 ' Выход из программы, в случае если программа была запущена в скрытом режиме
        End If
    End If
End Sub