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

Question

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

过去，我使用库代码来控制互斥体，这总是显得很复杂。当我在 Delphi XE 中开始一个新项目时，我想知道我是否需要挖掘旧代码，或者 XE 中是否已经内置了支持？或者是否有另一种易于应用、美观且现代的代码？

Answer 1

您在启动应用程序时创建一个命名的互斥体。检查

GetLastError

以查看其他实例是否已在运行。

将此代码放在 DPR 文件中“开始”之后。将 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.

有关此内容的文档以及通知方案位于 JCL Wiki。

Answer 3

我使用这个，在 XE2 到 Alexandria 中都可以使用，其优点是能够将当前正在运行的实例带到前面。

那些说不应该这样做的人，好吧，考虑到用户所做的最后一件事是尝试启动应用程序，将当前正在运行的实例放在前面是有意义的

unit CheckPrevious;

interface

uses
  Windows, SysUtils, WinSock;

function RestoreIfRunning(const AppHandle : THandle; MaxInstances : integer = 1) : boolean;

implementation

type
  PInstanceInfo = ^TInstanceInfo;
  TInstanceInfo = packed record
    PreviousHandle : THandle;
    RunCounter : integer;
  end;
var
  MappingHandle: THandle;
  InstanceInfo: PInstanceInfo;
  MappingName : string;
  RemoveMe : boolean = True;

function RestoreIfRunning(const AppHandle : THandle; MaxInstances : integer = 1) : boolean;
begin
  Result := True;
  MappingName := StringReplace(ParamStr(0),'\','',[rfReplaceAll, rfIgnoreCase]);
  {$IFDEF WIN64}
  MappingHandle := CreateFileMapping($FFFFFFFFFFFFFFFF,nil,PAGE_READWRITE,0,SizeOf(TInstanceInfo),PChar(MappingName));
  {$ELSE}
  MappingHandle := CreateFileMapping($FFFFFFFF,nil,PAGE_READWRITE,0,SizeOf(TInstanceInfo),PChar(MappingName));
  {$ENDIF}
  if MappingHandle = 0 then
    RaiseLastOSError
  else
  begin
    if GetLastError <> ERROR_ALREADY_EXISTS then
    begin
      InstanceInfo := MapViewOfFile(MappingHandle,FILE_MAP_ALL_ACCESS,0,0,SizeOf(TInstanceInfo));
      InstanceInfo^.PreviousHandle := AppHandle;
      InstanceInfo^.RunCounter := 1;
      Result := False;
    end
    else //already runing
    begin
      MappingHandle := OpenFileMapping(FILE_MAP_ALL_ACCESS, False, PChar(MappingName));
      if MappingHandle <> 0 then
      begin
        InstanceInfo := MapViewOfFile(MappingHandle,FILE_MAP_ALL_ACCESS,0,0,SizeOf(TInstanceInfo));
        if InstanceInfo^.RunCounter >= MaxInstances then
        begin
          RemoveMe := False;
          if IsIconic(InstanceInfo^.PreviousHandle) then
            ShowWindow(InstanceInfo^.PreviousHandle, SW_RESTORE);
          SetForegroundWindow(InstanceInfo^.PreviousHandle);
        end
        else
        begin
          InstanceInfo^.PreviousHandle := AppHandle;
          InstanceInfo^.RunCounter := 1 + InstanceInfo^.RunCounter;
          Result := False;
        end
      end;
    end;
  end;
end;

initialization

finalization
  //remove one instance
  if RemoveMe then
  begin
    MappingHandle := OpenFileMapping(FILE_MAP_ALL_ACCESS, False, PChar(MappingName));
    if MappingHandle <> 0 then
    begin
      InstanceInfo := MapViewOfFile(MappingHandle, FILE_MAP_ALL_ACCESS, 0, 0, SizeOf(TInstanceInfo));
      InstanceInfo^.RunCounter := -1 + InstanceInfo^.RunCounter;
    end
    else
      RaiseLastOSError;
  end;
  if Assigned(InstanceInfo) then
    UnmapViewOfFile(InstanceInfo);
  if MappingHandle <> 0 then
    CloseHandle(MappingHandle);
end.

在您的项目 DPR 中，将 CheckPrevious 单元添加到使用中，然后在开始之后添加以下内容

  if RestoreIfRunning(Application.Handle, 1) then
    Exit;

我不知道这段代码的起源，否则我很乐意感谢作者。 （搜索 RestoreIfRunning 可能表明它来自 Zarko Gajic）

Answer 4

我就是这样做的。

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;