パイプを通して MS-DOS でコマンドを実行し、コマンド実行結果として出力された標準出力(またはエラー出力)をパイプを通してを取得するサンプルである。Creating a Child Process with Redirected Input and Output をまんま参考にしてこさえてみました。昔はもっと実装が面倒だった気がするけど気のせいかな？ Windows のバージョンが新しくなって容易に実装できるようになったのであろうか…

上記画像にて「比較」の「較」が文字化けしている。文字コードの下位バイトが 5C だからかと思ったけど、どうやら違う模様。良く分かりませんでした。

以下は基本的なMS-DOSコマンド実行ロジック。重要な箇所は色々あれど、STARTUPINFO構造体設定で dwFlags に STARTF_USESTDHANDLES を指定するところはきちんと抑えておいた方が良いと予感。これを指定しないとパイプから標準出力(またはエラー出力)を取得できなくなる。これについては コンソール プロセスを生成して標準ハンドルをリダイレクトする方法 を参照のこと。

'-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
' 機  能：ハンドルを閉じる(何やら面倒な作りにしてしまったよ…)
' 引  数：(i)FLAGS … 対象オブジェクトのハンドル
' 返り値：正常…True  異常…False
'=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
Private Function WarmingUp() As Boolean
    Dim udtSecAttr As SECURITY_ATTRIBUTES
    Dim FuncRet As Long

    With udtSecAttr
        .nLength = Len(udtSecAttr)
        .bInheritHandle = 1
        .lpSecurityDescriptor = 0
    End With

    With udtHHolder
        '標準出力のパイプを作成
        FuncRet = CreatePipe(.hChildStrOutRead, .hChildStdOutWrite, udtSecAttr, 0&)
        If FuncRet = 0 Then Exit Function

        FuncRet = SetHandleInformation(.hChildStrOutRead, HANDLE_FLAG_INHERIT, 0&)
        If FuncRet = 0 Then Exit Function

        '標準入力のパイプを作成
        FuncRet = CreatePipe(.hChildStdInRead, .hChildStdInWrite, udtSecAttr, 0&)
        If FuncRet = 0 Then Exit Function

        FuncRet = SetHandleInformation(.hChildStdInWrite, HANDLE_FLAG_INHERIT, 0&)
        If FuncRet = 0 Then Exit Function
    End With

    WarmingUp = True
End Function

'-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
' 機  能：プロセスを作成してコマンドを実行する
' 引  数：(i)ExecCmd … 実行するコマンド
' 返り値：正常…True  異常…False
'=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
Private Function CreateChildProcess(ByVal ExecCmd As String) As Boolean
    Dim udtStUpInfo As STARTUPINFO
    Dim udtProcInfo As PROCESS_INFORMATION
    Dim FuncRet As Long

    'STARTUPINFO構造体設定
    With udtStUpInfo
        .cb = Len(udtStUpInfo)
        .hStdError = udtHHolder.hChildStdOutWrite
        .hStdOutput = udtHHolder.hChildStdOutWrite
        .hStdInput = udtHHolder.hChildStdInRead
        .dwFlags = STARTF_USERHOWWINDOW Or STARTF_USESTDHANDLES
    End With

    'プロセスを作成する
    FuncRet = CreateProcess(vbNullString, GetMSDosCmd(ExecCmd), 0, 0, True, 0, ByVal 0, vbNullString, udtStUpInfo, udtProcInfo)
    If FuncRet = 0 Then Exit Function

    '返り値設定
    With udtProcInfo
        udtHHolder.hProcess = .hProcess
        udtHHolder.hThread = .hThread
    End With

    '正常
    CreateChildProcess = True
End Function

'-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
' 機  能：パイプから標準出力文字列を取得する
' 引  数：なし
' 返り値：なし
'=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
Private Function ReadFromPipe() As String
    Dim FuncRet As Long
    Dim ReadBytes&, WriteBytes As Long
    Dim DataBuff() As Byte
    Dim hParentStdOut As Long
    Dim Buffer As New ClsStringBuffer  'なんちゃって文字列変数

    '標準入力のハンドルを閉じる
    Call CloseHandles(FLAG_STD_OUT_WRITE)

    '読めなくなるまで読む
    Do
        ReDim DataBuff(BUFF_SIZE - 1) As Byte
        '読め〜
        FuncRet = ReadFile(udtHHolder.hChildStrOutRead, ByVal VarPtr(DataBuff(0)), BUFF_SIZE, ReadBytes, ByVal 0&)
        If FuncRet = 0 Or ReadBytes = 0 Then Exit Do

        'バッファに文字列を詰め込む
        Call Buffer.Append(StrNullCut(StrConv(DataBuff, vbUnicode)))
    Loop

    '返却
    ReadFromPipe = Buffer.ToString

    'バッファクラス開放
    Set Buffer = Nothing
End Function