REM file: Drivespc.bas - Public Domain DOS Utility
REM Version 1.0a created 12/11/1996

REM Compiling with Microsoft BASIC Professional Development System 7.1:
REM    BC DRIVESPC/FS/X/O;
REM    LINK DRIVESPC,,,QBX/E;

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

' 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: 'format.bi'

' declare functions
DECLARE FUNCTION ParseLine (S$)

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

' initialize filename buffer
DIM 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 Windows.Detected AS INTEGER, Total.Free AS DOUBLE

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

' increase stack size
STACK STACK

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

' 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 

' 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$("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")

' 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

' make header
IF Continuous.Display = False THEN
   COLOR White, Black
   PRINT "Drivespc v1.0a: Drive space 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)

' 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

' 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.Copy:

' finish header
IF Continuous.Display = False THEN
   COLOR Yellow, Black
   PRINT "Total free disk space: ";
   Disk.Space = Total.Free
   IF Format.Output THEN
      CALL FreeDiskSpace(DriveSpace$)
      PRINT DriveSpace$
   ELSE
      Var$ = FormatD$(Total.Free, "#,##0;;")
      PRINT Var$ + " bytes."
   END IF
   Prompt$ = "Press <enter> to exit to DOS:"
   CALL MorePrompt(Prompt$, CHR$(13), Outpt$)
END IF
COLOR Plain, Black
END

' display program usage
Boot.Usage:
 ' make header
 COLOR White, Black
 PRINT "Drivespc v1.0a: 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

Boot.Error:
 COLOR White, Black
 PRINT "Command line error. Type Drivespc /? for help."
 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$ = FormatD$(Temp#, "#,##0.0;;")
 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
 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$)
 SELECT CASE Outpt$
 CASE "r"
    RESUME
 CASE "q"
    Error.Level = True
    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
