Pipecom for FreeBASIC!

[SpriggsySpriggs]

Here is my FreeBASIC port of Pipecom! Right now, I've only converted the Windows portion. The Linux portion will be a bit tougher to do. I am a newbie with FreeBASIC as I just got started so the code might be not that great. However, it works just the same as the QB64 code.

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

[SpriggsySpriggs]

@Jack
Here is the library entry for pipecom from the old forum. Now, the FreeBASIC one works a bit differently but the idea is the same

[Jack]

thanks

[bplus]

Quote from reply #3 "...but the idea is the same and so a"   ?

@Sprigsy like a senile old man and so a

[SpriggsySpriggs]

@bplus I have fixed the post. I guess that must have escaped my backspace key earlier when I was working on the post.

[bplus]

I thought it kinda funny

[mnrvovrfc]

I thought a new moderator was hired or initiated. Might want to change the sub-forum name in "Expanding Horizons" category as well.

[SpriggsySpriggs]

If I use it more often or if it becomes an issue, sure. It's going to remain as-is for right now. Thank you for your input.