Pipecom for FreeBASIC! - Printable Version

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