Solved

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

Posted on 2004-03-28
11
5,236 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
ID: 10700457
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
ID: 10700691
  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
ID: 10700773
0
 
LVL 27

Expert Comment

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

Author Comment

by:EasyAim
ID: 10703209
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
Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

 
LVL 15

Expert Comment

by:ameba
ID: 10703513
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
ID: 10703671
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
ID: 10703793
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
ID: 10705836
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
ID: 10707723
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
ID: 10708699
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

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Introduction I needed to skip over some file processing within a For...Next loop in some old production code and wished that VB (classic) had a statement that would drop down to the end of the current iteration, bypassing the statements that were c…
The debugging module of the VB 6 IDE can be accessed by way of the Debug menu item. That menu item can normally be found in the IDE's main menu line as shown in this picture.   There is also a companion Debug Toolbar that looks like the followin…
As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). U…
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…

863 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

24 Experts available now in Live!

Get 1:1 Help Now