另类多线程的实现（消息）

[chenhui530]

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

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

[chenhui530]

VERSION 5.00
Begin VB.Form frmMain
Caption = "Form1"
ClientHeight = 3090
ClientLeft = 60
ClientTop = 450
ClientWidth = 4680
LinkTopic = "Form1"
ScaleHeight = 3090
ScaleWidth = 4680
StartUpPosition = 3 '窗口缺省
Begin VB.TextBox Text1
Height = 975
Left = 480
TabIndex = 0
Text = "Text1"
Top = 720
Width = 3735
End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

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

Private m_hThread As Long




Private Sub Form_Load()
StartHook Me.hWnd

m_hThread = CHCreateThread(Me.hWnd, AddressOf TestProc, &H2000, 0, 0)

End Sub

Private Sub Form_Unload(Cancel As Integer)
CloseHandle m_hThread
Unhook Me.hWnd
End Sub

[PctGL]

其实这个立刻返回的实现有很多api都支持...
用createthread lz 不觉得太麻烦了吗...

利用timer api就能写出一个类似此功能的代码, 我写过一个timer实现的方案... 可惜都认为是多线程, 而没人注意到他的应用.... 这个功能能实现一个伪异步的无等待死循环, 这个功能可以说是很有价值

利用这些知识点,实现了很多功能, 之后我去百度知道上去写 单线程异步 的百科... 被斥无知...