...shutdown a computer through a network connection?

Author: Manfred Ruzicka

Category: Internet / LAN

{-----------------------------------------------------------------------------
 Unit Name: shutdown
 Author:    Manfred Ruzicka
 Description: Mit diese Unit ist es möglich Betriebssysteme die auf Windows NT
              basieren herunterzufahren.
-----------------------------------------------------------------------------}


unit shutdown;

interface

uses
  
Windows,
  StdCtrls;

procedure shut(system, nachricht: string; force, reboot: Boolean; countdown: Integer);
procedure abortshut(system: string);

implementation

const
  
SE_SHUTDOWN_NAME = 'SeShutdownPrivilege';
var
  
hdlg: DWORD = 0;

procedure shut(system, nachricht: string; force, reboot: Boolean; countdown: Integer);
var
  
otoken, hToken: THandle;
  tp: TTokenPrivileges;
  h: DWORD;
begin
  
OpenProcessToken(GetCurrentProcess, TOKEN_ADJUST_PRIVILEGES, hToken);
  otoken := htoken;
  LookupPrivilegeValue(nil, SE_SHUTDOWN_NAME, tp.Privileges[0].luid);
  tp.privilegecount := 1;
  tp.privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
  h := 0;
  AdjustTokenPrivileges(hToken, False, tp, 0, PTokenPrivileges(nil)^, h);
  InitiateSystemShutdown(PChar(system), PChar(nachricht), countdown, force, reboot);
  tp.privilegecount := 1;
  tp.privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
  h := 0;
  AdjustTokenPrivileges(oToken, False, tp, 0, PTokenPrivileges(nil)^, h);
  CloseHandle(hToken);
end;

procedure abortshut(system: string);
var
  
hToken: THandle;
  tp: TTokenPrivileges;
  h: DWORD;
begin
  
OpenProcessToken(GetCurrentProcess, TOKEN_ADJUST_PRIVILEGES, hToken);
  LookupPrivilegeValue(PChar(system), SE_SHUTDOWN_NAME, 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);
  abortSystemShutdown(PChar(system));
end;

end.

 

printed from
www.swissdelphicenter.ch
developers knowledge base