Quantcast
Channel: VBForums - CodeBank - Visual Basic 6 and earlier
Viewing all articles
Browse latest Browse all 1529

[VB6] SendMessage - 64 bit compatible.

$
0
0
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:

Code:

' //
' // 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

Attached Files

Viewing all articles
Browse latest Browse all 1529

Trending Articles



<script src="https://jsc.adskeeper.com/r/s/rssing.com.1596347.js" async> </script>