apicallbackprocs.bas

几个不错的VB例子

End Function

'\\ --[VB_ENUMRESTYPEPROC]----------------------------------------------
'\\ Enumerates the resource types in a module
'\\ Decl:
'\\ BOOL (CALLBACK* ENUMRESTYPEPROC)(HMODULE hModule, LPTSTR lpType, LONG lParam);
'\\ ----------------------------------------------------------------------------------------
'\\ (c) 2001 - Merrion Computing.  All rights  to use, reproduce or publish this code reserved
'\\ Please check http://www.merrioncomputing.com for updates.
'\\ ----------------------------------------------------------------------------------------
Public Function VB_ENUMRESTYPEPROC(ByVal hModule As Long, ByVal lpType As Long, ByVal lParam As Long) As Long

Dim Params() As Variant

ReDim Params(1 To 3) As Variant
Params(1) = hModule
Params(2) = lpType
Params(3) = lParam

If Not Eventhandler Is Nothing Then
    Eventhandler.TriggerEvent ENUMRESTYPEPROC, Params()
End If

End Function

'\\ ----------------------------------------------------------------------------------------
'\\ (c) 2001 - Merrion Computing.  All rights  to use, reproduce or publish this code reserved
'\\ Please check http://www.merrioncomputing.com for updates.
'\\ ----------------------------------------------------------------------------------------
Public Function VB_EnumWinstations(ByVal lpstrName As String, ByVal lParam As Long) As Long

Dim Params() As Variant

ReDim Params(1 To 2) As Variant
Params(1) = lpstrName
Params(2) = lParam

If Not Eventhandler Is Nothing Then
    Eventhandler.TriggerEvent WINSTATIONENUMPROC, Params()
End If

VB_EnumWinstations = 1

End Function

'\\ -[VB_TimerProc]------------------------------------------------------
'\\ 'typedef VOID (CALLBACK* TIMERPROC)(HWND, UINT, UINT, DWORD);
'\\ parameters:
'\\ hWnd - The window handle to which the timer is attached...
'\\ ----------------------------------------------------------------------------------------
'\\ (c) 2001 - Merrion Computing.  All rights  to use, reproduce or publish this code reserved
'\\ Please check http://www.merrioncomputing.com for updates.
'\\ ----------------------------------------------------------------------------------------
Public Sub VB_TIMERPROC(ByVal hwnd As Long, _
                        ByVal uint1 As Long, _
                        ByVal nEventId As Long, _
                        ByVal dwParam As Long)

On Error Resume Next

Dim Params() As Variant

ReDim Params(1 To 4) As Variant
Params(1) = hwnd
Params(2) = uint1
Params(3) = nEventId
Params(4) = dwParam
If Not Eventhandler Is Nothing Then
    Eventhandler.TriggerEvent TIMERPROC, Params()
End If

End Sub

'\\ --[VB_WindowProc]-------------------------------------------------------------------
'\\ 'typedef LRESULT (CALLBACK* WNDPROC)(HWND, UINT, WPARAM, LPARAM);
'\\ Parameters:
'\\   hwnd - window handle receiving message
'\\   wMsg - The window message (WM_..etc.)
'\\   wParam - First message parameter
'\\   lParam - Second message parameter
'\\ Note:
'\\    When subclassing a window proc using this, set the eventhandler's
'\\    hOldWndProc property to the window's previous window proc address.
'\\ ----------------------------------------------------------------------------------------
'\\ (c) 2001 - Merrion Computing.  All rights  to use, reproduce or publish this code reserved
'\\ Please check http://www.merrioncomputing.com for updates.
'\\ ----------------------------------------------------------------------------------------
Public Function VB_WindowProc(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

On Local Error Resume Next
Dim lret As Long
Dim Params() As Variant
ReDim Params(1 To 5) As Variant

Params(1) = hwnd
Params(2) = wMsg
Params(3) = wParam
Params(4) = lParam
Params(5) = lret
If Not Eventhandler Is Nothing Then
    Eventhandler.TriggerEvent WNDPROC, Params()
End If
lret = Params(5)

VB_WindowProc = lret

End Function

'\\ [VB_WndEnumProc]---------------------------------------------------------------------------
'\\ 'typedef BOOL (CALLBACK* WNDENUMPROC)(HWND, LPARAM);
'\\ Used in EnumWindows and EnumChildWindows
'\\ hwnd - Window handle of the enumerated window,
'\\ lparam - passed into the enumwindows proc by programmer...
'\\ ----------------------------------------------------------------------------------------
'\\ (c) 2001 - Merrion Computing.  All rights  to use, reproduce or publish this code reserved
'\\ Please check http://www.merrioncomputing.com for updates.
'\\ ----------------------------------------------------------------------------------------
Public Function VB_WndEnumProc(ByVal hwnd As Long, ByVal lParam As Long) As Long

Dim Params() As Variant

'\\ 1 - Pack the param array.....
ReDim Params(1 To 2) As Variant
Params(1) = hwnd
Params(2) = lParam

'\\ 2 - Call the event firer....
If Not Eventhandler Is Nothing Then
    Eventhandler.TriggerEvent WNDENUMPROC, Params()
End If

VB_WndEnumProc = 1

End Function

Private Function TopLevelWndEnumProc(ByVal hwnd As Long, ByVal lParam As Long) As Long


Dim window As ApiWindow

If IsWindowApi(hwnd) Then
    '\\ If its already subclassed, return that instance...
    On Error Resume Next
    Set window = AllSubclassedWindows.Item(hwnd)
    On Error GoTo 0
    If window Is Nothing Then
        Set window = New ApiWindow
        window.hwnd = hwnd
    End If
    AllTopLevelWindows.Add window, "hwnd:" & window.hwnd
    TopLevelWndEnumProc = True
Else
    '\\ A bad hwnd has been returned - do not continue
    TopLevelWndEnumProc = False
End If


End Function

'\\ [VB_HOOKCALLWNDPROC]----------------------------------------------------------------------------------
'\\ typedef LRESULT (CALLBACK* HOOKPROC)(int code, WPARAM wParam, LPARAM lParam);
'\\ code - type of hook,
'\\ Wparam, Lparam - message specific
'\\ lMsgRet = The message to pass to the calling code
'\\ NOTE:
'\\  This code has been kept for backwards compatibility only.
'\\  You should use the specific CBTHookProc, ShellHookProc etc...
'\\ ----------------------------------------------------------------------------------------
'\\ (c) 2001 - Merrion Computing.  All rights  to use, reproduce or publish this code reserved
'\\ Please check http://www.merrioncomputing.com for updates.
'\\ ----------------------------------------------------------------------------------------
Public Function VB_HOOKCALLWNDPROC(ByVal Code As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

On Local Error Resume Next

Dim Params() As Variant
Dim lret As Long
Dim lMsgRet As Long

'\\ Note: If the code passed in is less than zero, it must be passed direct to the next hook proc
If Code < 0 Then
    VB_HOOKCALLWNDPROC = CallNextHookEx(Eventhandler.HookIdByType(WH_CALLWNDPROC), Code, wParam, lParam)
End If

'\\ 1 - Pack the param array.....
ReDim Params(1 To 4) As Variant
Params(1) = Code
Params(2) = wParam
Params(3) = lParam
Params(4) = lMsgRet

'\\ 2 - Call the event firer....
If Not Eventhandler Is Nothing Then
    Eventhandler.TriggerEvent HOOKPROC_CALLWNDPROC, Params()
    lMsgRet = Params(4)
End If


'\\ 3 - Pass this message on to the next hook proc in the chain (if any)
lret = CallNextHookEx(Eventhandler.HookIdByType(WH_CALLWNDPROC), Code, wParam, lParam)
If Err.LastDllError > 0 Then
    Call ReportError(Err.LastDllError, "VB_HOOKCALLWNDPROC ", GetLastSystemError)
End If

'\\ If the message isn't cancelled, return the next hook's message...
If Not (lMsgRet) Then
    '\\ Return value to calling code....
    VB_HOOKCALLWNDPROC = lret
End If

End Function

'\\ [VB_HOOKCBTPROC]----------------------------------------------------------------------------------------------
'\\ typedef LRESULT (CALLBACK* HOOKPROC)(int code, WPARAM wParam, LPARAM lParam);
'\\ code - type of hook,
'\\ Wparam, Lparam - message specific
'\\ lMsgRet = The message to pass to the calling code
'\\ ----------------------------------------------------------------------------------------------------------------------------------
'\\ (c) 2001 - Merrion Computing.  All rights  to use, reproduce or publish this code reserved
'\\ Please check http://www.merrioncomputing.com for updates.
'\\ ----------------------------------------------------------------------------------------------------------------------------------
Public Function VB_HOOKCBTPROC(ByVal Code As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

On Local Error Resume Next

Dim Params() As Variant
Dim lret As Long
Dim lMsgRet As Long

'\\ Note: If the code passed in is less than zero, it must be passed direct to the next hook proc
If Code < 0 Then
    VB_HOOKCBTPROC = CallNextHookEx(Eventhandler.HookIdByType(WH_CBT), Code, wParam, lParam)
End If

'\\ 1 - Pack the param array.....
ReDim Params(1 To 4) As Variant
Params(1) = Code
Params(2) = wParam
Params(3) = lParam
Params(4) = lMsgRet

'\\ 2 - Call the event firer....
If Not Eventhandler Is Nothing Then
    Eventhandler.TriggerEvent HOOKPROC_CBT, Params()
    lMsgRet = Params(4)
End If


'\\ 3 - Pass this message on to the next hook proc in the chain (if any)
lret = CallNextHookEx(Eventhandler.HookIdByType(WH_CBT), Code, wParam, lParam)
If Err.LastDllError > 0 Then
    Call ReportError(Err.LastDllError, "VB_HOOKCBTPROC ", GetLastSystemError)
End If

'\\ If the message isn't cancelled, return the next hook's message...
If Not (lMsgRet) Then
    '\\ Return value to calling code....
    VB_HOOKCBTPROC = lret
End If

End Function

'\\ [VB_HOOKDEBUGPROC]----------------------------------------------------------------------------------------------
'\\ typedef LRESULT (CALLBACK* HOOKPROC)(int code, WPARAM wParam, LPARAM lParam);
'\\ code - type of hook,
'\\ Wparam, Lparam - message specific
'\\ lMsgRet = The message to pass to the calling code
'\\ ----------------------------------------------------------------------------------------------------------------------------------
'\\ (c) 2001 - Merrion Computing.  All rights  to use, reproduce or publish this code reserved
'\\ Please check http://www.merrioncomputing.com for updates.
'\\ ----------------------------------------------------------------------------------------------------------------------------------
Public Function VB_HOOKDEBUGPROC(ByVal Code As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

On Local Error Resume Next

Dim Params() As Variant
Dim lret As Long
Dim lMsgRet As Long

'\\ Note: If the code passed in is less than zero, it must be passed direct to the next hook proc
If Code < 0 Then
    VB_HOOKDEBUGPROC = CallNextHookEx(Eventhandler.HookIdByType(WH_DEBUG), Code, wParam, lParam)
End If

'\\ 1 - Pack the param array.....
ReDim Params(1 To 4) As Variant
Params(1) = Code
Params(2) = wParam
Params(3) = lParam
Params(4) = lMsgRet

'\\ 2 - Call the event firer....
If Not Eventhandler Is Nothing Then
    Eventhandler.TriggerEvent HOOKPROC_DEBUG, Params()
    lMsgRet = Params(4)
End If


'\\ 3 - Pass this message on to the next hook proc in the chain (if any)
lret = CallNextHookEx(Eventhandler.HookIdByType(WH_DEBUG), Code, wParam, lParam)
If Err.LastDllError > 0 Then
    Call ReportError(Err.LastDllError, "VB_HOOKDEBUGPROC ", GetLastSystemError)
End If

'\\ If the message isn't cancelled, return the next hook's message...
If Not (lMsgRet) Then
    '\\ Return value to calling code....
    VB_HOOKDEBUGPROC = lret
End If

End Function

'\\ [VB_HOOKFOREGROUNDIDLEPROC]----------------------------------------------------------------------------------------------
'\\ typedef LRESULT (CALLBACK* HOOKPROC)(int code, WPARAM wParam, LPARAM lParam);
'\\ code - type of hook,
'\\ Wparam, Lparam - message specific
'\\ lMsgRet = The message to pass to the calling code
'\\ ----------------------------------------------------------------------------------------------------------------------------------
'\\ (c) 2001 - Merrion Computing.  All rights  to use, reproduce or publish this code reserved
'\\ Please check http://www.merrioncomputing.com for updates.
'\\ ----------------------------------------------------------------------------------------------------------------------------------
Public Function VB_HOOKFOREGROUNDIDLEPROC(ByVal Code As Long, ByVal wParam As Long, ByVal lParam As Long) As Long