AccesSoft - Articles - Blocking the closing window Access on Alt+F4
Main | Articles | Links | Map

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

Main | Articles | Links | Map
посуточная аренда квартир в ЮЗАО | Акриловые ванны тест. Акриловые ванны дата.

Copyright 2007 - 2008 AccesSoft. All Rights Reserved