[VB6] SendMessage - 64 bit compatible.

[The trick]

Hello eveyone.

I've added SendMessageW64 function to this module. Now you can pass a message to 64 bit applications and get 64 bit result. This is the example where you can obtain the treeview nodes from 64-bit regedit.exe:

' //
' // 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        As Long = &H20
Private Const TV_FIRST                As Long = &H1100
Private Const TVM_GETNEXTITEM         As Long = (TV_FIRST + 10)
Private Const TVM_GETITEM             As Long = (TV_FIRST + 62)
Private Const TVGN_ROOT               As Long = 0
Private Const TVGN_NEXT               As Long = 1
Private Const TVGN_CHILD              As Long = 4
Private Const TVIF_TEXT               As Long = 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