Как получить TVM_GETITEM дерева 64-битного процесса

Private Type TVITEM   ' was TV_ITEM
  mask As Long
  hItem As Long
  State As Long
  stateMask As Long
  pszText As Currency
  cchTextMax As Long
  iImage As Long
  iSelectedImage As Long
  cChildren As Long
  lParam As Long
End Type

Option Explicit
' *--------------------------------------------*
' | Программа RegJumpHack                      |
' | Версия 1.2                                 |
' | Copyright (c) 10.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 Declare Sub PutMem4 Lib "msvbvm60" (Destination As Any, Value As Any)
 
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 Currency
  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 = Trim$(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 = 255
        
        'PutMem4 tVI.pszText, pMemStr
        
        Debug.Print "WriteProcessMemory: " & WriteProcessMemory(hProcess, pMem, tVI, Len(tVI), lpWritten) ' Записать в память процесса структуру tVI
        Debug.Print lpWritten
        Debug.Print "SendMessageW: " & SendMessageW(hSysTreeView32, TVM_GETITEM, 0, pMem) ' Послать запрос на определение текса ветки дерева
        'MsgBox Err.LastDllError
        '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

Private Type TVITEM   ' was TV_ITEM
  mask As Long
  lPad0 As Long
  hItem As Currency
  State As Long
  stateMask As Long
  pszText As Currency
  cchTextMax As Long
  iImage As Long
  iSelectedImage As Long
  cChildren As Long
  lParam As Currency
End Type

..
PutMem4 tVI.pszText, ByVal pMemStr
..

If p_SendMessageW = 0 Then
            p_SendMessageW = GetProcAddress64(GetModuleHandle64("user32.dll"), "SendMessageW")
        End If

If p_SendMessageW = 0 Then
            modX64Call.Initialize
            p_SendMessageW = GetProcAddress64(GetModuleHandle64("user32.dll"), "SendMessageW")
            MsgBox p_SendMessageW ' Вернёт 0
        End If

Private Type LONGLONG
    LongLow As Long
    LongHigh As Long
End Type
 
Private Declare Function SendMessage32to64 Lib "user32.dll" Alias "SendMessageA" (ByVal hWnd As Long, _
           ByVal wMsg As Long, ByRef wParam As LONGLONG, ByRef lParam As LONGLONG) As Long

Private Type LONGLONG
    LongLow As Long
    LongHigh As Long
End Type
 
Private Declare Function SendMessage32to64 Lib "user32.dll" Alias "SendMessageW" (ByVal hWnd As Long, _
           ByVal wMsg As Long, ByRef wParam As LONGLONG, ByRef lParam As LONGLONG) As Long
 
 
Dim LL1 As LONGLONG
    Dim LL2 As LONGLONG
 
 
 
LL2.LongHigh = pMem
        
        Debug.Print ": " & SendMessage32to64(hSysTreeView32, TVM_GETITEM, LL1, LL2)

' //
' // Get procedure arrdess from 64 bit dll
' //
Public Function GetProcAddress64( _
                ByVal h64Lib As Currency, _
                ByRef sFunctionName As String) As Currency