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;
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:
You can include some attributes to the mutex name:
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.