dbgwproc.cls

来自「VB圣经」· CLS 代码 · 共 56 行

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "WindowProcHook"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit
Private m_DebugProc As Long
Private m_MainProc As Long
Private m_Thunk As PushParamThunk

Public Property Get ProcAddress() As Long
    ProcAddress = m_Thunk.pfn
End Property

Public Sub SetMainProc(Addr As Long)
    m_MainProc = Addr
End Sub

Public Sub SetDebugProc(Addr As Long)
    m_DebugProc = Addr
End Sub

Public Property Get MainProc() As Long
    MainProc = m_MainProc
End Property

Public Property Get DebugProc() As Long
    DebugProc = m_DebugProc
End Property

Friend Function WindowProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim lAddr As Long

    'Default to run normally
    lAddr = m_MainProc
    
    'Test if we're in break mode, use the alternate procedure if we are.
    If UseDebugProc Then lAddr = m_DebugProc
    If lAddr Then
        'Otherwise, just return 0
        WindowProc = CallWindowProc(lAddr, hWnd, uMsg, wParam, lParam)
    End If
End Function

Private Sub Class_Initialize()
    InitPushParamThunk m_Thunk, ObjPtr(Me), AddressOf RedirectWindowProc
End Sub