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.