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,16 ‘4个参数的类中函数。 16 ＝ 4个参数 × 单个参数字节数4，你可以自定义
' 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:[esi]
' 00151C00 68 00100000 PUSH 1000 '1000： 这是类的 Interface，接口指针，objptr(me)
' 00151C05 B8 00200000 MOV EAX,2000 ‘2000： 这是准备调用的类中的函数地址
' 00151C0A FFD0 CALL EAX
' 00401234 8B0424 MOV EAX,DWORD PTR SS:[ESP]
' 00151C10 C9 LEAVE
' 00151C11 C2 1000 RETN 16 ’这里同样要修改，这个16和上面的 16 是一个意思，要同时修改
插入>
注意， 这是本贴完成后增加的说明内容：
N 多人看完我的这个获取类中函数地址的文章之后都去测试可行性，想得到地址后自己做屑什么，我不反对你的做法。
但我要强调一句，首先上面的代码中的 GetWndProcAddress 返回值只是数组 LinkProc 元素 0 的地址
真正的你指定的函数地址，早已经被以下3行代码解析出来了:
mePtr = ObjPtr(Me)
CopyMemory jmpAddress, ByVal mePtr, 4
CopyMemory jmpAddress, ByVal jmpAddress + (SinceCount - 1) * 4 + &H1C, 4
但为什么还要加上下面那些数组赋值的代码，这个问题不是一句两句能说清楚的，简单说来类中的 函数 并非普通的函数一样，可以由任意
位置调用。所以要加上那些对 LinkProc 的操作，实际上就是构造了一个 普通函数 -> 类中函数 调用的小函数，
由于没过于细致的写， LinkProc 被写成了固定参数个数，无返回值的链接函数，如果你希望做到随意使用，可以
考虑修改上面代码中的 LinkProc 函数具体内容。有关 LinkProc 构造的小函数具体内容，可参看上面代码中被注释的汇编代码
上面的汇编代码未考虑返回值情况，函数返回值需要多加一个参数，没有做，有兴趣者可自行添加相关代码。
另外，我今天再补充一个 VB 的APi，
Private Declare Function GetIDsOfNames Lib "msvbvm60.dll" Alias "BASIC_CLASS_GetIDsOfNames" (ByVal ThisInterface As Long, Optional ByVal RIID As Long = &H733AAE58, Optional ByVal VarptrStringMethodNames As Long, Optional ByVal CountNames As Long = 1, Optional ByVal LCID As Long = &H409&, Optional ResultDispID As Integer) As Long
这个函数的功能是，根据指定的函数名，获取指定的类中的函数地址
只能获取接口函数的地址，属性，私有函数都无法获取。
属性其实也可以获取，只不过你必须得到属性接口类的真正指针，这需要很麻烦的通过继承MS的标准基类接口，并通过 Iunknow 接口获取基类地址，再查询
麻烦透顶，所以只考虑公共方法了。再者这个函数获取的并不是函数地址，而是一个 代表指定函数的 DispID，然后再次通过计算才能得到真正的函数地址。
使用方法见下面的例子。
实在是没办法。。。
有人拿着 GetWndProcAddress 测试，发现返回值一样，说我的根本获取不了函数地址。。。。无奈
GetIDsOfNames的用法，看参数基本你就知道了
GetIDsOfNames (objptr(me),,varptr("函数名"),,,NDid
例子：
Dim cName As String
Dim mePtr As Long
Dim jmpAddress As Long
mePtr = ObjPtr(Me) ’这是在类内部调用，在类外部获取某个类的函数地址时，用 objptr（对象） 的方式
cName = "dddddd" '类中的某函数名，必须是公共函数，属性都不行了且必须是公共的函数，私有不行
If (GetIDsOfNames(mePtr, &H733AAE58, ByVal VarPtr(cName), 1, &H409&, IDs)) = 0 Then
CopyMemory jmpAddress, ByVal mePtr, 4
CopyMemory jmpAddress, ByVal jmpAddress + IDs * 4 + &H1C, 4
MsgBox Hex(jmpAddress) & "这是真正的类函数地址，直接调用可是不对的，除非你真正理解调用方法"
End If
再简单的多说两句, 为什么不能获取类中的私有函数和属性方法了?
首先来说 GetIDsOfNames 是 Dispinterface 的标准方法之一, 在几乎每一个重型对象中存在,vb的窗口对象,类,控件都是重量级对象
他们都存在 dispinterface 接口, 通常我们从 iunknow 得到disp接口仅仅是基类接口,他仅仅能查询到 公共方法,属性在另外的disp接口
中,和事件一样,他们也有单独的封装. 所以不能通过查询基类接口的方法得到属性的地址,需要另外的接口,取得属性接口实例再查询.
由于取属性地址的应用很少,加之实现起来也很麻烦,背离了这个简单的小函数的初衷,也就不继续了.
私有函数地址的问题是这样的: 就象标准模块中的函数,他们在编译后直接以函数地址的方式存在,他们的函数名并不储存在 TypeInfo 中
所以,很清楚了,你无法通过 GetIDsOfNames 查询到私有函数的地址.
GetClassProcAddress 的好处在哪这下就很清楚了, 能够最简单,最直接的得到类中的各个属性,函数,包括私有的,公有的函数地址.
属性本身也是个函数.
具体 GetClassProcAddress 的使用方法见上文, 有关类函数真实地址的问题,在段落开头有详述.
<插入
这是已经过整理且运用的子类化代码。
优点：整合子类化到一个类模块中， 不在需要标准模块的参与， 具有高度的封装性
通过事件的方式，将截取到的消息发到引用实例类的代码区。
调用方法：
form1：
dim withevents iSubClass as SubClass'（ 将上面的代码保存到 subclass 类中）
sub form_load()
set iSubClass = new sub Class
isubclass.setmsghook me.hwnd
end sub
sub form_unload()
isubclass.setmsgunhook
set isubclass = nothing
end sub
sub isubclass_GetWindowMessage(Result as long ,byval chwnd as long ,byval message as long ,byval wparam as long ,byval lparam as long )
...（你自己的消息处理过程）
result = isubclass.calldeaultwindowproc(chwnd,message,wparam,lparam) '调用默认处理
'result 做为消息处理过程的返回值存储器，必须填充（callback规定）
end sub
控件和窗口，以后我们完全可以不在通过模块来实现子类化了
在控件和窗口中按照上述方法引用这个类，然后启动子类化，操作方法完全如上。
还在用标准模块实现子类化吗，你太out了
