Redirecting stdout/stderr/stdin for child processes from within VB

[michals]

I thought of adding some of my code (based on some articles found in these forums) which I found very useful. I know a few people were looking for this sort of stuff so here it is.

enjoy
------------------------------------------------------

Option Explicit

Private Const NORMAL_PRIORITY_CLASS = &H20&
Private Const INFINITE = -1&
Private Const STARTF_USESHOWWINDOW = &H1&
Private Const SW_HIDE = 0
Private Const STARTF_USESTDHANDLES = &H100&
Private Const SYNCHRONIZE = 1048576
Private Const STD_INPUT_HANDLE = -10&
Private Const STD_OUTPUT_HANDLE = -11&
Private Const STD_ERROR_HANDLE = -12&
Private Const STILL_ACTIVE = &H103
Private Const DUPLICATE_SAME_ACCESS = &H2&
Private Const ERROR_BROKEN_PIPE = &H109&
Private Const PURGE_TXCLEAR = &H4&
Private Const PIPE_NOWAIT = &H1&

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

Private Declare Function GetExitCodeProcess Lib "kernel32" _
(ByVal hProcess As Long, lpExitCode As Long) As Long

Private Declare 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 Function CloseHandle Lib "kernel32" (ByVal _
hObject 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 ReadFile Lib "kernel32" ( _
ByVal hFile As Long, _
ByVal lpBuffer As String, _
ByVal nNumberOfBytesToRead As Long, _
lpNumberOfBytesRead As Long, _
ByVal lpOverlapped As Any) As Long

Private Declare Function GetStdHandle Lib "kernel32" (ByVal nStdHandle As Long) As Long
Private Declare Function DuplicateHandle Lib "kernel32" (ByVal hSourceProcessHandle As Long, ByVal hSourceHandle As Long, ByVal hTargetProcessHandle As Long, lpTargetHandle As Long, ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwOptions As Long) As Long
Private Declare Function GetCurrentProcess Lib "kernel32" () As Long
Private Declare Function getLastError Lib "kernel32" Alias "GetLastError" () As Long
Private Declare Function SetNamedPipeHandleState Lib "kernel32" (ByVal hNamedPipe As Long, lpMode As Long, lpMaxCollectionCount As Long, lpCollectDataTimeout As Long) As Long

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

Private Type STARTUPINFO
cb As Long
lpReserved As Long
lpDesktop As Long
lpTitle As Long
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 Type PROCESS_INFORMATION
hProcess As Long
hThread As Long
dwProcessID As Long
dwThreadID As Long
End Type

Public Function ExecCmd(cmdline As String, Optional stdout As Variant) As Long
Dim proc As PROCESS_INFORMATION, ret As Long, bSuccess As Long
Dim start As STARTUPINFO
Dim sa As SECURITY_ATTRIBUTES
Dim hStdErrWritePipe As Long, hStdErrReadPipe As Long
Dim hStdOutReadPipe As Long, hStdOutWritePipe As Long
Dim bytesread As Long, mybuff As String
Dim i As Integer
Dim result As Long

sa.nLength = Len(sa)
sa.bInheritHandle = 1&
sa.lpSecurityDescriptor = 0&

'create two pipes for input and output redirection
If CreatePipe(hStdOutReadPipe, hStdOutWritePipe, sa, 0) = 0 Then
ExecCmd = Err.LastDllError
Exit Function
End If

'set non blocking mode on all pipe reads
ret& = SetNamedPipeHandleState(hStdOutReadPipe, PIPE_NOWAIT, 0&, 0&)

'Now we need to change the inheritable property for the readable end
'of the pipe so that the child will not inherit that handle as a "garbage"
'handle. This will keep us from having extra, unclosable handles to the pipe.
'Alternatively, we could have opened the pipe with saPipe.bInheritHandle = FALSE
'and changed the inherit property on the *write* handle of the pipe to TRUE.
ret& = DuplicateHandle(GetCurrentProcess(), _
hStdOutReadPipe, _
GetCurrentProcess(), _
0&, _
0&, _
0&, _
DUPLICATE_SAME_ACCESS)

'In most cases you can get away with using the same anonymous
'pipe write handle for both the child's standard output and
'standard error, but this may cause problems if the child app
'explicitly closes one of its standard output or error handles.
'If that happens, the anonymous pipe will close, since the child's
'standard output and error handles are really the same handle. The
'Child won 't be able to write to the other write handle since the
'pipe is now gone, and parent reads from the pipe will return
'ERROR_BROKEN_PIPE and child output will be lost. To solve this
'problem, simply duplicate the write end of the pipe to create
'another distinct, separate handle to the write end of the pipe.
'One pipe write handle will serve as standard out, the other as
'standard error. Now *both* write handles must be closed before the
'write end of the pipe actually closes.
ret& = DuplicateHandle(GetCurrentProcess(), _
hStdOutReadPipe, _
GetCurrentProcess(), _
hStdErrWritePipe, _
0&, _
1&, _
DUPLICATE_SAME_ACCESS)

'set up process control block
start.cb = Len(start)
start.dwFlags = STARTF_USESTDHANDLES Or STARTF_USESHOWWINDOW

'hStdInput needs a valid handle in case it is checked by the child
start.hStdInput = hStdOutReadPipe
start.hStdOutput = hStdOutWritePipe
start.hStdError = hStdErrWritePipe
start.wShowWindow = SW_HIDE

' Start the shelled application:
ret& = CreateProcessA(0&, cmdline, sa, sa, 1&, NORMAL_PRIORITY_CLASS, 0&, 0&, start, proc)

'while process is executing - collect it's output/error messages
'Get the status of the process
'Loop while the process is active

'sleep for 1 seconds to give NT a chance to catch up with creating the process
'also if a process terminates very quickly we want to give NT a chance to set it's
'internals so we can detect that the process is already dead.
DoEvents: Sleep 1000

'find out the status of the process created above
GetExitCodeProcess proc.hProcess, result

'and if still running proceed to report it's stdout and stderr
Do While result = STILL_ACTIVE
'Sleep command recommended as well as DoEvents
DoEvents: Sleep 500

'initialise buffer
mybuff = String(4096, Chr$(65))

'make sure the process is still running
GetExitCodeProcess proc.hProcess, result
If result = STILL_ACTIVE Then
ret& = ReadFile(hStdOutReadPipe, mybuff, 4096, bytesread, 0&)
End If
If ret And bytesread > 0 Then
Call g_buildProgress.addMessage(VBA.Left(mybuff, bytesread))
End If
DoEvents: Sleep 1000

'Loop while the process is active
GetExitCodeProcess proc.hProcess, result
Loop

' get return code and close handles
ret& = CloseHandle(hStdOutWritePipe)
ret& = CloseHandle(hStdErrWritePipe)
ret& = CloseHandle(hStdOutReadPipe)
ret& = GetExitCodeProcess(proc.hProcess, result)
ret& = CloseHandle(proc.hProcess)
ret& = CloseHandle(proc.hThread)

'return success flag
ExecCmd = result = 0
End Function

[BrunoJ]

First, thanks to michals for posting this. I realize this is an old post and he may not see the thanks, but I'll still express it.

I invite all comments to my posting. I am attempting to fully understand this before undertaking the sometimes arduous task of adapting it for use in VBA64.

That leads to my first observation - it appears as this was actually written for VBA, but adapted from VB. I say this because the function declaration for "getLastError" seems to serve no purpose in this context. My guess is its use was replaced by the "Err.LastDllError" method here. That and there is also an explicit use of "VBA.Left". Comments?

Most of the posting makes some sense until the "'make sure the process is still running" comment. Unless my understanding of stdin/stdout or what should be accomplished here is wrong (which I don't discount as a possibility), the ReadFile function should be called using hStdOutWritePipe, not hStdOutReadPipe. Also, there appears to be an object presumably defined in a different process as "g_buildProgress". I assume from the name that this is a progress reporting facility used during compilation, which makes little sense if this is VBA. Can anyone help with my confusion, please?