Option Explicit
Private Declare PtrSafe Function CreatePipe Lib "kernel32" ( _
phReadPipe As LongPtr, _
phWritePipe As LongPtr, _
lpPipeAttributes As Any, _
ByVal nSize As Long) As Long
Private Declare PtrSafe Function ReadFile Lib "kernel32" ( _
ByVal hFile As LongPtr, _
ByVal lpBuffer As String, _
ByVal nNumberOfBytesToRead As Long, _
lpNumberOfBytesRead As Long, _
ByVal lpOverlapped As Any) As Long
Private Declare PtrSafe Function PeekNamedPipe Lib "kernel32" ( _
ByVal hNamedPipe As LongPtr, _
lpBuffer As Any, _
ByVal nBufferSize As Long, _
lpBytesRead As Long, _
lpTotalBytesAvail As Long, _
lpBytesLeftThisMessage As Long _
) As Long
Private Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As LongPtr
bInheritHandle As Long
End Type
Private Type STARTUPINFO
cb As Long
lpReserved As LongPtr
lpDesktop As LongPtr
lpTitle As LongPtr
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 LongPtr
hStdInput As LongPtr
hStdOutput As LongPtr
hStdError As LongPtr
End Type
Private Type PROCESS_INFORMATION
hProcess As LongPtr
hThread As LongPtr
dwProcessID As Long
dwThreadID As Long
End Type
Private Declare PtrSafe Function CreateProcessA Lib "kernel32" (ByVal _
lpApplicationName As Long, ByVal lpCommandLine As String, _
lpProcessAttributes As Any, lpThreadAttributes As Any, _
ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, _
ByVal lpEnvironment As Long, ByVal lpCurrentDirectory As Long, _
lpStartupInfo As Any, lpProcessInformation As Any) As Long
Private Declare PtrSafe Function CloseHandle Lib "kernel32" (ByVal _
hObject As LongPtr) As Long
Private Declare PtrSafe Function GetExitCodeProcess Lib _
"kernel32" (ByVal hProcess As LongPtr, lpExitCode _
As Long) As Long
Private Const SW_SHOWNORMAL = 1
Private Const SW_HIDE = 0
Private Const STILL_ACTIVE = 259
Private Const NORMAL_PRIORITY_CLASS = &H20&
Private Const STARTF_USESHOWWINDOW = &H1&
Private Const STARTF_USESTDHANDLES = &H100&
Public Function ExecCmd(cmdline$) As String
Dim proc As PROCESS_INFORMATION, ret As Long, bSuccess As Long
Dim start As STARTUPINFO
Dim sa As SECURITY_ATTRIBUTES, hReadPipe As LongPtr, hWritePipe _
As LongPtr, hReadPipe2 As LongPtr, hWritePipe2 As LongPtr, ExitCode As Long, _
tBytesr As Long, tBytesa As Long, tMsg As Long, Result As Long
Dim bytesread As Long, mybuff As String
Dim i As Integer
mybuff = String(1024, "A")
sa.nLength = Len(sa)
sa.bInheritHandle = 1&
sa.lpSecurityDescriptor = 0&
ret = CreatePipe(hReadPipe, hWritePipe, sa, 0)
If ret = 0 Then
ExecCmd = "Error CreatePipe 1: " & Err.LastDllError
Exit Function
End If
start.hStdOutput = hWritePipe
ret = CreatePipe(hReadPipe2, hWritePipe2, sa, 0)
If ret = 0 Then
ExecCmd = "Error CreatePipe 2: " & Err.LastDllError
Exit Function
End If
start.hStdError = hWritePipe2
start.cb = Len(start)
start.dwFlags = STARTF_USESTDHANDLES Or STARTF_USESHOWWINDOW
start.wShowWindow = SW_SHOWNORMAL
ret& = CreateProcessA(0&, cmdline$, sa, sa, 1&, _
NORMAL_PRIORITY_CLASS, 0&, 0&, start, proc)
If ret <> 1 Then
ExecCmd = "Error CreateProcessA: " & Err.LastDllError
Exit Function
End If
Do
GetExitCodeProcess proc.hProcess, ExitCode
'**This call returns 0
'Result = PeekNamedPipe(hReadPipe2, ByVal 0&, 0, ByVal 0&, tBytesa, ByVal 0&)
'**This call works as expected
Result = PeekNamedPipe(hReadPipe, ByVal 0&, 0&, ByVal 0&, tBytesa, ByVal 0&)
If Result <> 0 And tBytesa > 0 Then
bSuccess = ReadFile(hReadPipe, mybuff, 1024, bytesread, 0&)
If bSuccess = 1 Then
ExecCmd = ExecCmd & Left(mybuff, bytesread)
End If
End If
DoEvents
'Don't quit looping until the app has closed
Loop While ExitCode = STILL_ACTIVE
ret& = CloseHandle(proc.hProcess)
ret& = CloseHandle(proc.hThread)
ret& = CloseHandle(hReadPipe)
ret& = CloseHandle(hWritePipe)
ret& = CloseHandle(hReadPipe2)
ret& = CloseHandle(hWritePipe2)
End Function
Sub test()
Dim result As String
'**This call returns nothing
'result = ExecCmd("cmd.exe /c dir X*")
'**This call returns the expected error
result = ExecCmd("cmd.exe /c dir X* 2>&1")
MsgBox (result)
End Sub
Option Explicit
Private Declare PtrSafe Function CreatePipe Lib "kernel32" ( _
phReadPipe As LongPtr, phWritePipe As LongPtr, _
lpPipeAttributes As Any, ByVal nSize As Long) As Long
Private Declare PtrSafe Function ReadFile Lib "kernel32" ( _
ByVal hFile As LongPtr, ByVal lpBuffer As String, _
ByVal nNumberOfBytesToRead As Long, _
lpNumberOfBytesRead As Long, ByVal lpOverlapped As Any) As Long
Private Declare PtrSafe Function PeekNamedPipe Lib "kernel32" ( _
ByVal hNamedPipe As LongPtr, _
lpBuffer As Any, ByVal nBufferSize As Long, _
lpBytesRead As Long, lpTotalBytesAvail As Long, _
lpBytesLeftThisMessage As Long) As Long
Private Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As LongPtr
bInheritHandle 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 LongPtr
hStdInput As LongPtr
hStdOutput As LongPtr
hStdError As LongPtr
End Type
Private Type PROCESS_INFORMATION
hProcess As LongPtr
hThread As LongPtr
dwProcessID As Long
dwThreadID As Long
End Type
Private Declare PtrSafe Function CreateProcessA Lib "kernel32" (ByVal _
lpApplicationName As Long, ByVal lpCommandLine As String, _
lpProcessAttributes As Any, lpThreadAttributes As Any, _
ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, _
ByVal lpEnvironment As Long, ByVal lpCurrentDirectory As Long, _
lpStartupInfo As Any, lpProcessInformation As Any) As Long
Private Declare PtrSafe Function CloseHandle Lib "kernel32" ( _
ByVal hObject As LongPtr) As Long
Private Declare PtrSafe Function GetExitCodeProcess Lib "kernel32" ( _
ByVal hProcess As LongPtr, lpExitCode As Long) As Long
Private Const NORMAL_PRIORITY_CLASS As Long = &H20
Private Const STARTF_USESHOWWINDOW As Long = &H1
Private Const STARTF_USESTDHANDLES As Long = &H100
Public Function ExecCmd(cmdline$) As String
Dim hReadPipe As LongPtr, hWritePipe As LongPtr
Dim proc As PROCESS_INFORMATION, start As STARTUPINFO
Dim sa As SECURITY_ATTRIBUTES
Dim ExitCode As Long, tBytesa As Long, tMsg As Long, result As Long
Dim bytesread As Long, mybuff As String * 1024
sa.nLength = LenB(sa)
sa.bInheritHandle = 1&
sa.lpSecurityDescriptor = 0&
result = CreatePipe(hReadPipe, hWritePipe, sa, 0)
If result = 0 Then
ExecCmd = "Error CreatePipe 1: " & Err.LastDllError
Exit Function
End If
With start
.hStdOutput = hWritePipe
.cb = LenB(start)
.dwFlags = STARTF_USESTDHANDLES Or STARTF_USESHOWWINDOW
.wShowWindow = 1 ' 1 = SW_SHOWNORMAL, 0 = SW_HIDE
End With
result = CreateProcessA(0&, cmdline$, sa, sa, 1&, _
NORMAL_PRIORITY_CLASS, 0&, 0&, start, proc)
If result <> 1 Then
ExecCmd = "Error CreateProcessA: " & Err.LastDllError
Exit Function
End If
Do
GetExitCodeProcess proc.hProcess, ExitCode
result = PeekNamedPipe(hReadPipe, ByVal 0&, 0&, ByVal 0&, tBytesa, ByVal 0&)
If result <> 0 And tBytesa > 0 Then
If ReadFile(hReadPipe, mybuff, 1024, bytesread, 0&) = 1 Then
ExecCmd = ExecCmd & Left(mybuff, bytesread)
End If
End If
DoEvents
Loop While ExitCode = 259 ' 259 = STILL_ACTIVE
CloseHandle proc.hProcess
CloseHandle proc.hThread
CloseHandle hReadPipe
CloseHandle hWritePipe
End Function
Sub test()
MsgBox (ExecCmd("cmd.exe /c dir *"))
End Sub
Option Explicit
Private Declare PtrSafe Function CreatePipe Lib "kernel32" ( _
phReadPipe As LongPtr, _
phWritePipe As LongPtr, _
lpPipeAttributes As Any, _
ByVal nSize As Long) As Long
Private Declare PtrSafe Function ReadFile Lib "kernel32" ( _
ByVal hFile As LongPtr, _
ByVal lpBuffer As String, _
ByVal nNumberOfBytesToRead As Long, _
lpNumberOfBytesRead As Long, _
ByVal lpOverlapped As Any) As Long
Private Declare PtrSafe Function PeekNamedPipe Lib "kernel32" ( _
ByVal hNamedPipe As LongPtr, _
lpBuffer As Any, _
ByVal nBufferSize As Long, _
lpBytesRead As Long, _
lpTotalBytesAvail As Long, _
lpBytesLeftThisMessage As Long _
) As Long
Private Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As LongPtr
bInheritHandle As Long
End Type
Private Type STARTUPINFO
cb As Long
lpReserved As LongPtr
lpDesktop As LongPtr
lpTitle As LongPtr
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 LongPtr
hStdInput As LongPtr
hStdOutput As LongPtr
hStdError As LongPtr
End Type
Private Type PROCESS_INFORMATION
hProcess As LongPtr
hThread As LongPtr
dwProcessID As Long
dwThreadID As Long
End Type
Private Declare PtrSafe Function CreateProcessA Lib "kernel32" (ByVal _
lpApplicationName As Long, ByVal lpCommandLine As String, _
lpProcessAttributes As Any, lpThreadAttributes As Any, _
ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, _
ByVal lpEnvironment As Long, ByVal lpCurrentDirectory As Long, _
lpStartupInfo As Any, lpProcessInformation As Any) As Long
Private Declare PtrSafe Function CloseHandle Lib "kernel32" (ByVal _
hObject As LongPtr) As Long
Private Declare PtrSafe Function GetExitCodeProcess Lib _
"kernel32" (ByVal hProcess As LongPtr, lpExitCode _
As Long) As Long
Private Const SW_SHOWNORMAL = 1
Private Const SW_HIDE = 0
Private Const STILL_ACTIVE = 259
Private Const NORMAL_PRIORITY_CLASS = &H20&
Private Const STARTF_USESHOWWINDOW = &H1&
Private Const STARTF_USESTDHANDLES = &H100&
Public Function ExecCmd(cmdline$) As String
Dim proc As PROCESS_INFORMATION, ret As Long, bSuccess As Long
Dim start As STARTUPINFO
Dim sa As SECURITY_ATTRIBUTES, hReadPipe As LongPtr, hWritePipe _
As LongPtr, hReadPipe2 As LongPtr, hWritePipe2 As LongPtr, ExitCode As Long, _
tBytesa As Long, Result As Long
Dim bytesread As Long, mybuff As String
mybuff = String(1024, "A")
sa.nLength = LenB(sa)
sa.bInheritHandle = 1&
sa.lpSecurityDescriptor = 0&
ret = CreatePipe(hReadPipe, hWritePipe, sa, 0)
If ret = 0 Then
ExecCmd = "Error CreatePipe 1: " & Err.LastDllError
Exit Function
End If
start.hStdOutput = hWritePipe
ret = CreatePipe(hReadPipe2, hWritePipe2, sa, 0)
If ret = 0 Then
ExecCmd = "Error CreatePipe 2: " & Err.LastDllError
Exit Function
End If
start.hStdError = hWritePipe2
start.cb = LenB(start)
start.dwFlags = STARTF_USESTDHANDLES Or STARTF_USESHOWWINDOW
start.wShowWindow = SW_SHOWNORMAL
ret& = CreateProcessA(0&, cmdline$, sa, sa, 1&, _
NORMAL_PRIORITY_CLASS, 0&, 0&, start, proc)
If ret <> 1 Then
ExecCmd = "Error CreateProcessA: " & Err.LastDllError
Exit Function
End If
Do
GetExitCodeProcess proc.hProcess, ExitCode
Result = PeekNamedPipe(hReadPipe2, ByVal 0&, 0, ByVal 0&, tBytesa, ByVal 0&)
If Result <> 0 And tBytesa > 0 Then
bSuccess = ReadFile(hReadPipe2, mybuff, 1024, bytesread, 0&)
If bSuccess = 1 Then
ExecCmd = ExecCmd & Left(mybuff, bytesread)
End If
End If
DoEvents
'Don't quit looping until the app has closed
Loop While ExitCode = STILL_ACTIVE
ret& = CloseHandle(proc.hProcess)
ret& = CloseHandle(proc.hThread)
ret& = CloseHandle(hReadPipe)
ret& = CloseHandle(hWritePipe)
ret& = CloseHandle(hReadPipe2)
ret& = CloseHandle(hWritePipe2)
End Function
Sub test()
Dim result As String
result = ExecCmd("cmd.exe /c dir X*")
MsgBox (result)
End Sub