Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
calling an external C program from QB64 & getting back results?
#5
(09-07-2022, 07:00 PM)Spriggsy Wrote:
(09-07-2022, 06:53 PM)madscijr Wrote: Thanks Spriggsy, that sounds like just what the doctor ordered. 
I'm just about out of time for today - will check back soon and let you know how that's working...

Oh, I actually forgot that the Mac and Linux versions both use a file for stderr (but not for stdout). However, you'll most likely be using the Windows portion anyways.

Yes, Windows. Eventually it would be nice to get this mouse thing working cross-platform, but that's for another day / month / year. 

I couldn't resist trying it before I go, and it works! Thank you! 

Code: (Select All)
_Title "Talk to EXE" ' display in the Window's title bar

' LOCAL VARIABLES
Dim sExePath As String
Dim sParams As String
Dim sCommand As String
Dim sResult As String

' CALL A PROGRAM AND GET BACK SOME RESULTS
sExePath = m_ProgramPath$ + "args_v2.exe"
sParams = "1 2 3"
sCommand = Chr$(34) + sExePath + Chr$(34) + " " + sParams

Cls
Print sCommand
Print
sResult = pipecom_lite$(sCommand)

Print "Contents of output:"
Print Chr$(34) + sResult + Chr$(34)
Print

End

' /////////////////////////////////////////////////////////////////////////////
' Spriggsys-API-Collection
' https://github.com/SpriggsySpriggs/Spriggsys-API-Collection/blob/master/Cross-Platform%20(Windows%2C%20Macintosh%2C%20Linux)/pipecomqb64.bas

Function pipecom& (cmd As String, stdout As String, stderr As String)
    $If WIN Then
        Type SECURITY_ATTRIBUTES
            nLength As Long
            $If 64BIT Then
                padding As Long
            $End If
            lpSecurityDescriptor As _Offset
            bInheritHandle As Long
            $If 64BIT Then
                padding2 As Long
            $End If
        End Type

        Type STARTUPINFO
            cb As Long
            $If 64BIT Then
                padding As Long
            $End If
            lpReserved As _Offset
            lpDesktop As _Offset
            lpTitle As _Offset
            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
            $If 64BIT Then
                padding2 As Long
            $End If
            lpReserved2 As _Offset
            hStdInput As _Offset
            hStdOutput As _Offset
            hStdError As _Offset
        End Type

        Type PROCESS_INFORMATION
            hProcess As _Offset
            hThread As _Offset
            dwProcessId As Long
            $If 64BIT Then
                padding2 As Long
            $End If
        End Type

        Const STARTF_USESTDHANDLES = &H00000100
        Const CREATE_NO_WINDOW = &H8000000

        Const INFINITE = 4294967295
        Const WAIT_FAILED = &HFFFFFFFF

        Declare Dynamic Library "Kernel32"
            Function CreatePipe% (ByVal hReadPipe As _Offset, Byval hWritePipe As _Offset, Byval lpPipeAttributes As _Offset, Byval nSize As Long)
            Function CreateProcess% Alias CreateProcessA (ByVal lpApplicationName As _Offset, Byval lpCommandLine As _Offset, Byval lpProcessAttributes As _Offset, Byval lpThreadAttributes As _Offset, Byval bInheritHandles As Integer, Byval dwCreationFlags As Long, Byval lpEnvironment As _Offset, Byval lpCurrentDirectory As _Offset, Byval lpStartupInfor As _Offset, Byval lpProcessInformation As _Offset)
            Function CloseHandle% (ByVal hObject As _Offset)
            Function ReadFile% (ByVal hFile As _Offset, Byval lpBuffer As _Offset, Byval nNumberOfBytesToRead As Long, Byval lpNumberOfBytesRead As _Offset, Byval lpOverlapped As _Offset)
            Function GetExitCodeProcess% (ByVal hProcess As _Offset, Byval lpExitCode As _Offset)
            Function WaitForSingleObject& (ByVal hHandle As _Offset, Byval dwMilliseconds As Long)
        End Declare

        Dim As Integer ok: ok = 1
        Dim As _Offset hStdOutPipeRead
        Dim As _Offset hStdOutPipeWrite
        Dim As _Offset hStdReadPipeError
        Dim As _Offset hStdOutPipeError
        Dim As SECURITY_ATTRIBUTES sa: sa.nLength = Len(sa): sa.lpSecurityDescriptor = 0: sa.bInheritHandle = 1

        If CreatePipe(_Offset(hStdOutPipeRead), _Offset(hStdOutPipeWrite), _Offset(sa), 0) = 0 Then
            pipecom = -1
            Exit Function
        End If

        If CreatePipe(_Offset(hStdReadPipeError), _Offset(hStdOutPipeError), _Offset(sa), 0) = 0 Then
            pipecom = -1
            Exit Function
        End If

        Dim As STARTUPINFO si
        si.cb = Len(si)
        si.dwFlags = STARTF_USESTDHANDLES
        si.hStdError = hStdOutPipeError
        si.hStdOutput = hStdOutPipeWrite
        si.hStdInput = 0
        Dim As PROCESS_INFORMATION pi
        Dim As _Offset lpApplicationName
        Dim As String fullcmd: fullcmd = "cmd /c " + cmd + Chr$(0)
        Dim As String lpCommandLine: lpCommandLine = fullcmd
        Dim As _Offset lpProcessAttributes
        Dim As _Offset lpThreadAttributes
        Dim As Integer bInheritHandles: bInheritHandles = 1
        Dim As Long dwCreationFlags: dwCreationFlags = CREATE_NO_WINDOW
        Dim As _Offset lpEnvironment
        Dim As _Offset lpCurrentDirectory
        ok = CreateProcess(lpApplicationName,_
        _Offset(lpCommandLine),_
        lpProcessAttributes,_
        lpThreadAttributes,_
        bInheritHandles,_
        dwCreationFlags,_
        lpEnvironment,_
        lpCurrentDirectory,_
        _Offset(si),_
        _Offset(pi))
        If ok = 0 Then
            pipecom = -1
            Exit Function
        End If

        ok = CloseHandle(hStdOutPipeWrite)
        ok = CloseHandle(hStdOutPipeError)

        Dim As String buf: buf = Space$(4096 + 1)
        Dim As Long dwRead
        While ReadFile(hStdOutPipeRead, _Offset(buf), 4096, _Offset(dwRead), 0) <> 0 And dwRead > 0
            buf = Mid$(buf, 1, dwRead)
            GoSub RemoveChr13
            stdout = stdout + buf
            buf = Space$(4096 + 1)
        Wend

        While ReadFile(hStdReadPipeError, _Offset(buf), 4096, _Offset(dwRead), 0) <> 0 And dwRead > 0
            buf = Mid$(buf, 1, dwRead)
            GoSub RemoveChr13
            stderr = stderr + buf
            buf = Space$(4096 + 1)
        Wend

        Dim As Long exit_code
        Dim As Long ex_stat
        If WaitForSingleObject(pi.hProcess, INFINITE) <> WAIT_FAILED Then
            If GetExitCodeProcess(pi.hProcess, _Offset(exit_code)) Then
                ex_stat = 1
            End If
        End If

        ok = CloseHandle(hStdOutPipeRead)
        ok = CloseHandle(hStdReadPipeError)
        If ex_stat = 1 Then
            pipecom = exit_code
        Else
            pipecom = -1
        End If

        Exit Function

        RemoveChr13:
        Dim j As Long
        j = InStr(buf, Chr$(13))
        Do While j
            buf = Left$(buf, j - 1) + Mid$(buf, j + 1)
            j = InStr(buf, Chr$(13))
        Loop
        Return
    $Else
        Declare CustomType Library
        Function popen%& (cmd As String, readtype As String)
        Function feof& (ByVal stream As _Offset)
        Function fgets$ (str As String, Byval n As Long, Byval stream As _Offset)
        Function pclose& (ByVal stream As _Offset)
        Function fclose& (ByVal stream As _Offset)
        End Declare

        Declare Library
        Function WEXITSTATUS& (ByVal stat_val As Long)
        End Declare

        Dim As String pipecom_buffer
        Dim As _Offset stream

        Dim buffer As String * 4096
        If _FileExists("pipestderr") Then
        Kill "pipestderr"
        End If
        stream = popen(cmd + " 2>pipestderr", "r")
        If stream Then
        While feof(stream) = 0
        If fgets(buffer, 4096, stream) <> "" And feof(stream) = 0 Then
        stdout = stdout + Mid$(buffer, 1, InStr(buffer, Chr$(0)) - 1)
        End If
        Wend
        Dim As Long status
        Dim As Long exit_code
        status = pclose(stream)
        exit_code = WEXITSTATUS(status)
        If _FileExists("pipestderr") Then
        Dim As Integer errfile
        errfile = FreeFile
        Open "pipestderr" For Binary As #errfile
        If LOF(1) > 0 Then
        stderr = Space$(LOF(1))
        Get #errfile, , stderr
        End If
        Close #errfile
        Kill "pipestderr"
        End If
        pipecom = exit_code
        Else
        pipecom = -1
        End If
    $End If
End Function ' pipecom&

Function pipecom_lite$ (cmd As String)
    Dim As Long a
    Dim As String stdout, stderr
    a = pipecom(cmd, stdout, stderr)
    pipecom_lite$ = stdout
End Function ' pipecom_lite$
Reply


Messages In This Thread
RE: calling an external C program from QB64 & getting back results? - by madscijr - 09-07-2022, 07:07 PM



Users browsing this thread: 3 Guest(s)