winwrap.bi
Simple class to ensure you can't forget to close or free some resource
Code: Select all
#macro GEN_WIN_WRAP(WinType)
#define TypeName WinType##Wrap
Type TypeName
as WinType _data
as Function stdcall(ByVal as WinType) as BOOL _deleter
Declare Constructor(ByVal d as WinType, ByVal deleter as Function stdcall(ByVal as WinType) as BOOL)
Declare Destructor()
Declare Function Release() as WinType
Declare Operator @() as WinType Ptr
End Type
Private Constructor TypeName(ByVal d as WinType, ByVal deleter as Function stdcall(ByVal as WinType) as BOOL)
_data = d
_deleter = deleter
End Constructor
Private Destructor TypeName()
If _deleter Then _deleter(_data)
End Destructor
Private Operator *(ByRef t as Const TypeName) as WinType
Return t._data
End Operator
Private Operator TypeName.@() as WinType Ptr
Return @_data
End Operator
Private Function TypeName.Release() as WinType
_deleter = NULL
Return _data
End Function
#undef TypeName
#endmacro
#define WIN_WRAP(WinType) WinType##Wrap
The easiest way is perhaps to output to a file and map it back in. Files created with FILE_FLAG_DELETE_ON_CLOSE and FILE_ATTRIBUTE_TEMPORARY keep their contents in the file cache as much as possible so while it does create a file name in a directory, the contents aren't likely to be written to disk. And unlike pipes, files don't get full... unless you run out of disk space, but then you have other issues.
Code: Select all
#include "windows.bi"
#include "winwrap.bi"
#include "crt/stdio.bi"
type ProcessOutput
as string output, errorOutput
as Ulong exitCode
end type
GEN_WIN_WRAP(HANDLE)
GEN_WIN_WRAP(PVOID)
Declare Function ReadStringfromFile(ByVal h as HANDLE, ByVal output as String Ptr) as Boolean
Declare Function CreatePipeFile(ByRef filename as Const String) as HANDLE
Declare Function GetFileContents(ByVal h as HANDLE, ByVal contents as String Ptr) as DWORD
#macro FAIL_IF(cond)
If cond Then
Print "Condition " #cond " failed"
Return GetLastError()
End If
#endmacro
Function RunPipeProcess(ByRef cmdLine as string, ByVal procOutput as ProcessOutput Ptr) as DWORD
If procOutput = NULL Then Return ERROR_INVALID_PARAMETER
dim as string stdoutFile = *_tempnam(NULL, "pipeout")
dim as string stderrFile = *_tempnam(NULL, "pipeerr")
dim as WIN_WRAP(HANDLE) hStdOut = type(CreatePipeFile(stdoutFile), @CloseHandle)
FAIL_IF(*hStdOut = INVALID_HANDLE_VALUE)
dim as WIN_WRAP(HANDLE) hStdErr = type(CreatePipeFile(stderrFile), @CloseHandle)
FAIL_IF(*hStdErr = INVALID_HANDLE_VALUE)
dim as PROCESS_INFORMATION pi
dim as STARTUPINFO si = type(SizeOf(si))
si.dwFlags = STARTF_USESTDHANDLES
si.hStdOutput = *hStdOut
si.hStdError = *hStdErr
FAIL_IF(CreateProcessA(NULL, StrPtr(cmdLine), NULL, NULL, TRUE, CREATE_NO_WINDOW, NULL, NULL, @si, @pi) = 0)
CloseHandle(pi.hThread)
WaitForSingleObject(pi.hProcess, INFINITE)
GetExitCodeProcess(pi.hProcess, @procOutput->exitCode)
CloseHandle(pi.hProcess)
FAIL_IF(GetFileContents(*hStdOut, @procOutput->output) <> ERROR_SUCCESS)
FAIL_IF(GetFileContents(*hStdErr, @procOutput->errorOutput) <> ERROR_SUCCESS)
Return ERROR_SUCCESS
End Function
Function GetFileContents(ByVal h as HANDLE, ByVal contents as String Ptr) as DWORD
dim as Ulong fileSize = GetFileSize(h, NULL)
If fileSize <> 0 Then
dim as WIN_WRAP(HANDLE) hMap = type(CreateFileMapping(h, NULL, PAGE_READONLY, 0, 0, NULL), @CloseHandle)
FAIL_IF(*hMap = NULL)
dim as WIN_WRAP(PVOID) pFileData = type(MapViewOfFile(*hMap, FILE_MAP_READ, 0, 0, 0), @UnmapViewOfFile)
FAIL_IF(*pFileData = NULL)
*contents = Left(*cast(ZString Ptr, *pFileData), fileSize)
End If
Return ERROR_SUCCESS
End Function
Private Function CreatePipeFile(ByRef filename as Const String) as HANDLE
dim as SECURITY_ATTRIBUTES sa = type(SizeOf(sa), NULL, TRUE)
Return CreateFileA( _
StrPtr(filename), _
GENERIC_READ Or GENERIC_WRITE, _
0, _
@sa, _
CREATE_ALWAYS, _
FILE_FLAG_DELETE_ON_CLOSE Or FILE_ATTRIBUTE_TEMPORARY Or FILE_FLAG_SEQUENTIAL_SCAN, _
NULL _
)
End Function
#undef FAIL_IF
dim as ProcessOutput po
dim as DWORD ret = RunPipeProcess("cmd /c type C:\windows\Ultimate.xml", @po)
Print "PipeProcess returned with status " & Hex(po.exitCode)
Print "Output was:"
Print po.output
Since pipes can get full you need to keep reading from them so the child process doesn't hang. If you redirect both stdout and stderr, then with the simple ReadFile loop, your app can get stuck trying to read from one of those while the app is hung trying to write to the other. which ends in deadlock. The simplest way around that is to loop on the process exit and checking every loop if the pipes have any data in them before reading. Polling is never elegant and increases the amonut of work your app has to do CPU wise but it works.
Code: Select all
#define _WIN32_WINNT &h0601
#include "windows.bi"
#include "winwrap.bi"
type ProcessOutput
as string output, errorOutput
as Ulong exitCode
end type
GEN_WIN_WRAP(HANDLE)
#macro FAIL_IF(cond)
If cond Then
Print "Condition " #cond " failed"
Return GetLastError()
End If
#endmacro
Sub ReadFromPipe(ByVal hPipe as HANDLE, ByVal dataString as String Ptr)
dim as ZString*1024 buffer
dim as DWORD toRead
PeekNamedPipe(hPipe, NULL, 0, NULL, @toRead, NULL)
While toRead > 0
dim as DWORD bytesToRead = min(SizeOf(buffer), toRead)
dim as DWORD bytesRead
If ReadFile(hPipe, @buffer, bytesToRead, @bytesRead, NULL) = FALSE Then
Exit While
End If
*dataString += Left(buffer, bytesRead)
toRead -= bytesRead
Wend
End Sub
Function RunPipeProcess(ByRef cmdLine as string, ByVal procOutput as ProcessOutput Ptr) as DWORD
If procOutput = NULL Then Return ERROR_INVALID_PARAMETER
dim as SECURITY_ATTRIBUTES sa = type(SizeOf(sa), NULL, TRUE)
'' CloseHandle(NULL) isn't allowed, so these start as INVALID_HANDLE_VALUE which is
dim as WIN_WRAP(HANDLE) hStdOutWrite = type(INVALID_HANDLE_VALUE, @CloseHandle)
dim as WIN_WRAP(HANDLE) hStdOutRead = type(INVALID_HANDLE_VALUE, @CloseHandle)
FAIL_IF(CreatePipe(@hStdOutRead, @hStdOutWrite, @sa, 0) = FALSE)
dim as WIN_WRAP(HANDLE) hStdErrWrite = type(INVALID_HANDLE_VALUE, @CloseHandle)
dim as WIN_WRAP(HANDLE) hStdErrRead = type(INVALID_HANDLE_VALUE, @CloseHandle)
FAIL_IF(CreatePipe(@hStdErrRead, @hStdErrWrite, @sa, 0) = FALSE)
dim as PROCESS_INFORMATION pi
dim as STARTUPINFO si = type(SizeOf(si))
si.dwFlags = STARTF_USESTDHANDLES
si.hStdOutput = *hStdOutWrite
si.hStdError = *hStdErrWrite
FAIL_IF(CreateProcessA(NULL, StrPtr(cmdLine), NULL, NULL, TRUE, CREATE_NO_WINDOW, NULL, NULL, @si, @pi) = 0)
dim as WIN_WRAP(HANDLE) hProcess = type(pi.hProcess, @CloseHandle)
CloseHandle(pi.hThread)
dim as Boolean keepLooping = True
While keepLooping
keepLooping = (WaitForSingleObject(*hProcess, 10) <> WAIT_OBJECT_0)
ReadFromPipe(*hStdOutRead, @procOutput->output)
ReadFromPipe(*hStdErrRead, @procOutput->errorOutput)
Wend
GetExitCodeProcess(*hProcess, @procOutput->exitCode)
Return ERROR_SUCCESS
End Function
#undef FAIL_IF
#undef GEN_WIN_WRAP
#undef WIN_WRAP
dim as ProcessOutput po
dim as DWORD ret = RunPipeProcess("cmd /c type C:\windows\Ultimate.xml", @po)
Print "PipeProcess returned with status " & Hex(po.exitCode)
Print "Output was:"
Print po.output
Print "Error output was:"
Print po.errorOutput
This version uses overlapped (asynchronous) reads. A little downside is that to enable overlapped for pipes, you have to create both ends of it yourself rather than just CreatePipe()-ing it.
On the plus side:
Overlapped can do multiple reads at once!
Overlapped doesn't hang your code!
Overlapped doesn't poll!
Overlapped will probably make you a cup of tea if you ask it nicely!
Code: Select all
#define _WIN32_WINNT &h0601
#include "windows.bi"
#include "winwrap.bi"
type ProcessOutput
as string output, errorOutput
as Ulong exitCode
end type
GEN_WIN_WRAP(HANDLE)
#macro FAIL_IF(cond)
If cond Then
Print "Condition " #cond " failed"
Return GetLastError()
End If
#endmacro
Function CreateAPipe(ByRef suffix as Const String, ByVal phRead as HANDLE Ptr, ByVal phWrite as HANDLE Ptr) As DWORD
dim as string pipeName = "\\.\pipe\" + Str(GetCurrentProcessId()) + "-" + Str(GetCurrentThreadId()) + suffix
dim as WIN_WRAP(HANDLE) hPipeRead = type( _
CreateNamedPipeA( _
StrPtr(pipeName), _
PIPE_ACCESS_INBOUND Or FILE_FLAG_OVERLAPPED, _
PIPE_TYPE_BYTE Or PIPE_READMODE_BYTE Or PIPE_WAIT Or PIPE_REJECT_REMOTE_CLIENTS, _
1, _
4096, 4096, _
1000, _
NULL _
), _
@CloseHandle _
)
FAIL_IF(*hPipeRead = INVALID_HANDLE_VALUE)
dim as SECURITY_ATTRIBUTES sa = type(SizeOf(sa), NULL, TRUE)
dim as HANDLE hPipeWrite = CreateFileA( _
StrPtr(pipeName), _
GENERIC_WRITE, _
0, _
@sa, _
OPEN_EXISTING, _
FILE_ATTRIBUTE_NORMAL, _
NULL _
)
FAIL_IF(hPipeWrite = INVALID_HANDLE_VALUE)
*phRead = hPipeRead.Release()
*phWrite = hPipeWrite
Return ERROR_SUCCESS
End Function
Type ReadStruct
as OVERLAPPED ol
as HANDLE hPipe
as String Ptr pStringOutput
as ZString*1024 pReadBuffer
End Type
'' This is called automatically on a thread pool thread when a ReadFile completes
Private Sub ReadComplete stdcall (ByVal readError as DWORD, ByVal bytes as DWORD, ByVal pOverlapped as OVERLAPPED ptr)
dim as ReadStruct ptr pReadStruct = cast(ReadStruct ptr, pOverlapped)
If bytes > 0 Then
*pReadStruct->pStringOutput += Left(pReadStruct->pReadBuffer, bytes)
End If
'' If this read succeeded, start the next one
If readError = ERROR_SUCCESS Then
dim as BOOL bRead = ReadFile( _
pReadStruct->hPipe, _
@pReadStruct->pReadBuffer, _
SizeOf(pReadStruct->pReadBuffer), _
NULL, _
pOverlapped _
)
dim as DWORD lastErr = GetLastError()
If bRead = FALSE AndAlso lastErr <> ERROR_IO_PENDING Then
Print "No more reading, ReadFile error " & Str(lastErr)
End If
End If
End Sub
Function RunPipeProcess(ByRef cmdLine as string, ByVal procOutput as ProcessOutput Ptr) as DWORD
If procOutput = NULL Then Return ERROR_INVALID_PARAMETER
'' CloseHandle(NULL) isn't allowed, so these start as INVALID_HANDLE_VALUE which is
dim as WIN_WRAP(HANDLE) hStdOutWrite = type(INVALID_HANDLE_VALUE, @CloseHandle)
dim as WIN_WRAP(HANDLE) hStdOutRead = type(INVALID_HANDLE_VALUE, @CloseHandle)
FAIL_IF(CreateAPipe("stdout", @hStdOutRead, @hStdOutWrite) <> ERROR_SUCCESS)
dim as WIN_WRAP(HANDLE) hStdErrWrite = type(INVALID_HANDLE_VALUE, @CloseHandle)
dim as WIN_WRAP(HANDLE) hStdErrRead = type(INVALID_HANDLE_VALUE, @CloseHandle)
FAIL_IF(CreateAPipe("stderr", @hStdErrRead, @hStdErrWrite) <> ERROR_SUCCESS)
'' This puts the thread pool in charge of our overlapped reads
'' when one completes, it uses one of its threads to call the function
'' meaning we don't have to keep checking if they've finished
BindIoCompletionCallback(*hStdOutRead, @ReadComplete, 0)
BindIoCompletionCallback(*hStdErrRead, @ReadComplete, 0)
dim as ReadStruct stderrData, stdoutData
stderrData.pStringOutput = @procOutput->errorOutput
stderrData.hPipe = *hStdErrRead
stdoutData.pStringOutput = @procOutput->output
stdoutData.hPipe = *hStdOutRead
'' do the bizzo, Solly
dim as PROCESS_INFORMATION pi
dim as STARTUPINFO si = type(SizeOf(si))
si.dwFlags = STARTF_USESTDHANDLES
si.hStdOutput = *hStdOutWrite
si.hStdError = *hStdErrWrite
FAIL_IF(CreateProcessA(NULL, StrPtr(cmdLine), NULL, NULL, TRUE, CREATE_NO_WINDOW, NULL, NULL, @si, @pi) = 0)
dim as WIN_WRAP(HANDLE) hProcess = type(pi.hProcess, @CloseHandle)
CloseHandle(pi.hThread)
'' start the reads
dim as BOOL bRead = ReadFile( _
*hStdOutRead, _
@stdoutData.pReadBuffer, _
SizeOf(stdoutData.pReadBuffer), _
NULL, _
@stdoutData.ol _
)
dim as DWORD lastError = GetLastError()
FAIL_IF((bRead = FALSE) AndAlso (lastError <> ERROR_IO_PENDING))
bRead = ReadFile( _
*hStdErrRead, _
@stderrData.pReadBuffer, _
SizeOf(stderrData.pReadBuffer), _
NULL, _
@stderrData.ol _
)
lastError = GetLastError()
FAIL_IF((bRead = FALSE) AndAlso (lastError <> ERROR_IO_PENDING))
'' and then have a rest
WaitForSingleObject(*hProcess, INFINITE)
GetExitCodeProcess(*hProcess, @procOutput->exitCode)
'' if we started another read after the child apps final write completed, stop it
CancelIoEx(*hStdErrRead, @stderrData.ol)
CancelIoEx(*hStdOutRead, @stdoutData.ol)
Return ERROR_SUCCESS
End Function
#undef FAIL_IF
dim as ProcessOutput po
dim as DWORD ret = RunPipeProcess("cmd /c type C:\windows\Ultimate.xml", @po)
Print "PipeProcess returned with status " & Hex(po.exitCode)
Print "Output was:"
Print po.output
Print "Error output was:"
Print po.errorOutput