ホーム >プログラム >Delphi 6 ローテクTips >二重起動防止の改良版

二重起動を防止しウィンドウを前面に表示させることでプログラムの二重起動を防止できます。
ただし、Delphiでプログラム開発中に開発しているプログラムをテストしようとすると設計時のフォームも同名であるためそちらがひっかかってしまことがあります。
起動しているプログラムを前面に表示させたいのに、DelphiのIDEが前面に表示されてしまうのです。

で、その解決法。

とはいえこの問題は、Delphiで自身が開発しているときだけに起きるものなので一般に配布するためのプログラム(たとえばフリーソフトとして公開するとか)には必要のない処理かもしれません。

先に起動しているプログラムを前面に表示するときの問題
まずは前回のおさらいから。
先に起動しているプログラムを前面に表示するためにFindWindow APIを使っています。
  lh_Window := FindWindow(TForm1, nil);
  lh_Owner  := GetWindow(lh_Window, GW_OWNER);
  if (IsIconic(lh_Owner)) then begin
    //最小化されていたら元のサイズに戻す
    SendMessage(lh_Owner, WM_SYSCOMMAND, WPARAM(SC_RESTORE and $FFF0), 0);
  end else begin
    //前面に移動させる
    SetForegroundWindow(lh_Window);
  end;
このときDelphiのIDEの方が先に起動したプログラムより前面になっていると、お目当てのプログラムのハンドルではなくDelphiの設計時のフォームのハンドルが返ってきてしまいます。
FindWindowは前面のウィンドウから検索するため、プログラムのハンドルにたどり着く前に設計時のフォームの方が先にヒットしてしまうためです。
解決策として一番簡単なのは、テストのときはDelphiを最小化することなのですが、もうちょっとかしこいやり方があります。

それにはFindWindow APIよりちょっとややこしいFindWindowEx APIと、もっとややこしいEnumWindows APIを使います。
解決策
DelphiのIDEで表示される設計時のフォームにはTGrabHandleという見えないウィンドウが存在します。
これはコンパイルしたプログラム本体には存在しません。
この差を利用してプログラム本体のフォームなのかIDEの設計時のフォームなのかを区別しようというものです。

WinSightやSPY++などのツールを使ってウィンドウのツリーを表示させてみると良く分かると思いますが設計時のフォームにはTGrabHandleというウィンドウがあります。
下の図では拙作のwinfo.exeを使ってForm1の情報を表示しています。

設計時のフォームにはいくつかのTGrabHandleという非可視のウィンドウがあるのが分かります。

コンパイルしたプログラムにはTGrabHandleというウィンドウは存在しません。

FindWindowEx API
参考サイト
FindWindowEx 関数
http://msdn.microsoft.com/ja-jp/library/cc410853.aspx
ではこのTGrabHandleを見つけるにはどうするか。

　FindWindwEx APIを使います。
function FindWindowEx(Parent, Child: HWND; ClassName, WindowName: PChar): HWND; stdcall;
このAPIはParentで指定したウィンドウの子ウィンドウを検索してそのウィンドウハンドル返すものです。

第一引数にFindWindowで取得したForm1のハンドルを指定します。
第二引数には0を指定しておきます。
第三引数に目的の'TGrabHandle'を指定します。
第四引数にはnilを指定しておきます。
  lh_Handle := FindWindowEx(FindWindow('TForm1', nil), 0, 'TGrabHandle', nil);
取得したlh_Handleが0ならTGrabHandleというウィンドウは存在しないのでコンパイルされたプログラム本体であると判断できます。
0以外ならTGrabHandleというウィンドウが存在しているのでDelphiの設計時のフォームであると判断できます。
EnumWindows API
参考サイト
EnumWindows 関数
http://msdn.microsoft.com/ja-jp/library/cc410851.aspx
EnumWindowsProc 関数
http://msdn.microsoft.com/ja-jp/library/cc410833.aspx
上記のようにFindWindowExを使ってコンパイルされたプログラム本体のフォームだと判断された場合はそれでいいのですが、設計時のフォームであった場合次のフォームを検索しなければなりません。
FindWindowExの第一引数に次のフォームのウィンドウハンドルを渡す必要があるということなのですが、FindWindow APIにはそのような機能はありません。
どうするか。

　EnumWindows APIを使います。

ややこしいです。
function EnumWindows(lpEnumFunc: TFNWndEnumProc; lParam: LPARAM): BOOL; stdcall;
この関数は第一引数に処理内容を書いた別の関数のアドレスを指定します。
EnumWindows 関数の説明をぱっと見で考えるとEnumWindowsProc APIを渡すのかと思ったのですが違いました。
そもそもEnumWindowsProcという名のAPIはありません。
EnumWindowsProc はアプリケーション定義の関数名のプレースホルダなので、コーディングでは実際に使う関数名に置き換えてください。
これはEnumWindowsProcと同じ型の関数を独自に作ってEnumWindowsに与えなさいということです。
Delphiで注意する点は二つ。
  1. 戻り値はBooleanではなくBOOLであること。
  2. 必ずstdcallをつけること。
戻り値をBooleanにしてもコンパイルでき一見問題なく動くようにも見えます。
けれどもResult := False;として処理を終了させようとしても終了せず最後まで実行されてしまいます。
stdcallをつけなくてもコンパイルは通りますがアクセス違反の例外が起きてしまうことがあります。
function EnumWindowsProc(hHandle: HWND; iLParam: LPARAM): BOOL; stdcall;
HWNDとLPARAMという二つの引数をもつ関数を作り、その関数のアドレスをEnumWindowsに渡します。
ちなみに関数名はEnumWindowsProcである必要はなくエラーにならなければ何でもOKです。
  EnumWindows(@EnumWindowsProc, 0);
そうするとデスクトップ上に存在するトップレベルウィンドウの数だけ独自に作ったEnumWindowProc関数が呼ばれます。
トップレベルウィンドウとはDelphiのプログラムでのフォームのことだと思ってください。
ちなみにフォームに貼り付けたボタンやパネルはトップレベルウィンドウではなく、その子ウィンドウになります。

呼ばれたEnumWindowProc関数の第一引数にはトップレベルウィンドウのウィンドウハンドルがセットされているので、EnumWindowProcはその値を使って処理を行います。
感覚的には
  EnumWindows(@EnumWindowsProc, 0);
というのは
  for i := 0 to (トップレベルウィンドウの数)-1 do begin
    if not(EnumWindowsProc(i番目のトップレベルウィンドウのハンドル, 0)) then begin
      Break;
    end;
  end;
ということと等価なのだと思います。

今回のEnumWindowsProcの処理の内容は以下の通りです。
function EnumWindowProc(hHandle: HWND; iLParam: LPARAM): BOOL; stdcall;
var
  lh_Owner: HWND;
begin
  Result := True;
  if (gfnsClassNameGet(hHandle) = 'TForm1') then begin
    if (FindWindowEx(hHandle, 0, 'TGrabHandle', nil) = 0) then begin
      //TGrabHandleというウィンドウはなかったので設計中のフォームではない
      //つまりこのhHndleが目的のプログラムのウィンドウハンドル
      lh_Owner := GetWindow(hHandle, GW_OWNER);
      if (IsIconic(lh_Owner)) then begin
        //最小化されていたら元に戻す
        SendMessage(lh_Owner, WM_SYSCOMMAND, WPARAM(SC_RESTORE and $FFF0), 0);
      end;
      //前面に移動させる
      SetForegroundWindow(hHandle);
    end;
    //必要な処理を終えたので以降の処理(トップレベルウィンドウの列挙)を続行しない
    Result := False;
  end else begin
    //TGrabHandleというウィンドウがあった
    //設計中のフォーム
    Beep;
  end;
end;
第一引数にトップレベルウィンドウの値がセットされた状態でこの関数が呼ばれるので、その値を元にgfnsClassNameGetでクラス名を取得します。
そのクラス名がTForm1であればFindWindowEx APIでTGrabHandleという子ウィンドウを探します。
探した結果、なければ目的のプログラムと判断して前面に表示させたあと、これ以降このEnumWindowProc関数が呼ばれる必要はないのでResultをFalseにして処理の終了をWindowsにしてもらいます。
探した結果、TGrabHandleというウィンドウがあればDelphiの設計時のフォームなので次のトップレベルウィンドウを調べるためにResultはTrueのままにしておきます。
この例ではBeepを鳴らしてうまく機能しているかのテストをしています。
program test;

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

{$R *.res}


function gfnsClassNameGet(hHandle: HWND): String;
//ウィンドウハンドルhHandleのクラス名を返す
const
  lci_LEN = 256;
var
  lp_Buff: PChar;
begin
  Result := '';
  lp_Buff := AllocMem((lci_LEN+1) * 2);
  try
    GetClassName(hHandle, lp_Buff, lci_LEN-1);
    Result := String(lp_Buff);
  finally
    FreeMem(lp_Buff);
  end;
end;

function EnumWindowProc(hHandle: HWND; iLParam: LPARAM): BOOL; stdcall;
var
  lh_Owner: HWND;
begin
  Result := True;
  if (gfnsClassNameGet(hHandle) = 'TForm1') then begin
    if (FindWindowEx(hHandle, 0, 'TGrabHandle', nil) = 0) then begin
      //TGrabHandleとうぃうウィンドウはなかったので設計中のフォームではない
      //つまりこのhHndleが目的のプログラムのウィンドウハンドル
      lh_Owner := GetWindow(hHandle, GW_OWNER);
      if (IsIconic(lh_Owner)) then begin
        //最小化されていたら元に戻す
        SendMessage(lh_Owner, WM_SYSCOMMAND, WPARAM(SC_RESTORE and $FFF0), 0);
      end;
      //前面に移動させる
      SetForegroundWindow(hHandle);
    end;
    //必要な処理を終えたので以降の処理(トップレベルウィンドウの列挙)を続行しない
    Result := False;
  end else begin
    //TGrabHandleとうぃうウィンドウがあった
    //設計中のフォーム
    Beep;
  end;
end;

begin
  //二重起動チェック
  if (CreateMutex(nil, False, 'Dsapbi203dap') <> 0) //関数が成功して
  and (GetLastError = ERROR_ALREADY_EXISTS)         //既に同名のミューテックスオブジェクトがあれば
  then begin                                       //二重起動である
    //まずメッセージを出す
    Application.MessageBox('二重起動は許可されていません', 'メッセージ');

    //先に起動しているプログラムを探す
    EnumWindows(@EnumWindowProc, 0);

    //プログラム終了
    Exit;
  end;

  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.
更に別の方法
2000以降のみでしか使えない方法ですが、EnumWindowProcの中でFindWindowExを使ってTGrabHandleというウィンドウがあるかチェックする以外にトップレベルウィンドウの実行ファイル名をウィンドウハンドルから取得して自身の実行ファイル名と比較するという方法もあります。

設計中のフォームの場合はコンパイルされたプログラム名ではなくDelphiのプログラム名('C:\Program Files\Borland\Delphi6\Bin\delphi32.exe'など)が返ります。

気をつける点はEnumWindowsで列挙されるトップレベルウィンドウのハンドルに自身のオーナーウィンドウのハンドル(Application.Handle)が含まれることです。
そのため列挙されるトップレベルウィンドウのハンドルとそのオーナーウィンドウのハンドルと自身のオーナーウィンドウのハンドルを比較する必要があります。
function EnumWindowProc(hHandle: HWND; iLParam: LPARAM): BOOL; stdcall;
var
  lh_Owner : HWND;
begin
  Result := True;

  if (gfnsExeNameGet(hHandle) = gfnsExeNameGet(Application.Handle)) then begin
    //実行ファイルの名前が同じだった。
    //ただし自分自身である可能性がある。
    lh_Owner := GetWindow(hHandle, GW_OWNER);
    if  (lh_Owner <> Application.Handle) //hHandleのオーナーウィンドウが自身のオーナーウィンドウではない。
    and (hHandle  <> Application.Handle) //hHandleが自身のオーナーウィンドウのハンドルではない。
    then begin
      //このhHndleが目的のウィンドウハンドル。
      Beep;
program test;

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

{$R *.res}

function gfnsExeNameGet(hHandle: HWND): WideString;
{ウィンドウハンドルから実行ファイル名を返す。
http://m--takahashi.com/bbs/pastlog/02500/02414.html
http://www.geocities.jp/fjtkt/problems/2003_0004.html
http://www2.big.or.jp/~osamu/Delphi/tips.cgi?index=0182.txt
http://homepage1.nifty.com/MADIA/delphi/Win32API/Process.htm
}
var
  li_PID     : DWORD;
  lh_Process : THandle;
  lp_Buff    : PWideChar;
begin
  Result := '';

  //ウィンドウを作成したプロセスIDを取得
  GetWindowThreadProcessId(hHandle, @li_PID);

  lh_Process := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, False, li_PID);
  try
    lp_Buff := AllocMem((MAX_PATH + 1) * SizeOf(lp_Buff));
    try
      //プロセスハンドルを渡すだけで実行ファイル名を得られた。インスタンスハンドルはいらないようだ。
      if (GetModuleFileNameExW(lh_Process, 0, lp_Buff, MAX_PATH) <> 0) then begin
         Result := WideString(lp_Buff);
      end;
    finally
      FreeMem(lp_Buff);
    end;
  finally
    CloseHandle(lh_Process);
  end;
end;

function EnumWindowProc(hHandle: HWND; iLParam: LPARAM): BOOL; stdcall;
var
  lh_Owner : HWND;
begin
  Result := True;

  if (gfnsExeNameGet(hHandle) = gfnsExeNameGet(Application.Handle)) then begin
    //実行ファイルの名前が同じだった。
    //ただし自分自身である可能性がある。
    lh_Owner := GetWindow(hHandle, GW_OWNER);
    if  (lh_Owner <> Application.Handle) //hHandleのオーナーウィンドウが自身のオーナーウィンドウではない。
    and (hHandle  <> Application.Handle) //hHandleが自身のオーナーウィンドウのハンドルではない。
    then begin
      //このhHndleが目的のウィンドウハンドル。
      Beep;
      if (IsIconic(lh_Owner)) then begin
        //最小化されていたら元に戻す。
        SendMessage(lh_Owner, WM_SYSCOMMAND, WPARAM(SC_RESTORE and $FFF0), 0);
      end;
      //前面に移動させる。
      SetForegroundWindow(lh_Owner);
      //必要な処理を終えたので以降の処理(トップレベルウィンドウの列挙)を続行しない。
      Result := False;
    end;
  end;
end;

begin
  //二重起動チェック。
  if  (CreateMutex(nil, False, 'Dsapbi203dap') <> 0) //関数が成功して、
  and (GetLastError = ERROR_ALREADY_EXISTS)          //既に同名のミューテックスオブジェクトがあれば、
  then begin                                        //二重起動である。
    //メッセージを出す。
    Application.MessageBox('二重起動は許可されていません', 'メッセージ');

    //先に起動しているプログラムを探して前面に表示する処理を行う。
    EnumWindows(@EnumWindowProc, 0);

    //プロラム終了。
    Exit;
  end;

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

2011-02-15:実行ファイル名を比較するやり方を追加。