Tipy a triky v Delphi, díl 99.

Je to už hodně dávno, někdy na samém začátku našeho seriálu, kdy jsme si povídali o programovém vypnutí či restartu počítače. No a dneska si povíme ještě o další možnosti, jak počítač vypnout.
Možná si ještě vzpomenete na původní funkce v jednom z prvních dílů seriálu. Pomocí nich naše aplikace dokázala restartovat či zcela vypnout počítač. Po stisknutí tlačítka se pak požadovaná funkce ihned provedla. Případně jste si mohli vytvořit jednoduchý program na vypnutí počítače po uplynutí určité doby, stačilo opatřit aplikaci jednoduchým Timerem. Tak či tak, naše aplikace musela v rozhodujícím okamžiku vypnutí počítače běžet, protože právě naše aplikace vydala příkaz, aby se systém ukončil.

Co když ale chceme, aby náš program sice vydal pokyn k vypnutí systému, ale aby nemusel v onu "kritickou" chvíli běžet? Jednoduše řečeno, naše aplikace rozkáže systému, aby se vypnul například za 5 minut a pak můžeme naší aplikaci klidně ukončit. Systém už se o zbytek postará. Přihlášeným uživatelům se zobrazí výstražné varování o tom, že bude systém vypnut a jaký uživatel k tomu vydal pokyn. Zároveň bude v tomto dialogovém okně i zobrazen odpočet času, zbývajícího do restartu. Navíc je ještě v tomto malém okně i místo pro zprávu pro uživatele, kde můžete blíže vysvětlit, proč k restartu či vypnutí dochází.

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function TimedShutDown(Computer: string; Msg: string; Time: Word; Force: Boolean; Reboot: Boolean): Boolean;
var
  rl: Cardinal;
  hToken: Cardinal;
  tkp: TOKEN_PRIVILEGES;
begin
  if not OpenProcessToken(GetCurrentProcess, TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, hToken) then ShowMessage(`Cannot open process token.`)
  else
  begin
    if LookupPrivilegeValue(nil, `SeShutdownPrivilege`, tkp.Privileges[0].Luid) then
    begin
      tkp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
      tkp.PrivilegeCount := 1;
      AdjustTokenPrivileges(hToken, False, tkp, 0, nil, rl);
      if GetLastError <> ERROR_SUCCESS then ShowMessage(`Error adjusting process privileges.`);
    end
  else
    ShowMessage(`Cannot find privilege value.`);
  end;
  Result := InitiateSystemShutdown(PChar(Computer), PChar(Msg), Time, Force, Reboot)
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  if not TimedShutDown(`\\pocitac`, `Pozor, pocítac bude restartován!`, 30, true, true) then ShowMessage(`Chyba, funkci se nepodarilo spustit...`);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  AbortSystemShutdown(`\\pocitac`);
end;

end.

Asi už vás napadlo z předchozího odstavce, že tato funkce bude pracovat pouze pod systémy NT/2000/XP. Starší řada 9x zobrazí při pokusu o aktivování funkce varovné hlášení a neprovede samozřejmě nic.

Všimněte si na konci zdrojového kódu ještě jedné funkce - AbortSystemShutdown. Ta slouží, jak říká její název, ke zrušení příkazu na vypnutí počítače. Stihnete-li tedy včas než vyprší daný časový interval tuto funkci aktivovat například stiskem příslušného tlačítka jako v našem příkladu, odpočítávání bude zrušeno a systém se nevypne.

Nesmíme zapomenout na popis parametrů naší funkce TimedShutDown. Prvním parametrem je název počítače, který chceme vypnout. Dále máme textovou proměnnou, kde můžeme napsat onu konkrétnější zprávu pro uživatele. Číslo, které následuje, udává v sekundách dobu, za jakou k restartu či vypnutí dojde. Předposlední logická proměnná určuje, zda chceme provést "násilné" vypnutí, tedy bez ohledu na to, v jakém stavu jsou ostatní spuštěné aplikace a zda nám chtějí vypnutí "dovolit". Poslední parametr určuje, zda dojde jen k restartu nebo k úplnému vypnutí.

Diskuze (2) Další článek: Microsoft vydal Web Services Enhancements version 2 pro zvýšení bezpečnosti webových služeb

Témata článku: Software, Windows, Programování, Restart, Trik, Vypnutí, Požadovaná funkce, Pokyn, Token, Díl


Určitě si přečtěte

Apple: naše mapy budou nejlepší na světě. Tajně jsme na nich pracovali několik let

Apple: naše mapy budou nejlepší na světě. Tajně jsme na nich pracovali několik let

** Apple odhalil své plány na zcela nové mapy ** Několik let pracuje na nových mapách, které by měly předběhnout konkurenci ** Objeví se s příchodem iOS 12 pro vybrané státy

Karel Javůrek | 50

Rekordy počasí: V Česku to ještě jde, skutečné extrémy zažívají jinde

Rekordy počasí: V Česku to ještě jde, skutečné extrémy zažívají jinde

** Teplotní extrémy dokážou překvapit. Seznamte se s rekordy v Česku i ve světě ** Rekordní hodnoty jsou mnohdy až k neuvěření ** Zjistěte, kdy ke bylo největší horko, zima, déšť či vítr

Karel Kilián | 7

Nová zbraň Microsoftu proti iPadu: Levný tablet Surface Go bude stát jen deset tisíc

Nová zbraň Microsoftu proti iPadu: Levný tablet Surface Go bude stát jen deset tisíc

** Microsoft představil nový tablet Surface Go ** Nový model zaujme nízkou cenou, ale schopnostmi zařízení Surface ** Microsoft nepoužil čip ARM, ale klasický procesor od Intelu 

Karel Javůrek | 116

15 věcí, které umí Windows 10, ale možná o nich vůbec nevíte

15 věcí, které umí Windows 10, ale možná o nich vůbec nevíte

** Systém Windows 10 umí spoustu užitečných drobností ** O mnoha praktických funkcích pravděpodobně ani nevíte ** Poznejte užitečné tipy, které se vám mohou hodit každý den

Vladislav Kluska | 36

Porno insider: Jak virtuální realita vstupuje do filmů pro dospělé

Porno insider: Jak virtuální realita vstupuje do filmů pro dospělé

** Pornografie údajně představuje třetinu internetové obsahu a je technologický tahounem ** Do erotického obsahu postupně zasahuje i virtuální realita ** Kromě vizuálního vjemu se pracuje také na virtuálním uspokojení toho hmatového

Jan Dudek | 28

Sex a rozmnožování při mezihvězdné cestě: Kolik lidí je potřeba pro let k Proximě Centauri?

Sex a rozmnožování při mezihvězdné cestě: Kolik lidí je potřeba pro let k Proximě Centauri?

** Vědci spočítali, jak velká by musela být posádka pro vícegenerační let k nejbližší hvězdné soustavě ** Proxima Centauri se nachází 4,3 světelných let od nás ** Za současných technologií bychom k ní letěli 6300 let

Petr Kubala | 52


Aktuální číslo časopisu Computer

Velký test 18 bezdrátových sluchátek

Vše o přechodu na DVB-T2

Procesory AMD opět porážejí Intel

7 NVMe M.2 SSD v přímém souboji