利用共享内存映射实现程序只能启动一次的限制

//=============================================================================
//
// 描述： 程序单次运行检测单元
// 作者： sgao
// 日期： 2015-09-25
// 备注： 程序创建的句柄都会在进程结束后自动释放，所以这里没有做关闭句柄操作
//
//=============================================================================

unit uRunOnceChecker;

interface
uses
  SysUtils,Windows;

type
  //共享内存信息
  TShareInfo = record
    AppHandle : THandle;
  end;
  PShareInfo = ^TShareInfo;

  //检查程序是否运行，如未运行创建共享内存
  //参数1：程序标识
  //参数2：共享内存信息(外部创建，内部释放)
  //返回值：程序是否已经运行
  function CheckOrCreate(AGuidId : string; var AShareInfo : PShareInfo) : Boolean;

  //检查程序是否已运行
  //参数1：程序标识
  //参数2：共享内存信息
  //返回值：程序是否已经运行
  function Check(AGuidId : string; out AShareInfo : PShareInfo) : Boolean;

implementation

  //检查程序是否运行，如未运行创建共享内存
  //参数1：程序标识
  //参数2：共享内存信息(外部创建，内部释放)
  //返回值：程序是否已经运行
  function CheckOrCreate(AGuidId : string; var AShareInfo : PShareInfo) : Boolean;
  var
    hMapFile : THandle;
    pInfo : PShareInfo;
  begin
    Result := False;
    if AShareInfo = nil then
      raise Exception.Create(‘需传入共享内存信息‘);

    //检查共享内存是否已经创建
    hMapFile := OpenFileMapping(FILE_MAP_ALL_ACCESS, False, PChar(AGuidId));
    //如果共享内存尚未创建
    if hMapFile = 0 then
    begin
      //创建内存映像文件--该句柄在程序退出时释放
      hMapFile := CreateFileMapping($FFFFFFFF, nil, PAGE_READWRITE, 0, SizeOf(TShareInfo), PChar(AGuidId));
      //映射内存
      pInfo := MapViewOfFile(hMapFile, FILE_MAP_WRITE or FILE_MAP_READ, 0, 0, 0);
      //初始化内存
      pInfo^.AppHandle := AShareInfo.AppHandle;
      Dispose(AShareInfo);
      AShareInfo := pInfo;
    end
    //共享内存已经创建
    else
    begin
      Dispose(AShareInfo);
      pInfo := MapViewOfFile(hMapFile, FILE_MAP_WRITE or FILE_MAP_READ, 0, 0, 0);
      //更新共享内存信息
      AShareInfo := pInfo;
      CloseHandle(hMapFile);
      Result := True;
    end;
  end;

  //检查程序是否已运行
  //参数1：程序标识
  //参数2：共享内存信息
  //返回值：程序是否已经运行
  function Check(AGuidId : string; out AShareInfo : PShareInfo) : Boolean;
  var
    hMapFile : THandle;
  begin
    Result := False;
    //检查共享内存是否已经创建
    hMapFile := OpenFileMapping(FILE_MAP_ALL_ACCESS, False, PChar(AGuidId));
    //如果共享内存已经创建
    if hMapFile <> 0 then
    begin
      AShareInfo := MapViewOfFile(hMapFile, FILE_MAP_WRITE or FILE_MAP_READ, 0, 0, 0);
      CloseHandle(hMapFile);
      Result := True;
    end;
  end;

end.

测试代码：

unit ufrmTest;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, RzEdit, uRunOnceChecker;

const  MAPFILE_NAME_GUID_1 = ‘{1141D1B7-F276-4F31-BB01-2E2447C256BC}‘;

const MAPFILE_NAME_GUID_2 = ‘{7EBAAA87-DBAC-4F69-8B77-C2D58EEFFA38}‘;

type
  TForm1 = class(TForm)
    btnCheckOrCreate: TButton;
    btnCheck: TButton;
    btnCheckOrCreate2: TButton;
    btnCheck2: TButton;
    mmo1: TRzMemo;
    procedure btnCheckOrCreateClick(Sender: TObject);
    procedure btnCheckClick(Sender: TObject);
    procedure btnCheckOrCreate2Click(Sender: TObject);
    procedure btnCheck2Click(Sender: TObject);
  private
    procedure CheckOrCreate(AGUID : string; AName : string);
    procedure Check(AGUID : string; AName : string);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.btnCheck2Click(Sender: TObject);
begin
  Check(MAPFILE_NAME_GUID_2, ‘B‘);
end;

procedure TForm1.btnCheckClick(Sender: TObject);
begin
  Check(MAPFILE_NAME_GUID_1, ‘A‘);
end;

procedure TForm1.btnCheckOrCreate2Click(Sender: TObject);
begin
  CheckOrCreate(MAPFILE_NAME_GUID_2, ‘B‘);
end;

procedure TForm1.btnCheckOrCreateClick(Sender: TObject);
begin
  CheckOrCreate(MAPFILE_NAME_GUID_1, ‘A‘);
end;

//检查程序是否在运行
procedure TForm1.Check(AGUID: string; AName: string);
var
  bRet : Boolean;
  pInfo : PShareInfo;
begin
  mmo1.Lines.Add(‘检查【程序‘ + AName + ‘】-----------------------------‘);
  bRet := uRunOnceChecker.Check(AGUID, pInfo);
  if bRet then
  begin
    mmo1.Lines.Add(‘程序【‘ + AName + ‘】在运行‘);
  end
  else
  begin
    mmo1.Lines.Add(‘程序【‘ + AName + ‘】未运行‘);
  end;

end;

//检查or创建程序的共享文件内存
procedure TForm1.CheckOrCreate(AGUID: string; AName: string);
var
  bRet : Boolean;
  pInfo : PShareInfo;
  hApp : THandle;
  hTopWindow : HWND;
begin
  mmo1.Lines.Add(‘检查or创建【程序‘ + AName + ‘】-----------------------------‘);
  New(pInfo);
  pInfo.AppHandle := Application.Handle;
  bRet := uRunOnceChecker.CheckOrCreate(AGUID, pInfo);
  if bRet then
  begin
    mmo1.Lines.Add(‘程序【‘ + AName + ‘】在运行‘);
    SendMessage(pInfo.AppHandle, WM_SYSCOMMAND, SC_RESTORE, 0);
    hTopWindow := GetLastActivePopup(pInfo.AppHandle);
    if (hTopWindow <> 0) and IsWindowVisible(hTopWindow) and IsWindowEnabled(hTopWindow) then
     SetForegroundWindow(hTopWindow);
  end
  else
  begin
    mmo1.Lines.Add(‘程序【‘ + AName + ‘】未运行，创建了共享内存‘);
  end;
end;

end.

运行结果：