REM file: Listvols.bas - Public Domain DOS Utility
REM Version 1.0a created 02/22/1996
REM Version 1.1a created 02/24/1996
REM Version 1.2a created 04/23/1996
REM Version 1.3a created 10/28/2000
REM Version 1.4a created 04/08/2001

' 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 Cyan = 11
CONST Green = 10
CONST Plain = 7
CONST Red = 12
CONST White = 15
CONST Yellow = 14

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

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

' 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, Drive.Number AS INTEGER
COMMON SHARED Display.Current AS INTEGER, Original.Drive AS INTEGER
COMMON SHARED Display.Drive.Letter AS INTEGER, Drive.Not.Ready AS INTEGER
COMMON SHARED Display.Serial AS INTEGER, Display.Date AS INTEGER
COMMON SHARED Display.FatType AS INTEGER, Attribute AS INTEGER
COMMON SHARED Display.Attribute AS INTEGER, Windows.Detected AS INTEGER
COMMON SHARED ASCIIZ.Root AS STRING * 4, File.Work.Date AS SINGLE
COMMON SHARED File.Work.Time AS SINGLE, Display.Not.Ready AS INTEGER

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

' declare registers
COMMON SHARED InregsX AS RegtypeX, OutregsX AS RegtypeX

' declare program dta
DIM BASIC.DTA.SEG AS INTEGER, BASIC.DTA.OFF AS INTEGER

' initialize filename buffer
DIM ASCIIZ AS STRING * 260

' initialize structures
DIM DTAfile AS DTAtype, BPBfile AS BPBtype

' 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

' store basic dta
InregsX.AX = &H2F00
CALL InterruptX(&H21, InregsX, OutregsX)
BASIC.DTA.SEG = OutregsX.ES
BASIC.DTA.OFF = OutregsX.BX

' restore directory search dta
InregsX.AX = &H1A00
InregsX.DS = VARSEG(DTAfile)
InregsX.DX = VARPTR(DTAfile)
CALL InterruptX(&H21, InregsX, OutregsX)

' check windows dos
InregsX.AX = &H160A
CALL InterruptX(&H2F, InregsX, OutregsX)
IF OutregsX.AX = False THEN
   Temp = (OutregsX.BX And &HFF00) / 256
   IF Temp >= 4 THEN
      Windows.Detected = True
   END IF
Endif

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

' store and parse command line
Command.Line = COMMAND$
IF Command.Line = NUL THEN
   Command.Line = UCASE$(ENVIRON$("LISTVOLS"))
END IF

' remove blanks from command line
DO
   Imbedded = ParseLine (" ")
   IF Imbedded = False THEN
      EXIT DO
   END IF
LOOP

' check command line switches
Display.Drive1 = ParseLine ("/A")
Display.Drive2 = ParseLine ("/B")
Continuous.Display = ParseLine ("/C")
Display.Date = ParseLine ("/D")
Display.Serial = ParseLine ("/E")
Display.FatType = ParseLine ("/F")
Display.Attribute = ParseLine ("/G")
Display.Current = ParseLine ("/X")
Display.Drive.Letter = ParseLine ("/Y")
Display.Errors = ParseLine ("/Z")
Control.Break = ParseLine ("/~")

' recheck command line
IF INSTR(Command.Line, "/") THEN
   GOTO Boot.Usage
END IF

' check command line
Command.Line = RTRIM$(Command.Line)
Command.Line = LTRIM$(Command.Line)
IF RIGHT$(Command.Line, 1) = ":" THEN
   New.Drive = ASC(LEFT$(Command.Line, 1)) - 64
END IF

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

' get current drive
InregsX.AX = &H1900
CALL InterruptX(&H21, InregsX, OutregsX)
Default.Drive = (OutregsX.AX AND &HFF)
Original.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 new drive
IF New.Drive THEN
   New.Drive = New.Drive - 1
   IF New.Drive >= False AND New.Drive <= Last.Drive THEN
      Default.Drive = New.Drive
      Display.Current = True
   END IF
END IF

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

' make header
IF Continuous.Display = False THEN
   COLOR White, Black
   PRINT "Listvols v1.4a: Volume display utility;"
END IF

' check redirected input
Redirected.Input = False
DO
   ' check control break
   IF BreakIS THEN
      GOTO End.Listvols
   END IF

   ' get standard input
   Standard.Input$ = NUL
   InregsX.AX = &HB00
   CALL InterruptX(&H21, InregsX, OutregsX)
   DO WHILE (OutregsX.AX AND &HFF) = &HFF
      Redirected.Input = True
      InregsX.AX = &H800
      CALL InterruptX(&H21, InregsX, OutregsX)
      Char$ = CHR$(OutregsX.AX AND &HFF)
      SELECT CASE ASC(Char$)
      CASE 10, 26
      CASE 13
	 EXIT DO
      CASE ELSE
	 Standard.Input$ = Standard.Input$ + Char$
      END SELECT
      InregsX.AX = &HB00
      CALL InterruptX(&H21, InregsX, OutregsX)
   LOOP

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

   ' check nul filename input
   IF Redirected.Input = False THEN
      IF Standard.Input$ = NUL THEN
         CALL RestInt ' restore Control-Break
         X$ = Inkey$ ' quits here
         CALL SetInt ' reset Control-Break
         IF X$ = CHR$(0) + CHR$(0) THEN
            GOTO End.Listvols
         END IF
      END IF
   END IF

   ' check standard input
   IF Redirected.Input THEN
      IF Standard.Input$ = NUL THEN
         GOTO End.Listvols
      END IF
   END IF
   IF Redirected.Input = False THEN
      EXIT DO
   END IF

   ' check standard input
   Standard.Input$ = RTRIM$(Standard.Input$)
   Standard.Input$ = LTRIM$(Standard.Input$)
   Standard.Input$ = UCASE$(Standard.Input$)
   IF RIGHT$(Standard.Input$, 1) = ":" THEN
      New.Drive = ASC(LEFT$(Standard.Input$, 1)) - 65
      IF New.Drive >= False AND New.Drive <= Last.Drive THEN
         Default.Drive = New.Drive
         Drive.Number = Default.Drive + 1
         GOSUB Get.Volume.Label
      END IF
   END IF
LOOP

' check to display current drive
IF Display.Current THEN
   Drive.Number = Default.Drive + 1
   GOSUB Get.Volume.Label
ELSE
   ' display drive A:
   IF Display.Drive1 = False THEN
      Drive.Number = 1
      GOSUB Get.Volume.Label
   END IF

   ' display drive B:
   IF Display.Drive2 = False THEN
      Drive.Number = 2
      GOSUB Get.Volume.Label
   END IF

   ' display drives C: to last drive
   FOR Drive.Number = 3 TO Last.Drive
      ' display drive letter volume
      Display.Not.Ready = True
      GOSUB Get.Volume.Label
   NEXT
END IF

End.Listvols:

' restore basic dta
InregsX.AX = &H1A00
InregsX.DS = BASIC.DTA.SEG
InregsX.DX = BASIC.DTA.OFF
CALL InterruptX(&H21, InregsX, OutregsX)

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

' 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 volume label for drive number
Get.Volume.Label:
 ' check control break
 IF BreakIS THEN
    RETURN
 END IF

 ' reset drive access error flag
 Drive.Not.Ready = False

 ' check drive
 InregsX.AX = &H3600 ' 1=a, 2=b
 InregsX.DX = Drive.Number
 CALL InterruptX(&H21, InregsX, OutregsX)
 IF OutregsX.AX = &HFFFF THEN
    IF Display.Not.Ready = False THEN
       COLOR Red, Black
       PRINT "Error reading drive "; CHR$(Drive.Number + 64); ":"
    END IF
    RETURN
 END IF

 ' change to drive
 InregsX.AX = &HE00 ' 0=a, 1=b
 InregsX.DX = Drive.Number - 1
 CALL InterruptX(&H21, InregsX, OutregsX)

 ' check windows dos
 IF Windows.Detected THEN
    ' get current directory
    InregsX.AX = &H7147
    InregsX.DX = Drive.Number
    InregsX.DS = VARSEG(ASCIIZ)
    InregsX.SI = VARPTR(ASCIIZ)
    CALL InterruptX(&H21, InregsX, OutregsX)
 ELSE
    ' get current directory
    InregsX.AX = &H4700
    InregsX.DX = Drive.Number
    InregsX.DS = VARSEG(ASCIIZ)
    InregsX.SI = VARPTR(ASCIIZ)
    CALL InterruptX(&H21, InregsX, OutregsX)
 END IF

 ' check error flag
 IF (OutregsX.Flags AND &H1) = &H1 THEN
    COLOR Red, Black
    PRINT "Error reading drive "; CHR$(Drive.Number + 64); ":"
    RETURN
 END IF

 ' display drive letter
 COLOR Yellow, Black
 IF Display.Drive.Letter = False THEN
    PRINT CHR$(Drive.Number + 64); ":";
 END IF

 ' store volume info
 ASCIIZ = "\*.*" + CHR$(0)
 InregsX.AX = &H4E00
 InregsX.CX = &H08
 InregsX.DS = VARSEG(ASCIIZ)
 InregsX.DX = VARPTR(ASCIIZ)
 CALL InterruptX(&H21, InregsX, OutregsX)

 ' check drive label
 IF (OutregsX.Flags AND &H1) = &H1 THEN
    IF Display.Drive.Letter = False THEN
       PRINT
    END IF
    RETURN
 END IF

 ' check drive access error flag
 IF Drive.Not.Ready THEN
    IF Display.Errors = False THEN
       PRINT "Disk not ready."
    ELSE
       IF Display.Drive.Letter = False THEN
          PRINT
       END IF
    END IF
    RETURN
 END IF

 ' store drive info
 Attribute = ASC(DTAfile.FileBits)

 ' store volume label
 Volume.Label$ = RTRIM$(DTAfile.ASCIIZfilename)
 Volume.Label$ = LEFT$(Volume.Label$, INSTR(Volume.Label$, CHR$(0)) - 1)

 ' display volume label
 PRINT Volume.Label$;

 ' check display type
 IF Display.Date OR Display.Serial OR Display.FatType OR Display.Attribute THEN
    PRINT " ";
 END IF

 ' check display volume date
 IF Display.Date THEN

    ' store volume date\time
    File.Work.Time = ASC(MID$(DTAfile.FileTime, 2, 1))
    File.Work.Date = ASC(MID$(DTAfile.FileDate, 2, 1))
    File.Work.Time = File.Work.Time * &H100 + ASC(MID$(DTAfile.FileTime, 1, 1))
    File.Work.Date = File.Work.Date * &H100 + ASC(MID$(DTAfile.FileDate, 1, 1))

    ' construct file date and time for display
    HourTemp! = INT(File.Work.Time / 2048)
    MinuteTemp! = INT((File.Work.Time AND &H7E0) / 32)
    SecondsTemp! = INT((File.Work.Time AND &H1F) / 2)

    YearTemp! = INT(File.Work.Date / 512)
    MonthTemp! = INT((File.Work.Date AND &H1E0) / 32)
    DayTemp! = INT(File.Work.Date AND &H1F)
    YearTemp! = YearTemp! + 1980

    File.Date$ = RIGHT$(STR$(MonthTemp! + 100), 2) + "-"
    File.Date$ = File.Date$ + RIGHT$(STR$(DayTemp! + 100), 2) + "-"
    File.Date$ = File.Date$ + MID$(STR$(YearTemp!), 2)

    File.Time$ = RIGHT$(STR$(HourTemp! + 100), 2) + ":"
    File.Time$ = File.Time$ + RIGHT$(STR$(MinuteTemp! + 100), 2) + ":"
    File.Time$ = File.Time$ + RIGHT$(STR$(SecondsTemp! + 100), 2)

    ' display file date\time
    COLOR Green, Black
    PRINT File.Date$; " "; File.Time$; " ";
 END IF

 ' check display serial number
 IF Display.Serial OR Display.FatType THEN
    ' get volume info
    InregsX.AX = &H6900
    InregsX.BX = Drive.Number
    InregsX.DS = VARSEG(BPBfile)
    InregsX.DX = VARPTR(BPBfile)
    CALL InterruptX(&H21, InregsX, OutregsX)
 END IF

 ' check flag error
 IF (OutregsX.Flags AND &H1) = &H1 THEN

    ' display any errors
    PRINT
    CALL DisplayError ("Error reading volume attributes.")
    RETURN
 ELSE

    ' check display serial number
    IF Display.Serial THEN
       ' display volume serial number
       COLOR Red, Black
       FOR Serial.Digit = 4 TO 1 STEP -1
          IF Serial.Digit = 2 THEN
             PRINT "-";
          END IF
          Serial.Digit.Value = ASC(MID$(BPBfile.Serial, Serial.Digit, 1))
          Serial.Digit.String$ = RIGHT$(HEX$(Serial.Digit.Value + &H100), 2)
          PRINT Serial.Digit.String$;
       NEXT
       PRINT " ";
    END IF

    ' check display serial number
    IF Display.FatType THEN

       ' display volume fat type
       COLOR White, Black
       PRINT RTRIM$(BPBfile.System); " ";
    END IF

    ' check display type
    IF Display.Attribute THEN
       COLOR Cyan, Black
       ' check for archive file
       IF (Attribute AND &H20) = &H20 THEN
          PRINT "Archive";
       END IF
    END IF
 END IF
 PRINT
 RETURN

' display program usage
Boot.Usage:
 ' restore key trapping
 CALL RestInt
 Var$=Inkey$
 ' make header
 COLOR White, Black
 PRINT "Listvols v1.4a: Volume display utility; "
 COLOR Yellow, Black
 PRINT "Usage:"
 PRINT "   Listvols [d:][/abcdefgxyz]"
 PRINT "Where:"
 PRINT "   d:  list drive D: volume only"
 PRINT "   /a  ignore drive A: volume"
 PRINT "   /b  ignore drive B: volume"
 PRINT "   /c  continuous display"
 PRINT "   /d  display volume serial number"
 PRINT "   /e  display volume creation date"
 PRINT "   /f  display volume fat type"
 PRINT "   /g  display volume attribute"
 PRINT "   /x  list only current volume"
 PRINT "   /y  don't display drive letter"
 PRINT "   /z  suppress errors"
 COLOR Plain, Black
 END

' critical error trap
Error.Routine:
 Data.Error = ERR
 IF Data.Error = 71 OR Data.Error = 57 THEN
    Drive.Not.Ready = True
    RESUME NEXT
 END IF
 IF Display.Errors THEN
    OutregsX.Flags = &H1
    RESUME NEXT
 END IF
 SELECT CASE Data.Error
 CASE 53
    Temp.Outpt$ = "File not found."
 CASE 61
    Temp.Outpt$ = "Disk full."
 CASE 70
    Temp.Outpt$ = "Permission denied."
 CASE ELSE
    Temp.Outpt$ = "Untrapped error" + STR$(Data.Error) + "."
 END SELECT
 COLOR White, 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"
    RESUME End.Listvols
 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, X$)
 IF Imbedded THEN
    Command.Line = LEFT$(Command.Line, Imbedded - 1) + MID$(Command.Line, Imbedded + LEN(X$))
    ParseLine = True
 ELSE
    ParseLine = False
 END IF
END FUNCTION 

SUB MorePrompt (Input.String$, Input.Mask$, Output.String$)
 COLOR White, Black
 PRINT Input.String$ + " ";
 Input.Char$ = NUL
 DO
    LOCATE , , 1
    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
    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
 InregsX.AX = &H0100
 CALL InterruptX(&H16, InregsX, OutregsX)
 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
