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.
ここで一意な名前の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.
これでプログラムの多重起動を禁止することができます。
作成する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.
Delphiのウィンドウコントロールはクラス名がそのままウィンドウクラス名になるため、FindWindowにはアプリケーションのメインフォームのクラス名を渡します。
0 件のコメント:
コメントを投稿