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