How can we determine a program is already running in either in the current user or other user in delphi

Question

I am trying to determine whether a certain process is running under the current user or under another user on the same pc. I've applied the following code and it works well as it program can determine the process from the task manager if that the certain process is running under the current user. Is there any ways to allow me to determine the running process if it is running under another user?

function ProcessExist(const APName: string; out PIDObtained: Cardinal): Boolean;
var
  isFound: boolean;
  AHandle, AhProcess: THandle;
  ProcessEntry32: TProcessEntry32;
  APath: array [0 .. MAX_PATH] of char;
begin
  AHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  try
    ProcessEntry32.dwSize := SizeOf(ProcessEntry32);
    isFound := Process32First(AHandle, ProcessEntry32);
    Result := False;
    while Integer(isFound) <> 0 do
    begin
      AhProcess := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, false, ProcessEntry32.th32ProcessID);

      if (UpperCase(StrPas(APath)) = UpperCase(APName)) or (UpperCase(ExtractFileName(ProcessEntry32.szExeFile)) = UpperCase(APname)) or
      (UpperCase(ProcessEntry32.szExeFile) = UpperCase(APName)) then begin
        GetModuleFileNameEx(AhProcess, 0, @APath[0], SizeOf(APath));
        if ContainsStr(StrPas(APath), TPath.GetHomePath() + TPath.DirectorySeparatorChar) then begin
          PIDObtained := ProcessEntry32.th32ProcessID;
          Result := true;
          break;
        end;
      end;
      isFound := Process32Next(AHandle, ProcessEntry32);
      CloseHandle(AhProcess);
    end;
  finally
    CloseHandle(AHandle);
  end;
end;

Does this answer your question? [How to check if a process belongs to the current user?](https://stackoverflow.com/questions/40674193/how-to-check-if-a-process-belongs-to-the-current-user) — Peter Wolf, Nov 23 '20 at 08:07
I have tried that, but when the application is running under other user on the same laptop, that code could not get the username of that user. — Leong, Nov 23 '20 at 08:47
You probably need to run your program with admin privileges. — fpiette, Nov 23 '20 at 09:32
`UpperCase()` only considers latin letters, which is by far not enough. — AmigoJack, Nov 23 '20 at 10:02
@AndreasRejbrand `AnsiUpperCase=...` isn't equivalent to `SameText(...)` once you leave the ASCII realm. — David Heffernan, Nov 23 '20 at 11:07
"Is there any ways to allow me to determine the running process if it is running under another user?" I don't understand the question. When you say the "running process", do you mean the process that is executing your code? And when you say "another user", you mean what exactly? — David Heffernan, Nov 23 '20 at 11:11
Leong: `AnsiUpperCase(X) = AnsiUpperCase(Y)` is better, but not as good as `AnsiSameText(X, Y)` or `SameText(X, Y, TLocaleOptions.loUserLocale)`. `*SameText` are the case-insensitive versions of `*SameStr`. — Andreas Rejbrand, Nov 23 '20 at 11:16
@DavidHeffernan: You are right, of course. I have rewritten my comment. — Andreas Rejbrand, Nov 23 '20 at 11:17
A common method is to get a lock on some resource available to both. Not being able to get the lock means the application / service is already running. For example a file in a directory accessible by both. — Brian, Nov 23 '20 at 13:03
`while Integer(isFound) <> 0 do` in Delphi is usually expressed as `while isFound do`. And you should probably tell us what you are trying to achieve, because the goal might affect what solutions are applicable. — Ken Bourassa, Nov 23 '20 at 14:28

The Bitman · Accepted Answer · 2020-11-26T17:53:39.683

Mutexes

Assuming the operational system is Windows, there are the Mutex objects. Mutexes are system resources. System resource means resource available for all processes in the storing area of the system. Any process can create and close (release) a mutex. Once a process created a mutex, another process can access it but unable to create a new instance until the existing one not closed.

Startup Mutex handling

So one solution to your problem is to check the existence of an unique named mutex on startup and react according to the answer:

the mutex exists : notify the user and exit the program.
the mutex does not exist : register the mutex and keep the process running

You can include some attributes to the mutex name:

program path : the instances launched from different folders won't consider the same
version number : the different versions of the app won't consider the same
another environment/app characteristics (Windows user name) to make running instances different

Solution:

MyApp.dpr:

program Project3;

uses
  Vcl.Forms,
  Unit1 in 'Unit1.pas' {TForm1},
  MutexUtility in 'MutexUtility.pas',
  Dialogs;

{$R *.res}

var
  hMutex : THandle;
  mutexName : string;

begin
  mutexName := TMutexUtility.initMutexName;
  if ( TMutexUtility.tryCreateMutex( mutexName, hMutex ) ) then
    try
      Application.Initialize;
      Application.MainFormOnTaskbar := True;
      Application.CreateForm(TForm1, Form1);
      Application.Run;
    finally
      TMutexUtility.releaseMutex( hMutex );
    end
  else
    showMessage( 'Another instance of the application is running! Shut it down to run the application!' );
end.

MutexUtility.pas:

unit MutexUtility;

interface

type
  TMutexUtility = class
    public
      class function initMutexName : string;
      class function tryCreateMutex( mutexName_ : string; var hMutex_ : THandle ) : boolean;
      class procedure releaseMutex( var hMutex_ : THandle );
  end;


implementation

uses
    System.SysUtils
  , Windows
  ;


const
  CONST_name_MyApp = 'MyApp';
  CONST_version_MyApp = 1.1;
  CONST_name_MyAppMutex : string = '%s (version: %f, path: %s) startup mutex name';

class function TMutexUtility.initMutexName : string;
begin
  result := format( CONST_name_AppMutex, [CONST_name_App, CONST_version_MyApp, LowerCase( extractFilePath( paramStr( 0 ) ).Replace( '\', '/' ) )] );
end;

class function TMutexUtility.tryCreateMutex( mutexName_ : string; var hMutex_ : THandle ) : boolean;
var
  c : cardinal;
begin
  hMutex_ := createMutex( NIL, FALSE, pchar( mutexName_ ) );
  result := GetLastError <> ERROR_ALREADY_EXISTS;
end;

class procedure TMutexUtility.releaseMutex( var hMutex_ : THandle );
begin
  if ( hMutex_ <> 0 ) then
  begin
    closeHandle( hMutex_ );
    hMutex_ := 0;
  end;
end;


end.

Note that there is a Global and a Local namespace for Mutexes, this is especially important in multi user environments such as Terminal Services/RDSH, WVD (Windows Virtual Desktop) and Citrix environments. See https://learn.microsoft.com/en-us/windows/win32/termserv/kernel-object-namespaces — Remko, Nov 28 '20 at 10:03

How can we determine a program is already running in either in the current user or other user in delphi

1 Answers1