'****************************************************************************
'
'   Errorlevel in PowerBASIC 3.0/3.2
'
'   entwickelt von / developed by   :  Thomas Gohel
'
'                           Fido    :  Thomas Gohel@2:2410/330.1
'                           InterNet:  author@pbsound.snafu.de
'                           Homepage:  http://www.snafu.de/~pbsound/
'
'****************************************************************************

$COMPILE EXE
DECLARE FUNCTION PBShell% (FileName$)

CLS
PRINT
PRINT "Fehlercode/Errorcode: "; PBShell%("c:\command.com")
END

FUNCTION PBShell% (FileName$)
        LOCAL Dummy%

        Datei$ = FileName$                  ' Dateiname umkopieren.
        Datei$ = LTRIM$(Datei$)             ' Filename trimmen.
        i% = INSTR(Datei$, " ")             ' Kommando uebergeben ?
        IF i% > 0 THEN                      '
           Cmd$ = MID$(Datei$, i%)          ' Kommando abtrennen
           Datei$ = LEFT$(Datei$, i% - 1)   ' Filename abtrennen
        END IF                              '
        Datei$ = UCASE$(Datei$)
        i% = INSTR(Datei$, ".")             ' Ist ein Punkt drin ?
        IF i% > 0 THEN                      '
           Ext$ = MID$(Datei$, i%)          ' Extension holen.
        ELSE                                '
           Ext$ = ""                        ' Extension ist leer.
        END IF                              '
        SELECT CASE Ext$                    ' Extensions abtesten.
            CASE ".BAT"                     ' Batch ueber COMMAND.COM
                                            ' ausfuehren.
                Cmd$ = "/C " + Datei$ + " " + Cmd$
                Datei$ = ENVIRON$("COMSPEC")
            CASE ".COM"                     ' Frei
            CASE ".EXE"                     ' Frei
            CASE ELSE                       ' Keine Extension,
                Datei$ = Datei$ + ".EXE"    ' .EXE anhaengen.
        END SELECT                          '

        Datei$ = Datei$ + CHR$(0)           ' ASCIIZ-String erzeugen.
        dNul$ = CHR$(0) + CHR$(0)           ' Doppelnull fuer Parameter-Block

        nul$ = SPACE$(127)                   ' 127 bytes fuer Strings retten.
        MemFree& = SETMEM(0)                 ' Freien Speicherplatz holen.
        x& = SETMEM(-MemFree&)               ' Speicherplatz komplett freigeben.
        nul$ = ""                            ' 127 bytes wieder freigeben.
        IF Cmd$ > "" THEN                    ' Kommandozeile ?
            CmdLen$ = CHR$(LEN(Cmd$))        ' Laenge des Cmd$ als String
            Cmd$ = CmdLen$ + Cmd$ + CHR$(13) ' Laenge + Cmd$ + '13'
            segm$ = MKI$(STRSEG(Cmd$))       ' Einzeln die Teile des Parameter-Blocks
            Offs$ = MKI$(STRPTR(Cmd$))       ' erzeugen ( MID$(....) = segm$ geht nicht. )
            Param$ = dNul$ + Offs$ + segm$   ' Parameterblock machen.
        ELSE                                 '
            Cmd$ = CHR$(13)                  ' Start of Bug-Fixed
            segm$ = MKI$(STRSEG(Cmd$))       ' Segment des Terminator (Dummy)
            Offs$ = MKI$(STRPTR(Cmd$))       ' Offset         -"-
            Param$ = dNul$ + Offs$ + segm$   ' Parameterblock machen.
        END IF                               ' End of Bugfixed
        DateiSeg?? = STRSEG(Datei$)          ' Adressen holen
        DateiOff?? = STRPTR(Datei$)
        ParamSeg?? = STRSEG(Param$)
        ParamOff?? = STRPTR(Param$)
        ! push ds                            ; DS sichern
        ! mov  ax, &h4B00                    ; EXEC-Funktion 4Bh / INT 21h
        ! mov  es, ParamSeg??                ; Segment des Parameterblocks
        ! mov  bx, ParamOff??                ; Offset des Parameterblocks
        ! mov  dx, DateiOff??                ; Offset des Dateinamens
        ! mov  ds, DateiSeg??                ; Segment des Dateinamens
        ! int  &h21                          ; Interrupt &h21
        ! pop  ds
        ! jc   ExecError
        ! jmp  ExecOk
        ExecError:
        ! mov Dummy%, ax
        SELECT CASE Dummy%                   ' Fehler auswerten.
            CASE 1   : PRINT "illegaler Funktionsaufruf!"
            CASE 2,3 : PRINT "Datei nicht gefunden: " + FileName$
            CASE 4   : PRINT "zu viele Dateien ge”ffnet"
            CASE 5   : PRINT "Zugriff verweigert " + Filename$
            CASE 8   : PRINT "Zuwenig freier Speicher f�r " + FileName$
            CASE 10  : PRINT "falscher Environmentblock"
            CASE 11  : PRINT "falsches Format"
            CASE ELSE: PRINT "Allgemeines Problem meim Ausfuehren von " + FileName$
        END SELECT
        ExecOk:

        Mem2& = SETMEM(MemFree&)             ' Speicher komplett freigeben.
        IF MemFree& <> Mem2& THEN            ' Speicher stimmt nicht mehr ??
            PRINT "Achtung: vermutlich wurde ein TSR installiert!!"
        END IF

        ! mov  ah, &h4d                      ; Exit-Code ermitteln
        ! int &h21                           ; Interrupt &h21
        ! mov Dummy%, al
        PBShell% = Dummy%

        ! mov  ah, &h03                      ; Aktuelle Cursorposition
        ! mov  bh, &h00                      ; �bergeben
        ! int &h10                           ; Interrupt &h10
        ! inc dh                             ; Umrechnen auf Basis 1
        ! inc dl
        ! mov NewZeile?, dh
        ! mov NewSpalte?, dl
        LOCATE NewZeile?, NewSpalte?         ' Cursor setzen
END FUNCTION