word的本地钩子陷入无限循环？

河之渡

参考网上代码做了一个word的本地钩子，但是却陷入了无限循环？该怎么样解决这个问题？

河之渡

‘下面是个简单的例子。
'**********************************************************************************************************

  Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long


'//取得类名
Private Declare Function GetClassName _
    Lib "user32" _
    Alias "GetClassNameA" ( _
        ByVal hwnd As Long, _
        ByVal lpClassName As String, _
        ByVal nMaxCount As Long) _
As Long
'//设置钩子函数
Public Declare Function SetWindowsHookEx _
    Lib "user32" _
    Alias "SetWindowsHookExA" ( _
        ByVal idHook As Long, _
        ByVal lpfn As Long, _
        ByVal hmod As Long, _
        ByVal dwThreadId As Long) _
As Long
'//结束钩子
Public Declare Function UnhookWindowsHookEx _
    Lib "user32" ( _
        ByVal hHook As Long) _
As Long
'//下一个钩子
Public Declare Function CallNextHookEx _
    Lib "user32" ( _
        ByVal hHook As Long, _
        ByVal nCode As Long, _
        ByVal wParam As Long, _
        lparam As Any) _
As Long
'//取得当前线程的ID
Public Declare Function GetCurrentThreadId _
    Lib "kernel32" () _
As Long
Public Const HCBT_SETFOCUS = 9
Public Const WH_CBT = 5
Public IHook As Long
Public IThreadId As Long
Public ClassName As String
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long

Dim cesII%
'-------设置钩子-----------
Public Sub EnableHook()
Dim Hw As Long
Dim fileName$
   
    Hw = FindWindow(vbNullString, fileName & " - Microsoft Word")
   
    Hw = FindWindow("OpusApp", vbNullString) 'word句柄
  '  Hw = FindWindowEx(Hw, 0, "_WwF", vbNullString) '类wwf句柄,从属word
  '  Hw = FindWindowEx(Hw, 0, "_WwB", vbNullString) '类wwb句柄,从属wwf
'  Hw = FindWindowEx(Hw, 0, "_WwG", vbNullString) '类wwg句柄，从属wwb,即编辑框句柄
    Thread = GetWindowThreadProcessId(Hw, pID)
  'Hw = FindWindow("OpusApp", vbNullString)
   Hw = GetWindowLong(Hw, GWL_HINSTANCE)
    If IHook = 0 Then
        IThreadId = GetCurrentThreadId
        IHook = SetWindowsHookEx(WH_CBT, AddressOf HookProc, 0, IThreadId)
    End If
End Sub
'-------取消钩子-----------
Public Sub FreeHook()
    If IHook <> 0 Then
        Call UnhookWindowsHookEx(IHook)
        IHook = 0
    End If
End Sub
'---------回调----------------
Public Function HookProc(ByVal nCode As Long, ByVal wParam As Long, ByVal lparam As Long) As Long
    If nCode < 0 Then
        HookProc = CallNextHookEx(IHook, nCode, wParam, lparam)
        Exit Function
    End If
    cesII = cesII + 1
    Debug.Print cesII
    If cesII Mod 10 = 0 Then
    '限入无限循环中，让它循环到100次后停下来观察
        Stop
      '  Call UnhookWindowsHookEx(IHook)
    End If
   ' Call UnhookWindowsHookEx(IHook)
    If wParam = 13 Then
        Stop
    End If
    HookProc = CallNextHookEx(IHook, nCode, wParam, lparam)
End Function

chuhaiou

用Exit DO防止无限循环

河之渡

里面没有Do循环，能用exit do吗？

河之渡

看到一个解释这种问题帖子，是说队列有消息没取出而引发的死循环。所以我试着用peektmessage取出消息，然后用postmessage发出消息，果然不再死循环了。