[ Lazarus のアプリの二重起動防止 ]

Delphi Programming / Object Pascal

[掲載 2020年06月28日] [更新 2020年07月18日]　Delphi 一般・その他

Lazarus のアプリの二重起動防止
動作確認等	Windows 7 U64(SP1) + lazarus-2.0.8

[整理番号 - 1520]

Lazarus のアプリの二重起動防止
01_Lazarus のアプリの二重起動防止用のコード例
02_二重起動防止を全てメインフォーム側で処理する例
03_二重起動防止用コンポーネント TUniqueInstance
04_二重起動防止用コンポーネント TOneInstance
05_メインフォームの生成と起動防止の処理
06_ShowWindow 関数における SW_RESTORE フラグの挙動

Lazarus のアプリの二重起動防止

Lazarus_InhibitRun.zip　[4.2 MB]　2020年07月15日版 (EXE 同梱)

Lazarus のアプリの二重起動の防止用のサンプルです．
Halbow 資料館に掲載しているサンプルの他に，TUniqueInstance というコンポーネントのテストコードも掲載しています．
二重起動防止のコードは Delphi でも利用できます．

01_Lazarus のアプリの二重起動防止用のコード例

Halbow 資料館のコードを使用した例です．
SetProp 関数を Application.Initialize の前に実行すると，起動済みの EXE のウィンドウが最前面に表示できませんでした．以下のコードでは Application.Run の直前で実行するようしています．
uses に Windows と Dialogs を追加して，アプリケーションを一意に識別するための定数 UniqueName:string を宣言します．

アプリケーションを初期化する前に，IsPrevAppExist 関数を実行します．その戻り値が True の時はそれ以降の処理はしません．つまり，アプリを起動しません．
戻り値が False の時は SetProp 関数で，起動するアプリ，つまり自分自身のウィンドウにユニークなプロパティを設定します．アプリの終了時に RemoveProp 関数でそのプロパティを削除します．

lazarus-2.0.8 では ShowWindow(hWindow, SW_RESTORE) が機能しませんでした．代わりに，このサンプルでは，WM_SYSCOMMAND メッセージを使用して SC_RESTORE を PostMessage でポストしています．

図1
二重起動防止

ダイアログを閉じると，起動済み EXE のウィンドウを最前面に表示

リスト1
Lazarus のアプリの二重起動防止用のコード例．プロジェクトのソースコード
SetProp を Application.Run の直前で実行

program project1;

{$mode objfpc}{$H+}

uses
  {$IFDEF UNIX}{$IFDEF UseCThreads}
  cthreads,
  {$ENDIF}{$ENDIF}
  Interfaces, // this includes the LCL widgetset
  Forms, Unit1, Windows, Dialogs
  { you can add units after this };

{$R *.res}

const
  UniqueName:string = 'HogeHogeApp';

//-----------------------------------------------------------------------------
//  EnumWindows のコールバック関数
//  起動済みのアプリを最前面に表示するために使用
//
//  lazarus-2.0.8 では ShowWindow(hWindow, SW_RESTORE) は機能しない
//  代わりに WM_SYSCOMMAND で SC_RESTORE をポストしている
//-----------------------------------------------------------------------------
function EnumWndProc(hWindow: HWND; lData: LPARAM): BOOL;stdcall;
begin
  Result := True;
  if GetProp(hWindow, PChar(lData)) = 1111 then begin
    if IsIconic(hWindow) then begin
      PostMessage(hWindow, WM_SYSCOMMAND, $FFF0 and SC_RESTORE, 0);
    end;
    SetForegroundWindow(hWindow);
    Result := False;
  end;
end;

//-----------------------------------------------------------------------------
//  引数で指定したプロパティを持つウィンドウが起動しているかを確認する関数
//-----------------------------------------------------------------------------
function IsPrevAppExist(AName: string):Boolean;
begin
  Result := False;
  CreateMutex(nil, True, PChar(AName));
  if GetLastError = ERROR_ALREADY_EXISTS then begin
    ShowMessage('このアプリは二重起動できません');
    EnumWindows(@EnumWndProc, LPARAM(PChar(AName)));
    Result := True;
  end;
end;

begin
  if IsPrevAppExist(UniqueName) then Exit;

  RequireDerivedFormResource:=True;
  Application.Scaled:=True;
  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
  SetProp(Application.Handle, PChar(UniqueName),1111);
  Application.Run;
  RemoveProp(Application.Handle, PChar(UniqueName));
end.

Application.MainFormOnTaskBar の値を True にした場合は，以下のように，SetProp と RemoveProp 関数の引数の値を Application.MainForm.Handle にします．
これは，最小化の状態から復帰するために必要な設定てす．最小化からの復帰が必要なければ変更する必要はありません．

リスト2
Application.MainFormOnTaskBar := True にした場合

begin
  if IsPrevAppExist(UniqueName) then Exit;

  RequireDerivedFormResource:=True;
  Application.Scaled:=True;
  Application.Initialize;
  Application.MainFormOnTaskBar := True;
  Application.CreateForm(TForm1, Form1);
  SetProp(Application.MainForm.Handle, PChar(UniqueName),1111);
  Application.Run;
  RemoveProp(Application.MainForm.Handle, PChar(UniqueName));
end.

以下の記事の方法で，メインフォームのウインドウのクラス名を設定すれば，ウィンドウのクラス名を使用してアプリの二重起動を防止することができます．
IDE から実行した時に二重起動防止になってしまう場合は，IDE を閉じてから，作成した EXE を起動して動作確認します．

参考リンク
[Lazarus のフォームのウィントウのクラス名設定]

リスト3
ウィンドウのクラス名を使用したアプリの二重起動防止例．uses に Windows, Dialogs が必要

var
  FPreHWND : HWND;

begin
  FPreHWND := FindWindow('TTestMainForm', nil);
  if FPreHWND <> 0 then begin
    ShowMessage('二重起動を禁止しています');
    if IsIconic(FPreHWND) then begin
      PostMessage(FPreHWND, WM_SYSCOMMAND, $FFF0 and SC_RESTORE, 0);
    end;
    SetForegroundWindow(FPreHWND);
    Exit;
  end;

  RequireDerivedFormResource:=True;
  Application.Scaled:=True;
  Application.Initialize;
  // 最小化からの復帰を有効にするには以下を追加
  Application.MainFormOnTaskBar := True;
  Application.CreateForm(TTestMainForm, TestMainForm);
  Application.Run;
end.

[備考 1]
Application.MainForm.Handle の値は，メインフォーム生成後でないと取得できません．フォームの生成前に取得しようとすると，実行時に例外が発生します．

[備考 2]
この二重起動防止のコードは Delphi でも利用できます．ただし，uses に Windows と Dialogs の他に Messages が必要です．
Delphi 2007 以降では，MainFormOnTaskbar の値は True がデフォルトです．

02_二重起動防止を全てメインフォーム側で処理する例

二重起動防止の処理を全てメインフォーム側で行う例です．正確な意味での「起動防止」ではありません．起動したアプリを，フォームを表示する前に終了させる方法です．
このサンプルではフォームの OnCreatae イベント内で処理しています．OnCreate イベント発生時点では，フォームは表示されていませんが生成されています．

このサンプルも，最小化状態からの復帰には，WM_SYSCOMMAND メッセージを使用して，SC_RESTORE コマンドを PostMessage でポストしています．
Application.MainFormOnTaskBar := True にしている場合は，SetProp と RemoveProp 関数の引数の値を Application.Handle ではなく，Handle にします．

リスト4
二重起動防止を全てメインフォーム側で処理する例

unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, Windows;

type

  { TForm1 }

  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private

  public

  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }

const
  UniqueName:string = 'HogeHogeApp';

//-----------------------------------------------------------------------------
//  EnumWindows のコールバック関数
//  起動済みのアプリを最前面に表示するために使用
//
//  lazarus-2.0.8 では ShowWindow(hWindow, SW_RESTORE) は機能しない
//  代わりに WM_SYSCOMMAND で SC_RESTORE をポストしている
//-----------------------------------------------------------------------------
function EnumWndProc(hWindow: HWND; lData: LPARAM): BOOL;stdcall;
begin
  Result := True;
  if GetProp(hWindow, PChar(lData)) = 1111 then begin
    if IsIconic(hWindow) then begin
      PostMessage(hWindow, WM_SYSCOMMAND, $FFF0 and SC_RESTORE, 0);
    end;
    SetForegroundWindow(hWindow);
    Result := False;
  end;
end;

//=============================================================================
//  フォーム生成時の処理
//  二重起動防止のチェック
//  既に起動していたらメインフォームであるこのフォームを閉じる
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  CreateMutex(nil, true, PChar(UniqueName));
  if GetLastError = ERROR_ALREADY_EXISTS then begin
    ShowMessage('このアプリは二重起動できません');
    EnumWindows(@EnumWndProc, LPARAM(PChar(UniqueName)));
    PostMessage(Handle, WM_CLOSE, 0, 0);
  end else begin
    SetProp(Application.Handle, PChar(UniqueName), 1111);
  end;
end;

//=============================================================================
//  メインフォーム破棄時の処理
//=============================================================================
procedure TForm1.FormDestroy(Sender: TObject);
begin
  RemoveProp(Application.Handle, PChar(UniqueName));
end;

//=============================================================================
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
//
end;

end.

[備考]
この二重起動防止のコードは Delphi でも利用できます．
Delphi 2007 以降では，MainFormOnTaskbar の値は True がデフォルトです．

03_二重起動防止用コンポーネント TUniqueInstance

TUniqueInstance という Lazarus 用の二重起動防止用のコンポーネントがあります．このコンポーネントをインストールしてテストしてみました．このコンポーネントは以下の最初のリンからダウンロードできます．

ダウンロードしたらブロックを解除して解凍展開します．その中の [ uniqueinstance-1.1 ] フォルダを，フォルダごと任意のフォルダにコピーします．この [ uniqueinstance-1.1 ] 内にコンポーネントのユニットファイルがあります．

参考リンク
Release UniqueInstance 1.1 · blikblum/luipack · GitHub
UniqueInstance - Free Pascal wiki

まず，Lazarus の IDE を起動して，[パッケージ] [パッケージファイル (.lpk) ょ開く] でパッケージファイル [uniqueinstance_package.lpk] 開きます．次に，表示されたダイアログの上部にある [コンパイル] をクリックしてパッケージ内のユニットをコンパイルしてパッケージを構成します．コンパイルはすぐに終わります．
コンパイルしたら [使用] [インストール] の操作でインストールします．これには少し時間がかかります．インストールが終了すると，Lazarus の IDE が自動的に閉じて再起動します．

コンパイルしたパッケージは，パッケージのダイアログを閉じてから，以下のリンクの記事の手順でもインストールできます．
このコンポーネントは，コンポーネントパレットの [System] タブに登録されます．

図2
TUniqueInstance コンポーネントをフォームに配置

リスト5
Lazarus 用の二重起動防止用コンポーネント TUniqueInstance のテスト

unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls,
  UniqueInstance, Windows;

type

  { TForm1 }

  TForm1 = class(TForm)
    Button1: TButton;
    UniqueInstance1: TUniqueInstance;
    procedure UniqueInstance1OtherInstance(Sender: TObject;
      ParamCount: Integer; const Parameters: array of String);
  private

  public

  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }

//=============================================================================
//  UniqueInstance1 の OnOtherInstance イベント処理
//  起動中の EXE を起動しようとすると発生する
//  引数は EXE のコマンドラインの数とその値
//
//  オブジェクトインスペクタで以下を設定
//  Enabled        : True (二重起動防止を有効にする)
//  Identifier     : MyHogeLazarusApp (EXE 識別用のユニークな文字列)
//  UpdateInterval : 1000 (イベント発生間隔．Windows では無効)
//
//  ShowMessage のダイアログはアクティブにはならない (筆者の環境では)
//=============================================================================
procedure TForm1.UniqueInstance1OtherInstance(Sender: TObject;
  ParamCount: Integer; const Parameters: array of String);
begin
  FormStyle := fsSystemStayOnTop;
  FormStyle := fsNormal;
  ShowMessage('このアプリは既に起動しています');
end;

end.

[備考 1]
パッケージのインストール方法は，メニューの表示が日本語であると仮定して説明しています．
メニューの表示言語は [tools] [Options...] のダイアログを表示して，左ペインの [Environment] 階層下の [General] を選択し，右ペインの [Language] で変更できます．日本語にするには，コンボボックスから [Japaese [ja] ] を選択します．この設定は，IDE を再起動すると有効になります．

[備考 2]
パッケージのダイアログで，ユニットファイルをダブルクリックすると IDE のエディタでコードを表示して編集できます．コードを変更したら [コンパイル] をクリックしてコンパイルします．
published のプロパティや GUI に関する内容，あるいはイベント関係のコードを変更した場合は，コンパイルだけでなく，再度インストールが必要です．

04_二重起動防止用コンポーネント TOneInstance

本ページの最初のサンプルは Halbow 資料館のコードを利用しました．参考にしたページに，二重起動禁止用のコンポーネントのコードが掲載されています．そのコンポーネントを試してみました．
uses に Windows を追加して，以下の修正をすればコンポーネントとしてインストールはできましたが，実行すると AllocateHWnd の部分で例外が発生しました．

  FAllocWnd := AllocateHWnd(AllocWnd);
           ↓ // 以下に変更．アドレス演算子の @ を追加
  FAllocWnd := AllocateHWnd(@AllocWnd);

ソースコードを確認すると，以下のように例外を発生させるコードしかありません．

function AllocateHWnd(Method: TWndMethod): HWND;
  begin
    runerror(211);
  end;


procedure DeallocateHWnd(Wnd: HWND);
  begin
    runerror(211);
  end;

TWin32WidgetSet absolute WidgetSet に同名の関数類が実装されています．それらの関数類を利用するには，uses に win32int を追加して，次のようにコードを変更します．これでコンポーネントとして正常に動作するようになりました．

  FAllocWnd := AllocateHWnd(@AllocWnd);
  DeallocateHWnd(FAllocWnd);
         ↓ // 以下に変更．
 　         // Win32WidgetSet の同名の関数を使用 ( uses に win32int が必要
  FAllocWnd := Win32WidgetSet.AllocateHWnd(@AllocWnd);
  Win32WidgetSet.DeallocateHWnd(FAllocWnd);

このコンポーネント TOneInstance は，添付のパッケージ oneinstance_pkg をインストールすると利用できます．パッケージのインストール方法は，前項の記事で確認してください．
このコンポーネントは，コンポーネントパレットの [System] タブに登録するようにしています．
前項でテストした TUniqueInstance コンポーネントは unix と Windows 兼用ですが，この TOneInstanceは Windows 専用のコンポーネントです．

図3
TOneInstance コンポーネントをフォームに配置

リスト6
Halbow 資料館の二重起動禁止用コンポーネント TOneInstance のテスト

unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, OneInstance;

type

  { TForm1 }

  TForm1 = class(TForm)
    Button1: TButton;
    OneInstance1: TOneInstance;
    procedure OneInstance1PrevInstanceExist(Sender: TObject);
  private

  public

  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }

//=============================================================================
//  OneInstance1 の OnPrevInstanceExist イベント処理
//  起動中の EXE を起動する時に発生する
//
//  オブジェクトインスペクタで以下を設定
//  UniqueName  : EXE 識別用のユニークな文字列
//=============================================================================
procedure TForm1.OneInstance1PrevInstanceExist(Sender: TObject);
begin
  ShowMessage('このアプリは二重起動できません');
  OneInstance1.ActivatePrevApp;
end;

end.

[備考]
Halbow 資料館の TOneInstance コンポーネントをインストールする際，新規にパッケージを作成しています．新規のパッケージは，メニューを日本語にしていると作成できませんでした．メニューの表示を [ 英語 [en] ] にして作成しました．

05_メインフォームの生成と起動防止の処理

二重起動防止用のコンポーネントの動作は，基本的に，二重起動の防止をメインフォームで処理する方法と同じです．
メインフォームに配置したコンポーネントは，メインフォームの生成時に生成されます．つまり，メインフォームが生成されなければコンポーネントは機能しません．この時点でアプリケーションの初期化である Application.Initialize は終了しています．本ページの最初の方法fでは，Application.Initialize を実行しません．メインフェームも生成しません．そのような処理は，メインフォームに配置するコンポーネントでは実現できません．

本ページのサンプルは，当初は最初の 2 つだけでしだ．上記のことを実際に確認できるように，コンポーネントを使用したサンプルを追加しています．

リスト7
lazarus-2.0.8 のプロジェクトのソースコードの実行部 (新規プロジェクト作成時)

begin
  RequireDerivedFormResource:=True;
  Application.Scaled:=True;
  Application.Initialize;
  // この時点ではフォームに配置したコンポーネントは生成されていない
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.

06_ShowWindow 関数における SW_RESTORE フラグの挙動

二重起動防止のサンプルで，先に起動した EXE のウィンドウを前面に表示する説明で SW_RESTORE フラグについて触れました．以下は，二重起動防止の場合ではありませんが，メインフォームのウィンドウを最小化の状態から復帰する時の SW_RESTORE フラグの挙動のテストサンプルです．

最初は，タスクバーのアイコンクリック，またはメインフォームの最小化ボタンで，あるいはシステムメニューの [最小化] で最小化した時の復帰の例です．
このコードで使用している TApplicationProperties コンポーネントは　[Additional] タブにあります．Lazarus には TApplicationEvents コンポーネントはありません．代わりにこのコンポーネントを使用します．ただし，機能は TApplicationEvents と同じではありません．

参考リンク
Lazarus Components - Lazarus wiki
TApplicationProperties - Free Pascal wiki

リスト8

unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, Windows;

type

  { TForm1 }

  TForm1 = class(TForm)
    ApplicationProperties1: TApplicationProperties;
    CheckBox1: TCheckBox;
    procedure ApplicationProperties1Minimize(Sender: TObject);
  private
    procedure WMUser100(var AMsg: TMessage); message WM_APP+100;
  public

  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }


//=============================================================================
//  ApplicationProperties1 の OnMinimize イベント
//  アプリケーションのウィンドウが最小化した時に発生するイベント
//  メインフォームの最小化ボタンクリックでも発生する
//=============================================================================
procedure TForm1.ApplicationProperties1Minimize(Sender: TObject);
begin
  // 最小化は処理の途中なので SendMessage は使用しない
  PostMessage(Handle, WM_APP+100, 0, 0);
end;

//-----------------------------------------------------------------------------
//  メッセージ処理
//-----------------------------------------------------------------------------
procedure TForm1.WMUser100(var AMsg: TMessage);
begin
  Sleep(2000);
  if not CheckBox1.Checked then begin
    // 復帰しない
    ShowWindow(Application.Handle, SW_RESTORE);
  end else begin
    // 以下にすれば最小化状態から復帰する
    PostMessage(Application.Handle, WM_SYSCOMMAND, $FFF0 and SC_RESTORE, 0);
  end;
end;

end.

コードで，アプリケーションのウィンドウを最小化して復帰する例です．

リスト9

//=============================================================================
//  コードでウィンドウを最小化
//  アプリケーションのウィンドウを最小化する
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  ShowWindow(Application.Handle, SW_MINIMIZE);
  PostMessage(Handle, WM_APP+100, 0, 0);
end;

//-----------------------------------------------------------------------------
//  メッセージ処理
//-----------------------------------------------------------------------------
procedure TForm1.WMUser100(var AMsg: TMessage);
begin
  Sleep(2000);
  if not CheckBox1.Checked then begin
    // 最小化状態から復帰する
    ShowWindow(Application.Handle, SW_RESTORE);
    // 以下でも復帰する
    // PostMessage(Application.Handle, WM_SYSCOMMAND, $FFF0 and SC_RESTORE, 0);
  end else begin
    // ShowWindow で最小化状態から復帰するが最前面には表示しない
    ShowWindow(Handle, SW_RESTORE);
    SetForegroundWindow(Handle);
  end;
end;

コードで，メインフォームのウィンドウを最小化して復帰する例です．
基本的に，アプリケーションのウィンドウに対して最小化の操作を行った場合は，最小化の復帰には ShowWindow 関数の第 1 引数のウィンドウハンドルにはアプリケーションのウィンドウハンドルを指定します．メインフォームのウィンドウに対して最小化の操作をした場合は，最小化の復帰にはメインフォームのウィンドウハンドルを指定します．

コードではなく，タスクバーのアイコンクリック等，システム的な操作で最小化した場合は，システムコマンドのメッセージである WM_SYSCOMMAND を使用すると考えてよさそうです．

リスト10

//=============================================================================
//  コードでウィンドウを最小化
//  メインフォーム (このフォーム) のウィンドウを最小化する
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  ShowWindow(Handle, SW_MINIMIZE);
  PostMessage(Handle, WM_APP+100, 0, 0);
end;

//-----------------------------------------------------------------------------
//  メッセージ処理
//-----------------------------------------------------------------------------
procedure TForm1.WMUser100(var AMsg: TMessage);
begin
  Sleep(2000);
  if not CheckBox1.Checked then begin
    // 最小化状態から復帰できない
    // タスクバーのアイコンクリックでも復帰できない
    ShowWindow(Application.Handle, SW_RESTORE);
  end else begin
    // 最小化状態から復帰する
    ShowWindow(Handle, SW_RESTORE);
    // 以下でも復帰する
    // PostMessage(Handle, WM_SYSCOMMAND, $FFF0 and SC_RESTORE, 0);
  end;
end;

以上は，ShowWindow 関数での SW_RESTORE フラグの動作確認のテストです．
タスクバーのアイコンクリック，またはメインフォームの最小化ボタンで，あるいはシステムメニューの [最小化] で最小化した場合は，以下のコードで元のサイズと位置に復帰します．

この最小化の操作は，アプリを使用するユーザによる操作と言えます．

procedure TForm1.WMUser100(var AMsg: TMessage);
begin
  Sleep(2000);
  Application.Restore;
end;

また，コードで最小化した場合は，以下のコードで元のサイズと位置に復帰します．アプリケーションのウィンドウをコードで最小化した場合は，Application.Restore でも復帰します．
この最小化は，アプリ側の都合で自動的に最小化し，何らかの処理の終了後に元に戻すような場合の処理と言えます．

procedure TForm1.WMUser100(var AMsg: TMessage);
begin
  Sleep(2000);
  Application.MainForm.WindowState := wsNormal;
end;