Delphi - prevent windows shutdown from tray application

Question

I'm trying to make a tiny tool for our system that would prevent windows shutdowns while our software runs. In order to make it independent, I made a separate application that prevent shutdown using this information.

However, when the application is minimized to tray, Windows simply kills it and shuts down normally. If the form is visible (aka I comment the Application.Minimize call from Form.OnCreate event), it does prevent the shutdown fine.

How could I achieve the MainWindow hook to keep live, or maybe get some other way of preventing system shutdowns, with the app being hidden in the tray?

Thanks.

Current code:

unit Main;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, TlHelp32, dateutils, Vcl.AppEvnts, Vcl.ExtCtrls;

type
  TForm1 = class(TForm)
    TrayIcon1: TTrayIcon;
    ApplicationEvents1: TApplicationEvents;
    procedure FormCreate(Sender: TObject);
    function HookEndSession(var Message: TMessage): Boolean;
    procedure WMQueryEndSession(var Msg : TWMQueryEndSession) ;
         message WM_QueryEndSession;
    procedure ApplicationEvents1Minimize(Sender: TObject);
    procedure ApplicationEvents1Restore(Sender: TObject);
    procedure TrayIcon1DblClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var Form1: TForm1;
var Mutex : THandle;

implementation

{$R *.dfm}



procedure TForm1.WMQueryEndSession(var Msg: TWMQueryEndSession);
begin
  Msg.Result := 0;
end;

function TForm1.HookEndSession(var Message: TMessage): Boolean;
begin
  result := false;
  if Message.Msg = WM_ENDSESSION then begin
    Message.Result := 0;
    result := true;
  end;
end;


procedure TForm1.TrayIcon1DblClick(Sender: TObject);
begin
  WindowState := wsNormal;
  Application.Terminate;
end;

procedure TForm1.ApplicationEvents1Minimize(Sender: TObject);
begin
  Hide();
  WindowState := wsMinimized;
  TrayIcon1.Visible := True;
end;

procedure TForm1.ApplicationEvents1Restore(Sender: TObject);
begin
  Application.Minimize;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Mutex := CreateMutex(nil, True, 'preventWinShutdown');
  if (Mutex = 0) OR (GetLastError = ERROR_ALREADY_EXISTS) then
  Application.Terminate;

  Application.HookMainWindow(HookEndSession);

  TrayIcon1.Hint := 'Windows Shutdown prevented.';
  //Application.Minimize;
end;


end.

Ondrej Kelle Ondrej Kelle · Accepted Answer · 2016-09-05T09:18:19

I don't have XE3 at hand but in XE7, TCustomTrayIcon.WindowProc explicitly handles WM_QUERYENDSESSION by returning 1 (equivalent to TRUE) which signals to Windows to go ahead with the logoff/shutdown/restart sequence. You can override it:

type
  TTrayIcon = class(Vcl.ExtCtrls.TTrayIcon)
  protected
    procedure WindowProc(var Message: TMessage); override;
  end;

procedure TTrayIcon.WindowProc(var Message: TMessage);
begin
  case Message.Msg of
    WM_QUERYENDSESSION:
      Message.Result := 0;
    else
      inherited WindowProc(Message);
  end;
end;

For a more complete solution, you would create a new class in a separate unit, inheriting from TCustomTrayIcon and re-publishing properties and events you wish to expose, like TTrayIcon does, install the component in the IDE and use it in any of your projects.

The above example is just a quick one with an interposer class which you can simply declare before your TForm1 and use immediately, in this unit only.

Delphi - prevent windows shutdown from tray application

2 Answers