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

#If VBA7 Then        ' Office 2010-2016
     Public Declare PtrSafe Sub keybd_event Lib "USER32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Integer, ByVal dwExtraInfo As Integer)
 
     Public Declare PtrSafe Function PostMessage Lib "USER32" Alias "PostMessageA" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr
     Public Declare PtrSafe Function SendMessage Lib "USER32" Alias "SendMessageA" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr
     'поиск окна
     Public Declare PtrSafe Function FindWindow Lib "USER32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
     'Функция определяет стиль окна
     #If Win64 Then
         Public Declare PtrSafe Function GetWindowLong Lib "USER32" Alias "GetWindowLongPtrA" (ByVal hwnd As LongPtr, ByVal nIndex As Long) As LongPtr
     #Else
         Public Declare PtrSafe Function GetWindowLong Lib "USER32" Alias "GetWindowLongA" (ByVal hwnd As LongPtr, ByVal nIndex As Long) As LongPtr
     #End If
     'Функция задаёт стиль окна
     Public Declare PtrSafe Function SetWindowLong Lib "USER32" Alias "SetWindowLongA" (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As Long
     ' изменяет режим отображения окна
     Public Declare PtrSafe Function ShowWindow Lib "user32.dll" (ByVal hwnd As LongPtr, ByVal nCmdShow As Long) As LongPtr
     Public Declare PtrSafe Function SetForegroundWindow Lib "USER32" (ByVal hwnd As LongPtr) As LongPtr
 
     Public Declare PtrSafe Function SetLayeredWindowAttributes Lib "USER32" (ByVal hwnd As LongPtr, ByVal crey As Byte, ByVal bAlpha As Byte, ByVal dwFlags As Long) As LongPtr
     Public Declare PtrSafe Function FindWindowEx Lib "USER32" Alias "FindWindowExA" (ByVal hWnd1 As LongPtr, ByVal hWnd2 As LongPtr, ByVal lpsz1 As String, ByVal lpsz2 As String) As LongPtr
 
     Declare PtrSafe Function GetTickCount Lib "kernel32" () As Long
 
     Declare PtrSafe Function SHCreateDirectoryEx Lib "shell32" Alias "SHCreateDirectoryExA" (ByVal hwnd As LongPtr, ByVal pszPath As String, ByVal psa As Any) As LongPtr
     Declare PtrSafe Function SHChangeNotify Lib "shell32.dll" (ByVal wEventID As Long, ByVal uFlags As Long, ByVal dwItem1 As Long, ByVal dwItem2 As Long) As LongPtr
     Declare PtrSafe Function GetKeyState Lib "USER32" (ByVal vKey As Long) As Integer
 
#Else        ' Office 2003-2007
     Public Declare Sub keybd_event Lib "USER32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Integer, ByVal dwExtraInfo As Integer)
 
     Public Declare Function PostMessage Lib "USER32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
     Public Declare Function SendMessage Lib "USER32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
     Public Declare Function FindWindow Lib "USER32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
     Public Declare Function GetWindowLong Lib "USER32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
     Public Declare Function SetWindowLong Lib "USER32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
     Public Declare Function ShowWindow Lib "user32.dll" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
     Public Declare Function SetForegroundWindow Lib "USER32" (ByVal hwnd As Long) As Long
 
     Private Declare Function SetLayeredWindowAttributes Lib "USER32" (ByVal hwnd As Long, ByVal crey As Byte, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
     Private Declare Function FindWindowEx Lib "USER32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
 
     Declare Function GetTickCount Lib "kernel32" () As Long
 
     Declare Function SHCreateDirectoryEx Lib "shell32" Alias "SHCreateDirectoryExA" (ByVal hwnd As Long, ByVal pszPath As String, ByVal psa As Any) As Long
     Declare Function SHChangeNotify Lib "shell32.dll" (ByVal wEventID As Long, ByVal uFlags As Long, ByVal dwItem1 As Long, ByVal dwItem2 As Long) As Long
     Declare Function GetKeyState Lib "USER32" (ByVal vKey As Long) As Integer
 
#End If

' //
' // Call 64-bit SendMessage from 32-bit process
' //
 
Option Explicit
 
Private Const MAX_PATH                As Long = 260
Private Const PROCESS_VM_READ         As Long = &H10
Private Const PROCESS_VM_OPERATION    As Long = &H8
Private Const PROCESS_VM_WRITE = &H20
Private Const TV_FIRST                As Long = &H1100
Private Const TVM_GETNEXTITEM         As Long = (TV_FIRST + 10)
Private Const TVM_GETITEM = (TV_FIRST + 62)
Private Const TVGN_ROOT               As Long = 0
Private Const TVGN_NEXT = 1
Private Const TVGN_CHILD = 4
Private Const TVIF_TEXT = 1
Private Const MEM_RESERVE             As Long = &H2000&
Private Const MEM_COMMIT              As Long = &H1000&
Private Const MEM_RELEASE             As Long = &H8000&
Private Const PAGE_READWRITE          As Long = 4&
 
Private Type STARTUPINFO
    cb              As Long
    lpReserved      As Long
    lpDesktop       As Long
    lpTitle         As Long
    dwX             As Long
    dwY             As Long
    dwXSize         As Long
    dwYSize         As Long
    dwXCountChars   As Long
    dwYCountChars   As Long
    dwFillAttribute As Long
    dwFlags         As Long
    wShowWindow     As Integer
    cbReserved2     As Integer
    lpReserved2     As Long
    hStdInput       As OLE_HANDLE
    hStdOutput      As OLE_HANDLE
    hStdError       As OLE_HANDLE
End Type
 
Private Type PROCESS_INFORMATION
    hProcess        As Long
    hThread         As OLE_HANDLE
    dwProcessId     As Long
    dwThreadId      As OLE_HANDLE
End Type
 
Private Type TVITEM64
    mask            As Long
    lPad            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
 
Private Declare Function CreateProcess Lib "kernel32" _
                         Alias "CreateProcessW" ( _
                         ByVal lpApplicationName As Long, _
                         ByVal lpCommandLine As Long, _
                         ByRef lpProcessAttributes As Any, _
                         ByRef lpThreadAttributes As Any, _
                         ByVal bInheritHandles As Long, _
                         ByVal dwCreationFlags As Long, _
                         ByRef lpEnvironment As Any, _
                         ByVal lpCurrentDirectory As Long, _
                         ByRef lpStartupInfo As STARTUPINFO, _
                         ByRef lpProcessInformation As PROCESS_INFORMATION) As Long
Private Declare Function Wow64DisableWow64FsRedirection Lib "kernel32" ( _
                         ByRef lvalue As Long) As Long
Private Declare Function Wow64RevertWow64FsRedirection Lib "kernel32" ( _
                         ByVal lvalue As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" ( _
                         ByVal hObject As OLE_HANDLE) As Long
Private Declare Function WaitForInputIdle Lib "user32" ( _
                         ByVal hProcess As OLE_HANDLE, _
                         ByVal dwMilliseconds As Long) As Long
Private Declare Function GetWindowsDirectory Lib "kernel32" _
                         Alias "GetWindowsDirectoryW" ( _
                         ByVal lpBuffer As Long, _
                         ByVal nSize As Long) As Long
Private Declare Function FindWindowEx Lib "user32" _
                         Alias "FindWindowExW" ( _
                         ByVal hWndParent As Long, _
                         ByVal hWndChildAfter As Long, _
                         ByVal lpClassName As Long, _
                         ByVal lpWindowName As Long) As Long
Private Declare Function GetProcessId Lib "kernel32" ( _
                         ByVal hProcess As OLE_HANDLE) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" ( _
                         ByVal hwnd As OLE_HANDLE, _
                         ByRef lpdwProcessId As Long) As Long
Private Declare Function OpenProcess Lib "kernel32" ( _
                         ByVal dwDesiredAccess As Long, _
                         ByVal bInheritHandle As Long, _
                         ByVal dwProcessId As Long) As OLE_HANDLE
Private Declare Function VirtualAllocEx Lib "kernel32.dll" ( _
                         ByVal hProcess As OLE_HANDLE, _
                         ByVal lpAddress As Long, _
                         ByVal dwSize As Long, _
                         ByVal flAllocationType As Long, _
                         ByVal flProtect As Long) As Long
Private Declare Function WriteProcessMemory Lib "kernel32" ( _
                         ByVal hProcess As OLE_HANDLE, _
                         ByVal lpBaseAddress As Long, _
                         ByRef lpBuffer As Any, _
                         ByVal nSize As Long, _
                         ByRef lpNumberOfBytesWritten As Long) As Long
Private Declare Function ReadProcessMemory Lib "kernel32" ( _
                         ByVal hProcess As OLE_HANDLE, _
                         ByVal lpBaseAddress As Long, _
                         ByRef lpBuffer As Any, _
                         ByVal nSize As Long, _
                         ByRef lpNumberOfBytesWritten As Long) As Long
Private Declare Function VirtualFreeEx Lib "kernel32.dll" ( _
                         ByVal hProcess As OLE_HANDLE, _
                         ByVal lpAddress As Long, _
                         ByVal dwSize As Long, _
                         ByVal dwFreeType As Long) As Long
Private Declare Function SendMessage Lib "user32" _
                         Alias "SendMessageW" ( _
                         ByVal hwnd As OLE_HANDLE, _
                         ByVal wMsg As Long, _
                         ByVal wParam As Long, _
                         ByRef lParam As Any) As Long
Private Declare Function Sleep Lib "kernel32" ( _
                         ByVal dwMilliseconds As Long) As Long
                         
Public Sub Main()
    Dim hProcess    As OLE_HANDLE
    Dim hTVWnd      As OLE_HANDLE
    Dim lPID        As Long
    Dim h64Current  As Currency
    Dim pMemory     As Long
    Dim lPass       As Long
    
    On Error GoTo CleanUp
    
    If Not modX64Call.Initialize Then
        MsgBox "Unable to initialize modX64Call", vbCritical
        Exit Sub
    End If
    
    hTVWnd = GetTVWindow(0)
    
    If hTVWnd = 0 Then
        
        hProcess = Run64BitRegEdit()
        
        If hProcess = 0 Then
            MsgBox "Unable to run regedit", vbCritical
            GoTo CleanUp
        End If
        
        For lPass = 0 To 2
        
            hTVWnd = GetTVWindow(0)
            
            If hTVWnd Then
                Exit For
            End If
            
            Sleep 200
            
        Next
        
        If lPass = 2 Then
            MsgBox "Unable to find treeview", vbCritical
            GoTo CleanUp
        End If
        
    Else
    
        If GetWindowThreadProcessId(hTVWnd, lPID) = 0 Then
            MsgBox "GetWindowThreadProcessId failed", vbCritical
            GoTo CleanUp
        End If
        
        hProcess = OpenProcess(PROCESS_VM_OPERATION Or PROCESS_VM_READ Or PROCESS_VM_WRITE, 0, lPID)
        
        If hProcess = 0 Then
            MsgBox "OpenProcess failed", vbCritical
            GoTo CleanUp
        End If
        
    End If
    
    pMemory = VirtualAllocEx(hProcess, 0, 4096, MEM_RESERVE Or MEM_COMMIT, PAGE_READWRITE)
    
    If pMemory = 0 Then
        MsgBox "VirtualAllocEx failed", vbCritical
        GoTo CleanUp
    End If
    
    h64Current = SendMessageW64(hTVWnd, TVM_GETNEXTITEM, 0, TVGN_ROOT / 10000)
    
    If h64Current = 0 Then
        MsgBox "SendMessageW64 failed", vbCritical
        GoTo CleanUp
    End If
    
    DumpTV64 0, hProcess, hTVWnd, h64Current, pMemory
    
CleanUp:
 
    If hProcess Then
        CloseHandle hProcess
    End If
    
    modX64Call.Uninitialize
 
End Sub
 
Private Sub DumpTV64( _
            ByVal lIdent As Long, _
            ByVal hProcess As OLE_HANDLE, _
            ByVal hwnd As OLE_HANDLE, _
            ByVal h64Item As Currency, _
            ByVal pMemory As Long)
    Dim tItem       As TVITEM64
    Dim h64Child    As Currency
    Dim sBuf        As String
    Dim lSize       As Long
    
    sBuf = Space$(260)
    
    tItem.pszText = (pMemory + 1024) / 10000
    tItem.mask = TVIF_TEXT
    tItem.cchTextMax = Len(sBuf)
    
    Do While h64Item <> 0@
        
        ' // Get text
        tItem.hItem = h64Item
 
        If WriteProcessMemory(hProcess, pMemory, tItem, LenB(tItem), 0) = 0 Then
            MsgBox "WriteProcessMemory failed", vbCritical
            Exit Sub
        End If
        
        If SendMessage(hwnd, TVM_GETITEM, 0, ByVal pMemory) = 0 Then
            MsgBox "SendMessageW64 failed", vbCritical
            Exit Sub
        End If
        
        If ReadProcessMemory(hProcess, pMemory + 1024, ByVal StrPtr(sBuf), LenB(sBuf), 0) = 0 Then
            MsgBox "ReadProcessMemory failed", vbCritical
            Exit Sub
        End If
    
        lSize = InStr(1, sBuf, vbNullChar)
        
        If lSize Then
            Debug.Print Space$(lIdent * 4) & Left$(sBuf, lSize - 1)
        End If
        
        h64Child = SendMessageW64(hwnd, TVM_GETNEXTITEM, TVGN_CHILD / 10000, h64Item)
        
        If h64Child <> 0 Then
            DumpTV64 lIdent + 1, hProcess, hwnd, h64Child, pMemory
        End If
        
        h64Item = SendMessageW64(hwnd, TVM_GETNEXTITEM, TVGN_NEXT / 10000, h64Item)
        
    Loop
    
End Sub
 
Private Function GetTVWindow( _
                 ByVal hProcess As OLE_HANDLE) As OLE_HANDLE
    Dim hwnd    As OLE_HANDLE
    Dim lPID    As Long
    Dim lPIDWnd As Long
    
    If hProcess Then
        lPID = GetProcessId(hProcess)
    End If
    
    Do
    
        hwnd = FindWindowEx(0, hwnd, StrPtr("RegEdit_RegEdit"), 0)
            
        If hwnd = 0 Then
            Exit Function
        End If
        
        If lPID Then
            If GetWindowThreadProcessId(hwnd, lPIDWnd) Then
                If lPIDWnd = lPID Then
                
                    GetTVWindow = FindWindowEx(hwnd, 0, StrPtr("SysTreeView32"), 0)
                    Exit Function
                
                End If
            End If
        Else
            GetTVWindow = FindWindowEx(hwnd, 0, StrPtr("SysTreeView32"), 0)
            Exit Function
        End If
        
    Loop While True
 
End Function
 
Private Function Run64BitRegEdit() As OLE_HANDLE
    Dim lFSRedirect As Long
    Dim tSI         As STARTUPINFO
    Dim tPI         As PROCESS_INFORMATION
    Dim hProcess    As OLE_HANDLE
    Dim lResult     As Long
    Dim sPath       As String
    Dim lSize       As Long
    
    sPath = Space$(MAX_PATH)
    lSize = GetWindowsDirectory(StrPtr(sPath), Len(sPath) + 1)
    sPath = Left$(sPath, lSize)
    
    If Wow64DisableWow64FsRedirection(lFSRedirect) = 0 Then
        Exit Function
    End If
    
    tSI.cb = Len(tSI)
    
    lResult = CreateProcess(StrPtr(sPath & "\regedit.exe"), 0, ByVal 0&, ByVal 0&, 0, 0, ByVal 0&, 0, tSI, tPI)
    
    Wow64RevertWow64FsRedirection lFSRedirect
    
    If lResult = 0 Then
        Exit Function
    End If
    
    CloseHandle tPI.hThread
    
    WaitForInputIdle tPI.hProcess, -1
    
    Run64BitRegEdit = tPI.hProcess
    
End Function