UnhookWinEvent не отцепляется в VBA

У меня есть книга Excel, связанная с Access. Чтобы помочь пользователю, Windows Event Hook настроен на возврат к книге Excel, когда фокус установлен на Access, когда книга Excel открыта.

Используемая техника соответствует описанному здесь решению Stack Exchange.

Для некоторых установок

"Неожиданная ошибка (16777035)"

происходит. После дальнейших исследований я также определил, что функция Windows User32 UnhookWinEvent не может отцепить событие. Я не уверен, что ошибка и ошибка отцепки связаны, но отцепку следует все равно очистить.

Чтобы продемонстрировать это, я создал минимальный файл.accdb с одной формой и одним модулем. Форма имеет кнопку, которая создает обработчик события, а затем отцепляет его. Модуль имеет функцию обратного вызова SetWinEventHook для перехваченных событий. Разнообразная информация отображается в окне VBA Immediate.

Код для формы:

'Form frmEventHookTest

Option Compare Database
Option Explicit

Private Const strcModuleName = "basEventHook"
Private Const strcErrMsgTitle = strcModuleName & " Module Error"
Private Const strcMsgTitle = strcModuleName & " Module"

Private Const WINEVENT_OUTOFCONTEXT = 0

Private Declare Function SetWinEventHook Lib "user32.dll" (ByVal eventMin As Long _
      , ByVal eventMax As Long _
      , ByVal hmodWinEventProc As Long, ByVal pfnWinEventProc As Long, ByVal idProcess As Long _
      , ByVal idThread As Long, ByVal dwFlags As Long) As Long
Private Declare Function UnhookWinEvent Lib "user32.dll" ( _
      ByRef hWinEventHook As Long) As Long
Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long

Private colRunningHandles As Collection
Public gblnEventHookGotFocus As Boolean

Private Sub cmdEventHook_Click()
   Const strcThisFunction = "cmdEventHook_Click"
   Dim lngThreadId As Long
   Dim lngEventHookId As Long
   Dim lngUnhookResult As Long
On Error GoTo Err_cmdEventHook_Click

   lngEventHookId = 0
   lngUnhookResult = 0
   lngThreadId = GetCurrentThreadId
   Debug.Print strcThisFunction + " hwnd: " + CStr(Application.hWndAccessApp) _
         + " Thread: " + CStr(lngThreadId)
   lngEventHookId = SetWinEventHook(EVENT_SYSTEM_FOREGROUND, EVENT_SYSTEM_FOREGROUND, 0& _
          , AddressOf WinEventFunc, 0, 0, WINEVENT_OUTOFCONTEXT)
   Debug.Print "StartEventHook Id: " + CStr(lngEventHookId)

   lngThreadId = GetCurrentThreadId
   If lngEventHookId <> 0 Then
      Debug.Print "Unhook Thread: " + CStr(lngThreadId) + " Hook Id: " + CStr(lngEventHookId)
      lngUnhookResult = UnhookWinEvent(lngEventHookId)
   End If 'lngEventHookId <> 0
   Debug.Print "Unhook result: " + CStr(lngUnhookResult)


Exit_cmdEventHook_Click:
   Exit Sub

Err_cmdEventHook_Click:
   MsgBox strcThisFunction + " " + CStr(Err.Number) + " " + Err.Description, vbCritical + vbOKOnly, strcModuleName
   Resume Exit_cmdEventHook_Click
End Sub

Код для модуля обратного вызова:

'Module basEventHook

Option Compare Database
Option Explicit

Private Const strcModuleName = "basEventHook"
Private Const strcErrMsgTitle = strcModuleName & " Module Error"
Private Const strcMsgTitle = strcModuleName & " Module"

Public Const EVENT_SYSTEM_FOREGROUND = &H3&

Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long _
      , lpdwProcessId As Long) As Long
Private Declare Function GetCurrentProcessId Lib "kernel32" () As Long

Public Function WinEventFunc(ByVal plngHookHandle As Long, ByVal plngEvent As Long, _
      ByVal plngHWnd As Long, ByVal plngIdObject As Long, ByVal plngIdChild As Long, _
      ByVal plngIdEventThread As Long, ByVal plngDwmsEventTime As Long) As Long
  'This function is a callback passed to the win32 api
  'We CANNOT throw an error or break. Bad things will happen.
   Const strcThisFunction = "WinEventFunc"
   Dim lngCurrentProcId As Long
   Dim lngWinThreadProcId As Long
   Dim lngPid As Long
On Error Resume Next

   If plngEvent = EVENT_SYSTEM_FOREGROUND Then
      lngWinThreadProcId = GetWindowThreadProcessId(plngHWnd, lngPid)
      lngCurrentProcId = GetCurrentProcessId
      Debug.Print "Hook handle: " + CStr(plngHookHandle) + " WinThreadHWnd: " + CStr(plngHWnd) _
            + " Pid: " + CStr(lngPid) + " WinThreadProcId: " + CStr(lngWinThreadProcId) _
            + ", curPid: " + CStr(lngCurrentProcId)
   End If 'plngEvent = EVENT_SYSTEM_FOREGROUND

Exit_WinEventFunc:
On Error GoTo 0
   Exit Function
End Function

Результаты нажатия на кнопку cmdEventHook:

cmdEventHook_Click hwnd: 2034428 Thread: 9284
StartEventHook Id: 234686679
Unhook Thread: 9284 Hook Id: 234686679
Unhook result: 0

Hook handle: 234686679 WinThreadHWnd: 2230772 Pid: 7208 WinThreadProcId: 9284, curPid: 7208

Результат unhook, равный 0, указывает на невозможность отсоединения. В документации по функции MS UnhookWinEvent говорится, что основными причинами сбоя являются:

  • Параметр hWinEventHook имеет значение NULL или недопустимо.
  • Хук события, указанный в hWinEventHook, уже удален.
  • UnhookWinEvent вызывается из потока, который отличается от исходного вызова SetWinEventHook.

Я считаю, что все это выполнено, поэтому я действительно не понимаю, почему событие не отцеплено?

У кого-нибудь есть идеи?

Спасибо... Линдси

0 ответов

Другие вопросы по тегам