Programming: How to prevent shutdown using VB?

Can you post the code so that we can have a look at it. Parts may need to be rewritten and reorganised.

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

I've asked for more help. :)

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

crossnet, why do you want to prevent shut down? ,if the application crashes you could be up the creek without a paddle

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