Solved

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

Posted on 2004-03-28
11
5,220 Views
Last Modified: 2012-06-21
I made the mistake of accepting an answer from a previous posted question without checking it out thoroughly.  It was:

http://www.experts-exchange.com/Programming/Programming_Languages/Visual_Basic/Q_20869890.html

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
'
' INSTRUCTIONS:
'   * 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 KEY_ALL_ACCESS = &H3F
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
 '
 Do
   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
     '
   Me.Refresh
   '
 Loop

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.
 '
 ' INPUT:
 '   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
 ' OUTPUT:
 '   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)
      Else
        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


0
Comment
Question by:EasyAim
  • 4
  • 3
  • 2
  • +2
11 Comments
 
LVL 15

Accepted Solution

by:
ameba earned 127 total points
Comment Utility
Change the application that uses the Sleep to wake up every so often.
Sleep function suspends the execution of the current thread; try using timer instead.
If you don't have timer class, let me know.
0
 

Author Comment

by:EasyAim
Comment Utility
  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.)

 
0
 
LVL 15

Expert Comment

by:ameba
Comment Utility
0
 
LVL 27

Expert Comment

by:Ark
Comment Utility
All you need is subclass any window in your app (even invisible) and wait for WM_ENDSESSION message.
0
 

Author Comment

by:EasyAim
Comment Utility
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.
0
How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

 
LVL 15

Expert Comment

by:ameba
Comment Utility
EasyAim,

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 ;-)
0
 
LVL 26

Expert Comment

by:EDDYKT
Comment Utility
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
0
 

Author Comment

by:EasyAim
Comment Utility
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.  
0
 
LVL 17

Expert Comment

by:zzzzzooc
Comment Utility
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.


Module1:
---------------

Option Explicit

Private Type CREATESTRUCT
    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 WM_QUERYENDSESSION = &H11

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
            DoEvents
        Loop
        Call WindowHook(False)
        Call WindowCreate(False)
    End If
End Sub
Public Sub WindowCreate(ByVal bCreate As Boolean)
    Dim CS As CREATESTRUCT
    If bCreate = True Then
        lMyWindow = CreateWindowEx(0, "ThunderMain", vbNullString, WS_OVERLAPPED, 0, 0, 300, 50, 0, 0, App.hInstance, CS)
    Else
        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)
    Else
        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
    If uMsg = WM_ENDSESSION Or uMsg = WM_QUERYENDSESSION Then
        bCheck = True
        MsgBox "Shutting down..."
    End If
    WindowProc = CallWindowProc(lPrevProc, hwnd, uMsg, wParam, lParam)
End Function
0
 

Author Comment

by:EasyAim
Comment Utility
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.
0
 
LVL 27

Expert Comment

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

Type CWPSTRUCT
    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 Const WM_QUERYENDSESSION = &H11

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
    Dim CWP As CWPSTRUCT
    CopyMemory CWP, ByVal lParam, Len(CWP)
    Select Case CWP.message
        Case  WM_ENDSESSION, WM_QUERYENDSESSION
'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

Regards
Ark

Hi, ameba! Glad to see you again :)
0

Featured Post

How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

Join & Write a Comment

If you have ever used Microsoft Word then you know that it has a good spell checker and it may have occurred to you that the ability to check spelling might be a nice piece of functionality to add to certain applications of yours. Well the code that…
When designing a form there are several BorderStyles to choose from, all of which can be classified as either 'Fixed' or 'Sizable' and I'd guess that 'Fixed Single' or one of the other fixed types is the most popular choice. I assume it's the most p…
Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…
Get people started with the utilization of class modules. Class modules can be a powerful tool in Microsoft Access. They allow you to create self-contained objects that encapsulate functionality. They can easily hide the complexity of a process from…

762 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

6 Experts available now in Live!

Get 1:1 Help Now