VBScript - 多重起動を禁止する

スクリプトを多重起動されるとマズいケースもあるでしょう。
どうすれば多重起動を禁止できるでしょうか。

★2024-02-02追記 >>>
一時ファイルを使って多重起動を防ぐ方法を書きました。
こちらの方が確実だと思います。
⇩

https://topview.jp/vbscript-prohibition-multiple-startup2-14954

概要

WMI （Windows の管理データ）の Win32_Process で Windows 上のプロセスを確認できます。

Win32_Process より自分自身のスクリプト名を実行するプロセスを取得することで、多重起動を禁止できます。

参考→ Win32_Process クラス

コードサンプル

以下は自分自身のスクリプト名を実行するプロセスを取得し、結果が複数だった場合に出力するコードです。

Option Explicit

'自分自身が wscript.exe または cscript.exe で実行されているか確認するクエリ
Dim query
query = " SELECT *" & _
         "   FROM Win32_Process" & _
         "  WHERE (Caption = 'wscript.exe' OR Caption = 'cscript.exe') " & _
         "    AND CommandLine LIKE '%" & WScript.ScriptName & "%'"

'SWbemLocator オブジェクトを生成
With CreateObject("WbemScripting.SWbemLocator")
    'ローカルPCに接続
    With .ConnectServer
        'クエリを実行
        Dim processes
        Set processes = .ExecQuery(query)

        'クエリの結果が2件以上あれば、同一スクリプトが実行されていると判断できる
        If processes.Count > 1 Then
            WScript.Echo "多重起動しています"
            
            'プロセス情報を出力
            Dim proc
            For Each proc In processes
                WScript.Echo "----------------------------------------"
                WScript.Echo "Name: " & proc.Name
                WScript.Echo "Caption: " & proc.Caption
                WScript.Echo "CommandLine: " & proc.CommandLine
                WScript.Echo "ProcessID: " & proc.ProcessID
            Next
        End If

        Set processes = Nothing
    End With
End With

多重起動を検知した場合、次のような出力結果となります。

C:\tmp\wsh>CScript prohibition_multiple_startup_.vbs
多重起動しています
----------------------------------------
Name: wscript.exe
Caption: wscript.exe
CommandLine: "C:\WINDOWS\System32\WScript.exe" "C:\tmp\wsh\prohibition_multiple_startup_.vbs"
ProcessID: 36048
----------------------------------------
Name: cscript.exe
Caption: cscript.exe
CommandLine: CScript  prohibition_multiple_startup_.vbs
ProcessID: 16796

多重起動を禁止するには、クエリの実行結果が2件以上だったときに、メッセージを表示してスクリプトを終了させれば良いでしょう。

'クエリの結果が2件以上あれば、同一スクリプトが実行されていると判断できる
If processes.Count > 1 Then
    WScript.Echo "すでに実行されているため終了します。"
    WScript.Quit 1
End If

関数化

汎用的に使えるよう関数化しておきます。

引数 piScriptName に自分自身のスクリプト名を指定します。
すでに実行されているなら True が、そうでないなら False が返ります。

'''
''' 指定されたスクリプト名が実行されているか判定します。
''' 実行中なら True を、そうでないなら False を返します。
'''
Function IsRunning (ByVal piScriptName)

    '戻り値初期化
    IsRunning = False

    '自分自身が wscript.exe または cscript.exe で実行されているか確認するクエリ
    Dim query
    query = " SELECT *" & _
             "   FROM Win32_Process" & _
             "  WHERE (Caption = 'wscript.exe' OR Caption = 'cscript.exe') " & _
             "    AND CommandLine LIKE '%" & piScriptName & "%'"

    'SWbemLocator オブジェクトを生成
    With CreateObject("WbemScripting.SWbemLocator")
        'ローカルPCに接続
        With .ConnectServer
            'クエリを実行
            Dim processes
            Set processes = .ExecQuery(query)

            'クエリの結果が2件以上あれば、同一スクリプトが実行されていると判断できる
            If processes.Count > 1 Then
                IsRunning = True
            End If

            Set processes = Nothing
        End With
    End With

End Function

改善したい点

エクスプローラからEnterキーを連続で叩くなど、短時間に複数実行されると両方「実行中」になってしまいました。

ExecQuery でプロセス情報を取得する前に複数実行されてしまうとこのようになるようです。

両方実行されるよりはマシですが、いずれ改善したいです。