アプリケーションの多重起動を禁止する

プログラムの性質によっては多重起動を禁止したいことがあります。このようなときには同期オブジェクトの一つであるmutexを使用します。

Delphiのプロジェクトソースを開くとこのようになっています。

program Project1;

uses
  Forms,
  Unit1 in 'Unit1.pas' {Form1};

{$R *.res}

begin
  Application.Initialize;
  Application.MainFormOnTaskbar := True;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.

Object Pascal

ここで一意な名前のmutexをプログラム実行中だけ作成(CreateMutex)し、もしその名前のmutexが存在していたらプログラムを終了、存在していなければ実行を継続し、プログラム終了時にはmutexを破棄(CloseHandle)するコードを追加します。

program Project1;

uses
  Windows,
  SysUtils,
  Forms,
  Unit1 in 'Unit1.pas' {Form1};

{$R *.res}

const
  { Mutex name }
  CMutexName: String = '{9D0E11F8-ED24-4D3E-91B1-5E9A9BF8673A}';

var
  hMutex: THandle;
begin

  Application.Initialize;
  Application.MainFormOnTaskbar := True;

  { Create mutex }
  SetLastError(0);
  hMutex := CreateMutex(nil,False,PChar(CMutexName));
  if hMutex = 0 then
  begin
    RaiseLastOSError;
  end;

  try
    if GetLastError = ERROR_ALREADY_EXISTS then
    begin
      Exit;
    end;

    Application.CreateForm(TForm1, Form1);
    Application.Run;

  finally
    { Close mutex }
    CloseHandle(hMutex);
  end;

end.

Object Pascal

これでプログラムの多重起動を禁止することができます。
作成するmutexの名前は任意(上記の例では適当にGUIDを生成して使用しています)ですが、'Global\'と'Local\'で始まるmutex名には特別な意味があるので注意が必要です(詳細はCreateMutex参照)。また同名のmutexが存在するかどうかを調べるのにOpenMutexを使用するとOpenMutexの呼び出しからCreateMutexの呼び出しまでの間が無防備になってしまうため、CreateMutexの第2パラメータbInitialOwnerにFalseを指定して呼び出し後、GetLastErrorの値がERROR_ALREADY_EXISTSかどうかで判定するようにします。

さらにアプリケーションのメインウィンドウを前面に移動し、最小化も解除するようにしてみます。

program Project1;

uses
  Windows,
  SysUtils,
  Messages,
  Forms,
  Unit1 in 'Unit1.pas' {Form1};

{$R *.res}

const
  { Mutex name }
  CMutexName: String = '{9D0E11F8-ED24-4D3E-91B1-5E9A9BF8673A}';

var
  hMutex: THandle;
  Wnd: HWnd;
  AppWnd: HWnd;
begin

  Application.Initialize;
  Application.MainFormOnTaskbar := True;

  { Create mutex }
  SetLastError(0);
  hMutex := CreateMutex(nil,False,PChar(CMutexName));
  if hMutex = 0 then
  begin
    RaiseLastOSError;
  end;

  try
    if GetLastError = ERROR_ALREADY_EXISTS then
    begin
      { Search main form }
      Wnd := FindWindow(PChar('TForm1'),nil);  // Class name of the main form
      if Wnd = 0 then
      begin
        Exit;
      end;

      { Bring foreground and activate }
      SetForegroundWindow(Wnd);

      { Get window handle of TApplication }
      AppWnd := GetWindowLong(Wnd,GWL_HWNDPARENT);
      if AppWnd <> 0 then
      begin
        Wnd := AppWnd;
      end;

      { Restore if iconized }
      if IsIconic(Wnd) then
      begin
        SendMessage(Wnd,WM_SYSCOMMAND,SC_RESTORE,-1);
      end;

      Exit;
    end;

    Application.CreateForm(TForm1, Form1);
    Application.Run;

  finally
    { Close mutex }
    CloseHandle(hMutex);
  end;

end.

Object Pascal

Delphiのウィンドウコントロールはクラス名がそのままウィンドウクラス名になるため、FindWindowにはアプリケーションのメインフォームのクラス名を渡します。