此份代码利用自定义消息来实现“多线程”的功能，严格意义上来说不能说成是多线程因为是利用消息机制让代码跑在主线程上来的，具体大家自己看代码。在某种要求下可以当多线程来使用。

Attribute VB_Name = "modMultiThread"
Option Explicit

Private Const GWL_WNDPROC = -4

Private Const WM_COPYDATA = &H4A

Private Declare Function CreateThread Lib "kernel32" (lpThreadAttributes As Any, ByVal dwStackSize As Long, ByVal lpStartAddress As Long, lpParameter As Any, ByVal dwCreationFlags As Long, lpThreadId As Long) As Long

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long

Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long

Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long



Private lpPrevWndProc As Long

Private ShellCode(80) As Byte


Public Function TestProc(ByVal lpParameter) As Long

    MsgBox Hex(lpParameter)
'    DbgBreakPoint

End Function

'Public Sub TestProc(ByVal lpParameter)
'    MsgBox Hex(lpParameter)
''    DbgBreakPoint
'End Sub

Public Sub Unhook(ByVal hWnd As Long)
    If lpPrevWndProc Then
        SetWindowLong hWnd, GWL_WNDPROC, lpPrevWndProc
    End If
End Sub

Public Sub StartHook(ByVal hWnd As Long)
    lpPrevWndProc = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub

Private Function WindowProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Dim MessageId As Long
    Dim dwFunAddress As Long
    Dim dwParameter As Long
    Dim pData As Long
    
    If uMsg = WM_COPYDATA Then
        CopyMemory pData, ByVal lParam + 8, 4
        
        CopyMemory MessageId, ByVal pData, 4
        'Debug.Print "MessageId: " & Hex(MessageId)
        If MessageId = &H1000 Then
            CopyMemory dwFunAddress, ByVal pData + 4, 4
            CopyMemory dwParameter, ByVal pData + 8, 4
            Debug.Print "FunAddress: " & Hex(dwFunAddress) & ",Parameter: " & Hex(dwParameter)
            '这里不能使用移花接木，可惜了，所以只能自己建立一个函数表然后和地址对应，然后通过查表来对应调用哪个函数了
            TestProc dwParameter
        End If
    End If
    
    WindowProc = CallWindowProc(lpPrevWndProc, hWnd, uMsg, wParam, lParam)
End Function


Public Function CHCreateThread(ByVal hWnd As Long, ByVal lpStartAddress As Long, ByVal lpParameter As Long, ByVal dwCreationFlags As Long, lpThreadId As Long) As Long
    Dim wValue As Integer
    Dim dwValue As Long
    Dim dwThreadId As Long
    Dim hThread As Long
    
    wValue = &HEC83
    CopyMemory ByVal VarPtr(ShellCode(0)), ByVal VarPtr(wValue), 2
    ShellCode(2) = &H18 'sub     esp, 18h
    
    dwValue = &H1C24448B
    CopyMemory ByVal VarPtr(ShellCode(3)), ByVal VarPtr(dwValue), 4 'mov     eax, [esp+1Ch]
    
    dwValue = &HC24548D
    CopyMemory ByVal VarPtr(ShellCode(7)), ByVal VarPtr(dwValue), 4 'lea     edx, [esp+0xC]
    
    ShellCode(11) = &H52 'push    edx             ; lParam
    
    wValue = &H6A
    CopyMemory ByVal VarPtr(ShellCode(12)), ByVal VarPtr(wValue), 2 'push    0               ; wParam

    dwValue = &H8244C8D
    CopyMemory ByVal VarPtr(ShellCode(14)), ByVal VarPtr(dwValue), 4 'lea     ecx, [esp+8]
    
    wValue = &H4A6A
    CopyMemory ByVal VarPtr(ShellCode(18)), ByVal VarPtr(wValue), 2 'push    4Ah             ; Msg
    
    ShellCode(20) = &H68
    dwValue = hWnd
    CopyMemory ByVal VarPtr(ShellCode(21)), ByVal VarPtr(dwValue), 4 'push   hWnd
    
    dwValue = &H102444C7
    CopyMemory ByVal VarPtr(ShellCode(25)), ByVal VarPtr(dwValue), 4
    dwValue = &H1000
    CopyMemory ByVal VarPtr(ShellCode(29)), ByVal VarPtr(dwValue), 4 'mov     dword ptr [esp+10h], 1000h
    
    dwValue = &H142444C7
    CopyMemory ByVal VarPtr(ShellCode(33)), ByVal VarPtr(dwValue), 4
    dwValue = lpStartAddress
    CopyMemory ByVal VarPtr(ShellCode(37)), ByVal VarPtr(dwValue), 4 'mov     dword ptr [esp+14h], lpStartAddress
    
    dwValue = &H18244489
    CopyMemory ByVal VarPtr(ShellCode(41)), ByVal VarPtr(dwValue), 4 'mov     [esp+18h], eax
    
    dwValue = &H1C2444C7
    CopyMemory ByVal VarPtr(ShellCode(45)), ByVal VarPtr(dwValue), 4
    dwValue = 0
    CopyMemory ByVal VarPtr(ShellCode(49)), ByVal VarPtr(dwValue), 4 'mov     dword ptr [esp+1ch], 0
    
    dwValue = &H202444C7
    CopyMemory ByVal VarPtr(ShellCode(53)), ByVal VarPtr(dwValue), 4
    dwValue = &HC
    CopyMemory ByVal VarPtr(ShellCode(57)), ByVal VarPtr(dwValue), 4 'mov     dword ptr [esp+20h], 0xC
    
    dwValue = &H24244C89
    CopyMemory ByVal VarPtr(ShellCode(61)), ByVal VarPtr(dwValue), 4 'mov     [esp+24h], ecx
    
    ShellCode(65) = &HB8
    dwValue = GetProcAddress(GetModuleHandle("User32.dll"), "SendMessageA")
    CopyMemory ByVal VarPtr(ShellCode(66)), ByVal VarPtr(dwValue), 4 'mov     eax, SendMessageA
    
    wValue = &HD0FF
    CopyMemory ByVal VarPtr(ShellCode(70)), ByVal VarPtr(wValue), 2 'call     eax
    
    wValue = &HC033
    CopyMemory ByVal VarPtr(ShellCode(72)), ByVal VarPtr(wValue), 2 'xor     eax, eax
    
    wValue = &HC483
    CopyMemory ByVal VarPtr(ShellCode(74)), ByVal VarPtr(wValue), 2
    ShellCode(76) = &H18 'add     esp, 18h
    
    wValue = &H4C2
    CopyMemory ByVal VarPtr(ShellCode(77)), ByVal VarPtr(wValue), 2
    ShellCode(79) = &H0 'ret     4

'    ShellCode(77) = &HCC 'int 3
'    wValue = &H4C2
'    CopyMemory ByVal VarPtr(ShellCode(78)), ByVal VarPtr(wValue), 2
'    ShellCode(80) = &H0 'ret     4
    
    hThread = CreateThread(ByVal 0&, _
                           0, _
                           ByVal VarPtr(ShellCode(0)), _
                           ByVal lpParameter, _
                           dwCreationFlags, _
                           dwThreadId _
                           )
    If lpThreadId Then
        lpThreadId = dwThreadId
    End If
    CHCreateThread = hThread
End Function