VB5.0 二重起動防止

質問

OSWin98/VB5.0を使用しています。同一のシステムの重複起動を防止したいのです。過去ログの、
http://oshiete1.goo.ne.jp/kotaeru.php3?q=644390
を参照し、
http://www.vbvbvb.com/jp/gtips/1101/gCreateToolhelp32SnapshotTh32csSnapprocess.html
のサンプルを参考にし、実行中のプロセスに同一のものがあれば、複数起動と判断するようにしました。
しかし、どうしても二重起動されてしまいます。

例１）A.exeを起動、A.vbpをデバッグで実行
　　　→二重起動を検出し、後者は起動されない
例２）A.exeを起動、A.exeを起動
　　　→二重起動が検出されず、後者も起動されてしまう

App.PrevInstanceで判断できると思うのですが、例１と同じ方法でもこの場合は、二重起動を防ぐことができません。
他によい方法がある、ここがおかしいんじゃないの？等ありましたら、教えてください。
よろしくお願いします。

回答No.2

noname#5584 · ベストアンサー

> それでも二重起動ができてしまう

Sub Main() が実行されていないのでは？
MsgBoxを表示させる等、工夫して、必要な処理が間違いなく実行されているか確認してください。

尚、App.PrevInstanceプロパティで防止できる二重起動は文字通り同一の実行ファイルの場合のみです。同じEXEファイルでも、コピーして複数のフォルダに配置すれば二重起動は可能です。
Mutexを使用する方法であれば、上記のケース (別の場所に同一プログラムが複数存在)でも起動できるのは1つだけです。

[コード例]

Option Explicit

' 指定されたクラス名とウィンドウ名を持つトップレベルウィンドウを探す。
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long

' 指定されたウィンドウが所有するポップアップウィンドウのうち、
' 直前にアクティブであったウィンドウを調べる。
Private Declare Function GetLastActivePopup Lib "user32" _
(ByVal hWndOwnder As Long) As Long

' 指定されたウィンドウを作成したスレッドをフォアグラウンドにし、そのウィンドウをアクティブにする。
Private Declare Function SetForegroundWindow Lib "user32" _
(ByVal hwnd As Long) As Long

' 指定されたウィンドウの表示状態を設定する。
Private Declare Function ShowWindow Lib "user32" _
(ByVal hwnd As Long, _
ByVal nCmdShow As Long) As Long

Private Const SW_RESTORE = 9

Private Declare Function OpenMutex Lib "Kernel32" Alias "OpenMutexA" _
(ByVal dwDesiredAccess As Long, _
ByVal bInheritHandle As Long, _
ByVal lpName As String) As Long

Private Declare Function CreateMutex Lib "Kernel32" Alias "CreateMutexA" _
(ByVal lpMutexAttributes As Long, _
ByVal bInitialOwner As Long, _
ByVal lpName As String) As Long

Private Declare Function ReleaseMutex Lib "Kernel32" (ByVal hMutex As Long) As Long

Private Declare Function CloseHandle Lib "Kernel32" (ByVal hObject As Long) As Long

Private Const SYNCHRONIZE As Long = &H100000
Private Const STANDARD_RIGHTS_REQUIRED As Long = &HF0000
Private Const MUTEX_QUERY_STATE As Long = &H1
Private Const MUTEX_ALL_ACCESS As Long = STANDARD_RIGHTS_REQUIRED Or SYNCHRONIZE Or MUTEX_QUERY_STATE

'ミューテックスオブジェクトのハンドル
Private hMutex As Long

'メインフォームのキャプション
Public Const pCstStrAppTitle = "Mutexによる重複起動防止"

Public Sub Main()
Dim strAppCaption As String
Dim lngFirstTophWnd As Long
Dim lngFirstPophWnd As Long
Dim lngResult As Long

'実行ファイルの場合のみ重複起動防止処理を行う。
If IsExeFile Then
If IsMutexEntity(pCstStrAppTitle) Then
' 多重起動を許さない。
' アプリケーションのキャプションを得る。
strAppCaption = App.Title
' 自アプリのキャプションを変更しておく。
App.Title = strAppCaption & Space(1)
' トップレベルのウィンドウハンドルを得る。
lngFirstTophWnd = FindWindow("ThunderRT6Main", strAppCaption)
' ちなみに、Visual Basic 5アプリの場合。
'lngFirstTophWnd = FindWindow("ThunderRT5Main", strAppCaption)
' 直前にアクティブなウィンドウハンドルを得る。
lngFirstPophWnd = GetLastActivePopup(lngFirstTophWnd)
' ウィンドウをアクティブにする。
lngResult = SetForegroundWindow(lngFirstPophWnd)
' 最小化されタスクバーに格納されてある場合があるので、ウィンドウを通常表示にさせる。
lngResult = ShowWindow(lngFirstPophWnd, SW_RESTORE)
' アプリケーションを終了させる。
End
End If
End If

frmMain.Caption = pCstStrAppTitle
frmMain.Show
End Sub

Public Function IsMutexEntity(ByRef strAppTitle As String) As Boolean
'Mutexが作成されているか調べる。作成されていなかったら作成する。

Dim strBuff As String

strBuff = String(255, 0)
Mid$(strBuff, 1, Len(strAppTitle)) = strAppTitle
'Mutexを開く。
hMutex = OpenMutex(MUTEX_ALL_ACCESS, 0, strBuff)

'Mutexオブジェクトがすでに存在する場合はハンドルをクローズし、終了。
If hMutex <> 0 Then
Call CloseHandle(hMutex)

IsMutexEntity = True
Exit Function
End If

'ミューテックスオブジェクトを作成する。
hMutex = CreateMutex(0, 0, strBuff)
End Function

Public Sub TerminateMutex()
'Mutexオブジェクトを解放する
Call ReleaseMutex(hMutex)
End Sub

Public Function IsExeFile() As Boolean
'実行ファイルか、IDE上の実行かを判定する。
On Error Resume Next
Debug.Print 1 / 0
IsExeFile = CBool(Err.Number = 0)
On Error GoTo 0
End Function

お礼

すみません。
私が大ボケでした。（二重起動を許可するかコマンドラインから引数を取得するところがうまくいっていませんでした。なので、二重起動チェックが起動していなかったのです。）
教えていただいたとおりにやってみるとできました。今日は一日はまっていたので、本当に助かりました。
本当に本当にありがとうございました。

回答No.1

noname#5584

App.PrevInstanceプロパティを利用する方法は下記の通りです。(一例)

' 指定されたクラス名とウィンドウ名を持つトップレベルウィンドウを探す。
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
' 指定されたウィンドウが所有するポップアップウィンドウのうち、
' 直前にアクティブであったウィンドウを調べる。
Private Declare Function GetLastActivePopup Lib "user32" _
(ByVal hWndOwnder As Long) As Long
' 指定されたウィンドウを作成したスレッドをフォアグラウンドにし、そのウィンドウをアクティブにする。
Private Declare Function SetForegroundWindow Lib "user32" _
(ByVal hwnd As Long) As Long
' 指定されたウィンドウの表示状態を設定する。
Private Declare Function ShowWindow Lib "user32" _
(ByVal hwnd As Long, _
ByVal nCmdShow As Long) As Long

Private Const SW_RESTORE = 9

Public Sub Main()
Dim strAppCaption As String
Dim lngFirstTophWnd As Long
Dim lngFirstPophWnd As Long
Dim lngResult As Long

If App.PrevInstance Then
' 多重起動の禁止。
' アプリケーションのキャプションを得る。
strAppCaption = App.Title
' 自アプリのキャプションを変更する。
App.Title = strAppCaption & " "
' トップレベルのウィンドウハンドルを得る。
lngFirstTophWnd = FindWindow("ThunderRT5Main", strAppCaption)
' Visual Basic 6.0アプリの場合。
'lngFirstTophWnd = FindWindow("ThunderRT6Main", strAppCaption)
' 直前にアクティブなウィンドウハンドルを得る。
lngFirstPophWnd = GetLastActivePopup(lngFirstTophWnd)
' ウィンドウをアクティブにする。
lngResult = SetForegroundWindow(lngFirstPophWnd)
' 最小化されタスクバーに格納されてある場合があるので、ウィンドウを通常表示にさせる。
lngResult = ShowWindow(lngFirstPophWnd, SW_RESTORE)
' アプリケーションを終了させる。
End
End If
End Sub

ただし、.NETでは、このコードは使用できません。
VB以外の開発ツールでは、Mutex等を使用する方法が一般的なようです。

http://dobon.net/vb/dotnet/process/checkprevinstance.html

参考URL：

http://dobon.net/vb/dotnet/process/checkprevinstance.html

補足

ありがとうございます。教えていただいたとおりにやっているのに、それでも二重起動ができてしまうとしたら、何か考えられる問題があるでしょうか。お心あたりがありましたら教えてください。