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