Tcl/TkでMutexを使った多重起動防止

Tcl単体でやろうとすると、ロックファイルでやりなさいということになるんですけど、その場合Tclの処理系が起動するまでに、別のインスタンスが起動できてしまう可能性があるので、厳密ではないです。たとえば、

run_twice.bat
start wish app.tcl
start wish app.tcl

とかやると、2重起動してしまいます。

プロセスリストを取得して処理する方法もあります http://goo.gl/K38a 。今まではこれを使っていました。ただ、プロセスリストの取得自体が結構時間かかるので、上記よりましですが確実ではないです。

別の方法として、socketで特定ポートをバインドして、多重起動時にエラーにするという方法があります。singleton application - Tcler's Wiki
ネットワークを使わないのにファイアウォールの例外にするか聞かれたりするのが嫌です。

Mutexを使うと、VBやC#とかでやってるみたいな厳密な多重起動防止対策ができます(Windows限定)。

twapi 2.2.3での実装

package require twapi 2.2.3
twapi::import_commands
 
set appname "My Application"
 
set handle [create_mutex -name $appname]
if {[lock_mutex $handle -wait 1] > 0} {
	tk_messageBox -icon error 
		-title "Startup error" 
		-message "Another instance is running." 
		-type ok
	exit
}
console show

twapi 3.0 正式版での実装

先日twapi3.0の正式版がリリースされました。
3.0では従来通りpackage require するか、dllを1個loadするかが選べるようになりました。
x86版はTcl8.4をサポートしています。
3.0ではAPIの仕様がいろいろ変わって、lock_mutexの返り値がsignalled, timeout, abandonedのいずれかとなっています。

load twapi-x86-3.0.29.dll
twapi::import_commands
 
set appname "My Application"
 
set handle [create_mutex -name $appname]
if {[lock_mutex $handle -wait 1] ne "signalled"} {
	tk_messageBox -icon error 
		-title "Startup error" 
		-message "Another instance is running." 
		-type ok
	exit
}
console show

先に起動してたウインドウを閉じるかユーザに聞く

そういうことをする実験です。実際にはプロセスをkillするとか、ウィンドウの存在を監視して、完全に終了するのを待つとかが必要になると思います。

package require Tk
load twapi-x86-3.0.29.dll
twapi::import_commands
 
set appname "My Application"
 
set handle [create_mutex -name $appname]
if {[lock_mutex $handle -wait 1] ne "signalled"} {
	set ans [tk_messageBox -icon error 
		-title "Startup error" 
		-message "Another instance is running. Kill it?" 
		-type yesno]
	switch $ans {
	yes {
		set hWnds [find_windows -text $appname]
		foreach hWnd $hWnds {
			close_window $hWnd
		}
	}
	no {
		exit
	}
	}
}
 
wm title . $appname
wm protocol . DELETE_WINDOW EXIT
proc EXIT {} {
	after 3000 exit
}

コメントを残す