获取VB类模块成员函数指针(转)

最近在做一些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