二重起動の禁止

質問

If App.PrevInstance = True Then
End
End If

このコードで二重起動を禁止しているのですが、
たまに二重起動してしまいます。
確実に禁止できる方法はありませんか？
（VB6）

回答No.3

noname#139383 · ベストアンサー

WMIオブジェクトを使って自身のプロセス名を指定して起動状態を確認する方法です。
これで確実に禁止できるはずです。

参照設定でMicrosoft WMI Scripting V1.2 Libraryにチェックをいれてください。

**************ここからソース*************
Option Explicit

Private Sub Main()
Dim strPROC_NAME As String

'実行ファイル(プロセス名)を代入
strPROC_NAME = App.EXEName
'二重起動防止
If fncGet_ProcStatus(strPROC_NAME & ".exe")=False Then
MsgBox "既に起動中です。"
'二重起動の場合、処理終了
End
End If
'処理を続行
End Sub

'/------------------------------------------------
' 関数名 : fncGet_ProcStatus
' 機能概要 : 引数で指定したプロセス名の起動を確認する。
' 引数 : strProcName(String) : 起動状態を確認するプロセス名
' 戻り値 : Boolean, True=起動していない,False=起動している
'------------------------------------------------/
Private Function fncGet_ProcStatus(ByVal strProcName As String) As Long
Dim Service As WbemScripting.SWbemObject
Dim ServiceSet As WbemScripting.SWbemObjectSet
Dim lngCounta As Long
On Error GoTo ErrTrap
fncGet_ProcStatus = False

'WMI(WindowsManagementInstrumentation)オブジェクトの宣言
Set ServiceSet = GetObject("winmgmts:{impersonationLevel=impersonate}"). _
InstancesOf("Win32_Process")
For Each Service In ServiceSet
If Service.Description = strProcName Then
lngCounta = lngCounta + 1
End If
Next

If lngCounta = 1 Then
'起動しているプロセスが１つだけならTrue
fncGet_ProcStatus = True
End If

'WMIオブジェクトの解放
If Not (ServiceSet Is Nothing) Then
Set ServiceSet = Nothing
End If
Exit Function
ErrTrap:
'WMIオブジェクトの解放
If Not (ServiceSet Is Nothing) Then
Set ServiceSet = Nothing
End If
End Function

お礼

忙しくて遅くなりましたが、
どうもありがとうございました。

回答No.2

taka_tetsu

>たまに二重起動してしまいます。

というくらいシビアなことを求めるのなら
FindWindow()よりもCreateMutex()の方がより確実。

Cの例ですけど。
http://www.expertmg.co.jp/html/cti/vctips/process.htm#多重起動を防止する

参考URL：

http://www.expertmg.co.jp/html/cti/vctips/process.htm#多重起動を防止する

回答No.1

chairwarmer

App.PrevInstanceのチェックの他にも
FindWindowのAPIを用いて同じタイトルのウィンドウが
開いていないかどうか探すチェックも組み込んでおくのはいかがでしょうか。

参考URL：

http://www31.ocn.ne.jp/~heropa/vb27.htm