Option Explicit
'================================================
' Thunk 实现子类化之第一版。扩展应用请使用第二版
' 作者：阿国哥 (hackor)
' 网站：http://www.aguoge.com/
'       hackor@yeah.net
' 注意：转载请保留此声明
'================================================

'第一版 汇编实现源码
'C74424 04 01000000    mov dword ptr ss:[esp+4],1       ;替换 hWnd 参数为 实例指针
'90                    nop
'90                    nop
'90                    nop
'B8 01000000           mov eax,1
'FFE0                  jmp eax                          ;跳到自定义的窗口函数
'90                    nop
'90                    nop

Private Const GWL_WNDPROC = (-4)
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 IsWindow Lib "user32" (ByVal hwnd As Long) As Long

'Thunk 代码及数据类型
Public Type SubclassThunk
    AsmMov1     As Long   '&H042444C7        C7 44 24 04
    pThis       As Long   'ObjPtr(对象)
    AsmMov2     As Long   '&HB8909090        90 90 90 B8
    pWndProc    As Long   'pWndProc
    AsmJmp      As Long   '&H9090E0FF        FF E0 90 90
    '-----------------
    hwnd        As Long
    WndProcNext As Long
End Type
'相应的汇编实现源码,nop 指令仅仅是对齐数据,另外注意字节顺序;
'--------------------------------------------------------------------------------
'机器码                汇编指令                          注释
'--------------------------------------------------------------------------------
'C74424 04 01000000    mov dword ptr ss:[esp+4],pThis   ;替换 hWnd 参数为 实例指针
'90                    nop                              ;
'90                    nop
'90                    nop
'B8 01000000           mov eax,pWndProc
'FFE0                  jmp eax                          ;跳到自定义的窗口函数
'90                    nop
'90                    nop

'-----------------------------
' 创建子类化
'-----------------------------
Public Function CreateSubclass(Thunk As SubclassThunk, ByVal hwnd As Long, _
                            ByVal pThis As Long, ByVal pWndProc As Long) As Long
    Dim pThunk As Long

    Debug.Assert IsWindow(hwnd)

    pThunk = VarPtr(Thunk)
    With Thunk
        .AsmMov1 = &H42444C7
        .pThis = pThis
        .AsmMov2 = &HB8909090
        .pWndProc = pWndProc
        .AsmJmp = &H9090E0FF
        '-------------------
        .hwnd = hwnd
        .WndProcNext = SetWindowLong(hwnd, GWL_WNDPROC, pThunk)
        CreateSubclass = .WndProcNext
    End With
End Function

'----------------------------
' 卸载子类化
'----------------------------
Public Sub DestroySubclass(Thunk As SubclassThunk)
    Debug.Assert Thunk.WndProcNext
    Call SetWindowLong(Thunk.hwnd, GWL_WNDPROC, Thunk.WndProcNext)
    Thunk.WndProcNext = 0
End Sub

'-------------------------------------------
' 窗口转发函数,实际应用中，应修改第一个参数
'-------------------------------------------
Public Function gWndProc(ByVal frmTest As Form1, ByVal uMsg As Long, _
                        ByVal wParam As Long, ByVal lParam As Long) As Long
    gWndProc = frmTest.WndProc(uMsg, wParam, lParam)
End Function

'在表单中 Option Explicit
Private Const WM_MBUTTONUP = &H208
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
Dim mWndProcThunkEx1 As SubclassThunkEx
Dim mWndProcThunkEx2 As SubclassThunkEx
Dim mWndProcThunkEx3 As SubclassThunkEx

Private mWndProcThunk As SubclassThunk

Private Sub Form_Load()
    Call CreateSubclass(mWndProcThunk, Me.hwnd, ObjPtr(Me), AddressOf gWndProc)
End Sub

Friend Function WndProc(ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    If uMsg = WM_MBUTTONUP Then Debug.Print "WM_MBUTTONUP"
    WndProc = CallWindowProc(mWndProcThunk.WndProcNext, mWndProcThunk.hwnd, uMsg, wParam, lParam)
End Function

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    DestroySubclass mWndProcThunk
End Sub

[培训]内核驱动高级班，冲击BAT一流互联网大厂工作，每周日13:00-18:00直播授课