Buchempfehlung
MySQL kurz & gut
MySQL kurz & gut
Das preiswerte Taschen- buch stellt MySQL-rele- vante Inhalte systematisch und knapp dar, sodass es sich optimal zum Nach- schlagen beim Pro- grammieren eignet. [Mehr Infos...]
FreeBASIC-Chat
Es sind Benutzer im FreeBASIC-Chat online.
(Stand:  )
FreeBASIC bei Twitter
Twitter FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!

fb:porticula NoPaste

Info
Info / Hilfe
Liste
Übersicht / Liste
Neu
Datei hochladen
Suche
Quellcode suchen
Download
Dateidownload

bipipe.bi

Uploader:Mitgliedgrindstone
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