最近在做一些VB6、VBA的项目，被如何获取类模块中的函数指针这个问题所困扰，收集整理后，有2分资料值得收藏，特将关键部分留存，以备后续查找。
参照连接1：http://www.cnblogs.com/pctgl/articles/1352916.html
参照连接2：http://blog.csdn.net/lyserver/article/details/4224676
以下是链接1中的部分内容：
1. 函数地址 ＝ GetClassProcAddress ( 指定为哪个函数 [上面解释]，想获取的函数的参数个数 )
2. 这个函数的实现前提，要求有个局部数组，也就是在类模块的声明部分声明一个数组，由于我这个是在写一个热键类中完成的，所以这个数组名就叫了 TimerCallBack，你可以随便修改为你想要的 100％ 免责开源...
3. 函数返回值是一个 Long 型数据，并不是你指定的函数的真正地址，而是 TimerCallBack 数组的首元素地址， TimerCallBack中是一个小型的用汇编写的函数。
4. 返回值就是你可以进行子类化的函数地址，返回值可直接用于 SetWindowLong x,x,这里
下面这个GetClassProcAddress函数是作者修改后的版本，我调整了一下格式，以便阅读：
Private Function GetClassProcAddress(ByVal SinceCount As Long, ByVal ParamsCount As Long) As Long
Dim mePtr As Long
Dim i As Long
Dim jmpAddress As Long mePtr = ObjPtr(Me)
CopyMemory i, ByVal mePtr, 4
CopyMemory i, ByVal i + (SinceCount - 1) * 4 + &H1C, 4
CopyMemory jmpAddress, ByVal i + 1, 4
jmpAddress = i + jmpAddress + 5 ReDim TimerCallback(33)
TimerCallback(0) = &H55
TimerCallback(1) = &H8B
TimerCallback(2) = &HEC
TimerCallback(3) = &H83
TimerCallback(4) = &HEC
TimerCallback(5) = &H10
TimerCallback(6) = &H8B
TimerCallback(7) = &HFC
TimerCallback(8) = &H8D
TimerCallback(9) = &H75
TimerCallback(10) = &H8
TimerCallback(11) = &H33
TimerCallback(12) = &HC9
TimerCallback(13) = &HB1
TimerCallback(15) = &HFC
TimerCallback(16) = &HF3
TimerCallback(17) = &HA5
TimerCallback(18) = &H68
TimerCallback(23) = &HB8
TimerCallback(28) = &HFF
TimerCallback(29) = &HD0
TimerCallback(30) = &HC9
TimerCallback(33) = &H0 TimerCallback(32) = ParamsCount * 4
TimerCallback(14) = ParamsCount ' mov cl,4(params) >>> for rep movs
CopyMemory TimerCallback(19), mePtr ' objptr(me)
CopyMemory TimerCallback(24), jmpAddress ' call eax If ParamsCount = 0 Then
TimerCallback(31) = &HC3
Else
TimerCallback(31) = &HC2
End If GetClassProcAddress = VarPtr(TimerCallback(0))
End Function
以上代码，其中有一部分是作者参考的，原始函数代码如下
Private Function GetClassProcAddress(ByVal SinceCount As Long) As Long
'***************************************************************************************************
' VB6 历史上最简单的获取类中指定函数地址的函数诞生了,can be get address of property to value ,too
'***************************************************************************************************
Dim i As Long, jmpAddress As Long CopyMemory i, ByVal ObjPtr(Me), 4 ' get vtable
CopyMemory i, ByVal i + (SinceCount - 1) * 4 + &H1C, 4 ' 查表
CopyMemory jmpAddress, ByVal i + 1, 4 ' 获取的函数地址实际还是一个表,是一个跳转表
GetClassProcAddress = i + jmpAddress + 5 ' 计算跳转相对偏移取实际地址
End Function
调用方法:
类模块中指定的函数地址 = GetClassProcAddress( 第几个函数 )
参数 SinceCount：是从某个类模块中最顶端的函数或属性算起,他是第几个函数
1. 当被查找的函数为 公用函数时,它的值就是自顶端算起的第几个函数,比如你在类模块中最顶端写的一个公用函数 WndProc,那么就传 1 如果是第2个公用函数或属性那么就传 2 依次... 注意,计算的时候要算上公用属性,公用属性也要算上,当他是函数,算做一个
2. 当被查找的函数为 局部函数时,也就是说如果是 Private 修饰的函数,则此参数值为 所有公用函数个数 + 这是第 N 个私有函数 也是从顶端算起,同样包括属性
原理:
对象是什么? 对象实际就是一个结构,VB,甚至 C++ 都不一定能让你真正深刻的理解最底层的对象构造,如果说 VB 能让你懂得什么叫继承 则 C++ 能让你知道对象还可以变异....对象原来是那么简单实现了那么高级的技术 再向底层看,用汇编构造对象,你就可以看到,对象原来就是一个结构,结构中包括所有公用函数,属性的地址指针,和连接,销毁函数指针等 那么,在返回到 VB,ObjPtr 可以得到对象的 vTable 指针,通过查询 vTable 就可以得到我们想要的函数指针,前提是我们要知道编译器是 按照什么样的顺序放置属性函数指针的,现在经过查询资料和测试,已经知道了,那就是 基址 + &H1C 所谓的基址其实就是vTable, &H1C就 是VB给结构添加的和必要的函数指针所占用的空间, 从vTable+&H1C 开始存储我们的函数地址,存储顺序如何,可以参照上面对 GetClassProcAddress 的参数 SinceCount 的解释.VB 把所有模块都单独的建立了一个表,每个表中又有单独的表表示他所包含的函数地址. 好了,函数和原理解释已经差不多了,再说说应用 很不幸的我要说,直接应用价值基本 = 0 , 郁闷啊... 为什么呢? 因为... 对象的函数他的第1个参数是vTable指针,第2个(暂时忘了,想起来再补) 于是你构造的函数有4个参数,但编译后该函数将有6个参数,那如果直接交给别人用,比如 APi 那还不出事吗... 会出事,但又不是不能弥补,加上少量的内嵌汇编代码,从新构造一个小函数,就可以完美的运行了,o... 还是很不错的选择 说了很多, 我也累了,就先打住了,总结起来,就是成功的用最简单的代码获取了类模块中指定的函数地址,从这个角度来说此文应该还是一精华文章吧? 等我有时间了,我会将弥补的汇编函数和 GetClassProcAddress 相结合,构造一个最简单化的代码,实现真正的类模块回调函数
以下是链接2中的部分内容：
参考2链接的作者构建了一个类模块，可以直接使用该类模块子类化指定窗体，其窗体新的消息处理过程名是WindowProc
该作者还构建过一个自定义计时器类，其中也用到了这个获取类模块函数指针的函数，链接http://blog.csdn.net/lyserver/article/details/4230045
以下是类模块的代码：
Option Explicit Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length 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 IsWindow Lib "user32" (ByVal hWnd 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 Const GWL_WNDPROC = (-4)
Private Const WM_NCDESTROY = &H82 Public Event WindowProc(ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long, bCallNext As Boolean, lReturn As Long)
Dim m_hwnd As Long, m_NewProc As Long, m_OldProc As Long
Private Sub Class_Initialize()
m_NewProc = GetClassProcAddr(Me, 5, 4, True)
End Sub Private Sub Class_Terminate()
Call Unbind
End Sub Public Function Bind(ByVal hWnd As Long) As Boolean
Call Unbind
If IsWindow(hWnd) Then m_hwnd = hWnd
m_OldProc = SetWindowLong(m_hwnd, GWL_WNDPROC, m_NewProc)
Bind = CBool(m_OldProc)
End Function Public Function Unbind() As Boolean
If m_OldProc <> 0 Then Unbind = CBool(SetWindowLong(m_hwnd, GWL_WNDPROC, m_OldProc))
m_OldProc = 0
End Function Private Function WindowProcCallBack(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim bCallNext As Boolean, lReturn As Long
bCallNext = True
RaiseEvent WindowProc(Msg, wParam, lParam, bCallNext, lReturn)
If bCallNext Then
WindowProcCallBack = CallWindowProc(m_OldProc, hWnd, Msg, wParam, lParam)
Else
WindowProcCallBack = lReturn
End If
If hWnd = m_hwnd And Msg = WM_NCDESTROY Then Call Unbind
End Function Private Function GetClassProcAddr(obj As Object, ByVal Index As Long, _
Optional ByVal ParamCount As Long = 4, Optional ByVal HasReturnValue As Boolean) As Long
Static lReturn As Long, pReturn As Long
Static AsmCode(50) As Byte
Dim i As Long, pThis As Long, pVtbl As Long, pFunc As Long pThis = ObjPtr(obj)
CopyMemory pVtbl, ByVal pThis, 4
CopyMemory pFunc, ByVal pVtbl + (6 + Index) * 4, 4
pReturn = VarPtr(lReturn) For i = 0 To UBound(AsmCode) '填充nop
AsmCode(i) = &H90
Next
AsmCode(0) = &H55 'push ebp
AsmCode(1) = &H8B: AsmCode(2) = &HEC 'mov ebp,esp
AsmCode(3) = &H53 'push ebx
AsmCode(4) = &H56 'push esi
AsmCode(5) = &H57 'push edi
If HasReturnValue Then
AsmCode(6) = &HB8 'mov offset lReturn
CopyMemory AsmCode(7), pReturn, 4
AsmCode(11) = &H50 'push eax
End If
For i = 0 To ParamCount - 1 'push dword ptr[ebp+xx]
AsmCode(12 + i * 3) = &HFF
AsmCode(13 + i * 3) = &H75
AsmCode(14 + i * 3) = (ParamCount - i) * 4 + 4
Next
i = i * 3 + 12
AsmCode(i) = &HB9 'mov ecx,this
CopyMemory AsmCode(i + 1), pThis, 4
AsmCode(i + 5) = &H51 'push ecx
AsmCode(i + 6) = &HE8 'call 相对地址
CopyMemory AsmCode(i + 7), pFunc - VarPtr(AsmCode(i + 6)) - 5, 4
If HasReturnValue Then
AsmCode(i + 11) = &HB8 'mov eax,offset lReturn
CopyMemory AsmCode(i + 12), pReturn, 4
AsmCode(i + 16) = &H8B 'mov eax,dword ptr[eax]
AsmCode(i + 17) = &H0
End If
AsmCode(i + 18) = &H5F 'pop edi
AsmCode(i + 19) = &H5E 'pop esi
AsmCode(i + 20) = &H5B 'pop ebx
AsmCode(i + 21) = &H8B: AsmCode(i + 22) = &HE5 'mov esp,ebp
AsmCode(i + 23) = &H5D 'pop ebp
AsmCode(i + 24) = &HC3 'ret
GetClassProcAddr = VarPtr(AsmCode(0))
End Function