REM file: Drivespc.bas - Public Domain DOS Utility
REM Version 1.0a created 12/11/1996
REM Version 1.1a created 03/26/2000
REM Version 1.2a 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 Green = 10
CONST Plain = 7
CONST Red = 12
CONST White = 15
CONST Yellow = 14

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

' declare subroutines
DECLARE SUB InitDriveSpace (D%)
DECLARE SUB FreeDiskSpace (V$)

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

' declare structures
COMMON SHARED FAT32struc AS FAT32Type

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

' initialize filename buffer
COMMON SHARED ASCIZ 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, Disk.Space AS DOUBLE
COMMON SHARED Drive.Letter AS INTEGER, Format.Output AS INTEGER
COMMON SHARED Skip.Drives() AS INTEGER, Disk.Ready AS INTEGER
COMMON SHARED Total.Free AS DOUBLE

' declare command line work variables
COMMON SHARED Command.Line AS STRING, Control.Break 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

' declare drives to skip
REDIM Skip.Drives(1 TO 26) AS INTEGER

' 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$("DRIVESPC"))
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")
Format.Output = ParseLine ("/T")
Display.Current = ParseLine ("/X")
Drive.Letter = ParseLine ("/Y")
Display.Errors = ParseLine ("/Z")
Control.Break = ParseLine ("/~")

' check command line switch
DO
   Imbedded = INSTR(Command.Line, "/1:")
   IF Imbedded = False THEN
      EXIT DO
   END IF
   Skip = ASC(MID$(Command.Line, Imbedded + 3, 1)) - 64
   IF Skip >= 1 AND Skip <= 26 THEN
      Skip.Drives(Skip) = True
   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.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)

' 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.Drivespc
END IF

' make header
IF Continuous.Display = False THEN
   COLOR White, Black
   PRINT "Drivespc v1.2a: Available drive space list utility;"
END IF

' check redirected input
Redirected.Input = False
DO
   ' check control break
   IF BreakIS THEN
      GOTO End.Drivespc
   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.Drivespc
   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.Drivespc
         END IF
      END IF
   END IF

   ' check standard input
   IF Redirected.Input THEN
      IF Standard.Input$ = NUL THEN
         GOTO End.Drivespc
      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
         COLOR Yellow, Black
         IF Skip.Drives(Default.Drive + 1) = False THEN
            Disk.Ready = False
            Disk.Space = False
            CALL InitDriveSpace(Default.Drive + 1)
            IF Disk.Space = True THEN
               IF Display.Errors = False THEN
                  COLOR Red, Black
                  PRINT "Error reading drive."
               END IF
            ELSE
               IF Drive.Letter = False THEN
                  PRINT CHR$(Default.Drive + 65); ":";
               END IF
               IF Disk.Ready = True THEN
                  IF Display.Errors = False THEN
                     PRINT "Disk not ready."
                  ELSE
                     PRINT "0"
                  END IF
               ELSE
                  Total.Free = Total.Free + Disk.Space
                  IF Format.Output THEN
                     CALL FreeDiskSpace(DriveSpace$)
                     PRINT DriveSpace$
                  ELSE
                     PRINT MID$(STR$(Disk.Space), 2)
                  END IF
               END IF
            END IF
         END IF
      END IF
   END IF
LOOP

' display drives
COLOR Yellow, Black
IF Display.Current THEN
   IF Skip.Drives(Default.Drive + 1) = False THEN
      Disk.Ready = False
      Disk.Space = False
      CALL InitDriveSpace(Default.Drive + 1)
      IF Disk.Space = True THEN
         IF Display.Errors = False THEN
            COLOR Red, Black
            PRINT "Error reading drive."
         END IF
      ELSE
         IF Drive.Letter = False THEN
            PRINT CHR$(Default.Drive + 65); ":";
         END IF
         IF Disk.Ready = True THEN
            IF Display.Errors = False THEN
               PRINT "Disk not ready."
            ELSE
               PRINT "0"
            END IF
         ELSE
            Total.Free = Total.Free + Disk.Space
            IF Format.Output THEN
               CALL FreeDiskSpace(DriveSpace$)
               PRINT DriveSpace$
            ELSE
               PRINT MID$(STR$(Disk.Space), 2)
            END IF
         END IF
      END IF
   END IF
ELSE
   IF Display.Drive1 = False THEN
      IF Skip.Drives(1) = False THEN
         Disk.Ready = False
         Disk.Space = False
         CALL InitDriveSpace(1)
         IF Disk.Space <> True THEN
            IF Drive.Letter = False THEN
               PRINT "A:";
            END IF
            IF Disk.Ready = True THEN
               IF Display.Errors = False THEN
                  PRINT "Disk not ready."
               ELSE
                  PRINT "0"
               END IF
            ELSE
               Total.Free = Total.Free + Disk.Space
               IF Format.Output THEN
                  CALL FreeDiskSpace(DriveSpace$)
                  PRINT DriveSpace$
               ELSE
                  PRINT MID$(STR$(Disk.Space), 2)
               END IF
            END IF
         END IF
      END IF
   END IF
   IF Display.Drive2 = False THEN
      IF Skip.Drives(2) = False THEN
         Disk.Ready = False
         Disk.Space = False
         CALL InitDriveSpace(2)
         IF Disk.Space <> True THEN
            IF Drive.Letter = False THEN
               PRINT "B:";
            END IF
            IF Disk.Ready = True THEN
               IF Display.Errors = False THEN
                  PRINT "Disk not ready."
               ELSE
                  PRINT "0"
               END IF
            ELSE
               Total.Free = Total.Free + Disk.Space
               IF Format.Output THEN
                  CALL FreeDiskSpace(DriveSpace$)
                  PRINT DriveSpace$
               ELSE
                  PRINT MID$(STR$(Disk.Space), 2)
               END IF
            END IF
         END IF
      END IF
   END IF
   FOR Drives = 3 TO Last.Drive
      IF Skip.Drives(Drives) = False THEN
         Disk.Ready = False
         Disk.Space = False
         CALL InitDriveSpace(Drives)
         IF Disk.Space <> True THEN
            IF Drive.Letter = False THEN
               PRINT CHR$(Drives + 64) + ":";
            END IF
            IF Disk.Ready = True THEN
               IF Display.Errors = False THEN
                  PRINT "Disk not ready."
               ELSE
                  PRINT "0"
               END IF
            ELSE
               Total.Free = Total.Free + Disk.Space
               IF Format.Output THEN
                  CALL FreeDiskSpace(DriveSpace$)
                  PRINT DriveSpace$
               ELSE
                  PRINT MID$(STR$(Disk.Space), 2)
               END IF
            END IF
         END IF
      END IF
   NEXT
END IF

End.Drivespc:

' finish header
IF Continuous.Display = False THEN
   COLOR Yellow, Black
   PRINT "Total remaining available disk space: ";
   Disk.Space = Total.Free
   IF Format.Output THEN
      CALL FreeDiskSpace(DriveSpace$)
      PRINT DriveSpace$
   ELSE
      Var$ = Format$(Total.Free, "#,##0;;")
      PRINT Var$ + " bytes."
   END IF
   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 "Drivespc v1.2a: Drive space display utility; "
 COLOR Yellow, Black
 PRINT "Usage:"
 PRINT "   Drivespc [d:][/abctxyz1]"
 PRINT "Where:"
 PRINT "   d:  display drive space on d: only"
 PRINT "   /a  ignore drive A:"
 PRINT "   /b  ignore drive B:"
 PRINT "   /c  continuous display"
 PRINT "   /t  display drive space in KB form"
 PRINT "   /x  list current drive only"
 PRINT "   /y  don't display drive letter"
 PRINT "   /z  suppress errors"
 PRINT "   /1:n  skip drive n (n is A to Z)"
 COLOR Plain, Black
 END

SUB FreeDiskSpace (Var$)
 Temp# = Disk.Space
 TempA = False
 DO
    IF Temp# >= 1024 THEN
       Temp# = Temp# / 1024
       TempA = TempA + 1
       IF TempA = 4 THEN
          EXIT DO
       END IF
    ELSE
       EXIT DO
    END IF
 LOOP
 Var$ = Format$(Temp#, "#,##0.000;;")
 SELECT CASE TempA
 CASE 0
    Var$ = Var$ + " B"
 CASE 1
    Var$ = Var$ + " KB"
 CASE 2
    Var$ = Var$ + " MB"
 CASE 3
    Var$ = Var$ + " GB"
 CASE 4
    Var$ = Var$ + " TB"
 END SELECT
END SUB

SUB InitDriveSpace (Drive.Number%)
 InregsX.AX = &H3600
 InregsX.DX = Drive.Number%
 CALL InterruptX(&H21, InregsX, OutregsX)
 IF Disk.Ready = True THEN
    EXIT SUB
 END IF
 IF OutregsX.AX = &HFFFF THEN
    Disk.Space = True
    EXIT SUB
 END IF
 ' get FAT32 drive space
 ASCIZ = CHR$(Drive.Number% + 64) + ":\" + CHR$(0)
 InregsX.AX = &H7303
 InregsX.DS = VARSEG(ASCIZ)
 InregsX.DX = VARPTR(ASCIZ)
 InregsX.ES = VARSEG(FAT32Struc)
 InregsX.DI = VARPTR(FAT32Struc)
 InregsX.CX = LEN(FAT32Struc)
 CALL InterruptX(&H21, InregsX, OutregsX)
 IF (OutregsX.Flags AND &H1) = &H0 THEN
    IF (OutregsX.AX AND &HFF) <> 0 THEN
       Bytes# = CLNG(ASC(MID$(FAT32Struc.BytesPerSector, 1, 1)))
       Bytes# = Bytes# + CLNG(ASC(MID$(FAT32Struc.BytesPerSector, 2, 1))) * 256#
       Bytes# = Bytes# + CLNG(ASC(MID$(FAT32Struc.BytesPerSector, 3, 1))) * 65536#
       Bytes# = Bytes# + CLNG(ASC(MID$(FAT32Struc.BytesPerSector, 4, 1))) * 16777216#
       Sectors# = CLNG(ASC(MID$(FAT32Struc.FreeSectors, 1, 1)))
       Sectors# = Sectors# + CLNG(ASC(MID$(FAT32Struc.FreeSectors, 2, 1))) * 256#
       Sectors# = Sectors# + CLNG(ASC(MID$(FAT32Struc.FreeSectors, 3, 1))) * 65536#
       Sectors# = Sectors# + CLNG(ASC(MID$(FAT32Struc.FreeSectors, 4, 1))) * 16777216#
       Disk.Space = Bytes# * Sectors#
       EXIT SUB
    END IF
 END IF
 ' get FAT16 drive space
 InregsX.AX = &H3600
 InregsX.DX = Drive.Number%
 CALL InterruptX(&H21, InregsX, OutregsX)
 IF OutregsX.AX < False THEN
    Sectors# = CDBL(OutregsX.AX + 65536)
 ELSE
    Sectors# = CDBL(OutregsX.AX)
 END IF
 IF OutregsX.BX < False THEN
    Clusters# = CDBL(OutregsX.BX + 65536)
 ELSE
    Clusters# = CDBL(OutregsX.BX)
 END IF
 IF OutregsX.CX < False THEN
    Bytes# = CDBL(OutregsX.CX + 65536)
 ELSE
    Bytes# = CDBL(OutregsX.CX)
 END IF
 Disk.Space = Sectors# * Clusters# * Bytes#
END SUB

' critical error trap
Error.Routine:
 Data.Error = ERR
 IF Data.Error = 71 THEN
    Disk.Ready = True
    RESUME NEXT
 END IF
 IF Data.Error = 57 THEN
    Disk.Ready = True
    RESUME NEXT
 END IF
 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 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"
    Error.Level = True
    RESUME End.Drivespc
 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
