Avatar of EasyAim
EasyAim asked on

How to detect system shutdown with a form-less Visual Basic application

I made the mistake of accepting an answer from a previous posted question without checking it out thoroughly.  It was:


As it turns out, the answer did not work, so I'm repeating the question. (I do stupid things like that when I don't have time to check out an answer but I'm getting pinged to close a question):

   I have a Visual Basic application that has no form.   It uses the API function 'Sleep()' to wake up every so often to check for downloaded files and other maintenance issues.  The problem is during a system reboot a very unprofessional shutdown error dialog box appears:

   "Ending program.... please wait"   with a progress bar.  

It eventually throws an error that requires human intervention to completely shut down.  (I'm not sure about other operating systems but this does occur for Windows 2000 anyway.)

REQUEST #1:  Can the 'ending program' dialog box be programmatically disabled to allow shutdown to continue?

REQUEST #2:  If not, how can I programmatically detect an operating system shut down?

NOTE:  Answers that use the Form_QueryUnload or anything else associated with a Visual Basic form will be rejected.  This application has no VB form.   A VB form will not be put into this application.

One method I thought that would work would be to detect registry changes.  I would have assumed that when a shutdown is initiated that some registry entry is changed... but I can't find it.  It may be the wrong method anyway.    Below is a test routine that checks various registry changes during a system shut down.  All of the registry entries noted in the code below had no change detected during a shutdown.

The utility below is one form with one button.  It creates a log file in the root directory called "c:\trash.log".  Note: this is a routine to check for registry changes during a shutdown.  It is NOT the routine that is causing the pop-up shutdown error.

' "DetectShutDown"
' Attempt to detect a shutdown event without using a Form event
'   * Create a Visual Basic form with one large button.
'     Name the button 'cmdStart'.
'   * Copy this code to the form.
'   * Create an executable of this code.
'   * Run the executable.
'   * Allow a few seconds to go by to get a baseline reading of
'     all of the registry values.
'   * Shutdown your computer using 'Start' / 'Turn off computer' / 'Restart'
'   * Upon re-starting the computer, review the log file "c:\trash.log"
'     and determine if any of the registry values indicated a shutdown.
Option Explicit
Dim sFileLog As String
Const WAIT_TIME As Single = 0.5  ' wait number of seconds between cycles
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function RegQueryValueExString Lib "advapi32.dll" Alias "RegQueryValueExA" _
  (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, _
   dwType As Long, ByVal lpValue As String, cbData As Long) As Long
Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" _
  (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegQueryValueExNull Lib "advapi32.dll" Alias "RegQueryValueExA" _
  (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, _
   lpType As Long, ByVal lpData As Long, lpcbData As Long) As Long
Private Declare Function RegQueryValueExLong Lib "advapi32.dll" Alias "RegQueryValueExA" _
  (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, _
   lpType As Long, lpData As Long, lpcbData As Long) As Long
Const HKEY_CLASSES_ROOT As Long = &H80000000
Const HKEY_CURRENT_USER As Long = &H80000001
Const HKEY_LOCAL_MACHINE As Long = &H80000002
Const HKEY_USERS As Long = &H80000003
Const ERROR_NONE = 0
Const REG_SZ As Long = 1
Const REG_DWORD As Long = 4

Private Sub Form_Load()
   sFileLog = "c:\trash.log"
End Sub

Private Sub cmdStart_Click()
 Dim i As Long
 Dim h As Integer
 Dim sTemp As String
 Dim iCount As Long
 Dim sngWakeUp As Single
 cmdStart.Caption = "RUNNING!" & vbCrLf & "see file: " & sFileLog
  h = FreeFile
  Open sFileLog For Output As h
  Print #h, String$(60, "=")
  Print #h, " file: " & sFileLog
  Print #h, " created: " & Format$(Now, "mm/dd/yyyy hh:nn:ss")
  Print #h, " "
  Print #h, "NOTE: Not all registry entries will be found, depending upon your operating system."
  Print #h, String$(60, "-")
  Close h
   iCount = iCount + 1
   Me.Caption = "Loop number " & iCount
   ' The API Sleep() function causes the warning to appear.
   Call Sleep(WAIT_TIME * 1000)
   ' attempt to detect system shutdown
   ' Note: Not all operating systems have these registry entries.
   Logger " "
   Logger "**** LOOP " & CStr(iCount) & " *****"
   sTemp = GetKeyValue(HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Explorer", "CleanShutdown", "-1")
     Logger "Explorer:CleanShutDown =              " & sTemp
   sTemp = GetKeyValue(HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Explorer", "Shutdown Setting", "-1")
     Logger "Explorer:Shutdown Setting =           " & sTemp
   sTemp = GetKeyValue(HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\CurrentVersion\policies\system", "Shutdownwithoutlogon", "-1")
     Logger "policies:Shutdownwithoutlogon =       " & sTemp
   sTemp = GetKeyValue(HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows NT\CurrentVersion\Winlogon\Notify\cscdll", "Shutdown", "-1")
     Logger "Winlogon:cscdll =                     " & sTemp
   sTemp = GetKeyValue(HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\CurrentVersion\Reliability", "ShutdownDoStateSnapshot", "-1")
     Logger "Reliability:ShutdownDoStateSnapshot = " & sTemp
   sTemp = GetKeyValue(HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\CurrentVersion\Reliability", "ShutdownReasonUI", "-1")
     Logger "Reliability:ShutdownReasonUI =        " & sTemp
   sTemp = GetKeyValue(HKEY_LOCAL_MACHINE, "System\CurrentControlSet\Control\Watchdog\Display", "Shutdown", "-1")
     Logger "Watchdog:Shutdown =                   " & sTemp
   sTemp = GetKeyValue(HKEY_LOCAL_MACHINE, "System\CurrentControlSet\Control\Watchdog\Display", "ShutdownCount", "-1")
     Logger "Watchdog:ShutdownCount =              " & sTemp
   sTemp = GetKeyValue(HKEY_LOCAL_MACHINE, "System\CurrentControlSet\Control\Windows", "ShutdownTime", "-1")
     Logger "CurrentControlSet:ShutdownTime =      " & sTemp

End Sub
Private Function GetKeyValue(lParentKey As Long, sKeyName As String, sParam As String, Optional sDefault As String = vbNullString) As String
 ' Read a registry entry.
 '   lParentKey = see the above declarations for the root id number
 '   sKeyName = the fully nested key name
 '   sParam   = the parameter where the value is stored
 '   sDefault = the default value if no key exists
 '   ReadKey  = the stored value
 Dim lResult As Long
 Dim hKey As Long       ' handle to opened key
 Dim vValue As Variant  ' returned value
 lResult = RegOpenKeyEx(lParentKey, sKeyName, 0, KEY_ALL_ACCESS, hKey)
 lResult = QueryValueEx(hKey, sParam, vValue)
 If lResult <> ERROR_NONE Then vValue = sDefault
 GetKeyValue = TrimToNull(CStr(vValue))
 If Len(GetKeyValue) < 1 Then GetKeyValue = sDefault
 RegCloseKey (hKey)
End Function

Private Function QueryValueEx(ByVal lhKey As Long, ByVal szValueName As String, vValue As Variant) As Long
  Dim cCh As Long
  Dim lRc As Long
  Dim lType As Long
  Dim lValue As Long
  Dim sValue As String
  ' Determine the size and type of data to be read
  lRc = RegQueryValueExNull(lhKey, szValueName, 0&, lType, 0&, cCh)
  If lRc <> ERROR_NONE Then
    vValue = "(registry entry does not exist)"
    Exit Function
  End If
  Select Case lType
    ' strings
    Case REG_SZ
      sValue = String(cCh, 0)
      lRc = RegQueryValueExString(lhKey, szValueName, 0&, lType, sValue, cCh)
      If lRc = ERROR_NONE Then
        vValue = Left$(sValue, cCh)
        vValue = Empty
      End If
    ' for DWORDS
    Case REG_DWORD
      lRc = RegQueryValueExLong(lhKey, szValueName, 0&, lType, lValue, cCh)
      If lRc = ERROR_NONE Then vValue = lValue
    Case Else
      lRc = -1
    End Select
    QueryValueEx = lRc
    End Function

Private Sub Logger(strInput As String)
 '  Write to a log file
 Dim hLog As Integer
 Dim strEntry As String
 strEntry = Format$(Now, "mm/dd/yyyy hh:mm:ss") & "  " & strInput
 If Len(sFileLog) > 0 Then
   hLog = FreeFile
   Open sFileLog For Append As hLog
   Print #hLog, strEntry
   Close hLog
 End If
 End Sub

Private Function TrimToNull(strInput As String) As String
  Dim i As Long
  i = InStr(1, strInput, Chr$(0), vbBinaryCompare)
  Select Case i
  Case 0
    TrimToNull = strInput
  Case 1
    TrimToNull = vbNullString
  Case Else
    TrimToNull = Left$(strInput, i - 1)
  End Select
End Function

Visual Basic Classic

Avatar of undefined
Last Comment

8/22/2022 - Mon

Log in or sign up to see answer
Become an EE member today7-DAY FREE TRIAL
Members can start a 7-Day Free trial then enjoy unlimited access to the platform
Sign up - Free for 7 days
Learn why we charge membership fees
We get it - no one likes a content blocker. Take one extra minute and find out why we block content.
See how we're fighting big data
Not exactly the question you had in mind?
Sign up for an EE membership and get your own personalized solution. With an EE membership, you can ask unlimited troubleshooting, research, or opinion questions.
ask a question

  I have a timer class used in a different part of the utility.  I will remove the Sleep() function and see if that helps.   (I think I tried that already but it has been a while.)



All you need is subclass any window in your app (even invisible) and wait for WM_ENDSESSION message.
I started with Experts Exchange in 2004 and it's been a mainstay of my professional computing life since. It helped me launch a career as a programmer / Oracle data analyst
William Peck

This VB app is a service with no forms, no buttons, no windows.  For instance, when you run Desaware's "Spy++" the running task does not show up in the tree anywhere.


Not sure if you use functions like OpenService, CreateService or QueryServiceStatus.
from http://msdn.microsoft.com/library/en-us/dllproc/base/queryservicestatusex.asp
QueryServiceStatusEx will return ERROR_SHUTDOWN_IN_PROGRESS if the system is shutting down.

Or, if you have service handler function, you will get a SERVICE_CONTROL_SHUTDOWN from service control manager when windows is shutting down.

Hi, Ark ;-)

Just question,

why not add a form to your app,

just do load without show and you will have a form to work with

USe Ark mension to subclass your form or you will have form_queryunload event
Get an unlimited membership to EE for less than $4 a week.
Unlimited question asking, solutions, articles and more.

The "no forms" policy is my client's own IT standard for automated processes.   I believe the policy developed when someone discovered that these apps (that run at night) would run faster if no information was sent to textboxes.  This resulted in an overkill policy of formless apps.   I personally find it distracting to try to write a VB app with no form to display intermediate results or other information.

   Exceptions to policy can be made by going to the boss but I thought I'd be the hero and solve this recurring problem. (It is not just my app.)

   Surely there's a simple trick to detect a shutdown event.  

Well as a work-around to "no forms", you can always use CreateWindowEx to create your own window and use the "ThunderMain" classname (VB form's classname) so it'll receive the shut-down message. I just tried it and it worked... saw the message box before XP shut down :] If that's what you're after then try the below in a new project.


Option Explicit

    lpCreateParams As Long
    hInstance As Long
    hMenu As Long
    hWndParent As Long
    cy As Long
    cx As Long
    y As Long
    x As Long
    style As Long
    lpszName As String
    lpszClass As String
    ExStyle As Long
End Type

Private Const GWL_WNDPROC = (-4)

Private Const WM_ENDSESSION = &H16

Private Const WS_OVERLAPPED = &H0&

Private Declare Function CreateWindowEx Lib "user32" Alias "CreateWindowExA" (ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal lpWindowName As String, ByVal dwStyle As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As Long, ByVal hMenu As Long, ByVal hInstance As Long, lpParam As Any) As Long
Private Declare Function DestroyWindow Lib "user32" (ByVal hwnd As Long) As Long

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 lMyWindow As Long, lPrevProc As Long, bCheck As Boolean
Public Sub Main()
    Call WindowCreate(True)
    If lMyWindow > 0 Then
        Call WindowHook(True)
        Do Until bCheck = True
        Call WindowHook(False)
        Call WindowCreate(False)
    End If
End Sub
Public Sub WindowCreate(ByVal bCreate As Boolean)
    If bCreate = True Then
        lMyWindow = CreateWindowEx(0, "ThunderMain", vbNullString, WS_OVERLAPPED, 0, 0, 300, 50, 0, 0, App.hInstance, CS)
        Call DestroyWindow(lMyWindow)
    End If
End Sub
Public Sub WindowHook(ByVal bHook As Boolean)
    If bHook = True Then
        lPrevProc = SetWindowLong(lMyWindow, GWL_WNDPROC, AddressOf WindowProc)
        Call SetWindowLong(lMyWindow, GWL_WNDPROC, lPrevProc)
    End If
End Sub
Public Function WindowProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
        bCheck = True
        MsgBox "Shutting down..."
    End If
    WindowProc = CallWindowProc(lPrevProc, hwnd, uMsg, wParam, lParam)
End Function

Ameba - I almost missed your comment concerning OpenService, CreateService or QueryServiceStatus.   I'll give them a try.

Mr. zzzzzooc - I'm not sure if an "artificial" window is allowed by the client.   But as a last resort I may have to go that route.
All of life is about relationships, and EE has made a viirtual community a real community. It lifts everyone's boat
William Peck

There are 2 ways to intercept window messages - subclassing and hook. Subclassing require window handle while hook works with thread, not window, so:

    lParam As Long
    wParam As Long
    message As Long
    hwnd As Long
End Type

Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal ncode As Long,
 ByVal wParam As Long, lParam As Any) As Long
Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource
As Any, ByVal cbCopy As Long)
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
Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long

Private Const WH_CALLWNDPROC = 4
Private Const WM_ENDSESSION = &H16

Private hHook As Long

Sub Main()
        hHook = SetWindowsHookEx(WH_CALLWNDPROC, AddressOf AppHook, App.hInstance, App.ThreadID)
'Rest of your code
End Sub

Public Function AppHook(ByVal idHook As Long, ByVal wParam As Long, ByVal lParam As
Long) As Long
    CopyMemory CWP, ByVal lParam, Len(CWP)
    Select Case CWP.message
'EndSession event occure, your code here
            AppHook = CallNextHookEx(hHook, idHook, wParam, ByVal lParam)
            UnhookWindowsHookEx hHook
            hHook = 0
            Exit Function
    End Select
    AppHook = CallNextHookEx(hHook, idHook, wParam, ByVal lParam)
End Function


Hi, ameba! Glad to see you again :)