Herunterfahren verhindern, Programm nicht beenden

[BlueStarHH]

Hallo,

beim Herunterfahren von Windows soll mein Programm das Herunterfahren stoppen (falls die offene Datei noch gespeichert werden muss). Das Programm selbst darf dann auch nicht beendet werden. Mit dem folgendem Code wird zwar das Herunterfahren von Windows gestoppt, das Programm aber trotzdem von Windows beendet. Was ist daran falsch?

Bitte vor dem Herunterfahren auf Button1 klicken, damit ShutdownBlockReasonCreate() aufgerufen wird, was seit Vista nötigt ist, da Windows sonst immer herunterfährt.

Delphi-Quellcode:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  protected
    procedure WMQueryEndSession(var Message: TWMQueryEndSession);
      message WM_QUERYENDSESSION;
    procedure WMEndSession(var Msg: TWMEndSession); message WM_ENDSESSION;
  public
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function ShutdownBlockReasonCreate(hWnd: hWnd; pwszReason: LPCWSTR): Bool;
  stdcall; external user32 name 'ShutdownBlockReasonCreate';

function ShutdownBlockReasonDestroy(hWnd: hWnd): Bool; stdcall;
  external user32 name 'ShutdownBlockReasonDestroy';

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

procedure TForm1.WMEndSession(var Msg: TWMEndSession);
begin
  Msg.Result := 0;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ShutdownBlockReasonCreate(handle, 'Reason gesetzt!');
end;

end.

[nahpets]

Meine Idee wäre jetzt dem OnClose-Ereignis des Formulars eine Routine "zu verpassen" und dort Abzufragen, ob das Programmbeendet werden darf oder nicht.

Delphi-Quellcode:

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Action := caNone; // Das Formular darf nicht geschlossen werden, daher geschieht nichts.
end;

Hier sollte das Programm dann nicht beendet werden.

[BlueStarHH]

Zitat:

Zitat von nahpets (Beitrag 1340866)

Meine Idee wäre jetzt dem OnClose-Ereignis des Formulars eine Routine "zu verpassen" und dort Abzufragen, ob das Programmbeendet werden darf oder nicht.

Delphi-Quellcode:

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Action := caNone; // Das Formular darf nicht geschlossen werden, daher geschieht nichts.
end;

Hier sollte das Programm dann nicht beendet werden.

Danke, aber das hat keinen Effekt: Windows beendet das Programm trotzdem.

[Sherlock]

Den ShutdownBlockReason musst Du nach dem Beantworten der WM_QUERYENDSESSION setzen...nicht irgendwann vorher.

Sherlock

[samso]

Vielleicht hilft das:

http://www.delphipraxis.net/179814-a...ndsession.html

[BlueStarHH]

Zitat:

Zitat von Sherlock (Beitrag 1340879)

Den ShutdownBlockReason musst Du nach dem Beantworten der WM_QUERYENDSESSION setzen...nicht irgendwann vorher.

Sherlock

Sicher? Nach meinem Gefühl wäre das viel zu spät. MS schreibt dazu:

Applications should call this function as they begin an operation that cannot be interrupted, such as burning a CD or DVD. When the operation has completed, call the ShutdownBlockReasonDestroy function to indicate that the system can be shut down.

Quelle: https://msdn.microsoft.com/en-us/lib...(v=vs.85).aspx

Edit:
Ich habs ausprobiert: Auch damit wird das Programm beendet:

procedure TForm1.WMQueryEndSession(var Message: TWMQueryEndSession);
begin
Message.Result := 0;
ShutdownBlockReasonCreate(handle, 'Reason gesetzt!');
end;

Der Text der "BlockReason" wird von Windows angezeigt, wenn ich ShutdownBlockReasonCreate per Button-Click oder per WMQueryEndSession aufrufe...

[BlueStarHH]

Zitat:

Zitat von samso (Beitrag 1340880)

Vielleicht hilft das:

http://www.delphipraxis.net/179814-a...ndsession.html

Danke, das habe ich gelesen. Hilft leider nicht.

[Sherlock]

Ja, BlueStarHH, hast Recht, ich hatte das falsch interpretiert.

Vertrackt... Hast Du die Möglichkeit zu loggen, was passiert, also welche Messages reinkommen?

Sherlock

[BlueStarHH]

Zitat:

Zitat von Sherlock (Beitrag 1340885)

Ja, BlueStarHH, hast Recht, ich hatte das falsch interpretiert.

Vertrackt... Hast Du die Möglichkeit zu loggen, was passiert, also welche Messages reinkommen?

Sherlock

Kann ich einbauen. Wie? Mit dem Debugger sieht man jedenfalls das erst WMQueryEndSession aufgerunfen wird und dann WMEndSession und danach wird das Programm von Windows beendet.

[Der schöne Günther]

Dumme Idee: Wenn ich den Quelltext in Vcl.Forms richtig verstehe, dann gibt eine VCL-Anwendung auf WM_QUERYENDSESSION immer True (1) zurück. Und gibt das erst gar nicht an deine Formulare weiter.

Umgehen (und richtig bearbeiten) könntest du das indem du Application.HookMainWindow(..) aufrufst und dort deinen eigenen Hook setzt.

Beispiel wäre ungefähr so:

Delphi-Quellcode:

[...]
Application.HookMainWindow(myApp.WndProcHook);
[...]

function TMyApp.WndProcHook(var message: TMessage): Boolean;
begin
   Result := False;

   case message.Msg of
      WM_QueryEndSession:   begin
         Result := True; // Wird in Vcl.Forms nicht weiter abgearbeitet
         (...) // z.B. an Application.MainForm weiterleiten...
      end;
   end;
end;

[Sherlock]

Zitat:

Zitat von Der schöne Günther (Beitrag 1340888)

Dumme Idee: Wenn ich den Quelltext in Vcl.Forms richtig verstehe, dann gibt eine VCL-Anwendung auf WM_QUERYENDSESSION immer True (1) zurück.

Immer wieder schön zu sehen, wie einem die VCL Arbeit abnimmt :stupid:

Sherlock

[BlueStarHH]

Zitat:

Zitat von Sherlock (Beitrag 1340890)

Zitat:

Zitat von Der schöne Günther (Beitrag 1340888)

Dumme Idee: Wenn ich den Quelltext in Vcl.Forms richtig verstehe, dann gibt eine VCL-Anwendung auf WM_QUERYENDSESSION immer True (1) zurück.

Immer wieder schön zu sehen, wie einem die VCL Arbeit abnimmt :stupid:

Sherlock

Daher gibt es ja meinen eigenen Handler, der 0 zurückgibt:

Delphi-Quellcode:

procedure WMQueryEndSession(var Message: TWMQueryEndSession); message WM_QUERYENDSESSION;

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

[BlueStarHH]

Zitat:

Zitat von Der schöne Günther (Beitrag 1340888)

Dumme Idee: Wenn ich den Quelltext in Vcl.Forms richtig verstehe, dann gibt eine VCL-Anwendung auf WM_QUERYENDSESSION immer True (1) zurück. Und gibt das erst gar nicht an deine Formulare weiter.

Umgehen (und richtig bearbeiten) könntest du das indem du Application.HookMainWindow(..) aufrufst und dort deinen eigenen Hook setzt.

Beispiel wäre ungefähr so:

Delphi-Quellcode:

[...]
Application.HookMainWindow(myApp.WndProcHook);
[...]

function TMyApp.WndProcHook(var message: TMessage): Boolean;
begin
   Result := False;

   case message.Msg of
      WM_QueryEndSession:   begin
         Result := True; // Wird in Vcl.Forms nicht weiter abgearbeitet
         (...) // z.B. an Application.MainForm weiterleiten...
      end;
   end;
end;

Hier wird WM_QueryEndSession nie angesprungen. Warum weiß ich nicht... Die WndProcHook wir ausgeführt. Beendet wird das Programm trotzdem.

[Neutral General]

Kommt die Message vielleicht bei dem Application-Fenster an?
Dann könntest du versuchen im WndProc(-Event) der Application die Message bearbeiten.

[THY4243]

Vielleicht ein ähnlicher Ansatz, der auszugsweise wiedergegeben zum Erfolg führte.:
Der Post http://www.delphipraxis.net/965876-post19.html war hilfreich.

Delphi-Quellcode:

Deklarationen bei Form:

type
  TForm1 = class(TForm)

  ... 

  private
    { Private-Deklarationen }
    procedure WMQueryEndSession(var Msg: TMessage); message WM_QUERYENDSESSION; {Messageverarbeitung mit Message anmelden}
    procedure WMEndsession(var Msg: TMessage); message WM_ENDSESSION; {Messageverarbeitung mit Message anmelden}
  
  ...
  
  end;

.....

Delphi-Quellcode:

Prozeduren:


procedure TForm1.WMQueryEndSession(var Msg: TMessage);
// Abfolge der Closevorgänge: http://www.delphipraxis.net/965876-post19.html
//
// [X] am Fenster:                          Abmelden/Herunterfahren:
// OnCloseQuery                             WM_QUERYENDSESSION
// OnClose                                  OnCloseQuery
// OnDestroy                                WM_ENDSESSION
//
const
    ENDSESSION_CLOSEAPP = $00000001; {lParam - WM_QUERYENDSESSION}
    ENDSESSION_CRITICAL = $40000000;
    ENDSESSION_LOGOFF   = $80000000;

var CanClose: boolean;
begin
  if (Msg.Msg = WM_QUERYENDSESSION) then 
  begin
    ShutdownBlockReasonCreate(Application.Handle, ...
    Form1.FormCloseQuery(NIL,CanClose); {geht, wenn Msg.Result:= 1 nicht gegeben wird, allerdings ist dann das Herunterfahren unter XP behindert - Win7 nicht}  {In FormCloseQuery Aufgaben erledigen und CanClose setzen} 

    Application.ProcessMessages;
    Msg.Result:= ABS(DWORD(CanClose)); {mit 1= true  antworten, dann kommt WM_ENDSESSION}
    end
  else
  begin
    Msg.Result:= 1; {mit 1= true  antworten, dann kommt WM_ENDSESSION - sonst wartet Windows auf die}
                    {Beendigung - Schwarzer Abmeldewartebildschirm in Windows 7}
  end;
end;

procedure TForm1.WMEndsession(var Msg: TMessage);
begin
  if Msg.Msg = WM_ENDSESSION then   {WM_SETTINGCHANGE = 26}
  begin
    if Msg.WParam = 1 then  {Msg.Result:= 1 wurde in WM_QUERYENDSESSION gegeben -> WM_ENDSESSION mit Msg.WParam = 1}
    begin                   {"If the session is being ended, this parameter is TRUE; otherwise, it is FALSE"}
      Form1.Close; {CloseQuery -> Close}
    end;
    ShutdownBlockReasonDestroy(Application.Handle);
  end;
end;

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
{Problem beim automatisierten Herunterfahren/Abmelden: Thread arbeitet nur, wenn CanClose:= false}
{Abfolge: 1. X -> Form.CloseQuery -> Form.Close -> Form.Hide}
begin

  {Aufgaben erledigen und dann ...}

  CanClose := False; {Applikation/Formular kann nicht geschlossen werden}

  {oder}

  CanClose := True; {Applikation/Formular geschlossen werden}
 
end;

[THY4243]

Nachtrag - natürlich zum Schluss noch:

Delphi-Quellcode:

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
{Abfolge: 1. X -> Form.CloseQuery -> Form.Close -> Form.Hide}
begin
  ....

  ShutdownBlockReasonDestroy(Application.Handle);

  ....

end;

[Sir Rufo]

Wenn ich doch von vornherein weiß - als Entwickler der Software sollte ich das wissen - dass die Anwendung beim Beenden noch etwas speichern muss (was auch länger dauert), dann kann man

Delphi-Quellcode:

ShutdownBlockReasonCreate

direkt beim Öffnen der Datei, Datenbank, whatever absetzen und wenn alles fertig ist, dann ein

Delphi-Quellcode:

ShutdownBlockReasonDestroy

.

Das ist auch wesentlich einfacher abzubilden als dieses Rumgefrickel wenn denn dann ein Herunterfahren ansteht.

Kann man so auch in der Doku lesen:

Zitat:

Applications should call this function as they begin an operation that cannot be interrupted, such as burning a CD or DVD. When the operation has completed, call the ShutdownBlockReasonDestroy function to indicate that the system can be shut down.

[BlueStarHH]

Zitat:

Zitat von Sir Rufo (Beitrag 1340922)

Wenn ich doch von vornherein weiß - als Entwickler der Software sollte ich das wissen - dass die Anwendung beim Beenden noch etwas speichern muss (was auch länger dauert), dann kann man

Delphi-Quellcode:

ShutdownBlockReasonCreate

direkt beim Öffnen der Datei, Datenbank, whatever absetzen und wenn alles fertig ist, dann ein

Delphi-Quellcode:

ShutdownBlockReasonDestroy

.

Genau so ist es. Siehe mein Post #6. Der Punkt wo genau ShutdownBlockReasonCreate aufgerrufen werden soll, ist hier wohl aber nicht das Problem. Windows zeigt wie gesagt, den Text der BlockReason an, (hat die BlockReason also erkannt) beendet das Programm aber trotzdem...

[BlueStarHH]

Zitat:

Zitat von THY4243 (Beitrag 1340920)

Vielleicht ein ähnlicher Ansatz, der auszugsweise wiedergegeben zum Erfolg führte.:
Der Post http://www.delphipraxis.net/965876-post19.html war hilfreich.

Delphi-Quellcode:

Deklarationen bei Form:

type
  TForm1 = class(TForm)

  ... 

  private
    { Private-Deklarationen }
    procedure WMQueryEndSession(var Msg: TMessage); message WM_QUERYENDSESSION; {Messageverarbeitung mit Message anmelden}
    procedure WMEndsession(var Msg: TMessage); message WM_ENDSESSION; {Messageverarbeitung mit Message anmelden}
  
  ...
  
  end;

.....

Delphi-Quellcode:

Prozeduren:


procedure TForm1.WMQueryEndSession(var Msg: TMessage);
// Abfolge der Closevorgänge: http://www.delphipraxis.net/965876-post19.html
//
// [X] am Fenster:                          Abmelden/Herunterfahren:
// OnCloseQuery                             WM_QUERYENDSESSION
// OnClose                                  OnCloseQuery
// OnDestroy                                WM_ENDSESSION
//
const
    ENDSESSION_CLOSEAPP = $00000001; {lParam - WM_QUERYENDSESSION}
    ENDSESSION_CRITICAL = $40000000;
    ENDSESSION_LOGOFF   = $80000000;

var CanClose: boolean;
begin
  if (Msg.Msg = WM_QUERYENDSESSION) then 
  begin
    ShutdownBlockReasonCreate(Application.Handle, ...
    Form1.FormCloseQuery(NIL,CanClose); {geht, wenn Msg.Result:= 1 nicht gegeben wird, allerdings ist dann das Herunterfahren unter XP behindert - Win7 nicht}  {In FormCloseQuery Aufgaben erledigen und CanClose setzen} 

    Application.ProcessMessages;
    Msg.Result:= ABS(DWORD(CanClose)); {mit 1= true  antworten, dann kommt WM_ENDSESSION}
    end
  else
  begin
    Msg.Result:= 1; {mit 1= true  antworten, dann kommt WM_ENDSESSION - sonst wartet Windows auf die}
                    {Beendigung - Schwarzer Abmeldewartebildschirm in Windows 7}
  end;
end;

procedure TForm1.WMEndsession(var Msg: TMessage);
begin
  if Msg.Msg = WM_ENDSESSION then   {WM_SETTINGCHANGE = 26}
  begin
    if Msg.WParam = 1 then  {Msg.Result:= 1 wurde in WM_QUERYENDSESSION gegeben -> WM_ENDSESSION mit Msg.WParam = 1}
    begin                   {"If the session is being ended, this parameter is TRUE; otherwise, it is FALSE"}
      Form1.Close; {CloseQuery -> Close}
    end;
    ShutdownBlockReasonDestroy(Application.Handle);
  end;
end;

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
{Problem beim automatisierten Herunterfahren/Abmelden: Thread arbeitet nur, wenn CanClose:= false}
{Abfolge: 1. X -> Form.CloseQuery -> Form.Close -> Form.Hide}
begin

  {Aufgaben erledigen und dann ...}

  CanClose := False; {Applikation/Formular kann nicht geschlossen werden}

  {oder}

  CanClose := True; {Applikation/Formular geschlossen werden}
 
end;

Das funktioniert unter Windows 10 auch nicht. Sogar die BlockReason wird bei Deinem Code nicht erkannt/gesetzt. Ist auch nicht verwunderlich, denn durch if (Msg.Msg = WM_QUERYENDSESSION) then wird der Code nie ausgeführt, da Win10 ein ENDSESSION_CRITICAL beim Beenden über den Button im Startmenü sendet. Aber auch wenn man die Zeile auskommentiert klappt es nicht: BlockReason nicht erkannt und Programm wird beendet.

[samso]

Ich habe mal was zusammen geschraddelt. Das ist nicht wirklich gut. Aber die angefragte Funktionalität ist da. D.h. der Neustart des Systems wird verhindert. Getestet mit Delphi 2007 unter Windows 10Pro-64Bit und Windows 7Pro-32Bit.

Edit: Geänderte Version. Zusätzlich mit ausführbarer Datei.

[BlueStarHH]

Zitat:

Zitat von samso (Beitrag 1340978)

Ich habe mal was zusammen geschraddelt. Das ist nicht wirklich gut. Aber die angefragte Funktionalität ist da. D.h. der Neustart des Systems wird verhindert. Getestet mit Delphi 2007 unter Windows 10Pro-64Bit und Windows 7Pro-32Bit.

Edit: Geänderte Version. Zusätzlich mit ausführbarer Datei.

Danke samso, Deine EXE läuft. Wenn ich dein Demoprojekt unverändert mit Delphi 2010 neu kompiliere, läuft es nicht mehr: Man sieht zwar den Text der BlockReason und es geht auch ganz kurz die Frage auf, ob gespeichert werden soll. Dann wird das Programm aber sofort und automatisch geschlossen, ohne das man einen Button im Dialog geklickt hat. Windows fährt dann nicht herunter.

Wenn ich das Projket mit Delphi 10 Seattle neu compliere ist alles OK. Was macht Delphi 2010 also anders? Evtl. eine Compiler-Einstellung oder ein Bug? Kann das jemand mal bitte mit Delphi 2010 ausprobieren? Im Anhang Dein Log, was meine mit Delphi 2010 erzeugte EXE geschrieben hat. Das sieht schon komisch aus.

[ConnorMcLeod]

Das könnte die Antwort sein ;-)
http://qc.embarcadero.com/wc/qcmain.aspx?d=84886

[dGeek]

Unter Windows 10 funktioniert dein beispielprojekt. Unter Windows 7 nicht mehr.