REM file: Dirattr.bas - Public Domain DOS Utility
REM Version 1.0a created 04/04/1995
REM Version 1.1a created 03/26/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: 'dta.bi'

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

' initialize filename buffer
DIM ASCIIZ AS STRING * 260, DTAfile AS DTAtype

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

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

' declare work variables
COMMON SHARED List.Archive AS INTEGER, List.Hidden AS INTEGER
COMMON SHARED List.Readonly AS INTEGER, List.System AS INTEGER
COMMON SHARED List.Volume AS INTEGER, Display.Errors AS INTEGER
COMMON SHARED List.Directory AS INTEGER, List.Lowercase AS INTEGER

' declare subroutine variables
COMMON SHARED Attribute AS INTEGER, Display.Descrip AS INTEGER
COMMON SHARED Display.Filename AS INTEGER, Continuous.Display AS INTEGER

' initialize drive work variables
COMMON SHARED Drive.Number AS INTEGER, Current.Drive AS INTEGER
COMMON SHARED Search.Drive AS INTEGER, Files.Counted AS INTEGER
COMMON SHARED Volumes.Counted AS INTEGER, Windows.Detected AS INTEGER

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

' 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$))
    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$))
       ParseLine = True
    ELSE
       ParseLine = False
    END IF
 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

' 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 = UCASE$(ENVIRON$("DIRATTR"))
END IF

' get command line switches
List.Archive = ParseLine ("+A")
List.Hidden = ParseLine ("+H")
List.Directory = ParseLine ("+I")
List.Readonly = ParseLine ("+O")
List.System = ParseLine ("+S")
List.Volume = ParseLine ("+V")
Continuous.Display = ParseLine ("/C")
List.Lowercase = ParseLine ("/U")
Display.Filename = ParseLine ("/X")
Display.Descrip = ParseLine ("/Y")
Display.Errors = ParseLine ("/Z")
Control.Break = ParseLine ("/~")

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

' reset count variables
Files.Counted = False
Volumes.Counted = False

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

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

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

' remove blanks from command line
Command.Line = RTRIM$(Command.Line)
Command.Line = LTRIM$(Command.Line)
Command.Line.Redirect = Command.Line

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

' search through all input filenames
Redirected.Input = False
DO
   ' check control break
   IF BreakIS THEN
      EXIT DO
   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

   ' clear break flag
   IF Redirected.Input = False THEN
      IF Cleared = False THEN
         Cleared = True
         Var = ClearBreak
      END IF
   END IF

   ' check control break
   IF BreakIS THEN
      EXIT DO
   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
            EXIT DO
         END IF
      END IF
   END IF

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

   ' display header
   GOSUB Header

   ' store entire command
   Command.Work = Command.Line.Redirect

   DO
      ' store redirected input
      Standard.Input$ = RTRIM$(Standard.Input$)
      Standard.Input$ = LTRIM$(Standard.Input$)
      IF LEFT$(Standard.Input$, 1) = CHR$(34) THEN
         Standard.Input$ = MID$(Standard.Input$, 2)
      END IF
      IF RIGHT$(Standard.Input$, 1) = CHR$(34) THEN
         Standard.Input$ = LEFT$(Standard.Input$, LEN(Standard.Input$) - 1)
      END IF

      ' store entire command
      IF LEFT$(Command.Line, 1) = CHR$(34) THEN
         Imbedded = INSTR(2, Command.Line, CHR$(34))
         IF Imbedded THEN
            Command.Work = Standard.Input$ + MID$(Command.Line, 2, Imbedded - 2)
            Command.Line = MID$(Command.Line, Imbedded + 1)
         ELSE
            Command.Work = Standard.Input$ + Command.Line
            Command.Line = NUL
         END IF
      ELSE
         Imbedded = INSTR(Command.Line, " ")
         IF Imbedded THEN
            Command.Work = Standard.Input$ + LEFT$(Command.Line, Imbedded - 1)
            Command.Line = MID$(Command.Line, Imbedded + 1)
         ELSE
            Command.Work = Standard.Input$ + Command.Line
            Command.Line = NUL
         END IF
      END IF
      Command.Line = LTRIM$(Command.Line)
      Command.Line = RTRIM$(Command.Line)

      ' store current drive
      IF MID$(Command.Work, 2, 1) = ":" THEN
         Search.Drive = ASC(UCASE$(LEFT$(Command.Work, 1)))
         Command.Work = MID$(Command.Work, 3)
      ELSE
	 Search.Drive = Current.Drive
      END IF
      Drive.Number = Search.Drive - 64

      ' 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

      ' display any errors
      CALL DisplayError ("Error accessing drive.")

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

         ' store current directory
         Directory.Search$ = "\" + LEFT$(ASCIIZ, INSTR(ASCIIZ, CHR$(0)) - 1)
         Imbedded1 = INSTR(Command.Work, "\")
         Imbedded2 = Imbedded1
         WHILE Imbedded1
            Imbedded2 = Imbedded1
            Imbedded1 = INSTR(Imbedded1 + 1, Command.Work, "\")
         WEND
         IF Imbedded2 THEN
            Directory.Search$ = LEFT$(Command.Work, Imbedded2)
            Command.Work = MID$(Command.Work, Imbedded2 + 1)
         END IF
         IF RIGHT$(Directory.Search$, 1) <> "\" THEN
            Directory.Search$ = Directory.Search$ + "\"
         END IF

         ' get filename spec
         Filename.Search$ = Command.Work
         IF Filename.Search$ = NUL THEN
            IF RIGHT$(Directory.Search$, 1) = "\" THEN
               IF LEN(Directory.Search$) > 1 THEN
                  Directory.Search$ = LEFT$(Directory.Search$, LEN(Directory.Search$) - 1)
               END IF
            END IF
         ELSE
            Directory.Search$ = Directory.Search$ + Filename.Search$
         END IF
         Command.Work = NUL

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

         ' display any errors
         CALL DisplayError ("Error accessing drive.")

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

            ' check file attribute
            IF List.Volume THEN

               ' make volume label search
               ASCIIZ = "\*.*" + CHR$(0)

               ' find first directory
               InregsX.AX = &H4E00
               InregsX.CX = &H08
               InregsX.DS = VARSEG(ASCIIZ)
               InregsX.DX = VARPTR(ASCIIZ)
               CALL InterruptX(&H21, InregsX, OutregsX)

               ' store volume label
               ASCIIZ = DTAfile.ASCIIZfilename

               ' store volume label attribute
               Attribute = &H8
            ELSE
               ' make directory filename
               ASCIIZ = Directory.Search$ + CHR$(0)

               ' check windows dos
               IF Windows.Detected THEN
                  ' get file attributes
                  InregsX.AX = &H7143
                  InregsX.BX = &H0
                  InregsX.DS = VARSEG(ASCIIZ)
                  InregsX.DX = VARPTR(ASCIIZ)
                  CALL InterruptX(&H21, InregsX, OutregsX)
               ELSE
                  ' get file attributes
                  InregsX.AX = &H4300
                  InregsX.DS = VARSEG(ASCIIZ)
                  InregsX.DX = VARPTR(ASCIIZ)
                  CALL InterruptX(&H21, InregsX, OutregsX)
               END IF

               ' store file attribute
               Attribute = OutregsX.CX
            END IF

            ' display any errors
            CALL DisplayError ("Error reading file attributes.")

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

               ' count files displayed
               IF List.Volume THEN
                  Volumes.Counted = Volumes.Counted + 1
               ELSE
                  Files.Counted = Files.Counted + 1
               END IF

               ' store list work variable
               List.File = True

               ' check list attribute
               IF List.Readonly THEN
                  IF (Attribute AND &H1) = &H0 THEN
                     List.File = False
                  END IF
               END IF

               ' check list attribute
               IF List.Hidden THEN
                  IF (Attribute AND &H2) = &H0 THEN
                     List.File = False
                  END IF
               END IF

               ' check list attribute
               IF List.System THEN
                  IF (Attribute AND &H4) = &H0 THEN
                     List.File = False
                  END IF
               END IF

               ' check list attribute
               IF List.Directory THEN
                  IF (Attribute AND &H10) = &H0 THEN
                     List.File = False
                  END IF
               END IF

               ' check list attribute
               IF List.Archive THEN
                  IF (Attribute AND &H20) = &H0 THEN
                     List.File = False
                  END IF
               END IF

               ' check list work variable
               IF List.File THEN

                  ' display directory name
                  IF Display.Filename = False THEN
                     COLOR Yellow, Black
                     IF List.Volume THEN
                        Volume.Label$ = LEFT$(ASCIIZ, INSTR(ASCIIZ, CHR$(0)) - 1)
                        IF List.Lowercase THEN
                           PRINT LCASE$(Volume.Label$);
                        ELSE
                           PRINT UCASE$(Volume.Label$);
                        END IF
                     ELSE
                        IF List.Lowercase THEN
                           PRINT LCASE$(Directory.Search$);
                        ELSE
                           IF Windows.Detected THEN
                              PRINT Directory.Search$;
                           ELSE
                              PRINT UCASE$(Directory.Search$);
                           END IF
                        END IF
                     END IF
                     IF Display.Descrip = False THEN
                        PRINT " ";
                     ELSE
                        PRINT
                     END IF
                  END IF

                  ' check suppress display
                  IF Display.Descrip = False THEN
                     COLOR White, Black

                     ' check for read-only file
                     IF (Attribute AND &H1) = &H1 THEN
                        PRINT "Read-only ";
                     END IF

                     ' check for hidden file
                     IF (Attribute AND &H2) = &H2 THEN
                        PRINT "Hidden ";
                     END IF

                     ' check for system file
                     IF (Attribute AND &H4) = &H4 THEN
                        PRINT "System ";
                     END IF

                     ' check for volume file
                     IF (Attribute AND &H8) = &H8 THEN
                        PRINT "Volume ";
                     END IF

                     ' check for directory file
                     IF (Attribute AND &H10) = &H10 THEN
                        PRINT "Directory ";
                     END IF

                     ' check for archive file
                     IF (Attribute AND &H20) = &H20 THEN
                        PRINT "Archive ";
                     END IF
                     PRINT
                  END IF
               END IF
            END IF
         END IF
      END IF
      ' check search filename
      IF Command.Line = NUL THEN
         EXIT DO
      END IF
   LOOP

   ' check for more filenames
   IF Standard.Input$ = NUL THEN
      EXIT DO
   END IF
LOOP

End.Dirattr:

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

' restore current drive
InregsX.AX = &HE00
InregsX.DX = Current.Drive - 65
CALL InterruptX(&H21, InregsX, OutregsX)

' display counters
IF Continuous.Display = False THEN
   COLOR Yellow, Black
   IF List.Volume THEN
      PRINT "Volumes counted"; Volumes.Counted
   ELSE
      PRINT "Files/directories counted"; Files.Counted
   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

Boot.Usage:
 ' restore key trapping
 CALL RestInt
 Var$=Inkey$
 ' make header
 COLOR White, Black
 PRINT "Dirattr v1.1a: File/directory attribute display utility; "
 COLOR Yellow, Black
 PRINT "Usage:"
 PRINT "   Dirattr [[d:\path\]filename.ext][+ahiosv][/cuxyz]"
 PRINT "Where:"
 PRINT "   +a  list archive bit"
 PRINT "   +h  list hidden attribute"
 PRINT "   +i  list directory attribute"
 PRINT "   +o  list read-only attribute"
 PRINT "   +s  list system attribute"
 PRINT "   +v  list volume label"
 PRINT "   /c  continuous display"
 PRINT "   /u  display files in lowercase"
 PRINT "   /x  suppress filename display"
 PRINT "   /y  suppress attribute description"
 PRINT "   /z  suppress errors"
 COLOR Plain, Black
 END

' make header
Header:
 IF Header.Flag THEN
    RETURN
 END IF
 Header.Flag = True
 IF Continuous.Display = False THEN
    COLOR White, Black
    PRINT "Dirattr v1.1a: File/directory attribute display utility;"
 END IF
 RETURN

' 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 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.Dirattr
 CASE "c"
    OutregsX.Flags = &H1
    RESUME NEXT
 END SELECT
 COLOR Plain, Black
 ' restore key trapping
 CALL RestInt
 END 0

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 flag
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
