Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
bipipe.bi
| Uploader: |  grindstone |
| Datum/Zeit: | 12.01.2021 16:23:29 |
Hinweis: Dieser Quelltext ist Bestandteil des Projekts Colochessum, zu dem es auf FreeBASIC-Portal.de eine Projektseite gibt.
#Include Once "windows.bi"
Type tBipdata
hProcessHandle As HANDLE
hWritePipe As HANDLE
hReadPipe As HANDLE
End Type
Function bipOpen(PrgName As String, showmode As Short = SW_NORMAL) As tBipdata Ptr
Dim As STARTUPINFO si
Dim As PROCESS_INFORMATION pi
Dim As SECURITY_ATTRIBUTES sa
Dim As HANDLE hReadPipe, hWritePipe, hReadChildPipe, hWriteChildPipe
Dim pPipeHandles As tBipdata Ptr
'set security attributes
sa.nLength = SizeOf(SECURITY_ATTRIBUTES)
sa.lpSecurityDescriptor = NULL 'use default descriptor
sa.bInheritHandle = TRUE
'create one pipe for each direction
CreatePipe(@hReadChildPipe,@hWritePipe,@sa,0) 'parent to child
CreatePipe(@hReadPipe,@hWriteChildPipe,@sa,0) 'child to parent
GetStartupInfo(@si)
si.dwFlags = STARTF_USESTDHANDLES Or STARTF_USESHOWWINDOW
si.wShowWindow = showmode 'appearance of child process window
si.hStdOutput = hWriteChildPipe
si.hStdError = hWriteChildPipe
si.hStdInput = hReadChildPipe
CreateProcess(0,PrgName,0,0,TRUE,CREATE_NEW_CONSOLE,0,0,@si,@pi)
CloseHandle(hWriteChildPipe)
CloseHandle(hReadChildPipe)
pPipeHandles = Allocate (SizeOf(tBipdata)) 'area for storing the handles
pPipeHandles->hProcessHandle = pi.hProcess 'handle to child process
pPipeHandles->hWritePipe = hWritePipe
pPipeHandles->hReadPipe = hReadPipe
Return pPipeHandles 'pointer to handle array
End Function
Sub bipClose(ByRef pPipeHandles As tBipdata Ptr)
If pPipeHandles = 0 Then Return
TerminateProcess(pPipeHandles->hProcessHandle, 0)
CloseHandle(pPipeHandles->hWritePipe)
CloseHandle(pPipeHandles->hReadPipe)
DeAllocate(pPipeHandles)
pPipeHandles = 0
End Sub
Function bipWrite(pPipeHandles As tBipdata Ptr, text As String, mode As String = "") As Integer
Dim As Integer iNumberOfBytesWritten
'Dim As String txt = text
'? Len(text);" ";
If pPipeHandles = 0 Then Return 0
If LCase(mode) <> "b" Then 'not binary mode
text += Chr(13,10)
EndIf
WriteFile(pPipeHandles->hWritePipe,StrPtr(text),Len(text),@iNumberOfBytesWritten,0)
Return iNumberOfBytesWritten
End Function
Function bipRead(pPipeHandles As tBipdata Ptr, timeout As UInteger = 100) As String
'returns the whole pipe content until the pipe is empty or timeout occurs.
' timeout default is 100ms to prevent a deadlock
Dim As Integer iNumberOfBytesRead, iTotalBytesAvail, iBytesLeftThisMessage
Dim As String buffer, retText
Dim As Double tout = Timer + Cast(Double,timeout) / 1000
If pPipeHandles = 0 Then Return "" 'no valid pointer
Do
PeekNamedPipe(pPipeHandles->hReadPipe,0,0,0,@iTotalBytesAvail,0)
If iTotalBytesAvail Then
buffer = String(iTotalBytesAvail,Chr(0))
ReadFile(pPipeHandles->hReadPipe,StrPtr(buffer),Len(buffer),@iNumberOfBytesRead,0)
retText &= buffer
ElseIf Len(retText) Then
Exit Do
EndIf
Loop Until Timer > tout
Return retText
End Function
Function bipReadLine(pPipeHandles As tBipdata Ptr, separator As String = "a" & Chr(13,10), timeout As UInteger = 100) As String
'returns the pipe content till the first separator if any, or otherwise the whole pipe
' content on timeout. timeout default is 100ms to prevent a deadlock
Dim As Integer iNumberOfBytesRead, iTotalBytesAvail, iBytesLeftThisMessage, endPtr
Dim As String buffer, retText, mode
Dim As Double tout = Timer + Cast(Double,timeout) / 1000
If pPipeHandles = 0 Then Return "" 'no valid pointer
mode = LCase(Left(separator,1))
separator = Mid(separator,2)
Do
PeekNamedPipe(pPipeHandles->hReadPipe,0,0,0,@iTotalBytesAvail,0)
If iTotalBytesAvail Then
buffer = String(iTotalBytesAvail,Chr(0))
PeekNamedPipe(pPipeHandles->hReadPipe,StrPtr(buffer),Len(buffer),@iNumberOfBytesRead, _
@iTotalBytesAvail,@iBytesLeftThisMessage) 'copy pipe content to buffer
Select Case mode
Case "a" 'any
endPtr = InStr(buffer, Any separator) 'look for line end sign
Case "e" 'exact
endPtr = InStr(buffer, separator) 'look for line end sign
End Select
If endPtr Then 'return pipe content till line end
Select Case mode
Case "a"
Do While (InStr(separator,Chr(buffer[endPtr - 1]))) And (endPtr < Len(buffer))
endPtr += 1
Loop
endPtr -= 1
Case "e"
endPtr += Len(separator)
End Select
retText = Left(buffer,endPtr)
ReadFile(pPipeHandles->hReadPipe,StrPtr(buffer),endPtr,@iNumberOfBytesRead,0) 'remove read bytes from pipe
Select Case mode
Case "a"
Return RTrim(retText,Any separator) 'remove line end sign from returned string
Case "e"
Return Left(retText,Len(retText) - Len(separator))
End Select
EndIf
EndIf
Loop Until Timer > tout
If iTotalBytesAvail Then 'return all pipe content
buffer = String(iTotalBytesAvail,Chr(0))
ReadFile(pPipeHandles->hReadPipe,StrPtr(buffer),Len(buffer),@iNumberOfBytesRead,0)
Return buffer
EndIf
Return ""
End Function