Windows 7 Forums
Welcome to Windows 7 Forums. Our forum is dedicated to helping you find support and solutions for any problems regarding your Windows 7 PC be it Dell, HP, Acer, Asus or a custom build. We also provide an extensive Windows 7 tutorial section that covers a wide range of tips and tricks.


Windows 7: Programming: How to prevent shutdown using VB?


02 Jan 2011   #1

Windows 7
 
 
Programming: How to prevent shutdown using VB?

Hello, sorry if i post in wrong thread. I'm in project to build an i-cafe software for my own i-cafe. I need the code to prevent windows 7 for shutdown if my application still running. My current code work fine in windows xp without any problem, but not in vista and 7. There are anyone here can help me fo this issue?
Any help would be appreciate, thank you!

My System SpecsSystem Spec
.

02 Jan 2011   #2

Windows 8.1 Pro RTM x64
 
 

Can you post the code so that we can have a look at it. Parts may need to be rewritten and reorganised.
My System SpecsSystem Spec
02 Jan 2011   #3

Windows 7
 
 

Here my code:

FYI, i use this code in Microsoft Access 2003

Code:
 
Option Explicit
 
Dim exittes As Boolean, cekexit As Boolean 
Dim wCaption As String
 
Private Declare Function GetActiveWindow Lib "user32" () As Long 
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function GetForegroundWindow Lib "user32" () As Long
 
 
Private Sub Form_Load()
exittes = False
cekexit = False
End Sub
 
Private Sub Form_Unload(Cancel As Integer)
'Code for prevent close and windows shutdown
cekexit = True
If exittes = False Then
Cancel = 1
End If
End Sub
 
Private Sub Form_Timer()
'This code for closing screen dialog to force clossing the application in vista & 7 
Dim WsShell
Set WsShell = CreateObject("WScript.Shell")
If (IsNull(wCaption)) And
(Isnull(GetFileName(GetHwndEXE(GetForegroundWindow())))) Then
Me.SetFocus
WsShell.SendKeys "{ESC}"
End If
If cekexit = True Then
Me.SetFocus
WsShell.SendKeys "{ESC}"
cekexit = False
End If
End Sub
 
Function GetWindowCaption()
Dim foreground_hwnd As Long
Dim Length As Long
 
foreground_hwnd = GetForegroundWindow()
 
wCaption= Space$(1024)
Length = GetWindowText(foreground_hwnd, wCaption, Len(txt))
wCaption= Left$(txt, Length)
End Function
 
Private Function CheckVersion() As Long
Dim tOS As OSVERSIONINFO
tOS.dwOSVersionInfoSize = Len(tOS)
Call GetVersionEx(tOS)
CheckVersion = tOS.dwPlatformId
End Function
 
Public Function GetHwndEXE(ByVal hWnd As Long) As String
Dim lProcessID As Long, lThread As Long
Dim lProcessHandle As Long
Dim sName As String, lModule As Long
Dim bMore As Boolean, tPROCESS As PROCESSENTRY32
Dim lSnapShot As Long
 
lThread = GetWindowThreadProcessId(hWnd, lProcessID)
 
If CheckVersion() = VER_PLATFORM_WIN32_WINDOWS Then
'Windows 9x
'Create a SnapShot of the Currently Running Processes
lSnapShot = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0)
If lSnapShot < 0 Then Exit Function
 
tPROCESS.dwSize = Len(tPROCESS)
 
'Enumerate those processes until we find a match
bMore = Process32First(lSnapShot, tPROCESS)
While bMore And tPROCESS.th32ProcessID <> lProcessID
bMore = Process32Next(lSnapShot, tPROCESS)
Wend
 
'If a match was found, get the EXE Path and Filename
If tPROCESS.th32ProcessID = lProcessID Then
sName = Left$(tPROCESS.szExeFile, InStr(tPROCESS.szExeFile, Chr(0)) - 1)
GetHwndEXE = sName
End If
 
Else
'Win NT
'Create an Instance of the Process
lProcessHandle = OpenProcess(PROCESS_QUERY_INFORMATION Or PROCESS_VM_READ, 0&, lProcessID)
 
'If the Process was successfully created, get the EXE
If lProcessHandle Then
'Just get the First Module, all we need is the Handle to get the Filename..
If EnumProcessModules(lProcessHandle, lModule, 4, 0&) Then
sName = Space(260)
Call GetModuleFileNameExA(lProcessHandle, lModule, sName, Len(sName))
GetHwndEXE = sName
End If
'Close the Process Handle
Call CloseHandle(lProcessHandle)
End If
End If
End Function
 
 
Public Function GetFileName(flname As String) As String
 
Dim posn As Integer, i As Integer
Dim fName As String
 
posn = 0
'find the position of the last "\" character in filename
For i = 1 To Len(flname)
If (Mid(flname, i, 1) = "\") Then posn = i
Next i
 
'get filename without path
fName = Right(flname, Len(flname) - posn)
 
GetFileName = fName
End Function
My System SpecsSystem Spec
.


05 Jan 2011   #4

Windows 7
 
 

My System SpecsSystem Spec
05 Jan 2011   #5

Windows 8.1 Pro RTM x64
 
 

I've asked for more help.
My System SpecsSystem Spec
05 Jan 2011   #6

win 7 ultimate32bit, Win8.1pro wmc 32bit
 
 

crossnet , have a look at this Visual Basic Component Shutdown Rules and also look at this code
  1. <LI style="FONT-STYLE: normal; FONT-FAMILY: 'Courier New', Courier, monospace; COLOR: black; FONT-WEIGHT: normal" itxtvisited="1">'constants needed, form level

    <LI style="FONT-STYLE: normal; FONT-FAMILY: 'Courier New', Courier, monospace; COLOR: black; FONT-WEIGHT: normal" itxtvisited="1"> Private Const WM_QUERYENDSESSION As System.Int32 = &H11

    <LI style="FONT-STYLE: normal; FONT-FAMILY: 'Courier New', Courier, monospace; COLOR: black; FONT-WEIGHT: normal" itxtvisited="1"> Private Const WM_CANCELMODE As System.Int32 = &H1F

    <LI style="FONT-STYLE: normal; FONT-FAMILY: 'Courier New', Courier, monospace; COLOR: black; FONT-WEIGHT: normal" itxtvisited="1">
    <LI style="FONT-STYLE: normal; FONT-FAMILY: 'Courier New', Courier, monospace; COLOR: black; FONT-WEIGHT: normal" itxtvisited="1"> 'the sub to intercept the windows messages

    <LI style="FONT-STYLE: normal; FONT-FAMILY: 'Courier New', Courier, monospace; COLOR: black; FONT-WEIGHT: normal" itxtvisited="1"> Protected Overrides Sub WndProc(ByRef ex As Message)

    <LI style="FONT-STYLE: normal; FONT-FAMILY: 'Courier New', Courier, monospace; COLOR: black; FONT-WEIGHT: normal" itxtvisited="1"> If ex.Msg = WM_QUERYENDSESSION Then

    <LI style="FONT-STYLE: normal; FONT-FAMILY: 'Courier New', Courier, monospace; COLOR: black; FONT-WEIGHT: normal" itxtvisited="1"> 'cancel the message

    <LI style="FONT-STYLE: normal; FONT-FAMILY: 'Courier New', Courier, monospace; COLOR: black; FONT-WEIGHT: normal" itxtvisited="1"> Dim MyMsg As New Message

    <LI style="FONT-STYLE: normal; FONT-FAMILY: 'Courier New', Courier, monospace; COLOR: black; FONT-WEIGHT: normal" itxtvisited="1"> MyMsg.Msg = WM_CANCELMODE

    <LI style="FONT-STYLE: normal; FONT-FAMILY: 'Courier New', Courier, monospace; COLOR: black; FONT-WEIGHT: normal" itxtvisited="1"> MyBase.WndProc(MyMsg)

    <LI style="FONT-STYLE: normal; FONT-FAMILY: 'Courier New', Courier, monospace; COLOR: black; FONT-WEIGHT: normal" itxtvisited="1"> Else

    <LI style="FONT-STYLE: normal; FONT-FAMILY: 'Courier New', Courier, monospace; COLOR: black; FONT-WEIGHT: normal" itxtvisited="1"> 'send the message as normal

    <LI style="FONT-STYLE: normal; FONT-FAMILY: 'Courier New', Courier, monospace; COLOR: black; FONT-WEIGHT: normal" itxtvisited="1"> MyBase.WndProc(ex)

    <LI style="FONT-STYLE: normal; FONT-FAMILY: 'Courier New', Courier, monospace; COLOR: black; FONT-WEIGHT: normal" itxtvisited="1"> End If
  2. End Sub
My System SpecsSystem Spec
05 Jan 2011   #7

win 7 ultimate32bit, Win8.1pro wmc 32bit
 
 

crossnet, why do you want to prevent shut down? ,if the application crashes you could be up the creek without a paddle
My System SpecsSystem Spec
06 Jan 2011   #8

Windows 7 Enterprise (x64); Windows Server 2008 R2 (x64)
 
 

How about this?

Code:
 
Public Sub Handler_SessionEnding(ByVal sender As Object, ByVal e As Microsoft.Win32.SessionEndingEventArgs) 
        If e.Reason = Microsoft.Win32.SessionEndReasons.Logoff Then 
            MessageBox.Show("User is logging off") 
        ElseIf e.Reason = Microsoft.Win32.SessionEndReasons.SystemShutdown Then 
            MessageBox.Show("System is shutting down") 
        End If 
    End Sub 
 
 Private Sub Form1_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles MyBase.Load 
        AddHandler Microsoft.Win32.SystemEvents.SessionEnding, AddressOf Handler_SessionEnding 
    End Sub
or

http://msdn.microsoft.com/en-us/libr...ionending.aspx

or a quick google:

Code:
' Original Code
' Created by E.Spencer - This code is public domain.
' Routines for running an app as an NT service.
'
' modified/rehashed by G.Crisp
' code modified to just detect and cancel windows shutdown - only a few unused bits deleted
'
'orginal code available from
'http://www.ilook.fsnet.co.uk/vb/vbntserv.htm
'
Public Const GWL_WNDPROC = (-4)
Public Const WM_ENDSESSION = &H16
Public Const WM_QUERYENDSESSION = &H11
Public WndProc As Long
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
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
' exiting from windows
'-------------------------------------------------------
Public Declare Function ExitWindowsEx Lib "user32.dll" (ByVal uFlags As Long, ByVal dwReserved As Long) As Long
'EWX_FORCE = 4 Force any applications to quit instead of prompting the user to close them.
'EWX_LOGOFF = 0 Log off the network.
'EWX_POWEROFF = 8 Shut down the system and, if possible, turn the computer off.
'EWX_REBOOT = 2 Perform a full reboot of the system.
'EWX_SHUTDOWN = 1
'call this from your form
Public Sub Hook(Lwnd As Long)
Dim uProcess As Long
WndProc = SetWindowLong(Lwnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub
Public Function WindowProc(ByVal hw As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
If uMsg = WM_QUERYENDSESSION Then
   'MsgBox "hw:" + CStr(hw) + " uMsg:" + CStr(uMsg) + " wParam:" + CStr(wParam)
   WindowProc = False 'send don't shut down
   'run code do what you want, then call ExitWindowsEx etc up to you
   Exit Function
ElseIf uMsg = WM_ENDSESSION Then
   'MsgBox "hw:" + CStr(hw) + " uMsg:" + CStr(uMsg) + " wParam:" + CStr(wParam)
   WindowProc = False
   'run code
   Exit Function
End If
WindowProc = CallWindowProc(WndProc, hw, uMsg, wParam, lParam)
End FunctionForm
Form

Code:
Private Sub Form_Load()
Hook (Me.hwnd)
End Sub
My System SpecsSystem Spec
06 Jan 2011   #9

Windows 7
 
 

Quote   Quote: Originally Posted by pebbly View Post
crossnet , have a look at this Visual Basic Component Shutdown Rules and also look at this code
  1. <LI style="FONT-STYLE: normal; FONT-FAMILY: 'Courier New', Courier, monospace; COLOR: black; FONT-WEIGHT: normal" itxtvisited="1">'constants needed, form level

    <LI style="FONT-STYLE: normal; FONT-FAMILY: 'Courier New', Courier, monospace; COLOR: black; FONT-WEIGHT: normal" itxtvisited="1"> Private Const WM_QUERYENDSESSION As System.Int32 = &H11

    <LI style="FONT-STYLE: normal; FONT-FAMILY: 'Courier New', Courier, monospace; COLOR: black; FONT-WEIGHT: normal" itxtvisited="1"> Private Const WM_CANCELMODE As System.Int32 = &H1F

    <LI style="FONT-STYLE: normal; FONT-FAMILY: 'Courier New', Courier, monospace; COLOR: black; FONT-WEIGHT: normal" itxtvisited="1">
    <LI style="FONT-STYLE: normal; FONT-FAMILY: 'Courier New', Courier, monospace; COLOR: black; FONT-WEIGHT: normal" itxtvisited="1"> 'the sub to intercept the windows messages

    <LI style="FONT-STYLE: normal; FONT-FAMILY: 'Courier New', Courier, monospace; COLOR: black; FONT-WEIGHT: normal" itxtvisited="1"> Protected Overrides Sub WndProc(ByRef ex As Message)

    <LI style="FONT-STYLE: normal; FONT-FAMILY: 'Courier New', Courier, monospace; COLOR: black; FONT-WEIGHT: normal" itxtvisited="1"> If ex.Msg = WM_QUERYENDSESSION Then

    <LI style="FONT-STYLE: normal; FONT-FAMILY: 'Courier New', Courier, monospace; COLOR: black; FONT-WEIGHT: normal" itxtvisited="1"> 'cancel the message

    <LI style="FONT-STYLE: normal; FONT-FAMILY: 'Courier New', Courier, monospace; COLOR: black; FONT-WEIGHT: normal" itxtvisited="1"> Dim MyMsg As New Message

    <LI style="FONT-STYLE: normal; FONT-FAMILY: 'Courier New', Courier, monospace; COLOR: black; FONT-WEIGHT: normal" itxtvisited="1"> MyMsg.Msg = WM_CANCELMODE

    <LI style="FONT-STYLE: normal; FONT-FAMILY: 'Courier New', Courier, monospace; COLOR: black; FONT-WEIGHT: normal" itxtvisited="1"> MyBase.WndProc(MyMsg)

    <LI style="FONT-STYLE: normal; FONT-FAMILY: 'Courier New', Courier, monospace; COLOR: black; FONT-WEIGHT: normal" itxtvisited="1"> Else

    <LI style="FONT-STYLE: normal; FONT-FAMILY: 'Courier New', Courier, monospace; COLOR: black; FONT-WEIGHT: normal" itxtvisited="1"> 'send the message as normal

    <LI style="FONT-STYLE: normal; FONT-FAMILY: 'Courier New', Courier, monospace; COLOR: black; FONT-WEIGHT: normal" itxtvisited="1"> MyBase.WndProc(ex)

    <LI style="FONT-STYLE: normal; FONT-FAMILY: 'Courier New', Courier, monospace; COLOR: black; FONT-WEIGHT: normal" itxtvisited="1"> End If
  2. End Sub
Thank you, i will test it
My System SpecsSystem Spec
06 Jan 2011   #10

Windows 7
 
 

Quote   Quote: Originally Posted by WindowsStar View Post
How about this?

Code:
 
Public Sub Handler_SessionEnding(ByVal sender As Object, ByVal e As Microsoft.Win32.SessionEndingEventArgs) 
        If e.Reason = Microsoft.Win32.SessionEndReasons.Logoff Then 
            MessageBox.Show("User is logging off") 
        ElseIf e.Reason = Microsoft.Win32.SessionEndReasons.SystemShutdown Then 
            MessageBox.Show("System is shutting down") 
        End If 
    End Sub 
 
 Private Sub Form1_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles MyBase.Load 
        AddHandler Microsoft.Win32.SystemEvents.SessionEnding, AddressOf Handler_SessionEnding 
    End Sub
or

SystemEvents.SessionEnding Event (Microsoft.Win32)

or a quick google:

Code:
' Original Code
' Created by E.Spencer - This code is public domain.
' Routines for running an app as an NT service.
'
' modified/rehashed by G.Crisp
' code modified to just detect and cancel windows shutdown - only a few unused bits deleted
'
'orginal code available from
'http://www.ilook.fsnet.co.uk/vb/vbntserv.htm
'
Public Const GWL_WNDPROC = (-4)
Public Const WM_ENDSESSION = &H16
Public Const WM_QUERYENDSESSION = &H11
Public WndProc As Long
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
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
' exiting from windows
'-------------------------------------------------------
Public Declare Function ExitWindowsEx Lib "user32.dll" (ByVal uFlags As Long, ByVal dwReserved As Long) As Long
'EWX_FORCE = 4 Force any applications to quit instead of prompting the user to close them.
'EWX_LOGOFF = 0 Log off the network.
'EWX_POWEROFF = 8 Shut down the system and, if possible, turn the computer off.
'EWX_REBOOT = 2 Perform a full reboot of the system.
'EWX_SHUTDOWN = 1
'call this from your form
Public Sub Hook(Lwnd As Long)
Dim uProcess As Long
WndProc = SetWindowLong(Lwnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub
Public Function WindowProc(ByVal hw As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
If uMsg = WM_QUERYENDSESSION Then
   'MsgBox "hw:" + CStr(hw) + " uMsg:" + CStr(uMsg) + " wParam:" + CStr(wParam)
   WindowProc = False 'send don't shut down
   'run code do what you want, then call ExitWindowsEx etc up to you
   Exit Function
ElseIf uMsg = WM_ENDSESSION Then
   'MsgBox "hw:" + CStr(hw) + " uMsg:" + CStr(uMsg) + " wParam:" + CStr(wParam)
   WindowProc = False
   'run code
   Exit Function
End If
WindowProc = CallWindowProc(WndProc, hw, uMsg, wParam, lParam)
End FunctionForm
Form

Code:
Private Sub Form_Load()
Hook (Me.hwnd)
End Sub
Thank you, i will test it and will report the result immediately.
My System SpecsSystem Spec
Reply

 Programming: How to prevent shutdown using VB?




Thread Tools



Similar help and support threads for2: Programming: How to prevent shutdown using VB?
Thread Forum
Prevent Shutdown ???????????????????? General Discussion
C++ Programming Chillout Room
Programming Chillout Room
prevent screen-shutdown when switching user. General Discussion
Jumplist Programming Q General Discussion
Prevent Network Card shutdown on ethernet cable removal Network & Sharing
Programming Help - Please! Chillout Room

Our Sites

Site Links

About Us

Find Us

Windows 7 Forums is an independent web site and has not been authorized, sponsored, or otherwise approved by Microsoft Corporation. "Windows 7" and related materials are trademarks of Microsoft Corp.

Designer Media Ltd

All times are GMT -5. The time now is 06:08 AM.
Twitter Facebook Google+



Windows 7 Forums

Seven Forums Android App Seven Forums IOS App
  

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33