Question

Delphi XE VCL是否支持确保只运行一个应用程序实例？

过去，我使用库代码来控制一直看起来很复杂的Mutex。当我在Delphi XE中开始一个新项目时，我想知道我是否需要挖掘旧代码，或者是否已经在XE中内置了支持？或者还有另一种易于应用的代码，它既漂亮又现代？

Answer 1

启动应用程序时，您将创建一个命名的互斥锁。检查GetLastError以查看其他实例是否已在运行。

将此代码放在DPR文件中的“begin”之后。用您自己的GUID替换GUID。当我需要一个不太可能用于其他任何事情的文本常量时，我通常只需按 Ctrl + G 来获取GUID！

if CreateMutex(nil, True, '6EACD0BF-F3E0-44D9-91E7-47467B5A2B6A') = 0 then
  RaiseLastOSError;

if GetLastError = ERROR_ALREADY_EXISTS then
  Exit;

可能看起来代码正在泄漏句柄，因为它没有保存CreateMutex的返回值。不是。当我们的应用程序终止时，Windows将自动释放句柄，这对我们来说绝对没问题。

Answer 2

我使用JCL来执行此操作：

program MyProgram;

uses
  JclAppInst;

begin
  JclAppInstances.CheckSingleInstance; // Added instance checking
  Application.Initialize;
  Application.CreateForm(TMainForm, MainForm);
  Application.Run;
end.

此文档和通知方案位于the JCL Wiki。

Answer 3

我就是这样做的。

<块引用>

closeProc(extractfilename(paramstr(0)));

function TForm1.closeProc(pname : string): integer;
const
PROCESS_TERMINATE = $0001;
var
ContinueLoop: BOOL;
FSnapshotHandle: THandle;
FProcessEntry32: TProcessEntry32;
i : integer;
pname2 : string;
begin
try
Result := 0;
i := 0;
FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
FProcessEntry32.dwSize := SizeOf(FProcessEntry32);
ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32);
while Integer(ContinueLoop) <> 0 do
    begin
    pname2 := trim(UpperCase(ExtractFileName(FProcessEntry32.szExeFile)));
    if ( pname2 = uppercase(pname)) then
      if FProcessEntry32.th32ProcessID <> GetCurrentProcessId then
        begin
          Result := Integer(TerminateProcess(OpenProcess(PROCESS_TERMINATE, BOOL(0), FProcessEntry32.th32ProcessID), 0));
          inc(i);
        end;
    ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32);
    if i > 50 then
      break;
    end;
CloseHandle(FSnapshotHandle);
except
end;
end;

如何确保只运行我的应用程序的单个实例？

3 个答案: