uShutdownStopper - Prevent A System from Shutting Down

Post date: Jun 6, 2010 10:08:21 PM

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.