http://www.cnblogs.com/pctgl/articles/1586841.html
这是例子: https://files.cnblogs.com/pctgl/iSubClass.rar
上一篇文章发出来之后，没想到很多人都注意到了，而且也用到了
但上次的代码还存有稍许遗憾就是不能进行子类化，这次我改了下，做了一个子类化专用函数GetWndProcAddress 此函数专用于子类化接口的获取
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
CopyMemory ByVal VarPtr(LinkProc(7)), jmpAddress
GetWndProcAddress = VarPtr(LinkProc(0))
End Function
参数 SinceCount 和上次文章介绍的用法相同，取消了参数部分的设置，于是乎接口函数的形式也就被固化了
接口函数：
Private Sub MsgHook(Result As Long, ByVal cHwnd As Long, ByVal Message As Long, ByVal wParam As Long, ByVal lParam As Long)
‘这里可以写你的处理过程，比如 if message ＝ 100 then msgbox “xx” 之后可以决定是否调用 callwindowproc
’ Result 必不可少， Result 参数保存回调函数的返回值。
Result = CallWindowProc(〔getwindowlong的返回值〕, cHwnd, Message, wParam, lParam)
End Sub
说明：
接口函数请务必按照如上形式声明和使用
1. 必须是 Sub 的函数形式，不能为 Function
2. Result 参数必须存在，所有参数传值，传址方式，参数类型，顺序都不允许改变
3.
刚才写了一堆，把问题详细的说了一遍，突然之间 FireFox 崩溃了
我也不写了，谁对这个问题有兴趣，对他的应用，和原理想更进一步了解的请来我Q群讨论吧 18403077
GetWndProcAddress 函数的中转汇编代码：
' 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
----------------------------------------
发一个例子，演示一下
新建 标准 exe 工程， 添加一个 Form1 ， 一个 Class1
Class1: 类模块代码：
Option Explicit
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 Type ThisClassSet
s_srcWndProcAddress As Long
s_Hwnd As Long
‘ Made By PctGL
End Type
Dim PG As ThisClassSet
Dim LinkProc() As Long
Private Const WM_LBUTTONDBLCLK = &H203
Private Sub MsgHook(Result As Long, ByVal cHwnd As Long, ByVal Message As Long, ByVal wParam As Long, ByVal lParam As Long)
If Message = WM_LBUTTONDBLCLK Then
MsgBox "WM_LBUTTONDBLCLK"
End If
Result = CallWindowProc(PG.s_srcWndProcAddress, 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
CopyMemory ByVal VarPtr(LinkProc(7)), jmpAddress
GetWndProcAddress = VarPtr(LinkProc(0))
End Function
Function SetMsgHook(ByVal cHwnd As Long) As Long
If cHwnd <> PG.s_Hwnd Then
PG.s_srcWndProcAddress = SetWindowLong(cHwnd, -4&, GetWndProcAddress(3))
PG.s_Hwnd = cHwnd
SetMsgHook = PG.s_srcWndProcAddress
End If
End Function
Sub SetMsgUnHook(Optional WndProcAddress As Long)
Dim i As Long
i = WndProcAddress
If WndProcAddress = 0 Then i = PG.s_srcWndProcAddress
SetWindowLong PG.s_Hwnd, -4&, i
End Sub
Form1:
Option Explicit
Dim m As New Class1
Private Sub Form_Load()
'设置子类化
m.SetMsgHook hWnd
End Sub
Private Sub Form_Unload(Cancel As Integer)
'取消子类化
m.SetMsgUnHook
End Sub
直接运行就可以了， 双击窗口客户区，可以看到测试的 MsgBox 提示
更多功能大家可以进一步开发，比如加个事件，将消息转发给窗口，就可以在窗口代码里面直接处理了
无论 GetWndProcAddress 或是 GetClassProcAddress 都只适用于类模块。
标准模块，窗口，控件都不能直接用的。
