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.
Я считаю, что все это выполнено, поэтому я действительно не понимаю, почему событие не отцеплено?
У кого-нибудь есть идеи?
Спасибо... Линдси