2002-08-25 08:35

'from: "lyp_st" Sat, 24 Aug 2002 19:35:41 -0000
'I used Createprocess to steer the standard exit of rc.exe in a textbox

     $APPTYPE GUI
     $INCLUDE "RAPIDQ.INC"



     TYPE SECURITY_ATTRIBUTES
      nLength AS LONG
      lpSecurityDescriptor AS LONG
      bInheritHandle AS LONG
     END TYPE

     TYPE PROCESS_INFORMATION
      hProcess AS LONG
      hThread AS LONG
      dwProcessId AS LONG
      dwThreadId AS LONG
     END TYPE

     TYPE STARTUPINFO
      cb AS DWORD
      lpReserved AS LONG
      lpDesktop AS LONG
      lpTitle AS LONG
      dwX AS DWORD
      dwY AS DWORD
      dwXSize AS DWORD
      dwYSize AS DWORD
      dwXCountChars AS DWORD
      dwYCountChars AS DWORD
      dwFillAttribute AS DWORD
      dwFlags AS DWORD
      wShowWindow AS WORD
      cbReserved2 AS WORD
      lpReserved2 AS LONG
      hStdInput AS LONG
      hStdOutput AS LONG
      hStdError AS LONG
     END TYPE
     TYPE OVERLAPPED
      ternal AS LONG
      ternalHigh AS LONG
      offset AS LONG
      OffsetHigh AS LONG
      hEvent AS LONG
     END TYPE

'constante pour createprocess
     CONST STARTF_USESHOWWINDOW = &H1
     CONST STARTF_USESTDHANDLES = 256 '&H100
     CONST SW_HIDE = 0
     CONST SW_SHOW = 1
     CONST GENERIC_WRITE = &H40000000
     CONST GENERIC_ALL = &H10000000
     CONST GENERIC_READ = &H80000000
     CONST OPEN_EXISTING = 3
     CONST FILE_SHARE_READ = &H1
     CONST FILE_SHARE_WRITE = &H2

     CONST EM_SETSEL = &HB1
     CONST EM_REPLACESEL = &HC2
     CONST CREATE_SUSPENDED = &H4

'declaration des APIs Windows
     DECLARE SUB GetStartupInfo LIB "kernel32" ALIAS "GetStartupInfoA" (lpStartupInfo AS STARTUPINFO)
     DECLARE FUNCTION SetWindowText LIB "user32"  ALIAS "SetWindowText" (BYVAL hwnd AS LONG, BYVAL lpString AS STRING) AS LONG
     DECLARE FUNCTION SendMessag LIB "user32" ALIAS "SendMessage" (BYVAL hwnd AS LONG, BYVAL wMsg AS LONG, BYVAL wParam AS LONG, lParam AS VARIANT) AS LONG
     DECLARE FUNCTION CloseHandle LIB "kernel32"  ALIAS "CloseHandle" (BYVAL hObject AS LONG) AS LONG
     DECLARE FUNCTION CreateFile _
      LIB "kernel32" _
      ALIAS "CreateFileA" ( _
      BYVAL lpFileName AS STRING, BYVAL dwDesiredAccess AS LONG, _
      BYVAL dwShareMode AS LONG, lpSecurityAttributes AS SECURITY_ATTRIBUTES, _
      BYVAL dwCreationDisposition AS LONG, BYVAL dwFlagsAndAttributes AS LONG, BYVAL hTemplateFile AS LONG) _
      AS LONG

     DECLARE FUNCTION CreateProcess LIB "kernel32" ALIAS "CreateProcessA" (lpApplicationName AS LONG, BYVAL lpCommandLine AS STRING, lpProcessAttributes AS LONG, lpThreadAttributes AS LONG, BYVAL bInheritHandles AS LONG, BYVAL dwCreationFlags AS LONG, lpEnvironment AS LONG, BYVAL lpCurrentDriectory AS LONG, lpStartupInfo AS STARTUPINFO, lpProcessInformation AS PROCESS_INFORMATION) AS LONG
     DECLARE FUNCTION CreatePipe LIB "kernel32" ALIAS "CreatePipe"(phReadPipe AS LONG, phWritePipe AS LONG, lpPipeAttributes AS SECURITY_ATTRIBUTES, BYVAL nSize AS LONG) AS LONG

     DECLARE FUNCTION ReadFile _
      LIB "kernel32" ALIAS "ReadFile" ( _
      BYVAL hFile AS LONG, lpBuffer AS LONG, _
      BYVAL nNumberOfBytesToRead AS LONG, _
      lpNumberOfBytesRead AS LONG, _
      BYVAL lpOverlapped AS LONG) _
      AS LONG



'  Dim sui As STARTUPINFO
'  Dim pa As SECURITY_ATTRIBUTES
     DIM fSuccess AS LONG
     DIM textb(15) AS BYTE ' * 15



     DECLARE SUB ouvreini(sender AS QFORM)
     DECLARE SUB redirect(sender AS QBUTTON)
     DECLARE SUB quit(sender AS QBUTTON)
     DECLARE SUB rechrc(sender AS QBUTTON)
     DECLARE SUB ficbas(sender AS QBUTTON)

'~~~~~~~~~~~~~~~~ fin declare API ~~~~~~~~~~~~~~~~~~~~


     CREATE Fenetre AS QFORM
      Center
      CAPTION = "Agenda en Basic"
      Height = 300
      Width = 455
      CREATE Button1 AS QBUTTON
       Left = 350
       Top = 6
       Height = 20
       CAPTION = "Compiler"
       OnClick = Redirect
      END CREATE
      CREATE Button2 AS QBUTTON
       Left = 350
       Top = 26
       Height = 20
       CAPTION = "Quitter"
       OnClick = quit
      END CREATE
      CREATE Button3 AS QBUTTON
       Left = 250
       Top = 6
       Height = 20
       Width=20
       CAPTION = "..."
       OnClick = rechrc
      END CREATE
      CREATE Button4 AS QBUTTON
       Left = 250
       Top = 26
       Width=20
       Height = 20
       CAPTION = "..."
       OnClick = ficbas
      END CREATE
      CREATE editrc AS QEDIT
       Left = 50
       Width = 200
       Top = 6
       Height = 20
      END CREATE
      CREATE editbas AS QEDIT
       Left = 50
       Width = 200
       Top = 26
       Height = 20
      END CREATE
      CREATE edit1 AS QRICHEDIT
       Left = 15
       Width = 300
       Top = 100
       Height = 160
      END CREATE
      CREATE Compilateur AS QLABEL
       Left = 5
       Top = 6
       CAPTION = "Rc"
      END CREATE
      CREATE fichbas AS QLABEL
       Left = 5
       Top = 26
       CAPTION = "*.bas"
      END CREATE
      OnShow=ouvreini
      OnClose=quit
     END CREATE

     DIM File AS QFILESTREAM
     DIM chemin AS STRING


     SUB Redirect()

      DIM i% AS INTEGER
      DIM t$ AS STRING
      DIM cmdline AS STRING
      DIM pra AS SECURITY_ATTRIBUTES
      DIM tra AS SECURITY_ATTRIBUTES
      DIM null AS VARIANT
      DIM zero AS OVERLAPPED
      DIM textentier AS STRING
      DIM hWrite1 AS LONG
      DIM hWrite2 AS LONG
      DIM hWrite3 AS LONG
      DIM bRead AS LONG
      DIM lpBuffer(10) AS BYTE
      DIM titre AS STRING
      DIM pi AS PROCESS_INFORMATION
      DIM sui AS STARTUPINFO
      DIM pa AS SECURITY_ATTRIBUTES
      DIM hRead AS LONG
      DIM hWrite AS LONG
      DIM textt AS STRING * 1024
      DIM Baud AS LONG

      edit1.Text=""
      textentier=""
      sui.cb = LEN(sui)
      pa.nLength = LEN(pa)
      pa.lpSecurityDescriptor = 0
      pa.bInheritHandle = -1

      IF CreatePipe(VARPTR(hRead), VARPTR(hWrite), pa&, 0) <> 0 THEN
       edit1.text="pass"
       GetStartupInfo sui
       sui.cb = LEN(sui)
       sui.hStdOutput = hWrite
       sui.hStdError = hWrite
       sui.dwFlags = STARTF_USESTDHANDLES OR RTF_USESHOWWINDOW   'Or
       sui.wShowWindow = 0' SW_HIDE
       titre = "test pipe"
       sui.lpTitle = VARPTR(titre)
       hWrite1 = CreateProcess(0&, editrc.text & " -id:\program\rapidq -ld:\program\rapidq " & editbas.text , 0, 0, BYVAL -1, 0, 0, 0, sui, pi)
       edit1.text="pass " & STR$(hwrite) & "  " & STR$(hread) '
       DO
        IF ReadFile(hRead, VARPTR(textt), 500, VARPTR(Baud), 0&) THEN
         textentier = textentier & textt
         textt = ""
        ELSE
         EXIT DO
        END IF
       LOOP
       edit1.Text = textentier
      END IF
      textt = ""
      Closehandle(hWrite1)
      Closehandle(hRead)
      Closehandle(hWrite)


     END SUB




     SUB rechrc()
    'Dim
      DIM OpenDialog AS QOPENDIALOG
      OpenDialog.FileName=LEFT$(COMMAND$(),rinstr(COMMAND$(),"\"))& "*.exe"

'Opendialog.FileName=
      IF OpenDialog.EXECUTE THEN
       editrc.text=OpenDialog.FileName
      END IF
     END SUB


     SUB ficbas()
    'Dim
      DIM OpenDialog AS QOPENDIALOG
      OpenDialog.FileName=LEFT$(COMMAND$(),rinstr(COMMAND$(),"\"))& "*.bas"

'Opendialog.FileName=
      IF OpenDialog.EXECUTE THEN
       editbas.text=OpenDialog.FileName
      END IF
     END SUB



     SUB ouvreini()
      chemin=LEFT$(COMMAND$(),rinstr(COMMAND$(),"\"))
      IF File.OPEN("compile.ini", fmOpenRead) <> FALSE THEN
       editrc.text=File.readline()
       editbas.text=file.readline()
       file.CLOSE
      ELSE
       editrc.text=LEFT$(COMMAND$(),rinstr(COMMAND$(),"\"))
       editbas.text=editrc.text
       file.OPEN("compile.ini",fmCreate)
       File.writeline(editrc.text)
       file.writeline(editbas.text)
       file.CLOSE
      END IF
     END SUB

     SUB quit()
      file.OPEN(chemin & "compile.ini",fmCreate)
      File.writeline(editrc.text)
      file.writeline(editbas.text)
      file.CLOSE
      END
     END SUB


     Fenetre.SHOWMODAL

2002-08-25 08:35