Как правильно получить имя пользователя, запустившего процесс?

[Сергей089]

Всем доброго вечера. У меня такая задачка: получить список процессов всех пользователей по имени файла (например, Project1.exe) и среди них выделить процессы текущего пользователя. Если честно, я мало в этом понимаю, поэтому программу собирал из чужих кусков:

1) Получение списка процессов. 1 часть. Tool Help API.
2) Получить список процессов и имена пользователей от которых они запущены

Помогите, пожалуйста, определить пользователя запустившего процесс (и не положить программку ). Сейчас у меня программа валится в функции GetProcessUserName. Я не знаю, как правильно получить Token.

Если разкомментировать 1 вариант, то программа работает стабильно, но пользователя не показывает.
Если - 2 или 3 вариант, то:
- в Delphi работает стабильно и со своей задачей справляется
- при запуске с exe ложится

Пишу в Delphi XE. ОС: Win XP, Win 7, Win Server 2003.

Вот мой модуль:

unit UMain;

interface

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

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

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses tlhelp32;

function GetNamebySID(destSystem: PChar; sid: PSID):PChar;
var
  _userName : PChar;
  _Domain: PChar;
  _Needed : DWORD;
  _DomLen : DWORD;
  _use  : SID_NAME_USE;
begin
  Result := 0;
  _Needed := 0;
  _DomLen := 0;
  LookupAccountSid(destSystem, sid, 0, _Needed, 0, _DomLen,  _use);
  if GetLastError() = ERROR_INSUFFICIENT_BUFFER then
    begin
      Result := HeapAlloc(GetProcessHeap(), 0, _Needed);
      _Domain:= GetMemory(_DomLen);
      LookupAccountSid(destSystem, sid, Result, _Needed, _Domain, _DomLen, _use);
      FreeMemory(_Domain);
    end;
end;

function GetProcessUserName(Process:THandle):PChar;
type
  PTOKEN_USER = ^TOKEN_USER;
  _TOKEN_USER = record
    User : TSidAndAttributes;
  end;
  TOKEN_USER = _TOKEN_USER;

var
  _Token, hProcess:THandle;
  _Info:PTOKEN_USER;
  _Needed:DWORD;
begin
  Result:=0;

  // 1 - вариант
  //if not OpenProcessToken(Process, TOKEN_QUERY, _Token) then exit;
  // 2 - вариант
  if not OpenProcessToken(OpenProcess(PROCESS_ALL_ACCESS, FALSE, Process), TOKEN_QUERY, _Token) then exit;
  // 3 - вариант
  //hProcess := OpenProcess(PROCESS_ALL_ACCESS, FALSE, Process);
  //if not OpenProcessToken(hProcess, TOKEN_QUERY, _Token) then exit;
  

  _Needed:=0;
  GetTokenInformation(_Token, TokenUser, 0, 0, _Needed);
  if GetLastError() = ERROR_INSUFFICIENT_BUFFER then
    begin
      _Info := HeapAlloc(GetProcessHeap(), 0, _Needed);
      if GetTokenInformation(_Token, TokenUser, _Info, _Needed, _Needed) then
        Result:=GetNamebySID(0, _Info^.User.Sid);
      HeapFree(GetProcessHeap(),0, _Info);
    end;
  // к 3 варианту
  //CloseHandle(hProcess);
end;

[Сергей089]

...ограничение 5000 символов...

Продолжение модуля

function FillProcessesList(var slProcesses: TStringList): Boolean;
var
  hSnap: THandle;
  pe32: TProcessEntry32;

  function ArrayToString(const a: array of Char): string;
  var
    str: String;
  begin
    if Length(a)>0 then
      begin
        SetString(str, PChar(@a[0]), Length(a));
        if pos(#0, str) > 0 then
          str := copy(str, 1, pos(#0, str) - 1);
        Result := str;
      end
    else
      Result := '';
  end;

begin
  Result := False;
  if slProcesses = nil then // Проверяем корректность параметра
    Exit;
  // Получаем снапшот состояния системных объектов
  hSnap := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  // При ошибке - выходим
  if hSnap = INVALID_HANDLE_VALUE then
    Exit;
  pe32.dwSize := SizeOf(TProcessEntry32); // Обязательно заполняем поле размера
  if not Process32First(hSnap, pe32) then
    begin
      CloseHandle(hSnap); // Если процессов в снипе не было, то закрываем хэндл
      Exit;               // снимка и выходим с ошибкой
    end;
  repeat       // Получаем инфу о каждом процессе из снапшота
    if ArrayToString(pe32.szExeFile) = 'Project1.exe' then
      slProcesses.Add('PID: ' + IntToStr(pe32.th32ProcessID) +
                    ' EXE NAME: ' + pe32.szExeFile +
                    ' Пользователь: ' + strpas(GetProcessUserName(pe32.th32ProcessID)));
  until not Process32Next(hSnap, pe32);
  CloseHandle(hSnap); // Обязательно закрываем хэндл снапшота
  Result := True; // Функция выполнилась успешно
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  slProcessesList: TStringList; // Сюда будем пихать список процессов
begin
  slProcessesList := TStringList.Create; // Создаем объект
  if FillProcessesList(slProcessesList) then // Заполняем список процессов
    Memo1.Lines.Assign(slProcessesList)      // и передаем его в TMemo
  else                                       // или выводим ошибку.
    ShowMessage('Ошибка. Не могу получить список процессов.');
  slProcessesList.Free; // Уничтожаем объект.
  Caption := 'Строк: ' + IntToStr(Memo1.Lines.Count);
end;

end.