enumhandler.cls

几个不错的VB例子

Dim nEventId As Long, dWord As Long, dwTime As Long
Dim hdc As Long, nInt As Long
Dim Code As Long
Dim lResult As Long
Dim LPCSTR As String, Handle As Long
Dim lpch As String, ichCurrent As Long, cch As Long
Dim lRet As Long, lWndProcRet As Long
Dim bDiscardMsg As Boolean
Dim ftTime As APIFileTime
Dim stTime As APISystemTime
Dim wndThis As ApiWindow
Dim dtTime As Date
Dim lpstrName As String
Dim hModule As Long, lpType As String, lpName As String, wLanguage As Long
Dim bCurrentProc As Boolean
Dim MsgInfo As ApiMSG
Dim kbThis As ApiKBDLLHOOKSTRUCT

Select Case ProcType
Case DLGPROC

    'hwnd = Arguments(1)
    'wMsg = Arguments(2)
    'wParam = Arguments(3)
    'lParam = Arguments(4)
    'RaiseEvent DLGPROCFired(hwnd, wMsg, wParam, lParam, bDiscardMsg, lWndProcRet)
    'If Not bDiscardMsg Then
    '    If m_OldDlgProc = 0 Then
    '        lRet = DefDlgProc(hwnd, wMsg, wParam, lParam)
    '    Else
    '        lRet = CallWindowProc(m_OldDlgProc, hwnd, wMsg, wParam, lParam)
    '    End If
    'End If
    'If lWndProcRet = 0 Then
    '    Arguments(5) = lRet
    'Else
    '    Arguments(5) = lWndProcRet
    'End If

Case EDITWORDBREAKPROC

    lpch = Arguments(1)
    ichCurrent = Arguments(2)
    cch = Arguments(3)
    Code = Arguments(4)
    RaiseEvent EDITWORDBREAKPROCFired(lpch, ichCurrent, cch, Code)

Case GRAYSTRINGPROC

    RaiseEvent GRAYSTRINGPROCfired(hdc, lParam, nInt)
    
Case HOOKPROC

    Code = Arguments(1)
    wParam = Arguments(2)
    lParam = Arguments(3)
    lResult = Arguments(4)
    RaiseEvent HOOKPROCFired(Code, wParam, lParam, lResult)
    '\\ Pass lResult back...
    Arguments(4) = lResult

Case PROPENUMPROC

    hwnd = Arguments(1)
    LPCSTR = Arguments(2)
    Handle = Arguments(3)
    RaiseEvent PROPENUMPROCFired(hwnd, LPCSTR, Handle)
    
Case PROPENUMPROCEX

    hwnd = Arguments(1)
    LPCSTR = Arguments(2)
    Handle = Arguments(3)
    dWord = Arguments(4)
    RaiseEvent PROPENUMPROCEXFired(hwnd, LPCSTR, Handle, dWord)
    
Case SENDASYNCPROC

    RaiseEvent SENDASYNCPROCFired(hwnd, wMsg, dWord, lResult)
    
Case TIMERPROC
    
    hwnd = Arguments(1)
    wMsg = Arguments(2)
    nEventId = Arguments(3)
    dwTime = Arguments(4)
    RaiseEvent TIMERPROCFired(hwnd, wMsg, nEventId, dwTime)
    
Case WNDENUMPROC

    hwnd = Arguments(1)
    lParam = Arguments(2)
    RaiseEvent WNDENUMPROCFired(hwnd, lParam)
    
Case WNDPROC

    hwnd = Arguments(1)
    wMsg = Arguments(2)
    wParam = Arguments(3)
    lParam = Arguments(4)
    
    On Error Resume Next
    Call AllSubclassedWindows.Item(hwnd).TriggerEvent(wMsg, wParam, lParam, bDiscardMsg, lWndProcRet)
    
    If Not bDiscardMsg Then
        If AllSubclassedWindows.Item(hwnd).OldProcAddress > 0 Then
            lRet = CallWindowProc(AllSubclassedWindows.Item(hwnd).OldProcAddress, hwnd, wMsg, wParam, lParam)
        Else
            lRet = DefWindowProc(hwnd, wMsg, wParam, lParam)
        End If
    End If
    If lWndProcRet = 0 Then
        Arguments(5) = lRet
    Else
        Arguments(5) = lWndProcRet
    End If
    
Case WINSTATIONENUMPROC
    lpstrName = Arguments(1)
    lParam = Arguments(2)
    RaiseEvent WINSTATIONENUMPROCFired(lpstrName, lParam)

Case DESKTOPENUMPROC
    lpstrName = Arguments(1)
    lParam = Arguments(2)
    RaiseEvent DESKTOPENUMPROCFired(lpstrName, lParam)

Case ENUMRESTYPEPROC
    hModule = Arguments(1)
    lpType = Arguments(2)
    lParam = Arguments(3)
    RaiseEvent ENUMRESTYPEPROCFired(hModule, lpType, lParam)

Case ENUMRESNAMEPROC
    hModule = Arguments(1)
    lpType = Arguments(2)
    lpName = Arguments(3)
    lParam = Arguments(4)
    RaiseEvent ENUMRESNAMEPROCFired(hModule, lpType, lpName, lParam)
    
Case ENUMRESLANGPROC
    hModule = Arguments(1)
    lpType = Arguments(2)
    lpName = Arguments(3)
    wLanguage = Arguments(4)
    lParam = Arguments(5)
    RaiseEvent ENUMRESLANGPROCFired(hModule, lpType, lpName, wLanguage, lParam)

'\\ DEJ 01/03/2001 - New specific hook procedures
Case HOOKPROC_CALLWNDPROC
    Code = Arguments(1)
    bCurrentProc = Arguments(2)
    lParam = Arguments(3)
    lResult = Arguments(4)
    RaiseEvent HOOKPROCCALLWNDPROC(Code, bCurrentProc, lParam, lResult)
    '\\ Pass lResult back...
    Arguments(4) = lResult
    
Case HOOKPROC_CALLWNDPROCRET
    Code = Arguments(1)
    bCurrentProc = Arguments(2)
    lParam = Arguments(3)
    lResult = Arguments(4)
    RaiseEvent HOOKPROCCALLWNDPROCRET(Code, bCurrentProc, lParam, lResult)
    '\\ Pass lResult back...
    Arguments(4) = lResult

Case HOOKPROC_CBT
    Code = Arguments(1)
    wParam = Arguments(2)
    lParam = Arguments(3)
    lResult = Arguments(4)
    '\\ Create a new window for these to use...
    Set wndThis = New ApiWindow
    
    '\\ Different events raised according to which message this is...
    Select Case True
    Case Code = HCBT_ACTIVATE
        Dim ActivateStruct As ApiCBTACTIVATESTRUCT
        Set ActivateStruct = New ApiCBTACTIVATESTRUCT
        ActivateStruct.CreateFromPointer lParam
        wndThis.hwnd = wParam
        RaiseEvent HOOKPROCCBTACTIVATE(wndThis, ActivateStruct, bDiscardMsg)
        Set ActivateStruct = Nothing
    
    Case Code = HCBT_CREATEWND
        Dim CreateWndStruct As ApiCBT_CREATEWND
        Set CreateWndStruct = New ApiCBT_CREATEWND
        CreateWndStruct.CreateFromPointer lParam
        wndThis.hwnd = wParam
        RaiseEvent HOOKPROCCBTCREATEWND(wndThis, CreateWndStruct, bDiscardMsg)
        Set CreateWndStruct = Nothing
    
    Case Code = HCBT_DESTROYWND
        wndThis.hwnd = wParam
        RaiseEvent HOOKPROCCBTDESTROYWND(wndThis, bDiscardMsg)
        
    Case Code = HCBT_MINMAX
        wndThis.hwnd = wParam
        RaiseEvent HOOKPROCCBTMINMAX(wndThis, APIDispenser.LoWord(lParam), bDiscardMsg)
        
    Case Code = HCBT_MOVESIZE
        Dim SizeRect As APIRect
        Set SizeRect = New APIRect
        SizeRect.CreateFromPointer lParam
        wndThis.hwnd = wParam
        RaiseEvent HOOKPROCCBTMOVESIZE(wndThis, SizeRect, bDiscardMsg)
        '\\ The sizerect can be changed :. save it back..
        SizeRect.SaveToPointer lParam
        Set SizeRect = Nothing
        
    Case Code = HCBT_SETFOCUS
        Dim wndLostFocus As ApiWindow
        Set wndLostFocus = New ApiWindow
        wndThis.hwnd = wParam
        wndLostFocus.hwnd = lParam
        RaiseEvent HOOKPROCCBTSETFOCUS(wndThis, wndLostFocus, bDiscardMsg)
        
    Case Code = HCBT_SYSCOMMAND
        RaiseEvent HOOKPROCCBTSYSCOMMAND(wParam, lParam, bDiscardMsg)
        
    Case Else
        RaiseEvent HOOKPROCCBT(Code, wParam, lParam, lResult)
    End Select
    '\\ Pass lResult back...
    Arguments(4) = lResult + CLng(bDiscardMsg)

Case HOOKPROC_DEBUG
    Code = Arguments(1)
    wParam = Arguments(2)
    lParam = Arguments(3)
    lResult = Arguments(4)
    Dim DebugInfo As ApiLogBrush
    Set DebugInfo = New ApiLogBrush
    DebugInfo.CreateFromPointer lParam
    RaiseEvent HOOKPROCDEBUG(Code, wParam, DebugInfo, lResult)
    '\\ Pass lResult back...
    Arguments(4) = lResult
    
Case HOOKPROC_GETMESSAGE
    Code = Arguments(1)
    wParam = Arguments(2)
    lParam = Arguments(3)
    lResult = Arguments(4)
    Set MsgInfo = New ApiMSG
    MsgInfo.CreateFromPointer lParam
    RaiseEvent HOOKPROCMESSAGE(Code, wParam, MsgInfo, lResult)
    '\\ Pass lResult back...
    Arguments(4) = lResult

Case HOOKPROC_JOURNALPLAYBACK
    Code = Arguments(1)
    wParam = Arguments(2)
    lParam = Arguments(3)
    lResult = Arguments(4)
    RaiseEvent HOOKPROCJOURNALPLAYBACK(Code, wParam, lParam, lResult)
    '\\ Pass lResult back...
    Arguments(4) = lResult

Case HOOKPROC_JOURNALRECORD
    Code = Arguments(1)
    wParam = Arguments(2)
    lParam = Arguments(3)
    lResult = Arguments(4)
    RaiseEvent HOOKPROCJOURNALRECORD(Code, wParam, lParam, lResult)
    '\\ Pass lResult back...
    Arguments(4) = lResult

Case HOOKPROC_MOUSE
    Code = Arguments(1)
    wParam = Arguments(2)
    lParam = Arguments(3)
    lResult = Arguments(4)
    '\\ Conver the pointer into a mouse hook structure object
    Dim MouseHookData As ApiMOUSEHOOKSTRUCT
    Set MouseHookData = New ApiMOUSEHOOKSTRUCT
    MouseHookData.CreateFromPointer lParam
    
    RaiseEvent HOOKPROCMOUSE(Code, wParam, MouseHookData, lResult)
    '\\ Pass lResult back...
    Arguments(4) = lResult

Case HOOKPROC_MOUSE_LL
    Code = Arguments(1)
    wParam = Arguments(2)
    lParam = Arguments(3)
    lResult = Arguments(4)
    '\\ Conver the pointer into a mouse hook structure object
    Dim LLMouseHookData As ApiLLMOUSEHOOKSTRUCT
    Set LLMouseHookData = New ApiLLMOUSEHOOKSTRUCT
    LLMouseHookData.CreateFromPointer lParam
    
    RaiseEvent HOOKPROCMOUSELL(Code, wParam, LLMouseHookData, lResult)
    '\\ Pass lResult back...
    Arguments(4) = lResult

Case HOOKPROC_MESSAGEFILTER
    Code = Arguments(1)
    wParam = Arguments(2)
    lParam = Arguments(3)
    lResult = Arguments(4)
    Set MsgInfo = New ApiMSG
    MsgInfo.CreateFromPointer lParam
    RaiseEvent HOOKPROCMESSAGEFILTER(Code, MsgInfo, lResult)
    Set MsgInfo = Nothing
    '\\ Pass lResult back...
    Arguments(4) = lResult

Case HOOKPROC_SHELL
    Code = Arguments(1)
    wParam = Arguments(2)
    lParam = Arguments(3)
    lResult = Arguments(4)
    Set wndThis = New ApiWindow
    wndThis.hwnd = wParam
    If Code = HSHELL_WINDOWCREATED Then
        RaiseEvent HOOKPROCSHELLCREATEWINDOW(wndThis)
    ElseIf Code = HSHELL_WINDOWDESTROYED Then
        RaiseEvent HOOKPROCSHELLDESTROYWINDOW(wndThis)
    End If
    Set wndThis = Nothing
    '\\ Pass lResult back...
    Arguments(4) = lResult

Case HOOKPROC_SYSMESSAGEFILTER
    Code = Arguments(1)
    wParam = Arguments(2)
    lParam = Arguments(3)
    lResult = Arguments(4)
    Set MsgInfo = New ApiMSG
    MsgInfo.CreateFromPointer lParam
    RaiseEvent HOOKPROCSYSMESSAGE(Code, MsgInfo, lResult)
    Set MsgInfo = Nothing
    '\\ Pass lResult back...
    Arguments(4) = lResult

Case HOOKPROC_KEYBOARD
    Code = Arguments(1)
    wParam = Arguments(2)
    lParam = Arguments(3)
    lResult = Arguments(4)
    Set kbThis = New ApiKBDLLHOOKSTRUCT
    kbThis.CreateFromPointer lParam
    RaiseEvent HOOKPROCKEYBOARD(Code, wParam, kbThis, lResult)
    Set kbThis = Nothing
    '\\ Pass lResult back...
    Arguments(4) = lResult

Case HOOKPROC_KEYBOARD_LL
    Code = Arguments(1)
    wParam = Arguments(2)
    lParam = Arguments(3)
    lResult = Arguments(4)
    Set kbThis = New ApiKBDLLHOOKSTRUCT
    kbThis.CreateFromPointer lParam
    RaiseEvent HOOKPROCKEYBOARDLL(Code, wParam, kbThis, lResult)
    Set kbThis = Nothing
    '\\ Pass lResult back...
    Arguments(4) = lResult
    
Case HOOKPROC_FOREGROUNDIDLE
    Code = Arguments(1)
    '\\ Other argumenst aren't used
    RaiseEvent HOOKPROCFOREGROUNDIDLE(Code)
    Arguments(4) = Code
    
End Select


End Sub

Private Sub Class_Terminate()

Dim lRet As Long

'\\ If ANY hook id is set, it must be closed
Call StopHook(WH_CALLWNDPROC)
Call StopHook(WH_CBT)
Call StopHook(WH_DEBUG)
Call StopHook(WH_FOREGROUNDIDLE)
Call StopHook(WH_GETMESSAGE)
Call StopHook(WH_HARDWARE)
Call StopHook(WH_JOURNALPLAYBACK)
Call StopHook(WH_JOURNALRECORD)
Call StopHook(WH_KEYBOARD_LL)
Call StopHook(WH_MOUSE)
Call StopHook(WH_MOUSE_LL)
Call StopHook(WH_MSGFILTER)
Call StopHook(WH_SHELL)
Call StopHook(WH_SYSMSGFILTER)
Call StopHook(WH_KEYBOARD)


End Sub