Добрейщего.
Есть функция проверки запущенности процесса в указанной сессии.
Почему то при многократном запуске она начинает нехило поджирать память. FastMM ничего не показывает при этом. Где цобакен не пойму.

unit Unit5;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;

type
  _WTS_PROCESS_INFO = record
    SessionId: DWORD;
    ProcessId: DWORD;
    pProcessName: LPTSTR;
    pUserSid: PSID;
  end;
  PWTS_PROCESS_INFO = ^_WTS_PROCESS_INFO;

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

const
  WTS_CURRENT_SERVER_HANDLE = THandle(0);

var
  Form5: TForm5;

  function WTSEnumerateProcessesEx(hServer: THandle; var pLevel: DWORD; SessionID: DWORD; var ppSessionInfo: PWTS_PROCESS_INFO; var pCount: DWORD): BOOL; stdcall; external 'Wtsapi32.dll' name 'WTSEnumerateProcessesExW';
  procedure WTSFreeMemory(pMemory:pointer); stdcall; external 'Wtsapi32.dll' name 'WTSFreeMemory';

implementation

{$R *.dfm}

function ProcessStartedInSession(ProcessName: String; SessionID: Integer): Boolean;
var
   pArrProcessInfo, p: PWTS_PROCESS_INFO;
   iNumProc: DWORD;
   i: Integer;
   pLevel: DWORD;
begin
  Result := False;
  pLevel := 0;
  if WTSEnumerateProcessesEx(WTS_CURRENT_SERVER_HANDLE, pLevel, SessionID, PWTS_PROCESS_INFO(pArrProcessInfo), iNumProc) then
  try
    p := pArrProcessInfo;
    for i := 0 to iNumProc - 1 do
    begin
      if UpperCase(p.pProcessName) = UpperCase(ProcessName) then
      begin
        Result := True;
        Break;
      end;
      Inc(p);
    end;
  finally
    WTSFreeMemory(pArrProcessInfo);
  end;
end;

procedure TForm5.Button1Click(Sender: TObject);
var
  i: Integer;
begin
  for i := 0 to 1000 do
  begin
    ProcessStartedInSession('asdads', 1);
    Sleep(10);
  end;
end;

end.