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:
https://www.experts-exchange.com/questions/20869890/Detect-a-Windows-Operating-system-Shut-Down.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_U
Logger "Explorer:CleanShutDown = " & sTemp
'
sTemp = GetKeyValue(HKEY_CURRENT_U
Logger "Explorer:Shutdown Setting = " & sTemp
'
sTemp = GetKeyValue(HKEY_LOCAL_MAC
Logger "policies:Shutdownwithoutl
'
sTemp = GetKeyValue(HKEY_LOCAL_MAC
Logger "Winlogon:cscdll = " & sTemp
'
sTemp = GetKeyValue(HKEY_LOCAL_MAC
Logger "Reliability:ShutdownDoSta
'
sTemp = GetKeyValue(HKEY_LOCAL_MAC
Logger "Reliability:ShutdownReaso
'
sTemp = GetKeyValue(HKEY_LOCAL_MAC
Logger "Watchdog:Shutdown = " & sTemp
'
sTemp = GetKeyValue(HKEY_LOCAL_MAC
Logger "Watchdog:ShutdownCount = " & sTemp
'
sTemp = GetKeyValue(HKEY_LOCAL_MAC
Logger "CurrentControlSet:Shutdow
'
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,
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(lhKe
If lRc = ERROR_NONE Then
vValue = Left$(sValue, cCh)
Else
vValue = Empty
End If
'
' for DWORDS
Case REG_DWORD
lRc = RegQueryValueExLong(lhKey,
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
https://www.experts-exchange.com/questions/20869890/Detect-a-Windows-Operating-system-Shut-Down.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_U
Logger "Explorer:CleanShutDown = " & sTemp
'
sTemp = GetKeyValue(HKEY_CURRENT_U
Logger "Explorer:Shutdown Setting = " & sTemp
'
sTemp = GetKeyValue(HKEY_LOCAL_MAC
Logger "policies:Shutdownwithoutl
'
sTemp = GetKeyValue(HKEY_LOCAL_MAC
Logger "Winlogon:cscdll = " & sTemp
'
sTemp = GetKeyValue(HKEY_LOCAL_MAC
Logger "Reliability:ShutdownDoSta
'
sTemp = GetKeyValue(HKEY_LOCAL_MAC
Logger "Reliability:ShutdownReaso
'
sTemp = GetKeyValue(HKEY_LOCAL_MAC
Logger "Watchdog:Shutdown = " & sTemp
'
sTemp = GetKeyValue(HKEY_LOCAL_MAC
Logger "Watchdog:ShutdownCount = " & sTemp
'
sTemp = GetKeyValue(HKEY_LOCAL_MAC
Logger "CurrentControlSet:Shutdow
'
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,
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(lhKe
If lRc = ERROR_NONE Then
vValue = Left$(sValue, cCh)
Else
vValue = Empty
End If
'
' for DWORDS
Case REG_DWORD
lRc = RegQueryValueExLong(lhKey,
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
Last Comment
ASKER CERTIFIED SOLUTION
THIS SOLUTION IS ONLY AVAILABLE TO MEMBERS.
View this solution by signing up for a free trial.
Members can start a 7-Day free trial and enjoy unlimited access to the platform.
These links say crash is possible if you don't have SP3 or later:
http://support.microsoft.com:80/support/kb/articles/q214/7/55.asp
http://support.microsoft.com/default.aspx?scid=kb;EN-US;264957
http://support.microsoft.com:80/support/kb/articles/q214/7/55.asp
http://support.microsoft.com/default.aspx?scid=kb;EN-US;264957
All you need is subclass any window in your app (even invisible) and wait for WM_ENDSESSION message.
ASKER
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.
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
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 ;-)
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
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
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
ASKER
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.
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.
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
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
ASKER
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.
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.
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_CALLWN
'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 :)
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_CALLWN
'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 :)
Visual Basic Classic
Visual Basic is Microsoft’s event-driven programming language and integrated development environment (IDE) for its Component Object Model (COM) programming model. It is relatively easy to learn and use because of its graphical development features and BASIC heritage. It has been replaced with VB.NET, and is very similar to VBA (Visual Basic for Applications), the programming language for the Microsoft Office product line.
165K
Questions
--
Followers
--
Top Experts
Get a personalized solution from industry experts
TRUSTED BY
ASKER