Einzelnen Beitrag anzeigen

DoktorD

Registriert seit: 13. Dez 2005
153 Beiträge
 
#1

ExitWindowsEx (Computer herunterfahren) funktioniert nicht

  Alt 15. Okt 2007, 09:15
Programm 1:
Also, ich habe ein Programm im hintergrund laufen, welches die ganze Zeit einen Zustand auf der COM Schnittstelle abfragt. Tritt dieser Zustand ein, dann soll der Rechner herunterfahren.

Programm 2:
Ein zweites Programm läuft jedoch noch, und diesem soll es ermöglicht werden, noch schnell die Daten zu sichern.
Dies geschieht mit FormCloseQuery. Im Beispiel lasse ich einfach einen Countdown rückwärts laufen.

Das Problem:
Programm 1 funktioniert, solange keine anderen Fenster (Programme) geöffnet sind.
Wenn aber andere Programme geöffnet sind (Programm 2), dann werden diese zwar so beenden wie ich es will, aber der Rechner fährt nicht herunter.

Was mache ich falsch?
Habe den Code auch als Datei angehängt. Um den Zustand von Programm 1 zu erzeugen, hab ich extra einen Button (Button1) hinzugefügt.

Hier mein Quellcode:

Programm 1:
Delphi-Quellcode:
unit UntApplication;

interface

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

type
  TExit=(Reboot,Shutdown,Logoff,Hibernate,Standby);

type
  TFrmApplication = class(TForm)
    edtDCDStatus: TEdit;
    Timer: TTimer;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure btnDCDClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    m_COMPort : TComPort;
    bLEDStatus : Boolean;
    bshutdown : Boolean;

    procedure ExitWin(Exit:TExit;Force:boolean);
    procedure GetShutdownPrivileges;
  public
    { Public-Deklarationen }
  end;

var
  FrmApplication: TFrmApplication;

implementation

{$R *.dfm}

procedure TFrmApplication.btnDCDClick(Sender: TObject);
begin
  edtDCDStatus.Text := IntToStr(m_COMPort.DCD);
end;

procedure TFrmApplication.Button1Click(Sender: TObject);
begin
  ExitWin(Shutdown,true);
end;

procedure TFrmApplication.FormCreate(Sender: TObject);
begin
  m_COMPort := TComPort.Create(1);
  m_COMPort.DTR(1);
  m_COMPort.RTS(1);
end;

procedure TFrmApplication.Timer1Timer(Sender: TObject);
begin
  if m_COMPort.DCD = 1 then
  begin
    bshutdown := true;
    ExitWin(Shutdown,true);
  end;

  if bshutdown then
  begin
    edtDCDStatus.Text := 'Taster wurde geschlossen. Rechner wird heruntergefahren';
    if bLEDStatus then
    begin
      m_COMPort.RTS(0);
      bLEDStatus := False;
    end
    else
    begin
      m_COMPort.RTS(1);
      bLEDStatus := True;
    end;
  end
  else
  edtDCDStatus.Text := 'Taster geöffnet';
end;



procedure TFrmApplication.ExitWin(Exit:TExit;Force:boolean);
var Flags:integer;
begin
  GetShutdownPrivileges;
  if Exit=Shutdown then
    ExitWindowsEx(EWX_ShutDown,0);

  if Exit=Hibernate then
    SetSystemPowerState(false,Force);

  if Exit=Standby then
    SetSystemPowerState(true,Force);

  if Exit=Logoff then
  begin
    Flags:=EWX_LOGoff;
    if Force then
      flags:=flags+EWX_FORCE;
    ExitWindowsEx(flags,0);
  end;

  if Exit=Reboot then
  begin
    flags:=EWX_REBOOT;
    if Force then
      flags:=flags+EWX_FORCE;
    ExitWindowsEx(flags,0);
  end;
end;


procedure TFrmApplication.GetShutdownPrivileges;
var vi : TOSVersionInfo;
    hToken : THandle;
    tp : TTokenPrivileges;
    h : DWord;
begin
  vi.dwOSVersionInfoSize:=SizeOf(vi);
  GetVersionEx(vi);
  if vi.dwPlatformId = VER_PLATFORM_WIN32_NT then
  begin
    OpenProcessToken(GetCurrentProcess(),TOKEN_ADJUST_PRIVILEGES,hToken);
    LookupPrivilegeValue(nil,'SeShutdownPrivilege',tp.Privileges[0].Luid);
    tp.PrivilegeCount := 1;
    tp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
    h := 0;
    AdjustTokenPrivileges(hToken,False,tp,0,PTokenPrivileges(nil)^,h);
    CloseHandle(hToken);
  end;
end;


end.
Programm 2:
Delphi-Quellcode:
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    Timer1: TTimer;
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure Timer1Timer(Sender: TObject);
  private
    nCountdown: Integer;
    bShutdown : Boolean;
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  CanClose := False;
  nCountdown := 20;
  if not bShutdown then
    Timer1.Enabled := True
  else
    CanClose := True;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  nCountdown := nCountdown -1;
  Edit1.Text := 'Fenster schließt in ' + IntToStr(nCountdown) + ' Sekunden';
  if nCountdown = 0 then
  begin
    bShutdown := true;
    Timer1.Enabled := False;
    Close;
  end;
end;

end.
Angehängte Dateien
Dateityp: rar beide_programme_183.rar (386,3 KB, 7x aufgerufen)
  Mit Zitat antworten Zitat