Doevents обратная функция: Прерывание стэка событий Windows пока не выполнится стэк событий application

Private Const REALTIME_PRIORITY_CLASS = &H100

Public Sub TimeRun()
Dim ii As Long 'counter
 
If ansiCNT(1) > 99 Then
ansiCNT(1) = 10
End If
 
ansiCNT(1) = ansiCNT(1) + 1
 
 
If GetAsyncKeyState(46) = -32768 Then 'delete
    ansiCNT(1) = 0
End If
 
If ansiCNT(5) = 1 Then '.........................................................................Delete
 
Delete Procedure
 
end if
 
End Sub
 
Private Function LowLevelkbdProc(ByVal uCode As Long, ByVal wParam As Long, lParam As KBDLLHOOKSTRUCT) As Long
 
'Исключение клавиш
          For i = 1 To 47
        
            If CLng(exept(i)) = CLng(lParam.VkCode) Then
       
                HookCh = wParam
      
            Exit Function
            End If
'Исключение клавиш      
    
     If i = 47 Then
      
       If uCode = HC_ACTION Then
 
          If wParam = WM_KEYDOWN Then
          
HOOK PROCEDURE
    
          Exit Function
         End If
         
        End If
     
      End If
      
      
    
       Next i
  
    LowLevelkbdProc = CallNextHookEx(hKeyHook, uCode, wParam, lParam)
End Function

Dim ansiCNT(1) As Long' -Счетчик от 1 до 99
 
If ansiCNT(1) > 99 Then' Возвращает Счетчик в значение 10.
ansiCNT(1) = 10
End If
 
ansiCNT(1) = ansiCNT(1) + 1' Крутит счетчик от 0 до 99
 
 
If GetAsyncKeyState(46) = -32768 Then ' Если ловит delete назначает счетчику 0
    ansiCNT(1) = 0
End If
 
If ansiCNT(1) = 1 Then ' Когда счетчик становится равен 1 выполняет nn-ую процудуру (Delete Procedure).
 
Delete Procedure
 
end if
 
End Sub
 
Private Function LowLevelkbdProc(ByVal uCode As Long, ByVal wParam As Long, lParam As KBDLLHOOKSTRUCT) As Long
 
'Исключение клавиш
          For i = 1 To 47' смотрит по коду клавиши выловленной хуком в массиве исключений(exept()) и если находит совпадение выходит из функции
        
            If CLng(exept(i)) = CLng(lParam.VkCode) Then
       
                HookCh = wParam
      
            Exit Function
            End If
'Исключение клавиш      
    
     If i = 47 Then ' последний элемент цикла срабатывает только если исключений не найдено .
      
       If uCode = HC_ACTION Then
 
          If wParam = WM_KEYDOWN Then
          
HOOK PROCEDURE' выполняет nn-ую процудуру (HOOK PROCEDURE)
    
          Exit Function
         End If
         
        End If
     
      End If
      
      
    
       Next i
  
    LowLevelkbdProc = CallNextHookEx(hKeyHook, uCode, wParam, lParam)
End Function

Option Explicit
 
Private Type KBDLLHOOKSTRUCT
    VkCode As Long
    ScanCode As Long
    flags As Long
    time As Long
    dwExtraInfo As Long
End Type
 
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 CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Integer, lParam As Any) As Long
Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Private Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
 
Private Const WH_KEYBOARD_LL = 13
Private Const HC_ACTION = 0
Private Const LLKHF_INJECTED = &H10
Private Const WM_KEYDOWN As Long = &H100
Private Const WM_KEYUP As Long = &H101
 
Dim hKeyHook    As Long
Dim idTimer     As Long
Dim counter     As Long
 
Public Sub Hook()
    hKeyHook = SetWindowsHookEx(WH_KEYBOARD_LL, AddressOf LowLevelkbdProc, App.hInstance, 0)
    If hKeyHook = 0 Then MsgBox ("Keyboard hook error")
End Sub
Public Sub UnHook()
    If hKeyHook Then UnhookWindowsHookEx (hKeyHook): hKeyHook = 0
End Sub
' Ïðîöåäóðà ïåðåõâàòà ñîîáùåíèé êëàâèàòóðû
Private Function LowLevelkbdProc(ByVal uCode As Long, ByVal wParam As Long, lParam As KBDLLHOOKSTRUCT) As Long
    If uCode = HC_ACTION Then
        If lParam.VkCode = vbKeyDelete Then
            If idTimer = 0 Then
                Select Case wParam
                Case WM_KEYDOWN
                    idTimer = SetTimer(0, 0, 32, AddressOf TimerProc): counter = 20
                End Select
            Else
                Select Case wParam
                Case WM_KEYUP
                    KillTimer 0, idTimer
                    idTimer = 0
                End Select
            End If
        End If
    End If
    LowLevelkbdProc = CallNextHookEx(hKeyHook, uCode, wParam, lParam)
End Function
 
Private Sub TimerProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal idEvent As Long, ByVal dwTime As Long)
    counter = counter - 1
    If counter = 0 Then
        KillTimer 0, idTimer
    Else
        Debug.Print "Delete Procedure" & Rnd
    End If
End Sub