2010-12-07 21:18

'
' ============================================================================
' Code redirected from SHELLREDIR    RAPIDQ FUNCTION     February 26, 2005
'
' Redirect the output of a Shell to ...
' assumes you load windows.inc
' Without warranty  :  sounds pretty good yet
' Translated from  VB  code at  :  http://www.visualbasicforum.com/t49495.html
' ============================================================================

'Const BUFFER_SIZE = 1024
''
'Declare Function RDR_CreateProcess Lib "kernel32" Alias "CreateProcessA" (lpApplicationName As Long, _
'lpCommandLine As Long, lpProcessAttributes As SECURITY_ATTRIBUTES, _
'lpThreadAttributes As SECURITY_ATTRIBUTES, ByVal bInheritHandles As Long, _
'ByVal dwCreationFlags As Long, lpEnvironment As Long, _
'lpCurrentDriectory As Long, lpStartupInfo As STARTUPINFO, _
' lpProcessInformation As PROCESS_INFORMATION) As Long



     FUNCTION ShellRedir (TheApp AS STRING, CommandLine AS STRING, fShowWindow AS INTEGER) AS STRING
      DIM tPipeAttributes AS SECURITY_ATTRIBUTES
      DIM tProcessAttributes AS SECURITY_ATTRIBUTES
      DIM tThreadAttributes AS SECURITY_ATTRIBUTES
      DIM tProcessInformation AS PROCESS_INFORMATION
      DIM tStartupInformation AS STARTUPINFO

      DEFINT hPipeRead, hPipeWrite, nbrByteRead, hProcess
      DIM sBit AS STRING * 1024
      DEFSTR RetTxt = ""
      DEFSTR sCommandLine = CommandLine
      DEFSTR sNull = TheApp

      tPipeAttributes.nLength = SIZEOF(tPipeAttributes)
      tPipeAttributes.lpSecurityDescriptor = 0
      tPipeAttributes.bInheritHandle = -1
      tProcessAttributes.nLength = SIZEOF(tProcessAttributes)
      tThreadAttributes.nLength = SIZEOF(tThreadAttributes)

      IF CreatePipe(VARPTR(hPipeRead), VARPTR(hPipeWrite), tPipeAttributes, 0) <> 0 THEN
       d.PRINT "pipe th ", hPipeRead
       d.PRINT "pipe wr ", hPipeWrite
       d.PRINT UDTPTR(tPipeAttributes)
       d.PRINT "  "

       GetStartupInfo tStartupInformation
       tStartupInformation.cb = SIZEOF(tStartupInformation)
       tStartupInformation.hStdOutput = hPipeWrite
       tStartupInformation.hStdError = hPipeWrite
       tStartupInformation.dwFlags = STARTF_USESHOWWINDOW OR STARTF_USESTDHANDLES
       tStartupInformation.wShowWindow = fShowWindow       'SW_HIDE  ' SW_SHOW
       DEFSTR sConsoleTitle = "FreeQ compiling...."
       tStartupInformation.lpTitle = VARPTR(sConsoleTitle)

'        hProcess = CreateProcess(VARPTR(sNull) , VARPTR(sCommandLine), tProcessAttributes, _
'                            tThreadAttributes, -1, 0, 0, VarPtr(sNull), tStartupInformation, tProcessInformation)
       hProcess = CreateProcess(sNull, sCommandLine, 0, 0, -1, 0, 0, 0, tStartupInformation, tProcessInformation)

       d.PRINT "process handl ",  hProcess
       d.PRINT d.Err$
'hWrite1 = CreateProcess(0&, Announcement$, 0, 0, -1, 0, 0, 0, sui, pi)


       IF hProcess <> 0 THEN
        DO
         IF ReadFile(hPipeRead, VARPTR(sBit), 1024, VARPTR(nbrByteRead), 0) <> 0 THEN
          RetTxt = RetTxt & LEFT$(sBit, nbrByteRead)
          DOEVENTS
         ELSE
          CloseHandle tProcessInformation.hThread
          CloseHandle tProcessInformation.hProcess
          EXIT DO
         END IF
         CloseHandle hPipeWrite
        LOOP
        CloseHandle hPipeWrite
        CloseHandle hPipeRead
       ELSE
        CloseHandle hPipeWrite
        CloseHandle hPipeRead
        RetTxt = "unable to create process"
       END IF
      ELSE
       RetTxt = "unable to create pipe"
      END IF
      Result = RetTxt
     END FUNCTION
'

2010-12-07 21:18