Živě.cz o počítačích a internetu

Tipy a triky v Delphi, díl 146. – kdo je vlastník procesu?

Jan Šindelář 7.7.2004

Dnešní článek vznikl (ostatně jako už mnohokrát) na popud jednoho ze čtenářů, který pro svůj program potřeboval vytvořit funkci, která u spuštěných procesů zjistí jejich vlastníka. Přesně to si právě dnes ukážeme.

Jméno vlastníka běžícího procesu může být velmi užitečná informace. Hodí se například pro různé bezpečnostní programy, které monitorují aktivity uživatelů, zaznamenávají podezřelé činnosti či pády aplikací.

Vlastníkem procesu může být jak samotný systém, tak konkrétní uživatel a navíc může být přihlášeno i několik uživatelů naráz a každý může mít spuštěny vlastní procesy. Proto je nezbytně nutné vědět, kterému uživateli daný proces patří a nestačí nám znát jméno aktuálně přihlášeného (resp. pod Windows XP aktuálně pracujícího) uživatele.

Ukážeme si tedy postup, jak prostřednictvím identifikačního čísla procesu zjistit jméno jeho vlastníka. S využitím knihovny TlHelp32 naše jednoduchá aplikace zobrazí seznam běžících procesů spolu se jmény jejich vlastníků.

Na prázdný formulář si připravíme pouze komponentu ListView ve stylu vsReport a připravíme si čtyři sloupce - v prvním bude číslo procesu, dále jméno procesu, uživatel a doména. Po spuštění programu se pak v rámci události OnCreate formuláře načtou postupně informace o všech procesech s využitím funkce GetUserAndDomainFromPID a zobrazí v ListView.

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    ListView1: TListView;
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

  PTOKEN_USER = ^TOKEN_USER;
  _TOKEN_USER = record
                  User: TSidAndAttributes;
                end;
  TOKEN_USER = _TOKEN_USER;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function GetUserAndDomainFromPID(ProcessId: DWORD; var User, Domain: string): Boolean;
var
  hToken: THandle;
  cbBuf: Cardinal;
  ptiUser: PTOKEN_USER;
  snu: SID_NAME_USE;
  ProcessHandle: THandle;
  UserSize, DomainSize: DWORD;
  bSuccess: Boolean;
begin
  Result := False;
  ProcessHandle := OpenProcess(PROCESS_QUERY_INFORMATION, False, ProcessId);
  if ProcessHandle <> 0 then
  begin
    if OpenProcessToken(ProcessHandle, TOKEN_QUERY, hToken) then
    begin
      bSuccess := GetTokenInformation(hToken, TokenUser, nil, 0, cbBuf);
      ptiUser  := nil;
      while (not bSuccess) and (GetLastError = ERROR_INSUFFICIENT_BUFFER) do
      begin
        ReallocMem(ptiUser, cbBuf);
        bSuccess := GetTokenInformation(hToken, TokenUser, ptiUser, cbBuf, cbBuf);
      end;
      CloseHandle(hToken);
      if not bSuccess then Exit;
      UserSize := 0;
      DomainSize := 0;
      LookupAccountSid(nil, ptiUser.User.Sid, nil, UserSize, nil, DomainSize, snu);
      if (UserSize <> 0) and (DomainSize <> 0) then
      begin
        SetLength(User, UserSize);
        SetLength(Domain, DomainSize);
        if LookupAccountSid(nil, ptiUser.User.Sid, PChar(User), UserSize, PChar(Domain), DomainSize, snu) then
        begin
          Result := True;
          User := StrPas(PChar(User));
          Domain := StrPas(PChar(Domain));
        end;
      end;
      if bSuccess then FreeMem(ptiUser);
    end;
    CloseHandle(ProcessHandle);
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  hProcSnap: THandle;
  pe32: TProcessEntry32;
  Domain, User: string;
begin
  ListView1.Items.BeginUpdate;
  hProcSnap := CreateToolHelp32SnapShot(TH32CS_SNAPALL, 0);
  if hProcSnap = INVALID_HANDLE_VALUE then Exit;
  pe32.dwSize := SizeOf(ProcessEntry32);
  if Process32First(hProcSnap, pe32) then
    while Process32Next(hProcSnap, pe32) do
    begin
      if GetUserAndDomainFromPID(pe32.th32ProcessID, User, Domain) then
      begin
        with Listview1.Items.Add do
          begin
            Caption := IntToStr(pe32.th32ProcessID);
            SubItems.Add(pe32.szExeFile);
            SubItems.Add(user);
            SubItems.Add(domain);
          end;
      end else Listview1.Items.Add.SubItems.Add(pe32.szExeFile);
    end;
  CloseHandle(hProcSnap);
  ListView1.Items.EndUpdate;
end;

end.

U některých systémových procesů, na které funkce nebude úplně úspěšná, se nám zobrazí pouze jméno procesu (viz. Větev Else u příslušného větvení). Tentýž případ nastane, pokud postup použijeme pod starší generací Windows 9x. Vždy by tedy funkci měl předcházet test, na kterém systému běží. Pro řadu 9x je pak vlastníkem procesů přihlášený uživatel, pro novější generaci NT pak použijeme funkci v plném rozsahu.

Ukázkový projekt vytvořený v Delphi7 si opět můžete stáhnout.