Windows 8 Schnelles Herunterfahren verhindert WMEndSession Messages?

[Ulrich Berger]

Hallo,

also soweit ich weiß ist tatsächlich standardmäßig das schnelle Herunterfahren unter Windows 8 aktiviert. Dazu stand vor ein paar Wochen mal etwas bei heise online, damals ging es darum daß es zu Datenverlust kommen kann wenn während Windows sich in diesem Zustand befindet von einem anderen Betriebssystem aus etwas am Dateisystem geändert wird.

Gruß Uli

[Real_Nikotin]

Also Problem bestand wirklich nur dahingehend das Firemonkey keinen Windows Message Handler besitzt. Ich hatte das glatt vergessen

Hier eine kurze Lösung um auch unter Firemonkey auf die Message zu reagieren:

Delphi-Quellcode:

unit shut;

interface

uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes, FMX.Forms, FMX.Platform.Win, FMX.Types,
FMX.Layouts, FMX.Memo;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    FHwnd: HWND;
    FOldWndProc: LONG;

    { Private-Deklarationen }
  public
    function WndProc(Hwnd: HWND; Msg:UINT; wParam: WPARAM; lParam: LPARAM): LRESULT;
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.fmx}

function WindowProc(Hwnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
begin
Result := Form1.WndProc(Hwnd, Msg, wParam, lParam);
end;


procedure TForm1.FormCreate(Sender: TObject);
begin
 FHwnd := FmxHandleToHwnd(Handle);
FOldWndProc := GetWindowLongPtr(FHwnd, GWL_WNDPROC);

SetWindowLongPtr(FHwnd, GWL_WNDPROC, NativeInt(@WindowProc));
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
SetWindowLongPtr(FHwnd, GWL_WNDPROC, FOldWndProc);
end;

function TForm1.WndProc(Hwnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT;
var TempList : TSTringList;
begin
Result := 0;

If Msg = WM_EndSession then
begin
    // BEREICH WAS BEIM SHUTDOWN PASSIEREN SOLL / Unabhängig von OnClose!
    sleep(10000);
    TempList := TStringList.Create;
    TEmpList.Add('TEST');
    TempList.SaveToFile(ExtractFilePath(ParamStr(0))+'Shutdown.txt');
    TempList.Free;
end;

Result := CallWindowProc(Ptr(FOldWndProc), Hwnd, Msg, wParam, lParam);
end;


end.

Vielleicht schaut mal einer drüber? Funktionieren tut es wie es soll aber vielleicht kennt jemand ne Ausnahme in der das so nicht funktionieren wird.

[jaenicke]

Ich würde dringend dazu raten das ab Vista sauber mit ShutdownBlockReasonCreate zu lösen:
http://msdn.microsoft.com/en-us/libr...(v=vs.85).aspx

Nur so bekommt der Benutzer (deine Meldung) angezeigt warum dein Programm nicht abgeschossen werden und der Shutdown trotzdem durchgeführt werden soll.

[hathor]

Mit regedit die Zeit in WaitToKillServiceTimeout verlängern.
Bei mir steht 12000 drin, was vermutlich 12 sec sind...

Delphi-Quellcode:

Windows Registry Editor Version 5.00

[HKEY_LOCAL_MACHINE\SYSTEM\ControlSet001\Control]
"WaitToKillServiceTimeout"="12000"

Mit dem Tool UWT - Ultimate Windows Tweaker kann man das u.a. bequem einstellen.
http://www.thewindowsclub.com/ultima...indows-7-vista

[jaenicke]

Die Timeouts zu verlängern wäre aber keine Lösung, sondern nur ein Verdecken des Problems auf Kosten des genervten Benutzers. Mit ShutdownBlockReasonCreate kann man das ganze sehr elegant lösen, also wozu an Systemeinstellungen herumschrauben?