好久没有更新博客了，先放上一个获得类成员函数指针的代码，具体解释我会在《深入了解VB变量与指针》系列文章加以说明。可能以后不会再往VB上使劲了，但我会花一段时间总结经验与大家共享。

Option Explicit '* **************************************************** * '* <a href="/tag/hanshu/" target="_blank" class="keywords">函数</a><a href="/tag/mingcheng/" target="_blank" class="keywords">名称</a>：GetClassProcAddr '* <a href="/tag/hanshu/" target="_blank" class="keywords">函数</a><a href="/tag/gongneng/" target="_blank" class="keywords">功能</a>：获得类成员<a href="/tag/hanshu/" target="_blank" class="keywords">函数</a>指针 '* 作者：lyserver '* 联系方式：http://blog.csdn.net/lyserver '* **************************************************** * Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any,Source As Any,ByVal Length As Long) 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),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

参数说明：

obj：类实例变量，如果在类模块内部，则为me。

Index：函数位置，在类模块中，自动先排序所有Public类型的函数，然后再排序Private类型的函数。

ParamCount：函数的参数个数。

HasReturnValue：是否有返回值。

调用实例，一个通用的窗口HOOK类：

Option Explicit Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination 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 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,m_OldProc)) m_OldProc = 0 End Function Private Function WindowProcCallBack(ByVal hWnd 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,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,ebp AsmCode(i + 23) = &H5D 'pop ebp AsmCode(i + 24) = &HC3 'ret GetClassProcAddr = VarPtr(AsmCode(0)) End Function