What block closing a window Access on Alt+F4
Sometimes (but beside me enough often) can be necessary to force the user it is correct to close application: i.e. consecutively close all opened forms, but afterwards and application itself by special button (or point menu) on which weighs the command DoCmd.Quit. But some users have an evil habit to close application with the help of крестика window menu (on the right at the top). Or at combinations of the keys Alt+F4.
What block the button of the closing window Access possible to read in article Disable button of the closing window MsAccess. But here is with blocking the closing Access through Alt+F4 happened to little повозиться. Searching for in Internete has brought me on site VB Forums. Here in topic Disable ALT-F4 user under ником Lord Orvell has offered the code for blocking the combinations of the keys Ctrl+Esc, Alt+Tab, Alt+Esc for programs on VB. Dmitriy Miloserdov (aka Benedikt) with site SQL.RU доработал offered code for use him(it) in program Access VBA. For functioning(working) is required OS Windows NT4 with SP 3 and above.
Option Compare Database
Option Explicit
Private Declare Function GetForegroundWindow Lib "user32" () As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" ( _
ByVal hWnd As Long, lpdwProcessId As Any) As Long
Private Declare Function GetModuleHandle Lib "kernel32" _
Alias "GetModuleHandleA" ( _
ByVal lpModuleName As String) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
pDest As Any, pSource As Any, ByVal cb As Long)
Private Const WH_KEYBOARD_LL = 13&
Private Const HC_ACTION = 0&
Private Type KBDLLHOOKSTRUCT
vkCode As Long
scanCode As Long
flags As Long
time As Long
dwExtraInfo As Long
End Type
Private Const LLKHF_ALTDOWN = &H20&
Private 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
Private Declare Function UnhookWindowsHookEx Lib "user32" ( _
ByVal hHook As Long) As Long
Private Declare Function CallNextHookEx Lib "user32" ( _
ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, _
ByVal lParam As Long) As Long
Private m_hLLKbdHook As Long
Private m_AccAppProcessId As Long
'----------------------------------------------------------------------------
Public Sub BlockAltF4()
If m_hLLKbdHook Then
Debug.Print "Low level keyboard hook already installed!"
Exit Sub
End If
GetWindowThreadProcessId Application.hWndAccessApp, m_AccAppProcessId
m_hLLKbdHook = SetWindowsHookEx(WH_KEYBOARD_LL, _
AddressOf LowLevelKeyboardProc, GetModuleHandle(vbNullString), 0&)
If m_hLLKbdHook Then
Debug.Print "Alt+F4 blocked."
Else
MsgBox "Failed to install low-level keyboard hook - " & Err.LastDllError
End If
End Sub
'----------------------------------------------------------------------------
Public Sub UnblockAltF4()
If m_hLLKbdHook Then
UnhookWindowsHookEx m_hLLKbdHook
m_hLLKbdHook = 0
Debug.Print "Alt+F4 unblocked."
End If
End Sub
Public Function LowLevelKeyboardProc(ByVal nCode As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long
Debug.Print "LowLevelKeyboardProc", nCode, wParam, Hex$(lParam)
Dim kbdllhs As KBDLLHOOKSTRUCT
If nCode = HC_ACTION Then
CopyMemory kbdllhs, ByVal lParam, Len(kbdllhs)
If (kbdllhs.vkCode = vbKeyF4) And (kbdllhs.flags And LLKHF_ALTDOWN) Then
Dim ForeProcessId As Long
GetWindowThreadProcessId GetForegroundWindow, ForeProcessId
If m_AccAppProcessId = ForeProcessId Then
Debug.Print "Alt+F4 blocked."
LowLevelKeyboardProc = 1
Exit Function
End If
End If
End If
LowLevelKeyboardProc = CallNextHookEx(m_hLLKbdHook, nCode, wParam, lParam)
End Function
Autor: Joss
It Is Added: 16.03.2008