[VB6] - Multithreading in VB6 part 3 - DLL injection.

[The trick]

Hello everyone! This part is rather more about DLL injections than about threading as such, but because DLL can run programs with different numbers of threads I made this as a continuation of the theme of multi-threading in VB6. In the last article, I wrote about the possibility of creating a thread in the DLL, and the method of creating a native DLL for VB6. I also wrote that such a DLL will work in any application, but did not result in an example. In this section we will write a DLL that will be performed in another 32-bit process and execute our code there. As an example, make an application that will perform subclassing a window in another thread and send messages in our application that we can handle. Write once - DLL for example only and is not intended for use in applications as There are disadvantages to minimize code as I did not eliminate.
I decided to make use of 3 cases:

• Limiting the minimum size overlapping windows.
• Tracking button press/release the mouse in the window.
• Log messages.

So, first you need to come up with a interaction mechanism between processes. I decided to go the following way:

• For the exchange of data between applications will use FileMapping.
• To send a message from the proces- "victim" to our application, we will use a new recorded message.
• For notification of completion subclassing will transmit a message to the other side.

Now you need to consider how to implement the launch. Put the hook "WH_GETMESSAGE" on a thread that contains the window. Now our DLL is loaded into the address space of the process of the victim. In the callback function "GetMsgProc" the first call will initialize the data and set the desired window subclassing to exchange as mentioned above use the file-mapping. So the code:

' // modSubclassDLL.bas  - hook and subclassing procedures
' // © Krivous Anatoly Anatolevich (The trick), 2014

Option Explicit

Private Const GWL_WNDPROC        As Long = (-4)
Private Const INFINITE           As Long = -1&
Private Const MUTEX_ALL_ACCESS   As Long = &H1F0001
Private Const FILE_MAP_READ      As Long = &H4
Private Const FILE_MAP_WRITE     As Long = &H2
Private Const WAIT_FAILED        As Long = -1&

' // This structure is passed between processes by the file mapping
Public Type MsgData
    hWnd    As Long     ' // Subclassing window handle
    uMsg    As Long     ' // Message
    wParam  As Long     ' // Parameters
    lParam  As Long     ' // -
    return  As Long     ' // Returned value
    defCall As Long     ' // Determines whether call the default window procedure or not
End Type

Private Declare Function OpenFileMapping Lib "kernel32" _
                         Alias "OpenFileMappingW" ( _
                         ByVal dwDesiredAccess As Long, _
                         ByVal bInheritHandle As Long, _
                         ByVal lpName As Long) As Long
Private Declare Function OpenMutex Lib "kernel32" _
                         Alias "OpenMutexW" ( _
                         ByVal dwDesiredAccess As Long, _
                         ByVal bInheritHandle As Long, _
                         ByVal lpName As Long) As Long
Private Declare Function MapViewOfFile Lib "kernel32" ( _
                         ByVal hFileMappingObject As Long, _
                         ByVal dwDesiredAccess As Long, _
                         ByVal dwFileOffsetHigh As Long, _
                         ByVal dwFileOffsetLow As Long, _
                         ByVal dwNumberOfBytesToMap As Long) As Long
Private Declare Function UnmapViewOfFile Lib "kernel32" ( _
                         ByVal lpBaseAddress As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" ( _
                         ByVal hObject As Long) As Long
Private Declare Function GetMem4 Lib "msvbvm60" ( _
                         ByRef Src As Any, _
                         ByRef Dst As Any) As Long
Private Declare Function WaitForSingleObject Lib "kernel32" ( _
                         ByVal hHandle As Long, _
                         ByVal dwMilliseconds As Long) As Long
Private Declare Function ReleaseMutex Lib "kernel32" ( _
                         ByVal hMutex As Long) As Long
Private Declare Function CallNextHookEx Lib "user32" ( _
                         ByVal hHook As Long, _
                         ByVal ncode As Long, _
                         ByVal wParam As Integer, _
                         ByRef lParam As Any) As Long
Private Declare Function SendMessage Lib "user32" _
                         Alias "SendMessageW" ( _
                         ByVal hWnd As Long, _
                         ByVal wMsg As Long, _
                         ByVal wParam As Long, _
                         ByRef lParam As Any) As Long
Private Declare Function SetWindowLong Lib "user32" _
                         Alias "SetWindowLongW" ( _
                         ByVal hWnd As Long, _
                         ByVal nIndex As Long, _
                         ByVal dwNewLong As Long) As Long
Private Declare Function SetProp Lib "user32" _
                         Alias "SetPropW" ( _
                         ByVal hWnd As Long, _
                         ByVal lpString As Long, _
                         ByVal hData As Long) As Long
Private Declare Function RemoveProp Lib "user32" _
                         Alias "RemovePropW" ( _
                         ByVal hWnd As Long, _
                         ByVal lpString As Long) As Long
Private Declare Function GetProp Lib "user32" _
                         Alias "GetPropW" ( _
                         ByVal hWnd As Long, _
                         ByVal lpString As Long) As Long
Private Declare Function GlobalAddAtom Lib "kernel32" _
                         Alias "GlobalAddAtomW" ( _
                         ByVal lpString As Long) As Integer
Private Declare Function GlobalDeleteAtom Lib "kernel32" ( _
                         ByVal nAtom As Integer) As Integer
Private Declare Function RegisterWindowMessage Lib "user32" _
                         Alias "RegisterWindowMessageW" ( _
                         ByVal lpString As Long) As Long
Private Declare Function CallWindowProc Lib "user32" _
                         Alias "CallWindowProcW" ( _
                         ByVal lpPrevWndFunc As Long, _
                         ByVal hWnd As Long, _
                         ByVal Msg As Long, _
                         ByVal wParam As Long, _
                         ByVal lParam As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" _
                    Alias "RtlMoveMemory" ( _
                    ByRef Destination As Any, _
                    ByRef Source As Any, _
                    ByVal Length As Long)


Private WM_SENDMESSAGE   As Long    ' // Our message for exchange with the main application. By sending from the current thread
                                    ' // this message to the main application (TestSubclassDLL) we notify the application using
                                    ' // SendMessage that new message has been received. This message has the parameters which
                                    ' // stored to the file mapping. If we'll pass the message from the main application we notify
                                    ' // that it's necessary to remove subbclassing and uninitialize data.
    
Dim hMutex      As Long     ' // Synchronization mutex
Dim hMap        As Long     ' // File mapping handle
Dim lpShrdData  As Long     ' // Shared data address
Dim hWndServer  As Long     ' // Window handle that receives messages
Dim hWndHook    As Long     ' // Subclassed window handle
Dim hHook       As Long     ' // Hook handle
Dim aPrevProc   As Integer  ' // Atom that represents the property of the original window procedure
Dim init        As Boolean  ' // Determines whether subclassing has been initialized or not
Dim disabled    As Boolean  ' // Subclassing has ended

' // Hook procedure
Public Function GetMsgProc( _
                ByVal code As Long, _
                ByVal wParam As Long, _
                ByVal lParam As Long) As Long
    Dim prevProc    As Long

    ' // If subclassing has not been initialized do it
    If Not (init Or disabled) Then
    
        ' // Open file mapping object
        hMap = OpenFileMapping(FILE_MAP_WRITE, False, StrPtr("TrickSubclassFileMap"))
        
        If hMap = 0 Then
        
            MsgBox "Unable to open the file mapping", vbCritical
            Clear
            Exit Function
            
        End If
        
        ' // Project to our address space
        lpShrdData = MapViewOfFile(hMap, FILE_MAP_WRITE, 0, 0, 0)
        CloseHandle hMap: hMap = 0
        
        If lpShrdData = 0 Then
        
            MsgBox "Unable to project the file mapping", vbCritical
            Clear
            Exit Function
            
        End If
        
        ' // Open synchronization mutex
        hMutex = OpenMutex(MUTEX_ALL_ACCESS, False, StrPtr("TrickSubclassMutex"))
        
        If hMutex = 0 Then
        
            MsgBox "Unable to open the mutex", vbCritical
            Clear
            Exit Function
            
        End If
        
        ' // Register window message
        WM_SENDMESSAGE = RegisterWindowMessage(StrPtr(WM_SENDMESSAGE))
        
        If WM_SENDMESSAGE = 0 Then
        
            MsgBox "Unable to register the shared message", vbCritical
            Clear
            Exit Function
            
        End If
        
        ' // Add/obtain the atom in order to save the window procedure
        aPrevProc = GlobalAddAtom(StrPtr("prevProc"))
        
        If aPrevProc = 0 Then
        
            MsgBox "Unable to add the atom", vbCritical
            Clear
            Exit Function
            
        End If
        

        ' // Grab the mutex. For example if the main application is inside the SetWindowsHookEx function consequently
        ' // we don't know the hook handle. Because of that the main application already grabbed this mutex the current
        ' // thread will wait until the mutex released. It occurs only when the main application has written the
        ' // hook handle to the shared memory
        If WaitForSingleObject(hMutex, INFINITE) = WAIT_FAILED Then
        
            MsgBox "Waiting error", vbCritical
            Clear
            Exit Function
            
        End If
        
        ' // Get the receiver window handle
        GetMem4 ByVal lpShrdData, hWndServer
        ' // Get the subclassing window handle
        GetMem4 ByVal lpShrdData + 4, hWndHook
        ' // Get the hook handle
        GetMem4 ByVal lpShrdData + 8, hHook
        ' // Release the mutex
        ReleaseMutex hMutex
        
        ' // Replace the address of the window procedure
        prevProc = SetWindowLong(hWndHook, GWL_WNDPROC, AddressOf WndProc)
        
        If prevProc = 0 Then
        
            MsgBox "Unable to replace the window procedure", vbCritical
            Clear
            Exit Function
            
        End If
        
        ' // Save the window procedure to the window property
        SetProp hWndHook, CLng(aPrevProc) And &HFFFF&, prevProc
        
        ' // Success
        init = True
        
    End If
    
    ' // Call the next hook chain
    GetMsgProc = CallNextHookEx(hHook, code, wParam, lParam)
    
End Function

' // Uninitialization
Public Sub Clear()

    If hMutex Then
    
        CloseHandle (hMutex)
        hMutex = 0
        
    End If
    
    If lpShrdData Then
    
        UnmapViewOfFile (lpShrdData)
        lpShrdData = 0
        
    End If
    
    If hWndHook Then
    
        RemoveProp hWndHook, CLng(aPrevProc) And &HFFFF&
        hWndHook = 0
        
    End If
    
    If aPrevProc Then
    
        GlobalDeleteAtom (aPrevProc)
        aPrevProc = 0
    
    End If
    
    init = False
    
End Sub

' // Window procedure
Private Function WndProc( _
                 ByVal hWnd As Long, _
                 ByVal uMsg As Long, _
                 ByVal wParam As Long, _
                 ByVal lParam As Long) As Long
    Dim sendData    As MsgData
    Dim prevProc    As Long
    
    ' // Check if the main application queries the subclassing completion
    If uMsg = WM_SENDMESSAGE Then
    
        ' // Get the original window handle
        prevProc = GetProp(hWnd, CLng(aPrevProc) And &HFFFF&)
        ' // Restore the original window handle
        SetWindowLong hWnd, GWL_WNDPROC, prevProc
        ' // Clean
        Clear
        
        ' // Disable subclassing
        ' // It's possible that GetMsgProc is called when hook has not been disabled in the main application.
        ' // This flag prevents the re-initialization
        
        disabled = True
        
        Exit Function

        ' // Now UnhookWindowsHookEx will be called and this dll will be unloaded
        
    End If
    
    ' // Make the query
    sendData.hWnd = hWnd
    sendData.uMsg = uMsg
    sendData.wParam = wParam
    sendData.lParam = lParam
    sendData.defCall = True
    
    ' // Grab the mutex
    If WaitForSingleObject(hMutex, INFINITE) = WAIT_FAILED Then
    
        MsgBox "Waiting error", vbCritical
        Clear
        Exit Function
    
    End If
    
    CopyMemory ByVal lpShrdData + 12, sendData, Len(sendData)
    
    ' // Release the mutex
    ReleaseMutex hMutex
    
    ' // Send the message to the receiver window
    SendMessage hWndServer, WM_SENDMESSAGE, 0, ByVal 0&
    
    ' // Grab the mutex
    If WaitForSingleObject(hMutex, INFINITE) = WAIT_FAILED Then
    
        MsgBox "Waiting error", vbCritical
        Clear
        Exit Function
        
    End If
    
    ' // Get the result
    CopyMemory sendData, ByVal lpShrdData + 12, Len(sendData)
    
    ' // Release the mutex
    ReleaseMutex hMutex
    
    ' // Check if it's needed to process the message
    If sendData.defCall Then
    
        prevProc = GetProp(hWnd, CLng(aPrevProc) And &HFFFF&)
        WndProc = CallWindowProc(prevProc, sendData.hWnd, sendData.uMsg, sendData.wParam, sendData.lParam)
        
    Else
    
        WndProc = sendData.return
        
    End If
    
End Function