Option Explicit

Private Type SECURITY_ATTRIBUTES
    nLength As Long
    lpSecurityDescriptor As Long
    bInheritHandle As Long
End Type

Private Type PROCESS_INFORMATION
    hProcess As Long
    hThread As Long
    dwProcessId As Long
    dwThreadId As Long
End Type

Private Type STARTUPINFO
    cb As Long
    lpReserved As String
    lpDesktop As String
    lpTitle As String
    dwX As Long
    dwY As Long
    dwXSize As Long
    dwYSize As Long
    dwXCountChars As Long
    dwYCountChars As Long
    dwFillAttribute As Long
    dwFlags As Long
    wShowWindow As Integer
    cbReserved2 As Integer
    lpReserved2 As Long
    hStdInput As Long
    hStdOutput As Long
    hStdError As Long
End Type

Private Declare Function CreateProcess Lib "kernel32" _
    Alias "CreateProcessA" ( _
    lpApplicationName As Any, ByVal lpCommandLine As String, _
    lpProcessAttributes As Any, lpThreadAttributes As Any, _
    ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, _
    lpEnvironment As Any, lpCurrentDirectory As Any, _
    lpStartupInfo As STARTUPINFO, _
    lpProcessInformation As PROCESS_INFORMATION) As Long

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

Private Declare Function ReadFile Lib "kernel32" ( _
    ByVal hFile As Long, lpBuffer As Any, _
    ByVal nNumberOfBytesToRead As Long, _
    lpNumberOfBytesRead As Long, lpOverlapped As Long) As Long

'Private Declare Function WaitForInputIdle Lib "user32" ( _
    ByVal hProcess As Long, ByVal dwMilliseconds As Long) As Long

Private Declare Function WaitForSingleObject Lib "kernel32" ( _
    ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long

Private Declare Function CreatePipe Lib "kernel32" ( _
    phReadPipe As Long, phWritePipe As Long, _
    lpPipeAttributes As Any, ByVal nSize As Long) As Long

Private Declare Function PeekNamedPipe Lib "kernel32" ( _
    ByVal hNamedPipe As Long, lpBuffer As Any, _
    ByVal nBufferSize As Long, lpBytesRead As Long, _
    lpTotalBytesAvail As Long, _
    lpBytesLeftThisMessage As Long) As Long

Private Declare Sub MoveMemory Lib "kernel32" _
    Alias "RtlMoveMemory" ( _
    Destination As Any, Source As Any, ByVal Length As Long)

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Private Const STARTF_USESTDHANDLES As Long = &H100&
Private Const STARTF_USESHOWWINDOW As Long = &H1&
Private Const SW_HIDE As Long = 0&
Private Const NORMAL_PRIORITY_CLASS As Long = &H20&
Private Const CREATE_NEW_CONSOLE As Long = &H10&

Private Const STATUS_WAIT_0 = 0&
Private Const STATUS_TIMEOUT = &H102&
Private Const STATUS_ABANDONED_WAIT_0 = &H80&

Private Const WAIT_OBJECT_0 = ((STATUS_WAIT_0) + 0&)
Private Const WAIT_ABANDONED = ((STATUS_ABANDONED_WAIT_0) + 0&)
Private Const WAIT_TIMEOUT = STATUS_TIMEOUT


Private Type OSVERSIONINFO
    dwOSVersionInfoSize As Long
    dwMajorVersion As Long
    dwMinorVersion As Long
    dwBuildNumber As Long
    dwPlatformId As Long
    szCSDVersion As String * 128
End Type

Private Declare Function GetVersionEx Lib "kernel32" _
    Alias "GetVersionExA" ( _
    lpVersionInformation As OSVERSIONINFO) As Long

Private Const VER_PLATFORM_WIN32_WINDOWS = 1
Private Const VER_PLATFORM_WIN32_NT = 2

Public Function ConsoleCommand(CommandLine As String) As Variant
    Const BUFFER_SIZE = &H2000&
    Const TIMEOUT_SECOND = 60
    Dim sa As SECURITY_ATTRIBUTES
    Dim si As STARTUPINFO
    Dim pi As PROCESS_INFORMATION
    Dim buf(0 To BUFFER_SIZE \ 4) As Long
    Dim hRead As Long, hWrite As Long
    Dim lSize As Long, lRet As Long
    Dim sResult As String, s As String
    Dim timeout As Date

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

    lRet = CreatePipe(hRead, hWrite, sa, BUFFER_SIZE)
    If lRet = 0 Then Exit Function

    With si
        .cb = Len(si)
        .dwFlags = STARTF_USESTDHANDLES Or STARTF_USESHOWWINDOW
        .wShowWindow = SW_HIDE
        .hStdOutput = hWrite
    End With

    lRet = CreateProcess(ByVal 0&, CommandLine & Chr(0), _
        sa, ByVal 0&, 1, CREATE_NEW_CONSOLE Or NORMAL_PRIORITY_CLASS, _
        ByVal 0&, ByVal 0&, si, pi)
    If lRet = 0 Then GoTo ErrorHandler

    timeout = Now() + TimeSerial(0, 0, TIMEOUT_SECOND)
    Do
        Sleep 1
        lRet = PeekNamedPipe(hRead, ByVal 0&, 0, ByVal 0&, lSize, ByVal 0&)
        If lSize > 0 Then
            lRet = ReadFile(hRead, buf(0), lSize, lSize, ByVal 0&)
            If lRet <> 0 And lSize > 0 Then
                s = String(lSize + 1, Chr(0))
                MoveMemory ByVal s, buf(0), lSize
                sResult = sResult & Left(s, InStr(1, s, Chr(0), 0) - 1)
             End If
        End If
        lRet = WaitForSingleObject(pi.hProcess, 0)
        If lRet = WAIT_OBJECT_0 Then Exit Do
        If Now() > timeout Then GoTo ErrorHandler
    Loop

    CloseHandle pi.hThread
    CloseHandle pi.hProcess
    CloseHandle hRead
    CloseHandle hWrite

    ConsoleCommand = sResult
    Exit Function

ErrorHandler:
    If pi.hThread Then CloseHandle pi.hThread
    If pi.hProcess Then CloseHandle pi.hProcess
    If hRead Then CloseHandle hRead
    If hWrite Then CloseHandle hWrite
End Function


Sub Test_ConsoleCommand()
    Dim verinfo As OSVERSIONINFO
    verinfo.dwOSVersionInfoSize = 148
    GetVersionEx verinfo

    If verinfo.dwPlatformId = VER_PLATFORM_WIN32_NT Then
        Debug.Print ConsoleCommand("cmd.exe /c dir")
    Else
        Debug.Print ConsoleCommand("command.com /c dir")
    End If
End Sub



'Another easier way using WSH

Sub Test_StdOut()
    Dim WshShell As Object, oExec As Object
    Dim soutput As String
    Set WshShell = CreateObject("WScript.Shell")
    Set oExec = WshShell.Exec("%ComSpec% /c dir")
    Do Until oExec.StdOut.AtEndOfStream
        soutput = soutput & oExec.StdOut.ReadAll
    Loop
    Debug.Print soutput
End Sub