VBScript コマンドの実行と標準出力の取得

VBScript内でコマンドを実行し、標準出力の文字列から成功の可否を判定します。

（ERRORLEVELは参照しません。）

'===================================
' コマンドを実行し、標準出力から成功の可否を判定する
' vbs_execcmd.vbs
'===================================
'
'変数宣言の強制
Option Explicit

'関数戻り値定数
Const ISSUCCESS  = 0
Const ISERROR    = 1

'固定文字列
'コマンドが成功時に出力する文字列
Const BATCH_SUCCESS_MSG  = "        1 個のファイルをコピーしました。"

'◆メイン処理呼び出し
Call CheckDualExec()
Call Main()

'◇メイン処理
Sub Main()
    On Error Resume Next

    'コマンドの起動
    Call execCmd("sample1.txt", "sample2.txt")

    'メイン処理終了
    Exit Sub
End Sub

'◇コマンドの起動
Sub execCmd(ByVal arg1, ByVal arg2)
    '変数宣言
    Dim WshShell   'WshShellオブジェクト
    Dim objPgm    'WshScriptExecオブジェクト
    Dim strCmd    '実行コマンド
    
    Set WshShell = CreateObject("WScript.Shell")
    
    'コマンド生成
    strCmd = "cmd /c copy " & arg1 & " " & arg2
    
    WScript.Echo "起動コマンド：" & strCmd
    
    'コマンドを起動
    Set objPgm = WshShell.Exec(strCmd)
    If Err.Number <> 0 Then
        WScript.Echo "コマンド起動時にエラー発生"
        WScript.Quit
    End IF
    
    '取込終了まで待機
    Do while objPgm.Status <> 1
        WScript.Sleep 100
    Loop
    
    'コマンドの起動結果判定
    If AskResult(objPgm) <> ISSUCCESS Then
        WScript.Echo "コマンドが正常終了しませんでした。"
        WScript.Quit
    End IF
    
    Set objPgm = Nothing
End Sub

'◇二重起動抑制
Sub CheckDualExec
    Dim objSWbemLocator
    Dim objServices
    Dim objProcess
    Dim objProcesses
    Dim first
    Set objSWbemLocator = CreateObject("WbemScripting.SWbemLocator")
    Set objServices = objSWbemLocator.ConnectServer(".", "root\cimv2")
    Set objProcesses = objServices.ExecQuery("SELECT * FROM Win32_Process")
    first = False
    For Each objProcess In objProcesses
        If WScript.FullName = objProcess.ExecutablePath Then
            If Instr( objProcess.CommandLIne , WScript.ScriptFullName ) > 0 Then
                If Not first Then
                    first = True
                Else
                    'プロセス終了
                    WScript.Quit
                End If
            End If
        End If
    Next
End Sub

'◇コマンドの処理結果確認
Function AskResult(objArg)
    Dim strCurLine

    '標準出力を取得
    If Not objArg.StdOut.AtEndOfStream Then
        strCurLine = objArg.StdOut.ReadAll
        WScript.Echo strCurLine
    End If
    
    '文字列を判定
    If BATCH_SUCCESS_MSG = Left(strCurLine,Len(BATCH_SUCCESS_MSG)) Then
        '正常終了時
        AskResult = ISSUCCESS
    Else
        '異常終了時
        AskResult = ISERROR
    End If
End Function