我们如何确定一个程序已经在当前用户或delphi中的其他用户中运行

Question

我正在尝试确定某个进程是在当前用户下运行，还是在同一台电脑上的另一个用户下运行。我应用了以下代码，它运行得很好。如果某个进程在当前用户上运行，程序可以从任务管理器中确定该进程。有没有什么方法可以让我确定正在运行的进程是否在另一个用户下运行？

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;

Answer 1

互斥

假设操作系统是Windows，则存在Mutex对象。互斥体是系统资源。系统资源是指系统存储区中所有进程可用的资源。任何进程都可以创建和关闭(释放(互斥锁。一旦一个进程创建了互斥体，另一个进程就可以访问它，但在现有实例未关闭之前无法创建新实例。

启动互斥处理

因此，解决问题的一个方法是在启动时检查是否存在一个唯一的命名互斥体，并根据答案做出反应：

• 互斥存在：通知用户并退出程序
• 互斥对象不存在：注册互斥对象并保持进程运行

您可以在互斥对象名称中包含一些属性：

• 程序路径：从不同文件夹启动的实例不会认为相同
• 版本号：不同版本的应用程序不会认为相同
• 另一个环境/应用程序特征(Windows用户名(使运行的实例不同

解决方案：

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.