Тестирование полезных кодов и примеров

Option Explicit
' *--------------------------------------------*
' | Программа RegJumpHack                      |
' | Версия 1.0                                 |
' | Copyright (c) 09.05.2023 by HackerVlad     |
' | e-mail: vladislavpeshkov@ya.ru             |
' *--------------------------------------------*
 
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 ShellExecute Lib "shell32" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
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 VirtualAllocEx Lib "kernel32.dll" (ByVal hProcess As Long, lpAddress As Any, ByRef dwSize As Long, ByVal flAllocationType As Long, ByVal flProtect As Long) As Long
Private Declare Function WriteProcessMemory Lib "kernel32" (ByVal hProcess As Long, ByVal lpBaseAddress As Long, lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long
Private Declare Function ReadProcessMemory Lib "kernel32" (ByVal hProcess As Long, ByVal lpBaseAddress As Long, lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long
Private Declare Function VirtualFreeEx Lib "kernel32.dll" (ByVal hProcess As Long, ByVal lpAddress As Long, ByRef dwSize As Long, ByVal dwFreeType As Long) As Long
Private Declare Function SendMessageW Lib "user32" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
 
Private Const INFINITE = -1
Private Const MEM_COMMIT = &H1000&
Private Const PAGE_READWRITE = 4&
Private Const PROCESS_QUERY_INFORMATION = 1024
Private Const PROCESS_VM_OPERATION = &H8
Private Const PROCESS_VM_READ = 16
Private Const PROCESS_VM_WRITE = &H20
Private Const MEM_RELEASE = &H8000&
Private Const TVIS_EXPANDED = &H20
 
Private Type TVITEM   ' was TV_ITEM
  mask As Long
  hItem As Long
  State As Long
  stateMask As Long
  pszText As Long   ' pointer
  cchTextMax As Long
  iImage As Long
  iSelectedImage As Long
  cChildren As Long
  lParam As Long
End Type
 
Sub CollapseVBIDETree()
    Dim hwndVBIDE As Long, hwndVBAProj As Long, hwndTV As Long
    Dim hwndCurrent As Long, hwndChildCurrent As Long
    Dim bSuccessModule As Boolean, bSuccessElse As Boolean, sNodeName As String
 
    'Find the handle of the VBEIDE window, down to the treeview in the project window
    hwndVBIDE = FindWindow("wndclass_desked_gsk", vbNullString)             'VBIDE Window
    hwndVBAProj = FindWindowEx(hwndVBIDE, 0&, "PROJECT", vbNullString)      'The Project - VBAProject Window
    hwndTV = FindWindowEx(hwndVBAProj, 0&, "SysTreeView32", vbNullString)   'The Treeview in the VBAProject Window
 
    'Get the handle of the Root of the Treeview
    hwndCurrent = TreeView_GetRoot(hwndTV)
 
    'Loop through all the children of the treeview.  This is all the current VBA Projects.
    'We can loop through until there are none left and a handle of zero is return
    Do While hwndCurrent <> 0
        sNodeName = GetTVItemText(hwndTV, hwndCurrent)
        Print sNodeName
        
        'Get the first child in the current project which is the 'Microsoft Excel Objects'
        hwndChildCurrent = TreeView_GetChild(hwndTV, hwndCurrent)
        'Set up a boolean to check if there is a 'Modules' child.  If not, we'll collapse the whole project
        bSuccessModule = False
 
        'Loop through all the child nodes to find the 'Modules' node
        Do While hwndChildCurrent <> 0
            'Get the name of the node
            sNodeName = GetTVItemText(hwndTV, hwndChildCurrent)
            
            Debug.Print sNodeName
            
            'If we find the Modules node then Expand it and flag it
            If sNodeName = "Modules" Then
                bSuccessModule = TreeView_Expand(hwndTV, hwndChildCurrent, TVE_EXPAND)
            Else
            'Otherwise collapse it
                bSuccessElse = TreeView_Expand(hwndTV, hwndChildCurrent, TVE_COLLAPSE)
            End If
            hwndChildCurrent = TreeView_GetNextSibling(hwndTV, hwndChildCurrent)
        Loop
 
        'If we don't find a Modules child then collapse the entire branch for that project
        If Not bSuccessModule Then
            Call TreeView_Expand(hwndTV, hwndCurrent, TVE_COLLAPSE)
        Else
        'Some workbooks if collapsed would stay collapsed so make sure they are expanded
            Call TreeView_Expand(hwndTV, hwndCurrent, TVE_EXPAND)
        End If
 
        'Move onto the next project
        hwndCurrent = TreeView_GetNextSibling(hwndTV, hwndCurrent)
    Loop
End Sub
 
Private Sub Command1_Click()
    Dim hRegEdit As Long
    Dim hSysTreeView32 As Long
    Dim hwndCurrent As Long
    Dim hwndChildCurrent As Long
    Dim pid As Long
    Dim hProcess As Long
    Dim tVI As TVITEM
    Dim tVI_new As TVITEM
    Dim pMem As Long
    Dim pMemStr As Long
    Dim lpWritten As Long
    Dim pszText As String * 256
    Dim sNodeName As String
    Dim cls(255) As Byte
    Dim hwndChildCurrent2 As Long
    Dim Paths() As String
    Dim PathStr As String
    Dim i As Integer
    
    PathStr = Text1.Text
    If Right$(PathStr, 1) = "\" Then PathStr = Mid$(PathStr, 1, Len(PathStr) - 1)
    
    If InStr(1, PathStr, "_") = 0 Then
        Beep
        Exit Sub
    End If
    
    Paths = Split(PathStr, "\")
    
    ' Найти окно редактора реестра
    hRegEdit = FindWindow("RegEdit_RegEdit", vbNullString)
    
    If hRegEdit = 0 Then ' Если редактор реестра не запущен, то запустить его
        ' Функция ShellExecute, в отличии от CreateProcess, позволяет запускать программы которые
        ' находятся в пропатченых каталогах (из всех каталогов переменной окружения среды PATH),
        ' таким образом, нам даже не надо вычислять каталог Windows и где лежит этот regedit.exe
        ShellExecute 0, "Open", "regedit.exe", vbNullString, vbNullString, vbNormalFocus
        
        Do ' Ожидаем появления окна
            hRegEdit = FindWindow("RegEdit_RegEdit", vbNullString)
        Loop While hRegEdit = 0 ' Выполнять цикл до тех пор пока не будет найдено искомое окно
        
        GetWindowThreadProcessId hRegEdit, pid ' Вычисляем PID процесса regedit
        hProcess = OpenProcess(PROCESS_QUERY_INFORMATION Or PROCESS_VM_OPERATION Or PROCESS_VM_READ Or PROCESS_VM_WRITE, 0, pid)  ' Открываем процесс на полный доступ
        WaitForInputIdle hProcess, INFINITE ' Ожидаем окончательной загрузки программы regedit
    Else ' RegEdit уже был запущен
        GetWindowThreadProcessId hRegEdit, pid ' Вычисляем PID процесса regedit
        hProcess = OpenProcess(PROCESS_VM_OPERATION Or PROCESS_VM_READ Or PROCESS_VM_WRITE, 0, pid)  ' Открываем процесс на полный доступ
    End If
    
    ' Найти дерево SysTreeView32 в окне реестра
    hSysTreeView32 = FindWindowEx(hRegEdit, ByVal 0&, "SysTreeView32", vbNullString)
    
    hwndCurrent = TreeView_GetRoot(hSysTreeView32) ' Получить дескриптор корня дерева
    
    Do While hwndCurrent <> 0 ' Получить доступ к TVM_GETITEM другого процесса
        ' Создать две страницы памяти: одну для структуры, другую для строки
        pMem = VirtualAllocEx(hProcess, ByVal 0&, 0, MEM_COMMIT, PAGE_READWRITE)
        pMemStr = VirtualAllocEx(hProcess, ByVal 0&, 0, MEM_COMMIT, PAGE_READWRITE)
        
        tVI.mask = TVIF_TEXT
        tVI.hItem = hwndCurrent
        tVI.pszText = pMemStr
        tVI.cchTextMax = MAX_ITEM
        
        WriteProcessMemory hProcess, pMem, tVI, Len(tVI), lpWritten ' Записать в память процесса структуру tVI
        SendMessageW hSysTreeView32, TVM_GETITEM, 0, pMem ' Послать запрос на определение текса ветки дерева
        ReadProcessMemory hProcess, pMemStr, ByVal pszText, MAX_ITEM, 0&
        sNodeName = GetStrFromBufferA(pszText)
        
        hwndChildCurrent = TreeView_GetChild(hSysTreeView32, hwndCurrent) ' Открыть корень дерева "Компьютер"
        
        Do While hwndChildCurrent <> 0 ' Начать перебор первичных кустов главного корневого узла "Компьютер"
            tVI.hItem = hwndChildCurrent
            WriteProcessMemory hProcess, pMem, tVI, Len(tVI), lpWritten ' Записать в память процесса структуру tVI
            WriteProcessMemory hProcess, pMemStr, ByVal VarPtr(cls(0)), MAX_ITEM, lpWritten ' Стереть старые данные
            
            SendMessageW hSysTreeView32, TVM_GETITEM, 0, pMem ' Послать запрос на определение текса ветки дерева
            ReadProcessMemory hProcess, pMemStr, ByVal pszText, MAX_ITEM, 0&
            ReadProcessMemory hProcess, pMem, tVI_new, Len(tVI_new), 0& ' Получить новое состояние
            sNodeName = GetStrFromBufferA(pszText)
            
            If StrComp(sNodeName, Paths(0), vbTextCompare) = 0 Then ' Если это первичный ключ
                TreeView_Expand hSysTreeView32, hwndChildCurrent, TVE_EXPAND ' Открыть первичный ключ
                
                If UBound(Paths) > 0 Then
                    For i = 1 To UBound(Paths)
                        hwndChildCurrent2 = TreeView_GetChild(hSysTreeView32, IIf(i = 1, hwndChildCurrent, hwndChildCurrent2))
                        
                        Do While hwndChildCurrent2 <> 0
                            tVI.hItem = hwndChildCurrent2
                            WriteProcessMemory hProcess, pMem, tVI, Len(tVI), lpWritten ' Записать в память процесса структуру tVI
                            WriteProcessMemory hProcess, pMemStr, ByVal VarPtr(cls(0)), MAX_ITEM, lpWritten ' Стереть старые данные
                            
                            SendMessageW hSysTreeView32, TVM_GETITEM, 0, pMem ' Послать запрос на определение текса ветки дерева
                            ReadProcessMemory hProcess, pMemStr, ByVal pszText, MAX_ITEM, 0&
                            sNodeName = GetStrFromBufferA(pszText)
                            
                            If StrComp(sNodeName, Paths(i), vbTextCompare) = 0 Then ' Если это глубинный ключ
                                TreeView_Expand hSysTreeView32, hwndChildCurrent2, TVE_EXPAND ' Открыть глубинный ключ
                                If i = UBound(Paths) Then
                                    ' В самом конце выделить нужный элемент дерева
                                    WaitForInputIdle hProcess, INFINITE
                                    SendMessageW hSysTreeView32, TVM_SELECTITEM, TVGN_CARET, hwndChildCurrent2
                                    SendMessageW hSysTreeView32, TVM_SELECTITEM, TVGN_FIRSTVISIBLE, hwndChildCurrent2
                                End If
                                
                                Exit Do ' Для ускорения процедуры, мы не будем перебирать дальше список уже неинтересуемых нами параметров
                            End If
                            
                            hwndChildCurrent2 = TreeView_GetNextSibling(hSysTreeView32, hwndChildCurrent2)
                        Loop
                    Next
                End If
            Else
                If (tVI_new.State And TVIS_EXPANDED) <> 0 Then ' Если главный куст дерева открыт
                    TreeView_Expand hSysTreeView32, hwndChildCurrent, TVE_COLLAPSE ' Послать запрос на закрытие главноего куста
                End If
            End If
            
            hwndChildCurrent = TreeView_GetNextSibling(hSysTreeView32, hwndChildCurrent)
        Loop
        
        hwndCurrent = TreeView_GetNextSibling(hSysTreeView32, hwndCurrent)
    Loop
    
    ' Освободить память
    VirtualFreeEx hProcess, pMem, ByVal 0&, MEM_RELEASE
    VirtualFreeEx hProcess, pMemStr, ByVal 0&, MEM_RELEASE
    CloseHandle hProcess
End Sub
 
Private Sub Command2_Click()
    ' А эта процедурка сворачивает дерево в VB IDE с проектами и формами и модулями
    CollapseVBIDETree
End Sub
 
Private Sub Form_Load()
    Top = 600
    Left = Screen.Width / 2 - Me.Width / 2
End Sub
 
Private Sub Text1_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        KeyAscii = 0
        Command1_Click
    End If
End Sub