modhook.bas

VB下开发Windows XP风格的控件

Attribute VB_Name = "modHookNoFocus"
Option Explicit
'-----------------------------------------------
' modHook.bas 由站长亲自编写的一个最简单的Hook程
' 序，只需要在WinProc过程中的Select Case语句中加
' 入需要拦截的Windows消息，以及你需要完成操作的代
' 码，就可以实现你的Hook程序。
'
' 由任何疑问请Email:    [e-mail]
'-----------------------------------------------
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 Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

Private Const GWL_WNDPROC As Long = (-4)
Private Const WM_SETFOCUS As Long = &H7

Private OldProc As Long
Private mhWnd As Long

'==================================================
'回调
Private Function WinProc(ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

    Select Case wMsg
      Case WM_SETFOCUS
        Exit Function '>---> Bottom
    End Select

    WinProc = CallWindowProc(OldProc, hWnd, wMsg, wParam, lParam)

End Function

'==================================================

'==================================================
'挂钩
Public Sub HookNoFocus(ByVal nhWnd As Long)

    If OldProc <> 0 Then
        Exit Sub '>---> Bottom
    End If

    mhWnd = nhWnd

    OldProc = SetWindowLong(nhWnd, GWL_WNDPROC, AddressOf WinProc)

End Sub

'==================================================

'==================================================
'脱钩
Public Sub UnHookNoFocus()

    If OldProc = 0 Then
        Exit Sub '>---> Bottom
    End If

    SetWindowLong mhWnd, GWL_WNDPROC, OldProc
    OldProc = 0

End Sub

'==================================================

':) Ulli's VB Code Formatter V2.10.8 (2003-01-01 13:56:37) 17 + 48 = 65 Lines