uShutdownStopper - Prevent A System from Shutting Down

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.

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.