'===========================================================================
' Subject: Run a Program without SHELL        Date: 09-15-02 (  :  )       
'  Author: Dieter Folger
                     Code: PB                     
'  Origin: folger@bnv-bamberg.de            Packet: PB.ABC
'===========================================================================
'-------------------------------------------------------------------------
' PBEXEC.BAS - Execute a program from PowerBASIC without SHELLing
'              and get errorcode from DOS or program
'              Based on a routine written by Ethan Winer
'              Converted to Power Basic by Dieter Folger
' Notes:       Programs must be called with full path (see examples)
'              Do not use in IDE!
'-------------------------------------------------------------------------
'----- Demo program starts here ------------------------------------------
PRINT "Trying to call PB.EXE"
ExecValue = Exec("PB.EXE","")
PRINT
PRINT "Errorcode returned:";ExecValue
PRINT 
IF ExecValue THEN
   PRINT "Calling PB.EXE was not successful"
   PRINT "Using PathSearch to find PB.EXE"
   PRINT "Press a key"
   WaitKey
   PB$ = PathSearch("PB.EXE")
   PRINT "Found: ";PB$
   IF LEN(PB$) THEN
      PRINT "Now calling PowerBasic with full path"
      PRINT "Press a key"
      Waitkey
      ExecValue = Exec(PB$,"")
      PRINT "Errorcode returned:";ErrorValue
   END IF
END IF
PRINT
PRINT "Calling a second copy of COMMAND.COM "
PRINT "Getting path to COMMAND.COM first"
CC$=PathSearch("COMMAND.COM")
IF LEN(CC$) THEN
   PRINT CC$
   PRINT "Now calling COMMAND.COM to show current DIR"
   Waitkey
   ExecValue = Exec(CC$,"/C DIR")
   PRINT "Errorlevel: ";ExecValue
   PRINT "End of demo"
END IF
END
'-----------------------------------------------------------------
FUNCTION Exec (ProgName AS STRING, Params AS STRING) AS INTEGER
'-----------------------------------------------------------------
ProgName = ProgName + Chr$(0)
Params = CHR$(LEN(Params)) + Params + CHR$(0)
DIM DosError AS INTEGER
DIM El AS INTEGER
DIM ParamBlock AS STRING * 14
ParamBlock = CHR$(0,0) + MKI$(STRPTR(Params)) + MKI$(STRSEG(Params))
Segm& = STRSEG(ProgName)
Offs& = STRPTR(ProgName)
Vseg& = VARSEG (ParamBlock)
VOff& = VARPTR (ParamBlock)
Y = SETMEM (-500000)
! push ds
! mov ds, Segm&
! mov dx, Offs&
! mov es, VSeg&
! mov bx, VOff&
! mov ax, &h4B00
! int &h21
! jnc NoCarry
! mov DosError, al
NoCarry:
! pop ds
! mov ax,&h4D00
! int &h21
! mov Endcode, al
IF DosError THEN Endcode = 255
Exec = Endcode
y = SETMEM (500000)
END FUNCTION
'-----------------------------------------
FUNCTION PathSearch (F$) PUBLIC AS STRING
'-----------------------------------------
  P$ = UCASE$(ENVIRON$("PATH")) + ";"
  DO
     P = INSTR(P$, ";")
     D$ = LEFT$(P$, P - 1)
     P$ = MID$(P$, P + 1)
     IF RIGHT$(D$, 1) <> "\" THEN D$ = D$ + "\"
     IF LEN(DIR$(D$ + F$)) THEN
        PathSearch = D$ + F$
        EXIT FUNCTION
     END IF
  LOOP UNTIL P$ = ""
END FUNCTION
'----------
SUB WaitKey
'----------
    DO
      K$=INKEY$
    LOOP UNTIL LEN(K$)
END SUB