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.

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.