uShutdownStopper - Prevent A System from Shutting Down

posted 6 Jun 2010, 15:08 by Delphi Basics
This useful class, written by testtest prevents a system from shutdown. The example included with the unit shows you how to retreive data from the shutdown attempts, such as:
Properties (in the order they are executed):
HideDesktop: Minimize all windows, hide taskbar and desktop icons
PlaySound: Plays the systems shutdown sound
MonitorOff: Turns of the monitor
 
Others:
SyncSound: If this and all the options above are true, it will hide the desktop, play the sound till its finished and then turn off the monitor.
If its false, the monitor will be turned off, while the sound is still playing.
GiveUp: Shutdown attempts until the programm will give up and allow windows shutdown. -1 will never give up, 0 won't ever block, 1 will block one attempt...
ShutdownLevel: slFirst will block the shutdown right at the beginning. All user programs will stay open. slLast will allow windows to close all user programs, but prevent shutdown. slDefault will not change the shutdown order. Some programs will be closed, some not.
Attempts: How many shutdowns where tried?
OnShutdownQuery: Callback procedure when windows requests shutdown. You can allow/deny shutdown by setting AllowShutdown under your own conditions.

Note:
As well as preventing system shutdown, this unit also prevents logout and restart (since it reacts to WM_QUERYENDSESSION).

unit uShutdownStopper;

interface
uses Windows, Messages, Classes, MMSystem;

type
  TShutdownLevel = (slFirst, slLast, slDefault);
  TShutdownQueryProc = procedure(Sender: TObject;
        var AllowShutdown: Boolean) of Object;
  TShutdownStopper = class
  private
    FHideDesktop: Boolean;
    FPlaySound: Boolean;
    FSyncSound: Boolean;
    FMonitorOff: Boolean;
    FGiveUp: Integer;
    FAttempts: Integer;
    FWindowHandle: HWND;
    FOnShutdownQuery: TShutdownQueryProc;
    FShutdownLevel: TShutdownLevel;
    FDefaultShutdownLevel: DWORD;
    FDefaultShutdownFlags: DWORD;
    procedure SetShutdownLevel(Level: TShutdownLevel);
    procedure WndProc(var Msg: TMessage);
    procedure Simulate;
  public
    constructor Create;
    property HideDesktop: Boolean read FHideDesktop write FHideDesktop;
    property PlaySound: Boolean read FPlaySound write FPlaySound;
    property MonitorOff: Boolean read FMonitorOff write FMonitorOff;
    property GiveUp: Integer read FGiveUp write FGiveUp;
    property Attempts: Integer read FAttempts;
    property ShutdownLevel: TShutdownLevel read FShutdownLevel write SetShutdownLevel;
    property OnShutdownQuery: TShutdownQueryProc read FOnShutdownQuery write FOnShutdownQuery;
    property SyncSound: Boolean read FSyncSound write FSyncSound;
    destructor Destroy; override;
  end;

implementation

procedure HideWindowsAndDesktop;
const
  MINIMIZE_ALL = 419;
var
  H: HWND;
begin
  H := FindWindow('Shell_TrayWnd', nil);
  if H <> 0 then
  begin
    PostMessage(H, WM_COMMAND, MINIMIZE_ALL, 0);
    ShowWindow(H, SW_HIDE);
  end;
  H := FindWindow(nil, 'Program Manager');
  if H <> 0 then
    ShowWindow(H, SW_HIDE);
end;

constructor TShutdownStopper.Create;
begin
  inherited;
  FHideDesktop := False;
  FPlaySound := False;
  FSyncSound := True;
  FMonitorOff := False;
  FGiveUp := 0;
  FAttempts := 0;
  FOnShutdownQuery := nil;
  GetProcessShutdownParameters(FDefaultShutdownLevel, FDefaultShutdownFlags);
  FWindowHandle := AllocateHWnd(WndProc);
end;

procedure TShutdownStopper.SetShutdownLevel(Level: TShutdownLevel);
begin
  FShutdownLevel := Level;
  case FShutdownLevel of
    slFirst: SetProcessShutdownParameters($3FF, FDefaultShutdownFlags);
    slLast : SetProcessShutdownParameters($100, FDefaultShutdownFlags);
    else SetProcessShutdownParameters(FDefaultShutdownLevel, FDefaultShutdownFlags);
  end;
end;

procedure TShutdownStopper.WndProc(var Msg: TMessage);
var Allow: Boolean;
begin
  with Msg do
  if Msg = WM_QUERYENDSESSION then
  begin
    Inc(FAttempts);
    Allow := (GiveUp >= 0) and (FAttempts > FGiveUp);
    if Assigned(FOnShutdownQuery) then
      FOnShutdownQuery(Self, Allow);
    if Allow then
      Result := 1
    else
    begin
      Result := 0;
      Simulate;
    end;
  end
  else
    DefWindowProc(FWindowHandle, Msg, WParam, LParam);
end;

procedure TShutdownStopper.Simulate;
const
  SS: array[Boolean] of DWORD = (SND_ASYNC, SND_SYNC);
begin
  if FHideDesktop then
    HideWindowsAndDesktop;
  if FPlaySound then
    MMSystem.PlaySound(PChar('SYSTEMEXIT'), 0, SS[FSyncSound]);
  if FMonitorOff then
    PostMessage(HWND_BROADCAST, WM_SYSCOMMAND, SC_MONITORPOWER, 2);
end;

destructor TShutdownStopper.Destroy;
begin
  DeallocateHWnd(FWindowHandle);
end;

end.


Useage:

unit Main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, MMSystem, StdCtrls, uShutdownStopper, Spin, ExtCtrls;

type
  TForm1 = class(TForm)
    CheckBox1: TCheckBox;
    CheckBox2: TCheckBox;
    SpinEdit1: TSpinEdit;
    Label1: TLabel;
    Label2: TLabel;
    ComboBox1: TComboBox;
    CheckBox3: TCheckBox;
    Timer1: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure CheckBox1Click(Sender: TObject);
    procedure CheckBox2Click(Sender: TObject);
    procedure SpinEdit1Change(Sender: TObject);
    procedure ComboBox1Change(Sender: TObject);
    procedure CheckBox3Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    Stopper: TShutdownStopper;
    procedure OnShutdownQuery(Sender: TObject; var AllowShutdown: Boolean);
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  Stopper := TShutdownStopper.Create;
  Stopper.GiveUp := -1;
  Stopper.ShutdownLevel := slFirst;
  Stopper.OnShutdownQuery := OnShutdownQuery;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  Stopper.Free;
end;

procedure TForm1.OnShutdownQuery(Sender: TObject; var AllowShutdown: Boolean);
begin
  Label2.Caption := Format('Attempts: %d', [Stopper.Attempts]);
  Timer1.Enabled := True;
end;

procedure TForm1.CheckBox1Click(Sender: TObject);
begin
  Stopper.PlaySound := CheckBox1.Checked;
end;

procedure TForm1.CheckBox2Click(Sender: TObject);
begin
  Stopper.MonitorOff := CheckBox2.Checked;
end;

procedure TForm1.SpinEdit1Change(Sender: TObject);
begin
  Stopper.GiveUp := SpinEdit1.Value;
end;

procedure TForm1.ComboBox1Change(Sender: TObject);
begin
  case ComboBox1.ItemIndex of
    0: Stopper.ShutdownLevel := slFirst;
    1: Stopper.ShutdownLevel := slLast;
    else Stopper.ShutdownLevel := slDefault;
  end;
end;

procedure TForm1.CheckBox3Click(Sender: TObject);
begin
  Stopper.HideDesktop := CheckBox3.Checked;
end;

// Restore desktop!!!
procedure TForm1.Timer1Timer(Sender: TObject);
const
  RESTORE_ALL = 416;
begin
  Timer1.Enabled := False;
  ShowWindow(FindWindow('ProgMan', 'Program Manager'), SW_SHOW);
  ShowWindow(FindWindow('Shell_TrayWnd', nil), SW_SHOW);
  PostMessage(FindWindow('Shell_TrayWnd', nil), WM_COMMAND, RESTORE_ALL, 0);
end;

end.


Only Delphi source code is included in the archive.
ċ
uShutdownStopper.rar
(3k)
Delphi Basics,
6 Jun 2010, 15:14
Comments