单类模块子类化,更精简的版本,作者为PctGL(VB6.0代码)

Option Explicit

'*************************************************************************
'**模 块 名：cSubClass
'**说 明：通用子类化模块,拦截本进程指定句柄的消息
'**创 建 人：嗷嗷叫的老马
'**日 期：2008年11月13日
'**版 本：V1.0
'**备 注：PctGL版本,代码更精简,执行效率更高.
'** 原帖地址: http://www.cnblogs.com/pctgl/articles/1586841.html
'*************************************************************************

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, Optional ByVal Length As Long = 4)
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 Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function VirtualProtect Lib "kernel32" (lpAddress As Any, ByVal dwSize As Long, ByVal flNewProtect As Long, lpflOldProtect As Long) As Long

Private Type ThisClassSet
s_srcWndProcAddress As Long
s_Hwnd As Long
End Type

Dim PG As ThisClassSet
Dim LinkProc() As Long

Event GetWindowMessage(Result As Long, ByVal cHwnd As Long, ByVal Message As Long, ByVal wParam As Long, ByVal lParam As Long)

Private Sub MsgHook(Result As Long, ByVal cHwnd As Long, ByVal Message As Long, ByVal wParam As Long, ByVal lParam As Long)
'子类化接口过程
RaiseEvent GetWindowMessage(Result, cHwnd, Message, wParam, lParam)
End Sub

Private Function GetWndProcAddress(ByVal SinceCount As Long) As Long
' 地址指针 ＝ GetWndProcAddress( 取第 N 个公共函数（属性） =或= 所有公共函数个数 + 第 N 个私有函数的函数地址）
Dim mePtr As Long
Dim jmpAddress As Long
mePtr = ObjPtr(Me)
CopyMemory jmpAddress, ByVal mePtr, 4
CopyMemory jmpAddress, ByVal jmpAddress + (SinceCount - 1) * 4 + &H1C, 4

ReDim LinkProc(10)
LinkProc(0) = &H83EC8B55
LinkProc(1) = &HFC8B14EC
LinkProc(2) = &H56FC758D
LinkProc(3) = &H3308758D
LinkProc(4) = &HFC04B1C9
LinkProc(5) = &HFF68A5F3
LinkProc(6) = &HB8FFFFFF
LinkProc(7) = &HFFFFFFFF
LinkProc(8) = &H48BD0FF
LinkProc(9) = &H10C2C924

CopyMemory ByVal VarPtr(LinkProc(5)) + 3, mePtr, 4
CopyMemory ByVal VarPtr(LinkProc(7)), jmpAddress, 4
GetWndProcAddress = VarPtr(LinkProc(0))
VirtualProtect ByVal VarPtr(LinkProc(0)), 44, &H40, mePtr
End Function

Function CallDefaultWindowProc(ByVal cHwnd As Long, ByVal Message As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
'调用窗口默认处理过程
CallDefaultWindowProc = CallWindowProc(PG.s_srcWndProcAddress, ByVal cHwnd&, ByVal Message&, ByVal wParam&, ByVal lParam&)
End Function

Function SetMsgHook(ByVal cHwnd As Long) As Long
'设置指定窗口的子类化
PG.s_Hwnd = cHwnd
PG.s_srcWndProcAddress = SetWindowLong(ByVal cHwnd, ByVal -4&, ByVal GetWndProcAddress(4))
SetMsgHook = PG.s_srcWndProcAddress
End Function

Sub SetMsgUnHook()
'取消窗口子类化
SetWindowLong ByVal PG.s_Hwnd&, ByVal -4&, ByVal PG.s_srcWndProcAddress&
End Sub

' 00151BEA 55 PUSH EBP
' 00151BEB 8BEC MOV EBP,ESP
' 00151BED 83EC 10 SUB ESP,14
' 00151BF0 8BFC MOV EDI,ESP
' 00151BF2 8D75 FC LEA ESI,DWORD PTR SS:[EBP-4]
' 00151BF5 56 PUSH ESI
' 00151BF6 8D75 08 LEA ESI,DWORD PTR SS:[EBP+8]
' 00151BF9 33C9 XOR ECX,ECX
' 00151BFB B1 04 MOV CL,4
' 00151BFD FC CLD
' 00151BFE F3:A5 REP MOVS DWORD PTR ES:[EDI],DWORD PTR DS>
' 00151C00 68 00100000 PUSH 1000
' 00151C05 B8 00200000 MOV EAX,2000
' 00151C0A FFD0 CALL EAX
' 00401234 8B0424 MOV EAX,DWORD PTR SS:[ESP]
' 00151C10 C9 LEAVE
' 00151C11 C2 1000 RETN 10