dcsimg
Results 1 to 20 of 20

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

  1. #1

    Thread Starter
    Frenzied Member
    Join Date
    Feb 2015
    Posts
    1,364

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


    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
    Last edited by The trick; Aug 22nd, 2016 at 04:39 PM. Reason: Translation to English

  2. #2

    Thread Starter
    Frenzied Member
    Join Date
    Feb 2015
    Posts
    1,364

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

    We analyze in detail the code. In the initialisation procedure, check the flags initialization and shutdown subclassing. If any True, the means or subclassing installed or completed. Otherwise, start initialization. The first step is open the file-mapping and project views of the process address space. To avoid race conditions using mutex synchronization objects. Then register the message "WM_SENDMESSAGE" to exchange in the system and get his number. To store the address of the previous window procedure, I decided to use the property window, but could be used and a variable module, since at a time can only intercept only one window in this embodiment. For faster access to the property, I use the atom, so register it with the name "prevProc". Then try to acquire the mutex. When it works, the general data are available only for that thread, no other thread will not be able to record something there and we will avoid race conditions. From file-mapping we obtain the needed data (handle of the main window of our application, handle the "window-subclassing" hook and handle, it must pass a "CallNextHookEx"). Later releases the mutex, and set the address of the window procedure in our (directly subclassing). Now all the messages intended for the window will go to the procedure "WndProc".* We analyze the procedure "WndProc". To start analyze the structure of the file-mapping:
    Check the message if it is our registered, it can only send our application when removing subclassing, so execute deinitialization. Otherwise, we form the message data and capture a mutex, write them to a file mapping with offset 0x0Ch (1210) and transmits them to the main window of our application for processing. Because we use the "SendMessage" for the transfer, leaving it will not happen until we are in your application does not finish processing the message. When you return the check flag "defCall", which is responsible whether to let a message on the old window procedure or not.

  3. #3

    Thread Starter
    Frenzied Member
    Join Date
    Feb 2015
    Posts
    1,364

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

    We now consider the main application:
    Standart module:
    Code:
    ' // modMain.bas - multithreading demonstration in the NativeDll.
    ' // Injection to another process and subclassing
    ' // © Krivous Anatoly Anatolevich (The trick), 2014
    
    Option Explicit
    
    DECLARATIONS
    . . .
    . . .
    
    Public WM_SENDMESSAGE   As Long ' // Our message
    Public hProcess         As Long ' // Process handle of the subclassed process
    
    Dim hMutex      As Long ' // Synchronization mutex
    Dim lpShrdData  As Long ' // Address of the shared memory
    Dim hLib        As Long ' // Handle of SubclassDLL
    Dim lpProc      As Long ' // Address of GetMsgProc function
    Dim hHook       As Long ' // Hook handle
    Dim TID         As Long ' // ID of thread
    Dim PID         As Long ' // ID of process
    Dim hMap        As Long ' // Handle of the file mapping obect
    Dim lpPrevProc  As Long ' // Address of the original window proc of the frmMain form
    
    ' // Initialization
    Public Function Initialize() As Boolean
        
        ' // Create synchronization mutex
        hMutex = CreateMutex(ByVal 0&, 0, StrPtr("TrickSubclassMutex"))
        
        If hMutex = 0 Then
        
            MsgBox "Unable to create the mutex"
            Clear
            Exit Function
            
        End If
        
        If Err.LastDllError = ERROR_ALREADY_EXISTS Then
        
            MsgBox "Application is already running"
            Clear
            Exit Function
            
        End If
        
        ' // Create file mapping
        hMap = CreateFileMapping(INVALID_HANDLE_VALUE, ByVal 0&, PAGE_READWRITE, 0, 100, StrPtr("TrickSubclassFileMap"))
        
        If hMap = 0 Then
        
            MsgBox "Unable to create the file mapping"
            Clear
            Exit Function
            
        End If
        
        ' // Project
        lpShrdData = MapViewOfFile(hMap, FILE_MAP_WRITE, 0, 0, 0)
        
        If lpShrdData = 0 Then
        
            MsgBox "Unable to map the file mapping", vbCritical
            Clear
            Exit Function
            
        End If
        
        ' // Register message
        WM_SENDMESSAGE = RegisterWindowMessage(StrPtr(WM_SENDMESSAGE))
        
        If WM_SENDMESSAGE = 0 Then
        
            MsgBox "Unable to register the message", vbCritical
            Clear
            Exit Function
            
        End If
        
        ' // Subclassing og frmMain
        lpPrevProc = SetWindowLong(frmMain.hwnd, GWL_WNDPROC, AddressOf WndProc)
        
        ' // Load Dll
        hLib = LoadLibrary(StrPtr("..\SubclassDLL\SubclassDLL"))
        
        If hLib = 0 Then
        
            MsgBox "Unable to load Dll"
            ReleaseMutex hMutex
            Exit Function
            
        End If
        
        ' // Get GetMsgProc function address
        lpProc = GetProcAddress(hLib, "GetMsgProc")
        
        If lpProc = 0 Then
        
            MsgBox "Unable to find the GetMsgProc procedure"
            ReleaseMutex hMutex
            Exit Function
            
        End If
        
        Initialize = True
        
    End Function
    
    ' // Uninitialization
    Public Sub Clear()
    
        If hMap Then
            CloseHandle (hMap)
        End If
        
        If hMutex Then
            CloseHandle (hMutex)
        End If
        
        If lpShrdData Then
            UnmapViewOfFile (lpShrdData)
        End If
        
        If hLib Then
            FreeLibrary (hLib)
        End If
        
        If lpPrevProc Then
            SetWindowLong frmMain.hwnd, GWL_WNDPROC, lpPrevProc
        End If
        
        If hProcess Then
            CloseHandle (hProcess)
        End If
        
    End Sub
    
    ' // Subclass window
    Public Function StartSubclass( _
                    ByVal hwnd As Long) As Long
                    
        ' // Get thread identifier
        TID = GetWindowThreadProcessId(hwnd, PID)
        
        If TID = 0 Then
        
            MsgBox "Unable to obtain the thread ID"
            Exit Function
            
        End If
        
        ' // Disallow to subclass the windows of main application
        If TID = App.ThreadID Then
        
            MsgBox "Unable to subclass the window of the main application"
            Exit Function
            
        End If
        
        ' // If subclassing was already set unsubclass it
        StopSubclass hwnd
        
        ' // Open process
        hProcess = OpenProcess(PROCESS_VM_OPERATION Or PROCESS_VM_WRITE Or PROCESS_VM_READ, 0, PID)
        
        If hProcess = 0 Then
        
            MsgBox "Unable to open the process"
            Exit Function
            
        End If
        
        ' // Grab mutex
        If WaitForSingleObject(hMutex, INFINITE) = WAIT_FAILED Then
        
            MsgBox "Waiting error", vbCritical
            Clear
            Exit Function
            
        End If
        
        ' // Install hook to receive messages in the specified thread
        hHook = SetWindowsHookEx(WH_GETMESSAGE, lpProc, hLib, TID)
        
        If hHook = 0 Then
        
            MsgBox "Unable to set the hook"
            ReleaseMutex hMutex
            Exit Function
            
        End If
        
        ' // Store the receiver window handler
        GetMem4 CLng(frmMain.hwnd), ByVal lpShrdData
        ' // Store handle of subbclassed window
        GetMem4 hwnd, ByVal lpShrdData + 4
        ' // Store hook handle
        GetMem4 hHook, ByVal lpShrdData + 8
        ' Освобождаем мьютекс, код в другом процессе теперь сможет читать эти данные
        ' // Release mutex. Now the process can read shared data
        ReleaseMutex hMutex
        
        StartSubclass = True
        
    End Function
    
    ' // Disable subclassing
    Public Function StopSubclass( _
                    ByVal hwnd As Long) As Long
                    
        If hHook Then
    
            ' // Send message to subclassed window. Our handler will handle this message
            SendMessage hwnd, WM_SENDMESSAGE, 0, ByVal 0&
            ' // Disable hook, subclassed process will unload our DLL
            UnhookWindowsHookEx (hHook): hHook = 0
            ' // Close process handle
            CloseHandle hProcess: hProcess = 0
            
            StopSubclass = True
            
        End If
        
    End Function
    
    ' // Window proc of frmMain window
    Private Function WndProc( _
                     ByVal hwnd As Long, _
                     ByVal uMsg As Long, _
                     ByVal wParam As Long, _
                     ByVal lParam As Long) As Long
                     
        Select Case uMsg
        Case WM_SENDMESSAGE
        
            Dim msg As MsgData
    
            ' // Grab the mutex although it isn't necessarily because caller thread already waits in the SendMessage function
            If WaitForSingleObject(hMutex, INFINITE) = WAIT_FAILED Then
            
                MsgBox "Waiting error", vbCritical
                Clear
                Exit Function
                
            End If
            
            ' // Copy message data to local variable
            CopyMemory msg, ByVal lpShrdData + 12, Len(msg)
            ' // Call our handler
            msg.return = frmMain.WndProc(msg.hwnd, msg.uMsg, msg.wParam, msg.lParam, msg.defCall)
            ' // Save back
            CopyMemory ByVal lpShrdData + 12, msg, Len(msg)
            ' // Release mutex
            ReleaseMutex hMutex
            
        Case Else
            WndProc = CallWindowProc(lpPrevProc, hwnd, uMsg, wParam, lParam)
        End Select
        
    End Function
    
    ' // Load list of messages
    Public Sub SetWMList( _
               ByRef msgList() As String)
    
        VERY LONG LIST
        SEE SOURCE
        . . .
        . . .
    
    End Sub
    Last edited by The trick; Aug 22nd, 2016 at 04:43 PM. Reason: Translation to English

  4. #4

    Thread Starter
    Frenzied Member
    Join Date
    Feb 2015
    Posts
    1,364

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

    Form:
    Code:
    ' // frmMain.frm - multithreading demonstration in the NativeDll.
    ' // Injection to another process and subclassing
    ' // © Krivous Anatoly Anatolevich (The trick), 2014
    
    Option Explicit
    
    Dim isDown      As Boolean      ' // Search flag
    Dim curHwnd     As Long         ' // Current subclassing window
    Dim prevWnd     As Long         ' // Previous marked window
    Dim mIcon       As StdPicture   ' // Window icon
    Dim iconHeight  As Long         ' // Height state of icon
    Dim msgList()   As String       ' // List of the windows messages
    
    ' // Window messages handler (all the addresses correspond to the address space in the subclassing process)
    Public Function WndProc( _
                    ByVal hwnd As Long, _
                    ByVal uMsg As Long, _
                    ByVal wParam As Long, _
                    ByVal lParam As Long, _
                    ByRef defCall As Long) As Long
                    
        ' // Check selected tab
        Select Case tabMain.SelectedItem.Index
        Case 1
            
            ' // Restriction of window size
            Select Case uMsg
            Case WM_GETMINMAXINFO
                Dim mmInf   As MINMAXINFO
                
                ' // Get MINMAXINFO structure
                If ReadProcessMemory(hProcess, ByVal lParam, mmInf, Len(mmInf), 0) = 0 Then Exit Function
                ' // Set limits
                mmInf.ptMinTrackSize.x = sldWidth.Value
                mmInf.ptMinTrackSize.y = sldHeight.Value
                ' // Store
                WriteProcessMemory hProcess, ByVal lParam, mmInf, Len(mmInf), 0
                ' // It isn't necessary to call the default procedure
                defCall = False
                
            End Select
            
        Case 2
    
            ' // Click within the window
            Select Case uMsg
            Case WM_LBUTTONDOWN
            
                picContainer(1).BackColor = vbHighlight
                lblClick.Visible = True
                
            Case WM_LBUTTONUP
            
                picContainer(1).BackColor = vbButtonFace
                lblClick.Visible = False
                
            End Select
            
        Case 3
        
            ' // Message log
            Dim sMsg As String
            
            ' // Check the message name
            If uMsg > UBound(msgList) Then
                sMsg = "Unknown 0x" & Hex(uMsg)
            Else
            
                If Len(msgList(uMsg)) = 0 Then
                    sMsg = "Unknown 0x" & Hex(uMsg)
                Else
                    sMsg = msgList(uMsg)
                End If
                
            End If
            
            ' // Add to the list with the parameters
            With lvwMsg.ListItems.Add(, , sMsg)
                .SubItems(1) = wParam
                .SubItems(2) = lParam
                
                ' // Ensure visibility of last message
                .Selected = True
                
            End With
            
        End Select
        
    End Function
    
    ' // Get window handle under cursor
    Private Function GetWindowFromCursor() As Long
        Dim pt As POINTAPI
        
        ' // Get cursor position
        GetCursorPos pt
        ' // Get handle
        GetWindowFromCursor = WindowFromPoint(pt.x, pt.y)
        
    End Function
    
    ' // Mark window with frame
    Private Sub MarkWindow( _
                ByVal hwnd As Long)
        Dim hRgn    As Long
        Dim r2      As Long
        Dim dc      As Long
        Dim rc      As RECT
        
        ' // Create region that will receive the window region
        hRgn = CreateRectRgn(0, 0, 1, 1)
        ' // Get device context of window
        dc = GetWindowDC(hwnd)
        
        ' // Get window region
        If (GetWindowRgn(hwnd, hRgn) And (Not NULLREGION)) = 0 Then
            ' // If the region is empty or an error occurs
            ' // get the rectangle of the window
            GetWindowRect hwnd, rc
            
            ' // Delete previous region
            DeleteObject hRgn
            
            ' // Translate window coordinates to 0.0
            OffsetRect rc, -rc.Left, -rc.Top
            
            ' // Create rectangle region
            hRgn = CreateRectRgn(rc.Left, rc.Top, rc.Right, rc.Bottom)
            
        End If
        
        ' // Get overlay mode
        r2 = GetROP2(dc)
        
        ' // Set XOR overlay, now by drawing with the white pen it turns the color inversion.
        SetROP2 dc, R2_XORPEN
        ' // Draw frame
        FrameRgn dc, hRgn, GetStockObject(WHITE_BRUSH), 3, 3
        ' // Restore overlay mode
        SetROP2 dc, r2
        ' // Release context
        ReleaseDC hwnd, dc
        ' // Clean region
        DeleteObject hRgn
        
    End Sub
    
    ' // Loading
    Private Sub Form_Load()
        ' // Set current directory
        ChDir App.Path: ChDrive App.Path
        
        ' // Initialization
        If Not Initialize() Then End
        
        ' // Load icon
        Set mIcon = LoadResPicture(101, vbResBitmap)
        
        ' // Calc icon state size
        iconHeight = ScaleY(mIcon.Height, vbHimetric, vbPixels) \ 3
        
        ' // Draw defaut icon (stopped)
        picIcon.PaintPicture mIcon, 0, 0, , iconHeight, , , , iconHeight
        
        ' // Load windows messages
        SetWMList msgList()
        
        ' // Status
        Me.Caption = "Stopped"
        
        ' // Update controls
        sldWidth_Change
        sldHeight_Change
        tabMain_Click
        
    End Sub
    
    ' // Ending
    Private Sub Form_Unload( _
                ByRef Cancel As Integer)
        
        ' // Disable subclassing if any
        If curHwnd Then
            StopSubclass curHwnd
        End If
        
        ' // Uninitialization
        Clear
        
    End Sub
    
    ' // Change tab size
    Private Sub picContainer_Resize( _
                ByRef Index As Integer)
    
        If Index = 2 Then
            ' // When it's the message log mode stretch list to the entire tab
            lvwMsg.Move 0, 0, picContainer(Index).ScaleWidth, picContainer(Index).ScaleHeight
        End If
        
    End Sub
    
    ' // Click onto icon
    Private Sub picIcon_Click()
    
        ' // If subclassing was set stop it
        If curHwnd Then
        
            StopSubclass curHwnd
            curHwnd = 0
            ' // Refresh icon
            picIcon.PaintPicture mIcon, 0, 0, , iconHeight, , , , iconHeight
            ' // ... and status
            Me.Caption = "Stopped"
            
        End If
        
    End Sub
    
    ' // Pressing button within icon
    Private Sub picIcon_MouseDown( _
                ByRef Button As Integer, _
                ByRef Shift As Integer, _
                ByRef x As Single, _
                ByRef y As Single)
                
        ' // If there is no subclassing
        If curHwnd = 0 Then
        
            ' // Begin to search windows
            isDown = True
            ' // Set cursor icon
            picIcon.MousePointer = vbCrosshair
            ' // Refresh icon
            picIcon.PaintPicture mIcon, 0, 0, , iconHeight, , iconHeight, , iconHeight
            ' // Clear previous window
            prevWnd = 0
            
        End If
        
    End Sub
    
    ' // Mouse move
    Private Sub picIcon_MouseMove( _
                ByRef Button As Integer, _
                ByRef Shift As Integer, _
                ByRef x As Single, _
                ByRef y As Single)
                
        ' // If there is search
        If isDown Then
            Dim handle As Long
            
            ' // Get window handle
            handle = GetWindowFromCursor
            
            ' // If a window exists under cursor
            If handle Then
            
                ' // Chack if the window is the previous window
                If handle = prevWnd Then
                    Exit Sub
                Else
                
                    ' // Clear previous window frame
                    MarkWindow prevWnd
                    ' // Draw new frame
                    MarkWindow handle
                    
                End If
            End If
            
            ' // Set previous window
            prevWnd = handle
            
            ' // Print handle on the caption
            Me.Caption = Hex(handle)
            
        End If
        
    End Sub
    
    ' // Releasing mouse in the icon
    Private Sub picIcon_MouseUp( _
                ByRef Button As Integer, _
                ByRef Shift As Integer, _
                ByRef x As Single, _
                ByRef y As Single)
        Dim handle As Long
        
        ' // Search completed
        isDown = False
        
        ' // If there is active subclassing exit. Subclassing wil be disabled in Click event
        If curHwnd Then Exit Sub
        
        ' // Set default mouse cursor
        picIcon.MousePointer = vbDefault
        
        ' // Get window under cursor
        handle = GetWindowFromCursor
        
        ' // If a window is under cursor
        If handle Then
        
            ' // Check if it's the previous window
            If handle = prevWnd Then
                ' // Clear frame
                MarkWindow handle
            End If
            
            ' // Enable subclassing
            If Not StartSubclass(handle) Then
                Me.Caption = "Stopped"
                picIcon.PaintPicture mIcon, 0, 0, , iconHeight, , , , iconHeight: Exit Sub
            End If
            
            ' // Set current window
            curHwnd = handle
            picIcon.PaintPicture mIcon, 0, 0, , iconHeight, , iconHeight * 2, , iconHeight
            Me.Caption = "Running " & Hex(curHwnd)
            
        Else
        
            picIcon.PaintPicture mIcon, 0, 0, , iconHeight, , , , iconHeight
            Me.Caption = "Stopped"
            
        End If
        
    End Sub
    Private Sub sldWidth_Change()
        lblWidth.Caption = "Width: " & sldWidth.Value
    End Sub
    Private Sub sldWidth_Scroll()
        sldWidth_Change
    End Sub
    Private Sub sldHeight_Change()
        lblHeight.Caption = "Height: " & sldHeight.Value
    End Sub
    Private Sub sldHeight_Scroll()
        sldHeight_Change
    End Sub
    
    Private Sub tabMain_Click()
        Static prevTab As Long
        
        picContainer(prevTab).Visible = False
        prevTab = tabMain.SelectedItem.Index - 1
        picContainer(prevTab).Move tabMain.ClientLeft, tabMain.ClientTop, tabMain.ClientWidth, tabMain.ClientHeight
        picContainer(prevTab).Visible = True
        
    End Sub
    Last edited by The trick; Aug 22nd, 2016 at 04:44 PM. Reason: Translation to English

  5. #5

    Thread Starter
    Frenzied Member
    Join Date
    Feb 2015
    Posts
    1,364

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

    We analyze in detail the code. When loading forms call the "Initialize", which initializes the data necessary for subclassing. First create a mutex for synchronization, file-mapping for data exchange and project his presentation, recording a message "WM_SENDMESSAGE", load the library with the procedure hook and subclass the main window to receive messages. Further, when the success of the icon to load and load conditions subclassing a list of messages.
    To start subclassing need to hold down the mouse button on the control "picIcon" and move it to the desired control. When this is getting the handle of the window under the cursor and mark frame. Frame for a window region is taken or if it exists, otherwise it is created on the basis of the window rectangle. Region outlines frame through "R2_XOR" overlay (vbXorPen), to remove the mark just once, a frame. When you release the button on the window, we handle it and run the function "StartSubclass". In this procedure, we check the thread (in its own thread, I forbade intercept messages can occur because recursion and departure), if necessary, set the subclassing. Next, open the process- "victim" because we need to read and write in the address space of the processing of messages passing flags "PROCESS_VM_OPERATION", "PROCESS_VM_WRITE", "PROCESS_VM_READ". Now to start subclassing need to prepare data for proces- "victim", so grab the mutex and then set the hook "WH_GETMESSAGE" in the thread proces- "victim". After that, copy the data into shared memory can be sure that the thread - "victim" will not be there to read. Even if the procedure "GetMsgProc" starts its execution, it will be waiting in the function "WaitForSingleObject" until we liberate the mutex. After copying releases the mutex, now everything is ready.
    After receiving the next message window victim, we pass it to our application of the procedure "WndProc" located in the DLL, which is loaded into the address space of the victim. In our application we have in the preparation of "WM_SENDMESSAGE" copy the data from the shared memory and transmits them to the processing method of the form "WndProc". In this method, we selected depending tabs anyway processes the message. In the first case we limit the minimum Ramer windows, by processing the message "WM_GETMINMAXINFO". It must be remembered that the addresses passed to the window procedure - this is the address in the address space proces- "victim" for our process, they are invalid. Because of this, we instead "CopyMemory" use "ReadProcessMemory" and "WriteProcessMemory". In the second processing "WM_LBUTTONDOWN" and "WM_LBUTTONUP" and in his course mark tab. Thirdly just set the name of the message and the list of parameters.
    To stop subclassing need to click on the icon that will be marked as "STOP". Thus, the function is called "StopSubclass". In it we pass the message window victim "WM_SENDMESSAGE", thereby saying that we end up subclassing. In the DLL, in the function "WndProc", as I described above, we produce deinitialization. After deinitialization returns to our application and removed the hook by calling "UnhookWindowsHookEx". After our system unloads the DLL from memory process victim.
    Name:  DllInj.png
Views: 1329
Size:  14.5 KB
    As we have seen - DLL, written in VB6, works fine in other people's programs and threads. This DLL is written only for testing and demonstration opportunities VB6. I did not set myself the task of writing a complete DLL for use in projects, so deliberately DLL has limitations and has an irregular architecture (you can not make multiple subclassing and other limitations and bugs), there are no checks. To demonstrate the capabilities of this enough.
    ___________________________________________________________________________________________
    How could we be sure that it is running in multi-threaded programs written in VB6, and DLL, written in VB6 work in any program. Thank you for your attention, good luck.
    Attached Files Attached Files
    Last edited by The trick; Aug 22nd, 2016 at 04:48 PM.

  6. #6
    Frenzied Member gibra's Avatar
    Join Date
    Oct 2009
    Location
    ITALY
    Posts
    1,669

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

    In the zip file the

    ..\GraphicsDLL\clsUnused.cls

    is missing on SubclassNativeDLL\SubclassDLL\ folder.

  7. #7

  8. #8
    Hyperactive Member
    Join Date
    Aug 2016
    Posts
    371

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

    Quote Originally Posted by The trick View Post
    Hi gibra! Thank for testing. I've fixed it.
    thanks。if you fixed ,please tell me

  9. #9

  10. #10
    Frenzied Member gibra's Avatar
    Join Date
    Oct 2009
    Location
    ITALY
    Posts
    1,669

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

    Quote Originally Posted by The trick View Post
    Hi gibra! Thank for testing. I've fixed it.
    Fixed, but not updated.
    When you update the SubclassNativeDLL.zip ?

  11. #11

  12. #12
    Frenzied Member gibra's Avatar
    Join Date
    Oct 2009
    Location
    ITALY
    Posts
    1,669

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

    Quote Originally Posted by The trick View Post
    I had updated it in the #7 post and upload new version.
    Then I don't understand.
    Your post #7 doesn't have new link.
    I have downloaded again the zip in post #5, but same problem.

    ...\GraphicsDLL\clsUnused.cls is listed in the VBP project :
    Code:
    Type=OleDll
    Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#C:\Windows\SysWow64\stdole2.tlb#OLE Automation
    Reference=*\G{0000000E-0000-0000-0000-000000000AAB}#0.0#0#..\TypeLib\DllInitialize.tlb#DllInitialize
    Class=clsUnused; ..\GraphicsDLL\clsUnused.cls
    Module=modMainDLL; modMainDLL_SingleThreadModel.bas
    Module=modSubclassDLL; modSubclassDLL.bas
    Startup="(None)"

    But both folder and file are missing in your zip.

    Also, the strings seem to be russian language (or something similar), unreadable for other users.
    i.e. when I load your project TestSubClassDLL in tabMain control I get this: Минимальный размер окна

    Please translate your strings, comments, etc... in english language, otherwise your projects are unusable.


  13. #13

  14. #14
    Frenzied Member gibra's Avatar
    Join Date
    Oct 2009
    Location
    ITALY
    Posts
    1,669

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

    Thank.

  15. #15

  16. #16
    Frenzied Member gibra's Avatar
    Join Date
    Oct 2009
    Location
    ITALY
    Posts
    1,669

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

    Thank.

  17. #17
    Hyperactive Member
    Join Date
    Aug 2016
    Posts
    371

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

    now I write a dll set hook WH_KEYBOARD.and have a form in this dll . I inject this dll to one program. but if I show the dll form.the program will die.
    can you have a demo to inject dll and show form?
    thanks sir. my poor English .i hope you can understand .

  18. #18

  19. #19
    Hyperactive Member
    Join Date
    Aug 2016
    Posts
    371

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

    Code:
    ' // Hook procedure
    Public HomeCOUNT As Long
    Public Function GetMsgProc(ByVal code As Long, _
                               ByVal wParam As Long, _
                               ByVal lParam As Long) As Long
    
            ' 
            If wParam = vbKeyHome Then
                If lParam And &H40000000 Then
                    HomeCOUNT = HomeCOUNT + 1
    
                    If HomeCOUNT = 1 Then
                       Form1.Show
                        GoTo mm
                    End If
                             
                    If (HomeCOUNT Mod 2) = 0 Then
                        Form1.Visible = False
                    Else
                        Form1.Visible = True
                    End If
                            
                End If
            End If
    mm:
        ' // Call the next hook chain
        GetMsgProc = CallNextHookEx(hHook, code, wParam, lParam)
    Code:
    ' 
    Private Const WH_KEYBOARD As Long = 2
    // Subclass window
    Public Function StartSubclass( _
                    ByVal hwnd As Long) As Long
                    
    ...
    ....
    
    
        ' // Install hook to receive messages in the specified thread
        hHook = SetWindowsHookEx(WH_KEYBOARD, lpProc, hLib, TID)
        
    ...

  20. #20
    Hyperactive Member
    Join Date
    Aug 2016
    Posts
    371

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

    Code:
    ' // Hook procedure
    Public HomeCOUNT As Long
    Public Function GetMsgProc(ByVal code As Long, _
                               ByVal wParam As Long, _
                               ByVal lParam As Long) As Long
    
            ' 
            If wParam = vbKeyHome Then
                If lParam And &H40000000 Then
                    HomeCOUNT = HomeCOUNT + 1
    
                    If HomeCOUNT = 1 Then
                       Form1.Show
                        GoTo mm
                    End If
                             
                    If (HomeCOUNT Mod 2) = 0 Then
                        Form1.Visible = False
                    Else
                        Form1.Visible = True
                    End If
                            
                End If
            End If
    mm:
        ' // Call the next hook chain
        GetMsgProc = CallNextHookEx(hHook, code, wParam, lParam)
    Code:
    ' 
    Private Const WH_KEYBOARD As Long = 2
    // Subclass window
    Public Function StartSubclass( _
                    ByVal hwnd As Long) As Long
                    
    ...
    ....
    
    
        ' // Install hook to receive messages in the specified thread
        hHook = SetWindowsHookEx(WH_KEYBOARD, lpProc, hLib, TID)
        
    ...

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Featured


Click Here to Expand Forum to Full Width