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

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

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

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;

互斥体

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

启动互斥锁处理

因此,您的问题的一种解决方案是在启动时检查是否存在唯一命名的互斥锁,并根据答案做出反应:

  • 存在互斥锁:通知用户并退出程序。
  • 互斥量不存在:注册互斥量并保留进程运行

您可以在互斥体名称中包含一些属性:

  • 程序路径:从不同文件夹启动的实例不会被认为是相同的
  • 版本号:不同版本的应用不会认为相同
  • 另一个 environment/app 特征(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.