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 Compiling with Microsoft BASIC Professional Development System 7.1:
REM    BC LISTVOLS/FS/X/O;
REM    LINK LISTVOLS,,,QBX/E;

' 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 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 Displayed.Drive AS INTEGER, Display.Current 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 Attribute AS INTEGER, Display.Attribute AS INTEGER
COMMON SHARED Windows.Detected AS INTEGER, ASCIZ.Root AS STRING * 4
COMMON SHARED File.Work.Date AS SINGLE, File.Work.Time AS SINGLE

' declare command line work variables
COMMON SHARED Command.Line AS STRING, Command.Line.Redirect AS STRING

' 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 ASCIZ AS STRING * 260

' initialize structures
DIM DTAfile AS DTAtype, BPBfile AS BPBtype

' increase stack size
STACK STACK

' declare standard error trap
ON ERROR GOTO Error.Routine

' 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 

' 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.Serial = ParseLine ("/D")
Display.Date = ParseLine ("/E")
Display.Attribute = ParseLine ("/F")
Display.Current = ParseLine ("/X")
Display.Drive.Letter = ParseLine ("/Y")
Display.Errors = ParseLine ("/Z")

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

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

' 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)

' reset drive displayed flag
Displayed.Drive = False

' search through all input filenames
Standard.Input$ = Command.Line

DO
   ' check command line
   IF LEN(Standard.Input$) = 2 THEN
      IF RIGHT$(Standard.Input$, 1) = ":" THEN
	 New.Drive = ASC(LEFT$(Standard.Input$, 1)) - 65
         IF New.Drive >= False AND New.Drive <= Last.Drive THEN
	    Drive.Number = New.Drive + 1
            Displayed.Drive = True
            GOSUB Get.Volume.Label
	 END IF
      END IF
   END IF

   ' get standard input
   Standard.Input$ = NUL
   InregsX.AX = &HB00
   CALL InterruptX(&H21, InregsX, OutregsX)
   DO WHILE (OutregsX.AX AND &HFF) = &HFF
      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 standard input
   IF Standard.Input$ = NUL THEN
      EXIT DO
   END IF
LOOP

' display drive volume labels
IF Displayed.Drive = False THEN

   ' 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
	 GOSUB Get.Volume.Label
      NEXT
   END IF
END IF

End.Copy:

' 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 = Default.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
COLOR Plain, Black
END

' display volume label for drive number
Get.Volume.Label:
 ' reset drive access error flag
 Drive.Not.Ready = False

 ' change to drive
 InregsX.AX = &HE00
 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(ASCIZ)
    InregsX.SI = VARPTR(ASCIZ)
    CALL InterruptX(&H21, InregsX, OutregsX)
 ELSE
    ' get current directory
    InregsX.AX = &H4700
    InregsX.DX = Drive.Number
    InregsX.DS = VARSEG(ASCIZ)
    InregsX.SI = VARPTR(ASCIZ)
    CALL InterruptX(&H21, InregsX, OutregsX)
 END IF

 ' check error flag
 IF (OutregsX.Flags AND &H1) = &H1 THEN
    IF Displayed.Drive THEN
       IF Display.Errors = False THEN
          COLOR Red, Black
          PRINT "Error reading drive."
       END IF
    END IF
    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
 ASCIZ = "\*.*" + CHR$(0)
 InregsX.AX = &H4E00
 InregsX.CX = &H08
 InregsX.DS = VARSEG(ASCIZ)
 InregsX.DX = VARPTR(ASCIZ)
 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.FileAttr)

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

 ' display volume label
 PRINT Volume.Label$;

 ' check display type
 IF Display.Serial OR Display.Date 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
    Hour! = INT(File.Work.Time / 2048)
    Minute! = INT((File.Work.Time AND &H7E0) / 32)
    Seconds! = INT((File.Work.Time AND &H1F) / 2)

    Year! = INT(File.Work.Date / 512)
    Month! = INT((File.Work.Date AND &H1E0) / 32)
    Day! = INT(File.Work.Date AND &H1F)
    Year! = Year! + 1980

    File.Date$ = RIGHT$(STR$(Month! + 100), 2) + "-"
    File.Date$ = File.Date$ + RIGHT$(STR$(Day! + 100), 2) + "-"
    File.Date$ = File.Date$ + MID$(STR$(Year!), 2)

    File.Time$ = RIGHT$(STR$(Hour! + 100), 2) + ":"
    File.Time$ = File.Time$ + RIGHT$(STR$(Minute! + 100), 2) + ":"
    File.Time$ = File.Time$ + RIGHT$(STR$(Seconds! + 100), 2)

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

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

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

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

       ' 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 " ";

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

 ' check display type
 IF Display.Attribute THEN
    ' check flag error
    IF (OutregsX.Flags AND &H1) = &H0 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:
 ' make header
 COLOR White, Black
 PRINT "Listvols v1.2a: Volume display utility; "
 COLOR Yellow, Black
 PRINT "Usage:"
 PRINT "   Listvols [d:][/abdefcxyz]"
 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 attribute"
 PRINT "   /x  list only current volume"
 PRINT "   /y  don't display drive letter"
 PRINT "   /z  suppress errors"
 COLOR Plain, Black
 END

Boot.Error:
 COLOR White, Black
 PRINT "Command line error. Type Listvols /? for help."
 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$)
 SELECT CASE Outpt$
 CASE "r"
    RESUME
 CASE "q"
    RESUME End.Copy
 CASE "c"
    OutregsX.Flags = &H1
    RESUME NEXT
 END SELECT
 END 0

SUB MorePrompt (Input.String$, Input.Mask$, Output.String$)
 COLOR White, Black
 PRINT Input.String$ + " ";
 Input.Char$ = NUL
 DO
    LOCATE , , 1
    Input.Char$ = INKEY$
    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

' 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
