Hallo.

Nachdem ich nun seit 1 Woche an dem Problem hänge, frage ich mal hier nach.

Es geht um folgendes: Mein Programm bekommt beim Herunterfahren nicht die Möglichkeit zum Speichern.

Es sei folgender Thread gegeben;

zusammenfalten · markieren

Delphi-Quellcode:

type
   TMyThread = class(TThread)
     private
        Abbrechen: boolean;
        Fertig: boolean;
     protected
        procedure Execute; override;
     public
        function MyHalt: boolean;
        constructor create; virtual;
   end;
   
constructor TMyThread.create;
begin
  inherited create(true);
  freeOnTerminate := true;
end;

procedure TMyThread.Execute;
begin
  fertig := false;
  repeat
    if Abbrechen then break; // Abbrechen ist ein Flag, der die Schleife zum Verlassen verleitet
    form2.Label1.Caption := inttostr(strtoint(form2.Label1.Caption)+1);
  until false;
  sleep(10000); // Symbolisiert einen langen Speichervorgang
  form2.label1.caption := 'Sauber beendet';
  sleep(10000);
  fertig := true; // Der Funktion "MyHalt" mitteilen, dass wir fertig sind!
end;

//nDelay-Millisekunden nix tun
procedure Schlafen(nDelay: Integer);
var
nStart : Integer;
begin
nStart := GetTickCount;
while integer(GetTickCount)-nStart < nDelay do begin
Application.ProcessMessages;
Sleep(0);
end;
end;

function TMyThread.MyHalt: boolean;
begin
  Abbrechen := true; // Die Funktion Execute soll ihre interne Endlosschleife nun verlassen und Speichern
  while not fertig do Schlafen(1000); // Warten, bis interne Schleife im Thread selbstständig beendet und alles abgespeichert
  result := true;
end;

Der Thread wird von einem Timer einmalig gestartet:

zusammenfalten · markieren

Delphi-Quellcode:

type
  TForm2 = class(TForm)
  {...}
  public
    thr: TMyThread;

procedure TForm2.Timer1Timer(Sender: TObject);
begin
  timer1.Enabled := false;

  SetPriorityClass(GetCurrentProcess, IDLE_PRIORITY_CLASS);

  thr := TMyThread.create;
  thr.Resume;
end;

Beim Beenden des Programms wird der Thread angehalten. Er hat die Möglichkeit zu speichern und darf sich dabei Zeit lassen!

zusammenfalten · markieren

Delphi-Quellcode:

type
  TForm2 = class(TForm)
  {...}
  private
    procedure WMQueryEndSession (var Msg: TWMQueryEndSession); message WM_QueryEndSession;

procedure TForm2.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  thr.MyHalt;
end;

// Auch bereits mit nur EndSession probiert!
procedure TForm2.WMQueryEndSession
      (var Msg : TWMQueryEndSession) ;
begin
  thr.MyHalt;
  Msg.Result := 1 ;
end;

Das normale Schließen funktioniert wie erwartet. Es wird 20 Sekunden gewartet, die Meldung ist vorhanden und es wurde somit symbolisch abgespeichert.

Das Problem ist nun: Egal wie ich es mache - das Programm bekommt beim Herunterfahren nicht die Möglichkeit, "abzuspeichern". Normalerweiße sollte der Counter sofort nach dem Klick auf "Herunterfahren" anhalten (aufgrund des Setzens von "Abbrechen:=true" bei "MyHalt"). Dann sollte das Programm 10 Sekunden verweilen und dann "Sauber beendet" anzeigen, dann nocheinmal 10 Sekunden warten und dann erst sollte es schließen. Was ist hier falsch?
Ich habe es schon mit allen möglichen Variationen - mit und ohne Thread, mit nur EndSession oder nur QueryEndSession oder beides usw.
Kann mir jemand helfen?

Gruß
blackdrake

// Nachtrag: Das Problem war ein fehlerhaft gesetzter Regkey (ich glaube es war "AutoEndTasks"). Keine Ahnung, welches geniale "Tool" einen solch dummen Wert ohne meine Kenntnis verändert hat.
// http://www.addictivetips.com/windows...tdown-process/

Weiß niemand eine Lösung?

Vielleicht hilft dir das: http://andreas-lauss.de/archives/akt...s-beendet-wird

Hallo.

Hilft leider nichts. Ich habe ja beider Windows-Signale WM_ENDSESSION und WM_QUERYENDSESSION schon in verschiedenen Kombinationen durchprobiert. Windows beendet das Programm gewaltsam, obwohl es durch die Verspätung von MyHalt() nicht mal ein QueryEndSession.Result = 1 bekommen hat.

Gruß
blackdrake

Was für ein Betriebsystem?

Vermutlich Vista.

Hallo Daniel,

warum arbeitest du nicht mit den VCL-Ereignissen?

zusammenfalten · markieren

Delphi-Quellcode:

unit CustThread;

interface

uses
  Classes;

type
  TCustomThread = class(TThread)
  private
    procedure ShowProgress;
    procedure AfterTermination(Sender: TObject);
  protected
    procedure Execute; override;
  public
    constructor Create;
  end;


implementation

uses
  SysUtils,
  MainFrm;

constructor TCustomThread.Create;
begin
  inherited Create(True);
  OnTerminate := AfterTermination;
end;

procedure TCustomThread.AfterTermination(Sender: TObject);
begin
  Sleep(5000);
end;

procedure TCustomThread.ShowProgress;
begin
  MainForm.Panel.Caption := TimeToStr(Now);
end;

procedure TCustomThread.Execute;
begin
  while not Terminated do
    Synchronize(ShowProgress);
end;

end.

Und hier noch das Testbett:

zusammenfalten · markieren

Delphi-Quellcode:

unit MainFrm;

interface

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

type
  TMainForm = class(TForm)
    Panel: TPanel;
    procedure PanelClick(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  private
    CustomThread: TCustomThread;
  end;

var
  MainForm: TMainForm;

implementation

{$R *.dfm}

procedure TMainForm.PanelClick(Sender: TObject);
begin
  Panel.OnClick := nil;
  CustomThread := TCustomThread.Create;
  CustomThread.Resume;
end;

procedure TMainForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  CustomThread.Terminate;
  CustomThread.Free;
  CanClose := True;
end;

end.

Grüße vom marabu

@Luckie: Ich habe Windows XP

@marabu: Danke für den Hinweis. Der Code ist jetzt etwas schlanker, aber leider funktioniert es immer noch nicht. Nach ca. 3 Sekunden schließt Windows den Prozess. Die ersten 10 Sekunden hält er also nicht mal durch. Wie soll denn das funktionieren, wenn ich vorher eine große Datenmenge abspeichern will? Ich bin am verzweifeln...

zusammenfalten · markieren

Delphi-Quellcode:

procedure TForm2.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  memo1.Lines.add('Close');
end;

procedure TForm2.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  memo1.Lines.add('QClose');
  thr.Terminate;
  thr.Free;
end;

procedure TForm2.Timer1Timer(Sender: TObject);
begin
  timer1.Enabled := false;

  SetPriorityClass(GetCurrentProcess, IDLE_PRIORITY_CLASS);

  thr := TMyThread.create;
  thr.Resume;
end;

procedure TMyThread.AfterTermination(Sender: TObject);
begin
  form2.memo1.Lines.add('1');
  sleep(10000);
  form2.memo1.Lines.add('2');
  sleep(10000);
  form2.memo1.Lines.add('3');
  sleep(10000);
end;

constructor TMyThread.create;
begin
  inherited create(true);
  OnTerminate := AfterTermination;
end;

procedure TMyThread.Execute;
begin
  repeat
    if Terminated then break;
    form2.Label1.Caption := inttostr(strtoint(form2.Label1.Caption)+1);
  until false;
  form2.memo1.Lines.add('ExecuteFertig');
end;

Gruß
blackdrake

Wenn du in meinem Code-Beispiel die Dauer von Sleep() erhöhst, dann solltest du den gewünschten Effekt beobachten können. Ich schlage vor, du kommentierst die für dein Logging bestimmten Zeilen erstmal aus und schaust, ob du dann die Wartezeit frei bestimmen kannst. Hast du dir schon die Informationen zu Synchronize() durchgelesen?

Gute Nacht

Wie ist dein Windows eingestellt? Das heißt, wie lange wartet es, bis es den "hängenden" Prozess abschießt?