[リストへもどる]   [VBレスキュー(花ちゃん)]
一括表示

投稿時間:2005/03/02(Wed) 15:05
投稿者名:L.O.N.
URL :
タイトル:
二重起動防止について(Mutex使用)
いつもお世話になっています。

プログラムの二重起動防止にMutexを使用して実装しているのですが。
開発環境上で実行すると、
二重起動していないのに、二重起動していると判定されてしまいます。

発生状況は、このプログラムのプロジェクトを開いて、
一回目は正常にフォームが表示されるのですが、
二回目以降を、開発環境上で開こうとすると
上記のとおり、二重起動と判定されてしまいます。
(実行形式にすると、このエラーは発生しません。)

何故、そのようになってしまうのかわかりません。
どうか、ご教授下さい。

以下が、その実行しているコードです。

------------------------------
Option Explicit

Private SystemMutex      As Long                                'このプログラムのMutex値

'プログラム初期化時使用定数定義
Private Const MUTANT_ALL_ACCESS = &H1F0001                      '

Private Sub Form_Load()

Dim PrevhMutex          As Long
Dim ProgramID           As String

    ProgramID = "856EC91F-638E-4AD8-92B2-6F0A57CE287F"          'Mutex用文字列設定(GUID使用)

    PrevhMutex = OpenMutex(MUTANT_ALL_ACCESS, 0, ProgramID)     'このIDでMutexが作成済み
かチェック
    If PrevhMutex Then                                          '作成済みならば、二重起動
なので
        MsgBox "多重起動"
        CloseHandle PrevhMutex                                  '取得したハンドルをクローズ
        End                                                     'プログラムを終了する
    End If
                                                                'ここにきた場合は、Mutexが
作成されていないので、
    SystemMutex = CreateMutex(0, 0, ProgramID)                  'Mutexを作成する

End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    
    ReleaseMutex SystemMutex                                    '使用していたMutexの削除

End Sub
------------------------------

投稿時間:2005/03/03(Thu) 00:44
投稿者名:Starfish
Eメール:
URL :
タイトル:
Re: 二重起動防止について(Mutex使用)
> いつもお世話になっています。
>
> プログラムの二重起動防止にMutexを使用して実装しているのですが。
> 開発環境上で実行すると、
> 二重起動していないのに、二重起動していると判定されてしまいます。

 Form_QueryUnload でMutexを削除しているので、フォームを閉じて
終了しないと、Mutexは削除されません。VBの停止ボタンで停止してしまうと
再度起動した時に二重起動のチェックでひっかかると思います。

投稿時間:2005/03/05(Sat) 09:16
投稿者名:L.O.N.
URL :
タイトル:
Re^2: 二重起動防止について(Mutex使用)
Starfish さん、返信ありがとうございました。

>  Form_QueryUnload でMutexを削除しているので、フォームを閉じて
> 終了しないと、Mutexは削除されません。VBの停止ボタンで停止してしまうと
> 再度起動した時に二重起動のチェックでひっかかると思います。

QueryUnload で使っていたのが、ReleaseMutex なのが、
原因みたいでした。
Win32API の本を調べたりして、削除時は、
CloseHandle を使用すると記述がありましたので、
そちらを使用すると、うまく動作しました。
(この返信の最後にうまく動作したコードをのせておきます。)

しかし、さらに調べていくと Mutex 作成時に、
すでにその名称での Mutexが作成されていたら、
CreateMutex を使用したすぐ後に、
GetLastError を使用すると、
作成済みの場合は、ERROR_ALREADY_EXISTS
が、取得できると記述がありましたが、
なぜか当方の環境では、うまく動作しませんでした。
しかも、VB6 で作成したのは正常に動作しなくて、
VC6 で作成した方は正常動作しているので、
OS レベルでの動作不良とは思えないのですが。

この件に関しては、知っている方、引き続きご教授下さい。

------------------------------
'ミューテックス関連
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 CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function ReleaseMutex Lib "kernel32" (ByVal hMutex As Long) As Long

Private Declare Function GetLastError Lib "kernel32" () As Long

Private SystemMutex      As Long                                'このプログラムのMutex値

'プログラム初期化時使用定数定義
Private Const MUTANT_ALL_ACCESS = &H1F0001                      '
Private Const ERROR_ALREADY_EXISTS = 183

Private Sub Form_Load()

Dim PrevhMutex          As Long
Dim ProgramID           As String
Dim ErrorCode           As Long
    
    ProgramID = "31CEDC40-45FC-4957-AB00-282CDAC6D901"
                                                                'ここにきた場合は、Mutexが作
成されていないので、
    PrevhMutex = OpenMutex(MUTANT_ALL_ACCESS, 0, ProgramID)     'CreateMutex の GetLastError
が成功しないので、
    If PrevhMutex <> 0 Then                                     '回避策として記述している
(100%の二重起動防止は、できないのは出来ないのはわかっているけど)
        MsgBox "多重起動"                                       'OpenMutex と CreateMutex の
間に割り込まれると、二重起動防止が出来ない
        ReleaseMutex PrevhMutex                                 '
        Unload Me
        Exit Sub
    End If
    
    SystemMutex = CreateMutex(0, True, ProgramID)               'Mutexを作成する
    ErrorCode = GetLastError
    If (ErrorCode = ERROR_ALREADY_EXISTS) Then                  '作成済みならば、これにひっ
かかるはずが、なぜか動作しない。
        MsgBox "多重起動"
        Unload Me
        Exit Sub
    End If
    
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    
Dim Win32Apiresultcode  As Long
    
    Win32Apiresultcode = CloseHandle(SystemMutex)

End Sub
------------------------------

投稿時間:2005/03/05(Sat) 14:16
投稿者名:Starfish
Eメール:
URL :
タイトル:
Re^3: 二重起動防止について(Mutex使用)
>     ErrorCode = GetLastError

    ErrorCode = Err.LastDllError

 VBから、GetLastErrorを呼び出しても正しい値は取れません。
Err.LastDllError を使ってください。

投稿時間:2005/03/08(Tue) 07:57
投稿者名:L.O.N.
URL :
タイトル:
Re^4: 二重起動防止について(Mutex使用)
Starfish さん、再度の返信ありがとうございます。

>  VBから、GetLastErrorを呼び出しても正しい値は取れません。
> Err.LastDllError を使ってください。

VB で GetLastError が正常に作動しない件は、
どうやらFAQレベルの内容のようですね。
(自分のレベルの低さになさけないです。)

Err.LastDllError に切り替えましたら、
正常に動作いたしました。

以下は、そのチェックを実行しているコードです。
------------------------------
'ミューテックス関連
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 CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

Private SystemMutex      As Long                                'このプログラムのMutex値

'プログラム初期化時使用定数定義
Private Const ERROR_ALREADY_EXISTS = 183

Private Sub Form_Load()

Dim PrevhMutex          As Long
Dim ProgramID           As String
Dim ErrorCode           As Long
    
    ProgramID = "31CEDC40-45FC-4957-AB00-282CDAC6D901"
    
    SystemMutex = CreateMutex(0, True, ProgramID)               'Mutexを作成する
    ErrorCode = Err.LastDllError
    If (ErrorCode = ERROR_ALREADY_EXISTS) Then                  '作成済みならば、これにひっ
かかるはずが、なぜか動作しない。
        MsgBox "多重起動"
        Unload Me
        Exit Sub
    End If
    
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    
Dim Win32Apiresultcode  As Long

    Win32Apiresultcode = CloseHandle(SystemMutex)

End Sub