Buchempfehlung
Visual Basic 6 Kochbuch
Visual Basic 6 Kochbuch
Viele praktische Tipps zum Programmieren mit Visual Basic 6, die sich oft auch auf FB übertragen lassen. [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!

Code-Beispiel

Code-Beispiele » Kleine Helferlein

bipipe.bi für Win + Linux

Lizenz:Erster Autor:Letzte Bearbeitung:
Creative CommonsMitgliedgrindstone 06.10.2020

Die hier vorgestellte Bibliothek stellt - per #Include eingebunden - 5 Funktionen zur Verfügung:

* bipOpen(ProgrammName, [showmode] ) - Öffnet das (Konsolen-)programm ProgrammName und richtet zwei unidirektionale Pipes zur Kommunikation ein. Der optionale Parameter showmode legt die Erscheinungsweise des aufgerufenen Programms fest. Mögliche Parameter siehe Externer Link!hier. Default ist SW_NORMAL. Der Rückgabewert ist ein Pointer auf das entsprechende HANDLE - Array (HandlePointer).
* bipClose(HandlePointer) - Beendet das Programm, schließt die Pipes, löscht die Handles, gibt den Speicher frei und setzt den HandlePointer auf 0.
* bipWrite(HandlePointer, text, ["b"]) - Sendet einen String zur Standardeingabe des geöffneten Programms. Wird der optionale Parameter "b" (für binary) gesetzt, wird der String unverändert gesendet, ansonsten wird noch ein Chr(13,10) angehängt.
* bipRead(HandlePointer, [timeout]) - Liest die Standardausgabe des Programms. Default für timeout ist 100ms.
* bipReadLine(HandlePointer, [separator], [timeout]) - Liest eine Zeile vom gestarteten Programm, analog zum "Line Input" - Befehl. Der optionale Parameter separator ist entweder ein "a" (für any), gefolgt von einer Liste von Zeichen, von denen jedes die Zeile beendet, oder ein "e" (für exact), gefolgt von einem oder mehreren Zeichen, das den Separator darstellt. Default ist "a" & Chr(13,10). Default für timeout ist 100ms.

Die Linux - Routinen wurden von darkinsanity geschrieben, ebenso die Konvertierung des ursprünglichen Codes zum Objekt.

English

This library provides - embedded by #Include - 5 functions:

* bipOpen(ProgramName, [showmode] ) - Opens the (console-)program ProgramName and establishes two uni-directional pipes for communication. The optional parameter showmode determines the specification how the window of the opened program is shown. Default is SW_NORMAL. The return value is a pointer to the according HANDLE - Array (HandlePointer).
* bipClose(HandlePointer) - Terminates the program, closes the pipes, deletes the handles, deallocates the memory and sets the HandlePointer to 0.
* bipWrite(HandlePointer, text, ["b"]) - Sends a string to the standard input of the opened program. With the optional parameter "b" (for binary) set, the string is transmitted unchanged, otherwise a Chr(13,10) is attached.
* bipRead(HandlePointer, [timeout]) - Reads the standard output of the program. The default for timeout is 100ms.
* bipReadLine(HandlePointer, [separator], [timeout]) - Reads a line from the opened program, analogue to the "Line Input" - statement. The optional parameter is either an "a" (for any), followed by a list of characters which any of them terminates the line, or an "e" (for exact), followed by one or multiple characters defining the separator. Default it "a" & Chr(13,10). The default for timeout is 100ms.

The Linux - routines were written by darkinsanity, as well as the conversion of the initially code to an objekt.

#If Defined(__FB_WIN32__)
    #Include Once "windows.bi"
#ElseIf Defined(__FB_LINUX__)
    #Include Once "crt/linux/unistd.bi"
    Declare Function ioctl Alias "ioctl" (fd As Integer, request As ULong, ...) As Integer
    #define FIONREAD    &h541B
#EndIf

Type BiPipe
    Private:
    #If Defined(__FB_WIN32__)
        hProcessHandle As HANDLE
        hWritePipe As HANDLE
        hReadPipe As HANDLE
    #ElseIf Defined(__FB_LINUX__)
        pipeStdin As Long
        pipeStdout As Long
    #EndIf

    Public:
    Declare Constructor (prgName As String,showmode As Short = SW_NORMAL)
    Declare Destructor ()
    Declare Function write (text As String) As Integer
    Declare Function Read (timeout As UInteger = 100) As String
    Declare Function readLine (separator As String = "a" & Chr(13,10), timeout As UInteger = 100) As String
End Type

#If Defined(__FB_WIN32__)
Constructor BiPipe (prgName As String,showmode As Short = SW_NORMAL)
    Dim As STARTUPINFO si
    Dim As PROCESS_INFORMATION pi
    Dim As SECURITY_ATTRIBUTES sa
    Dim As HANDLE hReadPipe, hWritePipe, hReadChildPipe, hWriteChildPipe

    '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)

    this.hProcessHandle = pi.hProcess 'handle to child process
    this.hWritePipe = hWritePipe
    this.hReadPipe = hReadPipe
End Constructor

Destructor BiPipe ()
    TerminateProcess(hProcessHandle, 0)
    CloseHandle(hWritePipe)
    CloseHandle(hReadPipe)
End Destructor

Function BiPipe.write (text As String) As Integer
    Dim bytesWritten As Integer

    WriteFile(hWritePipe, StrPtr(text), Len(text), @bytesWritten, 0)

    Return bytesWritten
End Function


Function BiPipe.read (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

    Do
        PeekNamedPipe(hReadPipe,0,0,0,@iTotalBytesAvail,0)
        If iTotalBytesAvail Then
            buffer = String(iTotalBytesAvail,Chr(0))
            ReadFile(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 BiPipe.readLine (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

    mode = LCase(Left(separator,1))
    separator = Mid(separator,2)

    Do
        PeekNamedPipe(hReadPipe,0,0,0,@iTotalBytesAvail,0)
        If iTotalBytesAvail Then
            buffer = String(iTotalBytesAvail,Chr(0))
            PeekNamedPipe(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(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(hReadPipe,StrPtr(buffer),Len(buffer),@iNumberOfBytesRead,0)
        Return buffer
    EndIf

    Return ""

End Function
#ElseIf Defined(__FB_LINUX__)
Constructor BiPipe (prgName As String)
    Dim pipeStdin(0 To 1) As Long
    Dim pipeStdout(0 To 1) As Long

    pipe_(@pipeStdin(0))
    pipe_(@pipeStdout(0))

    If fork() = 0 Then
        close_(pipeStdin(1))
        close_(pipeStdout(0))

        dup2(pipeStdin(0), 0)
        dup2(pipeStdout(1), 1)

        execl(StrPtr("/bin/sh"), StrPtr("sh"), StrPtr("-c"), StrPtr(prgName), Cast(UByte Ptr, 0))
        _exit(1)
    End If

    this.pipeStdin = pipeStdin(1)
    this.pipeStdout = pipeStdout(0)

    close_(pipeStdin(0))
    close_(pipeStdout(1))
End Constructor

Destructor BiPipe ()
    close_(pipeStdin)
    close_(pipeStdout)
End Destructor

Function BiPipe.write (text As String) As Integer
    Return write_(pipeStdin, StrPtr(text), Len(text))
End Function


Function BiPipe.read (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

    Do
        ioctl(pipeStdout, FIONREAD, @iTotalBytesAvail)
        If iTotalBytesAvail Then
            buffer = String(iTotalBytesAvail,Chr(0))

            read_(pipeStdout, StrPtr(buffer), Len(buffer))
            retText &= buffer
        ElseIf Len(retText) Then
            Exit Do
        End If
    Loop Until Timer > tout

    Return retText

End Function

#If 0
Function BiPipe.readLine (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

    mode = LCase(Left(separator,1))
    separator = Mid(separator,2)

    Do
        PeekNamedPipe(hReadPipe,0,0,0,@iTotalBytesAvail,0)
        If iTotalBytesAvail Then
            buffer = String(iTotalBytesAvail,Chr(0))
            PeekNamedPipe(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(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(hReadPipe,StrPtr(buffer),Len(buffer),@iNumberOfBytesRead,0)
        Return buffer
    EndIf

    Return ""

End Function
#EndIf
#EndIf

Function bipOpen(PrgName As String, showmode As Short = SW_NORMAL) As BiPipe Ptr
    Return new BiPipe(PrgName,showmode)
End Function

Sub bipClose(ByRef handles As BiPipe Ptr)
    delete handles
    handles = 0
End Sub

Function bipWrite(handles As BiPipe Ptr, text As String) As Integer
    Return handles->write(text)
End Function

Function bipRead(handles As BiPipe Ptr, timeout As UInteger = 100) As String
    Return handles->read(timeout)
End Function

Function bipReadLine(handles As BiPipe Ptr, separator As String = "a" & Chr(13,10), timeout As UInteger = 100) As String
    Return handles->readLine(separator,timeout)
End Function

Zusätzliche Informationen und Funktionen
  • Das Code-Beispiel wurde am 01.07.2015 von Mitgliedgrindstone angelegt.
  • Die aktuellste Version wurde am 06.10.2020 von Redakteurnemored gespeichert.
  Bearbeiten Bearbeiten  

  Versionen Versionen