REM file: Drives.bas - Public Domain DOS Utility
REM Version 1.0a created 03/07/1995
REM Version 1.1a created 04/08/2001
REM Version 1.2a created 04/28/2005
REM Version 1.3a created 12/10/2005

' default integer variables
DEFINT A-Z
REM $DYNAMIC

' define boolean values
CONST True = -1
CONST False = NOT True
CONST TrueD = -1#
CONST FalseD = NOT TrueD
CONST NUL = ""

' define color values
CONST Black = 0
CONST Green = 10
CONST Plain = 7
CONST Red = 12
CONST White = 15
CONST Yellow = 14

' get include files
REM $INCLUDE: 'qbx.bi'

' declare functions
DECLARE FUNCTION ParseLine (S$)
DECLARE FUNCTION BreakIS()
DECLARE FUNCTION ClearBreak()
DECLARE FUNCTION KeyIS()

' declare registers
COMMON SHARED InregsX AS RegtypeX, OutregsX AS RegtypeX
COMMON SHARED InregsX2 AS RegTypeX, InregsX3 AS RegTypeX

' initialize filename buffer
DIM ASCIIZ AS STRING * 260

' declare work variables
COMMON SHARED Default.Drive AS INTEGER, Drives AS INTEGER
COMMON SHARED Last.Drive AS INTEGER, Display.Drive1 AS INTEGER
COMMON SHARED Display.Drive2 AS INTEGER, Display.Errors AS INTEGER
COMMON SHARED Continuous.Display AS INTEGER, Display.Current AS INTEGER
COMMON SHARED New.Drive AS INTEGER, Change.Drive AS INTEGER
COMMON SHARED Skip.Drives() AS INTEGER, Windows.Detected AS INTEGER

' declare command line work variables
COMMON SHARED Command.Line AS STRING, Control.Break AS INTEGER
COMMON SHARED Last.Switch AS INTEGER

' declare external procedures
DECLARE SUB SetInt
DECLARE SUB RestInt

' backwards compatible for bc 7.1
REM $INCLUDE: 'bc7.inc'

' increase stack size
STACK STACK

' install new interrupt service routine
CALL SetInt

' declare standard error trap
ON ERROR GOTO Error.Routine

' dimension work variables
REDIM Skip.Drives(1 TO 26) AS INTEGER

' get current drive
InregsX.AX = &H1900
CALL InterruptX(&H21, InregsX, OutregsX)
Default.Drive = OutregsX.AX AND &HFF

' get maximum drives
InregsX.AX = &HE00
InregsX.DX = Default.Drive
CALL InterruptX(&H21, InregsX, OutregsX)
Last.Drive = OutregsX.AX AND &HFF

' check windows
Windows.Detected = True
If Load.Windows = False Then
   InregsX.AX = &H160A
   CALL InterruptX(&H2F, InregsX, OutregsX)
   IF OutregsX.AX > 0 THEN
      InregsX.AX = &H4A33
      CALL InterruptX(&H2F, InregsX, OutregsX)
      IF OutregsX.AX = 0 THEN
         Windows.Detected = 0 ' DOS 7.00
      END IF
   END IF
END IF
IF INSTR(COMMAND$, "/_") THEN
   Windows.Detected = True
END IF

' check command line
SELECT CASE COMMAND$
CASE "/?"
   GOTO Boot.Usage
END SELECT

' read command line from PSP
Command.Line = NUL
InregsX.AX = &H6200
CALL InterruptX(&H21, InregsX, OutregsX)
PSPsegment = OutregsX.BX
PSPoffset = 128
DEF SEG = PSPsegment
FOR Count = 1 TO 127
   Command.Char = PEEK(PSPoffset + Count)
   SELECT CASE Command.Char
   CASE 0, 10, 13
      EXIT FOR
   CASE ELSE
      Command.Line = Command.Line + CHR$(Command.Char)
   END SELECT
NEXT
DEF SEG
IF Command.Line = NUL THEN
   Command.Line = ENVIRON$("DRIVES")
END IF
Command.Line = RTRIM$(Command.Line)

' check command line switches
Display.Drive1 = ParseLine ("/A")
Display.Drive2 = ParseLine ("/B")
Continuous.Display = ParseLine ("/C")
Display.Current = ParseLine ("/X")
Change.Drive = ParseLine ("/Y")
Display.Errors = ParseLine ("/Z")
Control.Break = ParseLine ("/~")
Var = ParseLine("/_")

' check command line switch
DO
   Imbedded = INSTR(Command.Line, "/1:")
   IF Imbedded = False THEN
      EXIT DO
   END IF
   Last.Switch = Imbedded - 1
   Skip$ = UCASE$(MID$(Command.Line, Imbedded + 3, 1))
   IF Skip$ >= "A" AND Skip$ <= "Z" THEN
      Skip.Drives(ASC(Skip$)-64) = True
   ELSE
      GOTO Boot.Error
   END IF
   Command.Line = LEFT$(Command.Line, Imbedded - 1) + MID$(Command.Line, Imbedded + 4)
LOOP

' recheck command line
IF INSTR(Command.Line, "/") THEN
   GOTO Boot.Error
END IF
Command.Line = RTRIM$(Command.Line)
IF Last.Switch THEN
   IF LEN(Command.Line) > Last.Switch THEN
      GOTO Boot.Error
   END IF
END IF

' check command line
Command.Line = RTRIM$(Command.Line)
Command.Line = LTRIM$(Command.Line)
Command.Line = UCASE$(Command.Line)
IF LEN(Command.Line) = 2 THEN
   IF RIGHT$(Command.Line, 1) = ":" THEN
      New.Drive = ASC(LEFT$(Command.Line, 1)) - 64
      IF New.Drive >= 1 AND New.Drive <= 26 THEN
         Command.Line = Nul
      END IF
   END IF
END IF
IF LEN(Command.Line) THEN
   GOTO Boot.Error
END IF

' check break flag override
IF Control.Break THEN
   Var = ClearBreak
END IF

' check control break
IF BreakIS THEN
   GOTO End.Drives
END IF

' make header
IF Continuous.Display = False THEN
   COLOR White, Black
   PRINT "Drives v1.3a: Drive display utility;"
END IF

' check new drive
IF New.Drive THEN
   New.Drive = New.Drive - 1
   IF New.Drive >= False AND New.Drive <= Last.Drive THEN
      ' restore default drive
      InregsX.AX = &HE00
      InregsX.DX = New.Drive
      CALL InterruptX(&H21, InregsX, OutregsX)

      ' check windows dos
      IF Windows.Detected THEN
         ' check drive exists
         InregsX.AX = &H7147
         InregsX.DX = New.Drive + 1
         InregsX.DS = VARSEG(ASCIIZ)
         InregsX.SI = VARPTR(ASCIIZ)
         CALL InterruptX(&H21, InregsX, OutregsX)
      ELSE
         ' check drive exists
         InregsX.AX = &H4700
         InregsX.DX = New.Drive + 1
         InregsX.DS = VARSEG(ASCIIZ)
         InregsX.SI = VARPTR(ASCIIZ)
         CALL InterruptX(&H21, InregsX, OutregsX)
      END IF
      CALL DisplayError ("Error changing to drive.")

      ' check error flag
      IF (OutregsX.Flags AND &H1) = &H0 THEN
         ' make directory filename
         ASCIIZ = "\*.*" + CHR$(0)

         ' find first directory
         InregsX.AX = &H4E00
         InregsX.CX = &H37
         InregsX.DS = VARSEG(ASCIIZ)
         InregsX.DX = VARPTR(ASCIIZ)
         CALL InterruptX(&H21, InregsX, OutregsX)
         CALL DisplayError ("Error changing to drive.")
         IF (OutregsX.Flags AND &H1) = &H0 THEN
            Default.Drive = New.Drive
         END IF
      END IF
   END IF
END IF

' check control break
IF BreakIS THEN
   GOTO End.Drives
END IF

' display drives
COLOR Yellow, Black
ASCIIZ = "\" + CHR$(0)
IF Change.Drive = False THEN
   IF Display.Current THEN
      IF Skip.Drives(Default.Drive + 1) = False THEN
         PRINT CHR$(Default.Drive + 65) + ":"
      END IF
   ELSE
      IF Display.Drive1 = False THEN
         IF Skip.Drives(1) = False THEN
            PRINT "A:"
         END IF
      END IF
      IF Display.Drive2 = False THEN
         IF Skip.Drives(2) = False THEN
            PRINT "B:"
         END IF
      END IF
      FOR Drives = 3 TO Last.Drive
         IF Skip.Drives(Drives) = False THEN
            ' check windows dos
            IF Windows.Detected THEN
               ' check drive exists
               InregsX.AX = &H7147
               InregsX.DX = Drives
               InregsX.DS = VARSEG(ASCIIZ)
               InregsX.SI = VARPTR(ASCIIZ)
               CALL InterruptX(&H21, InregsX, OutregsX)
            ELSE
               ' check drive exists
               InregsX.AX = &H4700
               InregsX.DX = Drives
               InregsX.DS = VARSEG(ASCIIZ)
               InregsX.SI = VARPTR(ASCIIZ)
               CALL InterruptX(&H21, InregsX, OutregsX)
            END IF
            IF (OutregsX.Flags AND &H1) = &H0 THEN
               PRINT CHR$(Drives + 64) + ":"
            END IF
         END IF
      NEXT
   END IF
END IF

End.Drives:

' restore default drive
InregsX.AX = &HE00
InregsX.DX = Default.Drive
CALL InterruptX(&H21, InregsX, OutregsX)

' display new drive
IF Change.Drive THEN
   COLOR Yellow, Black
   PRINT CHR$(Default.Drive + 65) + ":"
END IF

' finish header
IF Continuous.Display = False THEN
   Prompt$ = "Press <enter> to exit to DOS:"
   CALL MorePrompt(Prompt$, CHR$(13), Outpt$)
END IF

' restore key trapping
CALL RestInt
COLOR Plain, Black
END

' display program usage
Boot.Usage:
 ' restore key trapping
 CALL RestInt
 Var$=Inkey$
 ' make header
 COLOR White, Black
 PRINT "Drives v1.3a: Drive display utility; "
 COLOR Yellow, Black
 PRINT "Usage:"
 PRINT "   Drives [d:][/abcxyz1]"
 PRINT "Where:"
 PRINT "   d:  change to drive"
 PRINT "   /a  ignore drive A:"
 PRINT "   /b  ignore drive B:"
 PRINT "   /c  continuous display"
 PRINT "   /x  list only current drive"
 PRINT "   /y  change drive only"
 PRINT "   /z  suppress errors"
 PRINT "   /1:n  skip drive n (n is A to Z)"
 COLOR Plain, Black
 END

Boot.Error:
 CALL RestInt
 Var$=Inkey$
 COLOR White, Black
 PRINT "Command line error. Type Drives /? for help."
 COLOR Plain, Black
 END

' critical error trap
Error.Routine:
 Data.Error = ERR
 IF Display.Errors THEN
    Error.Level = True
    OutregsX.Flags = &H1
    RESUME NEXT
 END IF
 SELECT CASE Data.Error
 CASE 53
    Temp.Outpt$ = "File not found."
 CASE 57
    Temp.Outpt$ = "Media error."
 CASE 61
    Temp.Outpt$ = "Disk full."
 CASE 70
    Temp.Outpt$ = "Permission denied."
 CASE 71
    Temp.Outpt$ = "Disk not ready."
 CASE ELSE
    Temp.Outpt$ = "Untrapped error" + STR$(Data.Error) + "."
 END SELECT
 COLOR Green, Black
 PRINT Temp.Outpt$
 Prompt$ = "Press R to retry, Q to quit, C to continue:"
 CALL MorePrompt(Prompt$, "rqc", Outpt$)
 IF BreakIS THEN
    Outpt$ = "q"
 END IF
 SELECT CASE Outpt$
 CASE "r"
    RESUME
 CASE "q"
    Error.Level = True
    RESUME End.Drives
 CASE "c"
    OutregsX.Flags = &H1
    RESUME NEXT
 END SELECT
 COLOR Plain, Black
 ' restore key trapping
 CALL RestInt
 END 0

' command line parser
FUNCTION ParseLine (X$)
 Imbedded = INSTR(Command.Line, LCASE$(X$))
 IF Imbedded THEN
    Command.Line = LEFT$(Command.Line, Imbedded - 1) + MID$(Command.Line, Imbedded + LEN(X$))
    Last.Switch = Imbedded - 1
    ParseLine = True
 ELSE
    Imbedded = INSTR(Command.Line, UCASE$(X$))
    IF Imbedded THEN
       Command.Line = LEFT$(Command.Line, Imbedded - 1) + MID$(Command.Line, Imbedded + LEN(X$))
       Last.Switch = Imbedded - 1
       ParseLine = True
    ELSE
       ParseLine = False
    END IF
 END IF
END FUNCTION 

SUB MorePrompt (Input.String$, Input.Mask$, Output.String$)
 COLOR White, Black
 PRINT Input.String$ + " ";
 Input.Char$ = NUL
 DO
    LOCATE , , 1
    InregsX2 = InregsX
    DO
       IF BreakIS THEN
          EXIT DO
       END IF
       IF KeyIS THEN
          IF OutregsX.AX <> 0 THEN
             InregsX.AX = &H0000
             CALL InterruptX(&H16, InregsX, OutregsX)
             Input.Char$=CHR$(OutregsX.AX AND &HFF)
             EXIT DO
          END IF
       END IF
    LOOP
    InregsX = InregsX2
    IF BreakIS THEN
       EXIT DO
    END IF
    IF LEN(Input.Char$) THEN
       Input.Char$ = LCASE$(Input.Char$)
       IF INSTR(Input.Mask$, Input.Char$) THEN
          PRINT Input.Char$
	  Output.String$ = Input.Char$
	  EXIT DO
       END IF
    END IF
 LOOP
END SUB

' clears Control-Break flag
FUNCTION ClearBreak
 DEF SEG = &H40
 POKE &H71, &H0
 DEF SEG
 ClearBreak = True
END FUNCTION

' checks Control-Break
FUNCTION BreakIS
 STATIC Var AS INTEGER
 IF KeyIS THEN
    IF OutregsX.AX = 0 THEN
       Var = True
    END IF
 END IF
 IF Var THEN
    Continuous.Display = True
 END IF
 BreakIS = Var
END FUNCTION

' checks keyboard buffer
FUNCTION KeyIS
 InregsX3 = InregsX
 InregsX.AX = &H0100
 CALL InterruptX(&H16, InregsX, OutregsX)
 InregsX = InregsX3
 IF (OutregsX.Flags AND &H40) = &H40 THEN
    KeyIS = False
 ELSE
    KeyIS = True
 END IF
END FUNCTION

' displays carry flag error
SUB DisplayError (Temp$)
 ' check carry flag error
 IF (OutregsX.Flags AND &H1) = &H1 THEN
    ' check display errors flag
    IF Display.Errors = False THEN
       ' display error
       COLOR Red, Black
       PRINT Temp$
    END IF
 END IF
END SUB
