// Hiermit kann man Computer im Netzwerk (auch den eigenen) nach einer
// bestimmten Anzahl von Sekunden herunterfahren. Dabei wird auf diesem
// Computer eine Dialogbox gezeigt, welche neben einer speziellen Meldung
// auch noch die verbleibende Zeit bis zum Herunterfahren und den User
// anzeigt, welcher das Herunterfahren initialisiert hat.

// Getestet mit D4 unter XP

function ComputerShutDown(Computer: string; 
  CownDownSec: DWord; Restart: Bool): boolean; 
var 
  p: PChar; 
  dw: DWORD; 
  hToken: THANDLE; 
  Shutdown_Name, s: string; 
  ptkp, tkp: TOKEN_PRIVILEGES; 
begin 
  screen.cursor := crhourglass; 
  result := false; 
  dw := MAX_COMPUTERNAME_LENGTH + 1; 
  getmem(p, dw); 
  GetComputerName(p, dw); 
  s := p; 
  freemem(p); 
  if (Computer = '') or 
    (ansilowercase(copy(Computer, length(Computer) - length(s) + 1, length(s))) 
    = ansilowercase(s)) then 
    Shutdown_Name := 'SeShutdownPrivilege' else 
    Shutdown_Name := 'SeRemoteShutdownPrivilege'; 
  if Restart then 
    s := ' Er wird anschließend neu gestartet.' else 
    s := ''; 
  dw := TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY; 
  if OpenProcessToken(GetCurrentProcess, dw, hToken) then begin 
    if LookupPrivilegeValue(nil, PChar(Shutdown_Name), tkp.Privileges[0].Luid) 
      then begin 
      tkp.PrivilegeCount := 1; 
      tkp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED; 
      AdjustTokenPrivileges(hToken, FALSE, tkp, sizeof(ptkp), ptkp, dw); 
      if GetLastError = ERROR_SUCCESS then begin 
        Result := InitiateSystemShutdown(PChar(Computer), 
          PChar('Dieser Computer muss leider abgeschaltet werden.' 
          + s), CownDownSec, true, Restart); 
        AdjustTokenPrivileges(hToken, FALSE, ptkp, dw, tkp, dw); 
      end; 
    end; 
  end; 
  screen.cursor := crdefault; 
end; 
 
 
 
// --- Beispielaufrufe --- 
 
// einen Netzwerk-Computer herunterfahren 
 
procedure TForm1.Button1Click(Sender: TObject); 
begin 
  if not ComputerShutDown('\\PC100', 180, false) then 
    showmessage('Herunterfahren fehlgeschlagen.'); 
end; 
 
 
// den lokalen Computer herunterfahren und neu starten
 
procedure TForm1.Button2Click(Sender: TObject); 
begin 
  if not ComputerShutDown('', 90, True) then showmessage('FEHLER'); 
end;



Zugriffe seit 6.9.2001 auf Delphi-Ecke