Перезагрузке/завершении работы/смены пользователя операционной системы

Option Explicit
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long
Private Declare Function EnumThreadWindows Lib "user32" (ByVal dwThreadId As Long, ByVal lpfn As Long, ByVal lParam As Long) As Long
Private Declare Function DispatchMessage Lib "user32" Alias "DispatchMessageA" (lpMsg As msg) As Long
Private Declare Function GetMessage Lib "user32" Alias "GetMessageA" (lpMsg As msg, ByVal hwnd As Long, ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax 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 Declare Sub PostQuitMessage Lib "user32" (ByVal nExitCode As Long)
Public Sub Main()
    Dim lngRetval As Long, strURL As String, _
        lnghSession As Long, lngContexValue As Long, lnghRequest As Long, lnghSendRequest As Long, _
        strRetVal As String, lnghTimerQueue As Long, lnghTimer As Long, udtMSG As msg, lngTimerId As Long, _
        lngFuncPtr As Long
    lngRetval = EnumThreadWindows(GetCurrentThreadId(), AddressOf basModule.EnumThreadWndProc, 0&)
    If (mlnghWnd <> 0&) Then
        lngTimerId = SetTimer(mlnghWnd, 1&, 15000, 0&)
        mlngFuncPtr = SetWindowLong(mlnghWnd, GWL_WNDPROC, AddressOf basModule.WindowProc)
    End If
    Do
        lngRetval = GetMessage(udtMSG, 0&, 0&, 0&)
        If (lngRetval = -1&) Then
            
        Else
    
            Select Case udtMSG.message
                Case WM_QUIT
                    Exit Do
                Case WM_QUERYENDSESSION
                    
                Case WM_ENDSESSION
                    
            End Select
            DispatchMessage udtMSG
        End If
    Loop
End Sub
Public Function EnumThreadWndProc(ByVal hwnd As Long, ByVal lParam As Long) As Long
    Dim lngRetval As Long, strBuff As String
    strBuff = Strings.String$(255&, vbNullChar)
    lngRetval = GetClassName(hwnd, strBuff, Len(strBuff))
    If (Strings.InStr(1&, strBuff, "ThunderRT6Main") <> 0&) Then
        mlnghWnd = hwnd
    Else
        EnumThreadWndProc = True
    End If
End Function
Public Function WindowProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Select Case uMsg
        Case WM_TIMER
            
        Case WM_QUERYENDSESSION
            
        Case WM_ENDSESSION
            PostQuitMessage 0&
    End Select
    WindowProc = CallWindowProc(mlngFuncPtr, hwnd, uMsg, wParam, lParam)
End Function