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.