Pipecom for FreeBASIC!

Windows specific questions.
Post Reply
Balderdash
Posts: 3
Joined: Jan 26, 2023 18:11

Pipecom for FreeBASIC!

Post by Balderdash »

I had written a little utility for QB64 a while back that I called "pipecom". It allowed me to run a command and grab the exit code, stdout, and stderr all in one go without use of any files. I've been looking into FreeBASIC and I noticed it had the "OPEN PIPE" command. Unfortunately, it doesn't really work for me as it doesn't grab stderr. However, I have decided to rewrite pipecom for FreeBASIC for those who might have been wanting something that does this. I am a newbie to FreeBASIC so the code might not be quite up to snuff. Right now, I've only written it for Windows but I will also write the version for Linux, once I get FreeBASIC up on WSL2. I hope this code is helpful for someone out there. Right now, the example I am doing is calling PowerShell to open a file dialog. The cmd string can be replaced with whatever you want.

Code: Select all

#define UNICODE
#include once "windows.bi"

type PIPE_STRUCT
   as DWORD exitCode
   as string _stdout, _stderr
end type

declare function pipecom overload (cmd as string) as PIPE_STRUCT
declare function pipecom (cmd as string, byref _stdout as string, byref _stderr as string) as DWORD
declare function StrRemove (byref s as string, ch as ubyte) as string

dim as string cmd = "PowerShell -NoProfile Add-Type -AssemblyName System.Windows.Forms;$FileBrowser = New-Object System.Windows.Forms.OpenFileDialog -Property @{ Title = '" +_
 Chr(34) + "Select a FreeBASIC file" + Chr(34) +_
 "'; InitialDirectory = '" + Chr(34) + ".\" +_
  Chr(34) + "'; Filter = '" + Chr(34) + "FreeBASIC Files (*.bas, *.bi)|*.BAS;*.BI|All Files (*.*)|*.*" + Chr(34) +_
   "'; FilterIndex = '" + Chr(34) + LTrim(Str(0)) + Chr(34) +_
    "'; };$null = $FileBrowser.ShowDialog();$FileBrowser.FileName;exit $LASTEXITCODE"

with pipecom(cmd)
   print .exitCode
   print ._stdout
end with

sleep

function pipecom (cmd as string, byref _stdout as string, byref _stderr as string) as DWORD
   dim as PIPE_STRUCT piped = pipecom(cmd)
   _stdout = piped._stdout
   _stderr = piped._stderr
   return piped.exitCode
end function

function pipecom (cmd as string) as PIPE_STRUCT
   
   dim as PIPE_STRUCT piped
   
   dim as SECURITY_ATTRIBUTES sa
   with sa
      .nLength = sizeof(SECURITY_ATTRIBUTES)
      .lpSecurityDescriptor = null
      .bInheritHandle = true
   end with

   dim as HANDLE hStdOutPipeRead, hStdOutPipeWrite, hStdReadPipeError, hStdOutPipeError

   if CreatePipe(@hStdOutPipeRead, @hStdOutPipeWrite, @sa, null) = false then
      piped.exitCode = -1
   end if

   if createpipe(@hStdReadPipeError, @hStdOutPipeError, @sa, null) = false then
      piped.exitCode = -1
   end if

   dim as STARTUPINFO si
   with si
      .cb = sizeof(STARTUPINFO)
      .dwFlags = STARTF_USESTDHANDLES
      .hstdError = hStdOutPipeError
      .hStdOutput = hStdOutPipeWrite
      .hStdInput = null
   end with

   dim as PROCESS_INFORMATION procinfo
   dim as string lpCommandLine = "cmd /c " + cmd

   if CreateProcess(null, lpCommandLine, null, null, true, CREATE_NO_WINDOW, null, null, @si, @procinfo) = false then
      piped.exitCode = -1
   end if

   CloseHandle(hStdOutPipeWrite)
   CloseHandle(hStdOutPipeError)

   dim as string buf = string(4096 + 1, 0)
   dim as string _stdout, _stderr
   dim as DWORD dwRead

   while ReadFile(hStdOutPipeRead, strptr(buf), 4096, @dwRead, null) andAlso dwRead > 0
      buf = mid(buf, 1, dwRead)
      _stdout += buf
      buf = string(4096 + 1, 0)
   wend

   while readfile(hStdReadPipeError, strptr(buf), 4096, @dwRead, null) andalso dwRead > 0
      buf = mid(buf, 1, dwRead)
      _stderr += buf
      buf = string(4096 + 1, 0)
   wend

   if instr(_stdout, chr(13)) then
      _stdout = StrRemove(_stdout, 13)
   end if

   if instr(_stderr, chr(13)) then
      _stderr = StrRemove(_stderr, 13)
   end if

   dim as DWORD exit_code, ex_stat
   
   piped._stderr = _stderr
   piped._stdout = _stdout

   if WaitForSingleObject(procinfo.hProcess, INFINITE) <> WAIT_FAILED then
      if GetExitCodeProcess(procinfo.hProcess, @exit_code) then
         ex_stat = 1
      end if
   end if

   closehandle(hStdOutPipeRead)
   closehandle(hStdReadPipeError)

   if ex_stat = 1 then
      piped.exitCode = exit_code
   else
      piped.exitCode = -1
   end if

   return piped
end function

function StrRemove (byref s as string, ch as ubyte) as string

   if (0 = strptr(s)) then return ""

   '' Get the trimmed string length
   ''
   dim new_length as integer = len(s)
   for i as integer = 0 to len(s) - 1
      if (ch = s[i]) then
         new_length -= 1
         exit for
      end if
   next

   '' Allocate an appropriately sized string
   ''
   dim result as string = string(new_length, 0)
      
   '' Copy the non-matching ubytes to the new string
   ''
   dim it as ubyte ptr = @result[0]
   for i as integer = 0 to len(s) - 1
      if (ch <> s[i]) then
         *it = s[i]
         it += 1
      end if
   next
   
   return result

end function
marcov
Posts: 3455
Joined: Jun 16, 2005 9:45
Location: Netherlands
Contact:

Re: Pipecom for FreeBASIC!

Post by marcov »

(There used to be a GNU tool called REDIR to do that

For hints and pointers, look at the implementation of "Runcommand" and its parent class TProcess in Free Pascal/Lazarus. You can ask questions about that here, I'm the current maintainer
)
adeyblue
Posts: 299
Joined: Nov 07, 2019 20:08

Re: Pipecom for FreeBASIC!

Post by adeyblue »

Balderdash wrote: Jan 30, 2023 21:21 I am a newbie to FreeBASIC so the code might not be quite up to snuff.
Cool, nothing wrong with your FB.

The only problem when separating stderr and stdout instead of using one pipe for both is that if the child app writes to both stdout and stderr, and the pipe you're not reading from becomes full (because this code pattern can only read from either the stdout or stderr pipe at once) then:
1) the child app will hang waiting for you to read from the full pipe to make space for its writing
2) your app will hang because the read on the pipe that you are reading from will never end, as the child app will never close to make it fail.

You can see this hang by putting your stderr read loop above the stdout one and running this as the piped command:
type C:\windows\system32\cmd.exe

This may leave the child cmd hanging around which you'll need to close with Task Manager.

There isn't really a 'nice' way to sort this out without making it more complex since ReadFile doesn't support timeouts. The simplest would be a loop with 2 PeekNamedPipe() to see when data is available on each pipe before doing a read. A bit more advanced would be overlapped reads so they don't hang by design but then you have to deal with carrying buffers and state around. Alternatively you could pipe to a temporary file that has Delete_on_close and attribute_temporary so the contents stay in memory rather than go to disk and then just read it all in at the end.
Balderdash
Posts: 3
Joined: Jan 26, 2023 18:11

Re: Pipecom for FreeBASIC!

Post by Balderdash »

The reason my code flows the way it does is because I got the logic from an MSDN example. So far, I've not had any issues with hanging of executables when I call them but there coild always be an exception somewhere. I know I've used it for many programs in QB64 but the FreeBASIC version could be a bit iffy due to my inexperience with it. I'll take your suggestions and see what can be done.

Thanks!
marcov
Posts: 3455
Joined: Jun 16, 2005 9:45
Location: Netherlands
Contact:

Re: Pipecom for FreeBASIC!

Post by marcov »

Balderdash wrote: Jan 31, 2023 21:25 The reason my code flows the way it does is because I got the logic from an MSDN example. So far, I've not had any issues with hanging of executables when I call them but there coild always be an exception somewhere. I know I've used it for many programs in QB64 but the FreeBASIC version could be a bit iffy due to my inexperience with it. I'll take your suggestions and see what can be done.
Adeyblue is right. Use peek. Test with a program that writes stderr only very rarely (less than 4096 for everyfew MBs to stdout) frequently. Sooner or later it will block trying to gather 4096 bytes of stderr output. Then the writing side will block when unread stdout will reach 1-2MB and the pipe buffers are full and everything will just hang.
Balderdash
Posts: 3
Joined: Jan 26, 2023 18:11

Re: Pipecom for FreeBASIC!

Post by Balderdash »

Thank you both for your suggestions. I will definitely look into using PeekNamedPipe() for my program!
Post Reply