Tipy a triky v Delphi, díl 104.

Jak zamknout pracovní stanici a jak zjistit kolik paměti zabírá náš proces, tak to je dnešní program.
Oba dnešní příklady jsou opět určeny pro generaci Windows na bázi NT a oba příklady budou uvedeny v jednom zdrojovém kódu. Nejprve tedy několik slov k prvnímu tipu, tedy k uzamčení pracovní stanice. Možná že znáte a používáte tuto funkci běžně. Pro ty z vás, kteří snad neví o co jde, jen krátké vysvětlení. Jednoduše řečeno, pokud potřebujete od počítače na chvilku odběhnout, nechcete ho kvůli tomu vypínat a přitom nechcete, aby vám někdo jiný koukal do monitoru nebo se vám dokonce přímo v počítači "hrabal", stačí vaší stanici zamknout. V systému NT a 2000 stačí stisknout obvyklou trojkombinaci CTRL+ALT+DEL a vybrat příslušnou funkci, v XP tuto záležitost vlastně nahrazuje volba "Přepnout uživatele". Opětovné odemknutí počítače pak provedete jednoduše přihlášením do systému, přičemž všechny aplikace budou ve stavu před zamknutím. V našem příkladu docílíme zamknutí stanice snadno využitím příslušné funkce z knihovny USER32.DLL a naše funkce pouze vrací logickou hodnotu pro kontrolu, zda se věc podařila či ne.

Náš druhý dnešní příklad bude z trochu jiného soudku. Jednoduchá funkce nám zjistí, kolik paměti zabírá naše aplikace (aktuální proces). K této funkci budeme potřebovat knihovnu psAPI. Nyní tedy společný zdrojový kód pro oba příklady:

unit Unit1;

interface

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

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 LockWS: Boolean;
type
  TLockWorkStation = function: Boolean;
var
  hUser32: HMODULE;
  LockWorkStation: TLockWorkStation;
begin
  result := False;
  hUser32 := GetModuleHandle(`USER32.DLL`);
  if hUser32 <> 0 then
  begin
    @LockWorkStation := GetProcAddress(hUser32, `LockWorkStation`);
    if @LockWorkStation <> nil then
    begin
      LockWorkStation;
      Result := True;
    end;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  if not LockWS then ShowMessage(`Chyba, funkci se nepodarilo spustit.`);
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  pmc: PPROCESS_MEMORY_COUNTERS;
  cb: Integer;
begin
  try
    cb := SizeOf(_PROCESS_MEMORY_COUNTERS);
    GetMem(pmc, cb);
    pmc^.cb := cb;
    if GetProcessMemoryInfo(GetCurrentProcess(), pmc, cb) then ShowMessage(IntToStr(pmc^.WorkingSetSize) + ` Bytes`)
    else ShowMessage(`Chyba, nelze zjistit pouziti pameti.`);
    FreeMem(pmc);
  except
  end;
end;

end.

Jak bylo řečeno v úvodu, dnešní příklady budou pracovat pouze pod NT systémy. Ve starších systémech však k žádné chybě nedojde, prostě se nic nestane.

Diskuze (1) Další článek: W32.Sobig.F: další červ útočí, tentokrát poštou

Témata článku: Software, Windows, Programování, Trik, 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

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

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

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


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