REM file: Stree.bas - Public Domain DOS Utility

REM Version 1.0a created 02/05/1995
REM Version 1.1a created 02/06/1995
REM Version 1.2a created 02/21/1997
REM Version 1.3a created 06/11/1999
REM Version 1.4a created 10/28/2000
REM Version 1.5a created 02/28/2001
REM Version 1.6a created 03/01/2004
REM Version 1.7a created 08/19/2004
REM Version 1.8a created 08/21/2004
REM Version 1.9a created 10/06/2004
REM Version 2.0a created 10/20/2004
REM Version 2.1a created 11/22/2004
REM Version 2.2a created 12/20/2004
REM Version 2.3a created 12/28/2004
REM Version 2.4a created 12/31/2004
REM Version 2.5a created 12/31/2004
REM Version 2.6a created 12/31/2004
REM Version 2.7a created 03/15/2005
REM Version 2.8a created 08/31/2006

' declare subroutines
DECLARE SUB Directories (D$)

' default integer variables
DEFINT A-Z
REM $DYNAMIC

' define boolean values
CONST True = -1
CONST TrueD = -1#
CONST False = 0
CONST FalseD = 0#
CONST FalseS = 0!
CONST NUL = ""

' define color values
CONST Black = 0
CONST Cyan = 11
CONST Green = 10
CONST Magenta = 12
CONST Plain = 7
CONST Red = 12
CONST White = 15
CONST Yellow = 14

' get include files
REM $INCLUDE: 'qbx.bi'
REM $INCLUDE: 'dta.bi'
REM $INCLUDE: 'dta2.bi'
REM $INCLUDE: 'fcb.bi'
REM $INCLUDE: 'wdta.bi'

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

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

' declare registers
COMMON SHARED InregsX AS RegtypeX, OutregsX AS RegtypeX
COMMON SHARED InregsX2 AS RegTypeX, InregsX3 AS RegTypeX

' declare date\time variables
COMMON SHARED Search.From.Date AS SINGLE, Search.To.Date AS SINGLE
COMMON SHARED Search.From.Time AS SINGLE, Search.To.Time AS SINGLE
COMMON SHARED File.Work.Date AS SINGLE, File.Work.Time AS SINGLE
COMMON SHARED Creation.Time AS INTEGER, Access.Time AS INTEGER
COMMON SHARED Modified.Time AS INTEGER, File.Access.Date AS SINGLE

' declare file creation time seconds work variables
COMMON SHARED Half.Second1 AS SINGLE, Half.Second2 AS SINGLE
COMMON SHARED Millisecond AS INTEGER

' declare work variables
COMMON SHARED Search.Archive AS INTEGER, Search.Hidden AS INTEGER
COMMON SHARED Search.Readonly AS INTEGER, Search.System AS INTEGER
COMMON SHARED Recurse.Directories AS INTEGER, Attribute AS INTEGER
COMMON SHARED Extended.List AS INTEGER, Display.Errors AS INTEGER
COMMON SHARED Continuous.Display AS INTEGER, Directories.Counted AS SINGLE
COMMON SHARED Display.Lines AS INTEGER, Display.Lowercase AS INTEGER
COMMON SHARED Drive.Search AS STRING * 1, Current.Drive AS STRING * 1
COMMON SHARED Nested.Levels AS INTEGER, Windows.Detected AS INTEGER
COMMON SHARED Nested.Recurse AS INTEGER, Windows.DOS AS INTEGER
COMMON SHARED Short.Filenames AS INTEGER, Short.Display AS INTEGER
COMMON SHARED Wide.Display AS INTEGER, Display.Length AS INTEGER
COMMON SHARED Truncate.Slash AS INTEGER, Strip.Drive AS INTEGER
COMMON SHARED Check.Root AS INTEGER, First.Dir AS INTEGER, Length AS INTEGER
COMMON SHARED Quit.Searching AS INTEGER, More.Display AS INTEGER

' declare directory variables
COMMON SHARED ASCIIZ AS STRING * 260, ASCIIZ2 AS STRING * 260
COMMON SHARED ASCIIZ3 AS STRING * 260, ASCIIZ.Sub AS STRING * 260
COMMON SHARED Directory.ASCIIZ AS STRING * 260

' declare disk transfer area structures
COMMON SHARED SWDTA AS WDTAtype, TreeWDTA AS WDTAtype
COMMON SHARED TempDTA AS DTAtype

' 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
COMMON SHARED Redirected.Input AS INTEGER, Last.Switch AS INTEGER
COMMON SHARED Pipe.Buffer AS STRING * 1

' 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$))
    Last.Switch = Imbedded - 1
    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$))
       Last.Switch = Imbedded - 1
       ParseLine = True
    ELSE
       ParseLine = False
    END IF
 END IF
END FUNCTION 

' reset counters
Directories.Counted = FalseS
Display.Lines = False
Continuous.Display = False
Nested.Levels = False
Quit.Searching = 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 = CHR$((OutregsX.AX AND &HFF) + 65)

' check windows
Windows.Detected = True
If Load.Windows = False Then
   InregsX.AX = &H160A
   CALL InterruptX(&H2F, InregsX, OutregsX)
   IF OutregsX.AX > 0 THEN
      InregsX.AX = &H4A33
      CALL InterruptX(&H2F, InregsX, OutregsX)
      IF OutregsX.AX = 0 THEN
         Windows.Detected = 0 ' DOS 7.00
      END IF
   END IF
END IF
IF INSTR(COMMAND$, "/_") THEN
   Windows.Detected = True
END IF
InregsX.AX = &H4A33
CALL InterruptX(&H2F, InregsX, OutregsX)
IF OutregsX.AX = False THEN
   Windows.DOS = True
END IF

' 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 = ENVIRON$("STREE")
END IF
Command.Line = RTRIM$(Command.Line)

' check command line switches
Search.Archive = ParseLine ("/A")
Continuous.Display = ParseLine ("/C")
Extended.List = ParseLine ("/E")
Short.Display = ParseLine ("/F")
Check.Root = ParseLine ("/G")
Search.Hidden = ParseLine ("/H")
Search.Readonly = ParseLine ("/O")
Search.System = ParseLine ("/S")
Recurse.Directories = ParseLine ("/R")
Display.Lowercase = ParseLine ("/Y")
Strip.Drive = ParseLine ("/U")
Short.Filenames = ParseLine ("/V")
Wide.Display = ParseLine ("/W")
Truncate.Slash = ParseLine ("/X")
Display.Errors = ParseLine ("/Z")
Control.Break = ParseLine ("/~")
Var = ParseLine("/_")

' reset some display variables
IF Wide.Display THEN
   Extended.List = False
   Short.Display = True
   Short.Filenames = True
END IF

' get date\time from command line
Search.From.Date = False
Search.To.Date = False
Search.From.Time = False
Search.To.Time = False
Imbedded = INSTR(UCASE$(Command.Line), "/D")
IF Imbedded THEN
   Last.Switch = Imbedded - 1
   D$ = MID$(Command.Line, Imbedded + 2, 21)
   Command.Line = LEFT$(Command.Line, Imbedded - 1) + MID$(Command.Line, Imbedded + 23)
   IF LEN(D$) <> 21 THEN
      GOTO Boot.Error
   END IF
   IF MID$(D$, 11, 1) <> "-" THEN
      GOTO Boot.Error
   END IF
   S$ = LEFT$(D$, 10)
   D1! = INT(VAL(MID$(S$, 1, 2)))
   D2! = INT(VAL(MID$(S$, 4, 2)))
   D3! = INT(VAL(MID$(S$, 7, 4)))
   Search.From.Date = ((D3! - 1980) * 512) + D1! * 32 + D2!
   S$ = RIGHT$(D$, 10)
   D1! = INT(VAL(MID$(S$, 1, 2)))
   D2! = INT(VAL(MID$(S$, 4, 2)))
   D3! = INT(VAL(MID$(S$, 7, 4)))
   Search.To.Date = ((D3! - 1980) * 512) + D1! * 32 + D2!
   IF Search.From.Date < False OR Search.To.Date < False THEN
      GOTO Boot.Error
   END IF
END IF
Imbedded = INSTR(UCASE$(Command.Line), "/T")
IF Imbedded THEN
   Last.Switch = Imbedded - 1
   T$ = MID$(Command.Line, Imbedded + 2, 17)
   Command.Line = LEFT$(Command.Line, Imbedded - 1) + MID$(Command.Line, Imbedded + 19)
   IF LEN(T$) <> 17 THEN
      GOTO Boot.Error
   END IF
   IF MID$(T$, 9, 1) <> "-" THEN
      GOTO Boot.Error
   END IF
   S$ = LEFT$(T$, 8)
   T1! = INT(VAL(MID$(S$, 1, 2)))
   T2! = INT(VAL(MID$(S$, 4, 2)))
   T3! = INT(VAL(MID$(S$, 7, 2)))
   IF T3! / 2! <> INT(T3! / 2!) THEN
      Half.Second1 = .5!
   ELSE
      Half.Second1 = FalseS
   END IF
   Search.From.Time = T1! * 2048 + T2! * 32 + INT(T3! / 2)
   S$ = RIGHT$(T$, 8)
   T1! = INT(VAL(MID$(S$, 1, 2)))
   T2! = INT(VAL(MID$(S$, 4, 2)))
   T3! = INT(VAL(MID$(S$, 7, 2)))
   IF T3! / 2! <> INT(T3! / 2!) THEN
      Half.Second2 = .5!
   ELSE
      Half.Second2 = FalseS
   END IF
   Search.To.Time = T1! * 2048 + T2! * 32 + INT(T3! / 2)
   IF Search.From.Time < False OR Search.To.Time < False THEN
      GOTO Boot.Error
   END IF
END IF

' get extended date\time switches
Creation.Time = ParseLine("/1")
Access.Time = ParseLine("/2")
Modified.Time = ParseLine("/3")
IF Creation.Time = False THEN
   IF Access.Time = False THEN
      IF Modified.Time = False THEN
         Modified.Time = True
      END IF
   END IF
END IF

' add one-half second
IF Creation.Time THEN
   Search.From.Time = Search.From.Time + Half.Second1
   Search.To.Time = Search.To.Time + Half.Second2
END IF

' get nested switch from command line
Imbedded = INSTR(UCASE$(Command.Line), "/N")
IF Imbedded THEN
   Last.Switch = Imbedded - 1
   Command.Line = LEFT$(Command.Line, Imbedded - 1) + MID$(Command.Line, Imbedded + 2)
   GOSUB Get.Numeric
   Nested.Recurse = Var%
END IF

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

' check trailing command line
Command.Line = RTRIM$(Command.Line)
IF Last.Switch THEN
   IF LEN(Command.Line) > Last.Switch THEN
      GOTO Boot.Error
   END IF
END IF

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

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

' store directory
Directory.ASCIIZ = "\" + RTRIM$(Directory.ASCIIZ) + CHR$(0)

' 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

' check pipe length
InregsX.AX = &H4202 ' eof
InregsX.BX = 0 ' stdin
InregsX.CX = 0
InregsX.DX = 0
Call InterruptX(&H21, InregsX, OutregsX)
If OutregsX.AX > 0 Then
   Pipe.Redirect = True
   InregsX.AX = &H4200
   InregsX.BX = 0 ' stdin
   InregsX.CX = 0
   InregsX.DX = 0
   Call InterruptX(&H21, InregsX, OutregsX)
Endif
If Pipe.Redirect = False Then
   DEF SEG = &H40
   X = PEEK(&H71)
   DEF SEG
   IF X = 64 THEN
      DEF SEG = &H40
      POKE &H71, 0
      DEF SEG
   END IF
Endif
DO
   ' check control break
   IF BreakIS THEN
      EXIT DO
   END IF

   ' get standard input
   Standard.Input$ = NUL

   If Pipe.Redirect Then
      DO
         ' read from device
         InregsX.AX = &H3F00
         InregsX.BX = 0 ' stdin
         InregsX.CX = 1 ' char
         InregsX.DS = VARSEG(Pipe.Buffer)
         InregsX.DX = VARPTR(Pipe.Buffer)
         Call InterruptX(&H21, InregsX, OutregsX)
         If (OutregsX.Flags AND &H1) = &H1 Then
            Exit Do
         Endif
         If (OutregsX.Flags AND &H1) = &H0 Then
            If OutregsX.AX = 0 Then
               Exit Do
            Endif

            ' store input
            Redirected.Input = True

            ' store character
            Char$ = Pipe.Buffer

            ' check input character
            SELECT CASE ASC(Char$)
            CASE 10, 26
            CASE 13
               EXIT DO
            CASE ELSE
               Standard.Input$ = Standard.Input$ + Char$
            END SELECT
         END IF
      LOOP
   END IF

   ' 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

   ' filename processing loop
   DO
      ' check control break
      IF BreakIS THEN
         EXIT DO
      END IF

      ' 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
         Drive.Search = LEFT$(Command.Work, 1)
         Command.Work = MID$(Command.Work, 3)
      ELSE
	 Drive.Search = Current.Drive
      END IF
      Drive.Search = UCASE$(Drive.Search)

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

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

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

         ' store current directory
         Directory$ = LEFT$(ASCIIZ, INSTR(ASCIIZ, CHR$(0)) - 1)
         IF Directory$ = "\" THEN
            Directory.Search$ = "\" 
         ELSE
            Directory.Search$ = "\" + Directory$
         END IF
         IF Command.Work <> NUL THEN
            IF Directory.Search$ = "\" + Command.Work THEN
               Directory.Search$ = "\" + Command.Work
            ELSE
               IF LEFT$(Command.Work, 1) <> "\" THEN
                  IF Directory.Search$ = "\" THEN
                     Directory.Search$ = "\" + Command.Work
                  ELSE
                     Directory.Search$ = Directory.Search$ + "\" + Command.Work
                  END IF
               ELSE
                  Directory.Search$ = Command.Work
               END IF
            END IF
         END IF

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

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

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

            ' call routine to search for files
            IF Continuous.Display = False THEN
               COLOR Yellow, Black
               Display.Lines = Display.Lines + 1
               PRINT "Searching: " + Directory.Search$
            END IF

            ' subroutine to search directory filenames
            CALL Directories(Directory.Search$)

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

            ' check windows dos
            IF Windows.Detected THEN
               ' restore current directory
               InregsX.AX = &H713B
               InregsX.DS = VARSEG(Directory.ASCIIZ)
               InregsX.DX = VARPTR(Directory.ASCIIZ)
               CALL InterruptX(&H21, InregsX, OutregsX)
            ELSE
               ' restore current directory
               InregsX.AX = &H3B00
               InregsX.DS = VARSEG(Directory.ASCIIZ)
               InregsX.DX = VARPTR(Directory.ASCIIZ)
               CALL InterruptX(&H21, InregsX, OutregsX)
            END IF
         END IF
      END IF

      ' check search filename
      IF Command.Line = NUL THEN
	 EXIT DO
      END IF

      ' check quit searching
      IF Quit.Searching THEN
	 EXIT DO
      END IF
   LOOP

   ' check search filename
   IF Standard.Input$ = NUL THEN
      EXIT DO
   END IF

   ' check quit searching flag
   IF Quit.Searching THEN
      EXIT DO
   END IF
LOOP

End.Stree:

' 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 = ASC(Current.Drive) - 65
CALL InterruptX(&H21, InregsX, OutregsX)

' check windows dos
IF Windows.Detected THEN
   ' restore current directory
   InregsX.AX = &H713B
   InregsX.DS = VARSEG(Directory.ASCIIZ)
   InregsX.DX = VARPTR(Directory.ASCIIZ)
   CALL InterruptX(&H21, InregsX, OutregsX)
ELSE
   ' restore current directory
   InregsX.AX = &H3B00
   InregsX.DS = VARSEG(Directory.ASCIIZ)
   InregsX.DX = VARPTR(Directory.ASCIIZ)
   CALL InterruptX(&H21, InregsX, OutregsX)
END IF

' display counters
IF Continuous.Display = False THEN
   IF Wide.Display THEN
      IF Display.Length THEN
         PRINT
      END IF
   ENDIF
   COLOR Yellow, Black
   PRINT "Directories counted"; Directories.Counted
   Prompt$ = "Press <enter> to exit to DOS:"
   CALL MorePrompt(Prompt$, CHR$(13), Outpt$)
END IF

' restore key trapping
CALL RestInt

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 "Stree v2.8a: Directory search utility;"
 END IF
 RETURN

Get.Numeric:
 Var% = False
 DO
    Temp$ = MID$(Command.Line, Imbedded, 1)
    IF Temp$ >= "0" AND Temp$ <= "9" THEN
       Var% = Var% * 10 + VAL(Temp$)
       Command.Line = LEFT$(Command.Line, Imbedded - 1) + MID$(Command.Line, Imbedded + 1)
    ELSE
       EXIT DO
    END IF
 LOOP
 RETURN

' display program usage
Boot.Usage:
 ' restore key trapping
 CALL RestInt
 Var$=Inkey$
 ' make header
 COLOR White, Black
 PRINT "Stree v2.8a: Directory search utility;"
 COLOR Yellow, Black
 PRINT "Usage:"
 PRINT "   Stree [d:\path\][/ahos][/cdefgnrtuvwxyz][/123]"
 PRINT "Where:"
 PRINT "   /c  continuous display      /e  extended display"
 PRINT "   /f  short filename display  /g  skip current directory"
 PRINT "   /r  recurse directories     /nxxx  recurse levels override"
 PRINT "   /v  use 8.3 filenames       /u  strip leading drive letter"
 PRINT "   /w  wide list display       /x  truncate slash"
 PRINT "   /y  lowercase display       /z  suppress errors"
 PRINT "   display directory ranges; (/1  creation, /2 accessed, /3 modified):"
 PRINT "      /d  is range of file dates in form mm/dd/yyyy-mm/dd/yyyy"
 PRINT "      /t  is range of file times in form hh:mm:ss-hh:mm:ss"
 PRINT "   display directory attributes / prefix with:"
 PRINT "      a  archive, h  hidden, o  read-only, s  system"
 COLOR Plain, Black
 END

Boot.Error:
 CALL RestInt
 Var$=Inkey$
 COLOR White, Black
 PRINT "Command line error. Type Stree /? for help."
 COLOR Plain, Black
 END

' subroutine to access directories
SUB Directories (Directory.Search$)
 ' declare subroutine variables
 DIM DTAfile AS DTAtype
 DIM DTAfile2 AS DTAtype
 DIM Wfile.Handle AS INTEGER
 DIM Sfile.Handle AS INTEGER

 ' make directory filename
 IF INSTR(Directory.Search$, "?") OR INSTR(Directory.Search$, "*") THEN
    ASCIIZ.Sub = Directory.Search$ + CHR$(0)
 ELSE
    IF RIGHT$(Directory.Search$, 1) <> "\" THEN
       Directory.Search$ = Directory.Search$ + "\"
    END IF
    ASCIIZ.Sub = Directory.Search$ + "*.*" + CHR$(0)
 END IF

 ' make directory filename for attribute search
 IF Directory.Search$ = "\" THEN
    ASCIIZ2 = "\" + CHR$(0)
 ELSE
    IF INSTR(Directory.Search$, "?") OR INSTR(Directory.Search$, "*") THEN
       ASCIIZ2 = Directory.Search$ + CHR$(0)
    ELSE
       ASCIIZ2 = LEFT$(Directory.Search$, LEN(Directory.Search$) - 1) + CHR$(0)
    END IF
 END IF

 ' restore data segment dta
 GOSUB Restore.DTA

 ' check windows dos
 IF Windows.Detected THEN
    ' find first long filename
    InregsX.AX = &H714E
    InregsX.CX = &H37
    InregsX.SI = &H1
    InregsX.DS = VARSEG(ASCIIZ.Sub)
    InregsX.DX = VARPTR(ASCIIZ.Sub)
    InregsX.ES = VARSEG(TreeWDTA)
    InregsX.DI = VARPTR(TreeWDTA)
    CALL InterruptX(&H21, InregsX, OutregsX)
    Wfile.Handle = OutregsX.AX
 ELSE
    ' find first directory
    InregsX.AX = &H4E00
    InregsX.CX = &H37
    InregsX.DS = VARSEG(ASCIIZ.Sub)
    InregsX.DX = VARPTR(ASCIIZ.Sub)
    CALL InterruptX(&H21, InregsX, OutregsX)
 END IF

 ' check findirst error
 IF (OutregsX.Flags AND &H1) = &H1 THEN
    EXIT SUB
 END IF

 ' check windows dos
 IF Windows.Detected THEN
    ' find first long filename
    InregsX.AX = &H714E
    InregsX.CX = &H37
    InregsX.SI = &H1
    InregsX.DS = VARSEG(ASCIIZ2)
    InregsX.DX = VARPTR(ASCIIZ2)
    InregsX.ES = VARSEG(SWDTA)
    InregsX.DI = VARPTR(SWDTA)
    CALL InterruptX(&H21, InregsX, OutregsX)
    Sfile.Handle = OutregsX.AX

    ' store directory name
    Directory$ = SWDTA.ASCIIZshort
    Directory$ = LEFT$(Directory$, INSTR(Directory$, CHR$(0)) - 1)

    ' close long filename search
    InregsX.AX = &H71A1
    InregsX.BX = Sfile.Handle
    CALL InterruptX(&H21, InregsX, OutregsX)

    ' check directory length
    IF Short.Filenames THEN
       ' get windows short filename
       InregsX.AX = &H7160
       InregsX.CX = &H8001
       InregsX.DS = VARSEG(ASCIIZ2)
       InregsX.SI = VARPTR(ASCIIZ2)
       InregsX.ES = VARSEG(ASCIIZ3)
       InregsX.DI = VARPTR(ASCIIZ3)
       CALL InterruptX(&H21, InregsX, OutregsX)
       Directory$ = ASCIIZ3
       Directory$ = LEFT$(Directory$, INSTR(Directory$, CHR$(0)) - 1)
    END IF
 ELSE
    ' restore directory search dta
    InregsX.AX = &H1A00
    InregsX.DS = VARSEG(DTAfile2)
    InregsX.DX = VARPTR(DTAfile2)
    CALL InterruptX(&H21, InregsX, OutregsX)

    ' find first directory
    InregsX.AX = &H4E00
    InregsX.CX = &H37
    InregsX.DS = VARSEG(ASCIIZ2)
    InregsX.DX = VARPTR(ASCIIZ2)
    CALL InterruptX(&H21, InregsX, OutregsX)
    TempDTA = DTAfile2
    GOSUB Restore.DTA
 END IF

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

 ' store attribute
 Attribute = OutregsX.CX

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

    ' read half-second
    Millisecond = False
    IF Windows.Detected THEN
       IF Creation.Time THEN
          InregsX.AX = &H7143
          InregsX.BX = &H08
          InregsX.DS = VARSEG(ASCIIZ2)
          InregsX.DX = VARPTR(ASCIIZ2)
          CALL InterruptX(&H21, InregsX, OutregsX)
          Millisecond = OutregsX.SI
       END IF
    END IF

    ' store directory date
    CALL Make.Date

    ' check date\time range
    Valid.Date = True
    IF Search.From.Date OR Search.To.Date THEN
       IF File.Work.Date < Search.From.Date THEN
          Valid.Date = False
       END IF
       IF File.Work.Date > Search.To.Date THEN
          Valid.Date = False
       END IF
    END IF
    IF Search.From.Time OR Search.To.Time THEN
       File.Work.Time = INT(File.Work.Time)
       IF Creation.Time THEN
          IF Millisecond >= 100 THEN
             File.Work.Time = File.Work.Time + .5!
          END IF
          IF File.Work.Time < Search.From.Time THEN
             Valid.Date = False
          END IF
          IF File.Work.Time > Search.To.Time THEN
             Valid.Date = False
          END IF
       END IF
       File.Work.Time = INT(File.Work.Time)
       IF Modified.Time THEN
          Search.From.Time2! = Search.From.Time AND NOT(&H1F)
          Search.To.Time2! = Search.To.Time AND NOT(&H1F)
          IF File.Work.Time < Search.From.Time2! THEN
             Valid.Date = False
          END IF
          IF File.Work.Time > Search.To.Time2! THEN
             Valid.Date = False
          END IF
       END IF
    END IF

    ' check directory attribute
    Valid.Attribute = True

    ' check for read-only file
    IF Search.Readonly THEN
       IF (Attribute AND &H1) <> &H1 THEN
          Valid.Attribute = False
       END IF
    END IF

    ' check for hidden file
    IF Search.Hidden THEN
       IF (Attribute AND &H2) <> &H2 THEN
          Valid.Attribute = False
       END IF
    END IF

    ' check for system file
    IF Search.System THEN
       IF (Attribute AND &H4) <> &H4 THEN
          Valid.Attribute = False
       END IF
    END IF

    ' check for archive file
    IF Search.Archive THEN
       IF (Attribute AND &H20) <> &H20 THEN
          Valid.Attribute = False
       END IF
    END IF

    ' check for valid directory
    IF Valid.Date THEN
       IF Valid.Attribute THEN

          ' store directory name
          IF Windows.Detected AND Short.Filenames THEN
             Outpt$ = RTRIM$(Directory$)
          ELSE
             Outpt$ = RTRIM$(Directory.Search$)
          END IF
          IF Short.Display THEN
             IF RIGHT$(Outpt$, 1) = "\" THEN
                Outpt$ = LEFT$(Outpt$, LEN(Outpt$) -1)
             END IF
             FOR Imbedded = LEN(Outpt$) TO 1 STEP -1
                IF MID$(Outpt$, Imbedded, 1) = "\" THEN
                   Outpt$ = MID$(Outpt$, Imbedded + 1)
                   EXIT FOR
                END IF
             NEXT
          END IF
          IF Truncate.Slash THEN
             IF Outpt$ <> "\" THEN
                IF RIGHT$(Outpt$, 1) = "\" THEN
                   Outpt$ = LEFT$(Outpt$, LEN(Outpt$) - 1)
                END IF
             END IF
          END IF
          IF Short.Filenames = False OR Short.Display THEN
             IF MID$(Outpt$, 2, 1) <> ":" THEN
                IF LEFT$(Directory.Search$, 2) <> "\\" THEN
                   Outpt$ = Drive.Search + ":" + Outpt$
                END IF
             END IF
          END IF
          IF LEFT$(Directory.Search$, 2) = "\\" THEN
             IF MID$(Outpt$, 2, 1) = ":" THEN
                Outpt$ = MID$(Outpt$, 3)
             END IF
          END IF
          IF Strip.Drive THEN
             IF MID$(Outpt$, 2, 1) = ":" THEN
                Outpt$ = MID$(Outpt$, 3)
             END IF
          END IF
          IF Display.Lowercase THEN
             Outpt$ = LCASE$(Outpt$)
          ELSE
             IF Windows.Detected = False THEN
                Outpt$ = UCASE$(Outpt$)
             END IF
          END IF

          ' set directory flag
          Flag = True
          ' check to ignore first directory
          IF Check.Root THEN
             ' check flag already set
             IF First.Dir = False THEN
                First.Dir = True ' reset flag
                Flag = False ' set flag
             END IF
          END IF
          ' display directory
          IF Flag THEN
             ' increment directories counted
             Directories.Counted = Directories.Counted + 1!
             ' check wide display output
             IF Wide.Display THEN
                COLOR Yellow, Black
                Outpt$ = LEFT$(Outpt$, 14)
                PRINT Outpt$;
                PRINT SPACE$(15 - LEN(Outpt$));
                ' count directories in one line
                Display.Length = Display.Length + 1
                IF Display.Length = 5 THEN
                   ' reset counters
                   PRINT
                   Display.Length = False
                   Display.Lines = Display.Lines + 1
                   GOSUB Page.Prompt
                   IF Quit.Searching THEN
                      EXIT SUB
                   END IF
                END IF
             ELSE
                ' store length of directory name
                Length = LEN(Outpt$)
                ' calculate length variable
                GOSUB Calc.Length
                ' check for overflow past more prompt
                ' before directory displayed
                IF Continuous.Display = False THEN
                   ' reset display line counter
                   IF Display.Lines > 22 THEN
                      GOSUB Page.Prompt
                      IF Quit.Searching THEN
                         EXIT SUB
                      END IF
                      ' recalculate length
                      GOSUB Calc.Length
                   END IF
                END IF
                ' display full directory pathname
                COLOR Yellow, Black
                PRINT Outpt$
                ' check for paginate
                ' after directory displayed
                IF Continuous.Display = False THEN
                   GOSUB Page.Prompt
                   IF Quit.Searching THEN
                      EXIT SUB
                   END IF
                END IF
                ' check output type
                IF Extended.List THEN
                   ' display extended directory attributes
                   CALL Display.List
                   ' check for paginate
                   ' after extended info displayed
                   IF Continuous.Display = False THEN
                      GOSUB Page.Prompt
                      IF Quit.Searching THEN
                         EXIT SUB
                      END IF
                   END IF
                END IF
             END IF
          END IF
       END IF
    END IF
 END IF

 ' restore subroutine dta
 GOSUB Restore.DTA

 ' check to recurse directories
 IF Recurse.Directories THEN

    ' recurse directories
    DO
       ' check control break
       IF BreakIS THEN
          Quit.Searching = True
       END IF

       ' check quit searching
       IF Quit.Searching THEN
          EXIT SUB
       END IF

       ' check directory attribute
       IF Windows.Detected THEN
          Dir.Attribute = ASC(TreeWDTA.FileBits)
       ELSE
          Dir.Attribute = ASC(DTAfile.FileBits)
       END IF
       IF (Dir.Attribute AND &H10) = &H10 THEN

          ' store directory name
          IF Windows.Detected THEN
             Directory$ = TreeWDTA.ASCIIZfull
          ELSE
             Directory$ = DTAfile.ASCIIZfilename
          END IF
          Directory$ = LEFT$(Directory$, INSTR(Directory$, CHR$(0)) - 1)

          ' check directory name
          IF Directory$ <> "." AND Directory$ <> ".." THEN

             ' make next search directory
             IF INSTR(Directory.Search$, "?") OR INSTR(Directory.Search$, "*") THEN
                New.Directory$ = Directory.Search$
                FOR Imbedded = LEN(New.Directory$) TO 1 STEP -1
                   IF MID$(New.Directory$, Imbedded, 1) = "\" THEN
                      EXIT FOR
                   END IF
                NEXT
                New.Directory$ = LEFT$(New.Directory$, Imbedded - 1)
                IF New.Directory$ = "" THEN
                   Next.Directory$ = "\" + Directory$
                ELSE
                   Next.Directory$ = New.Directory$ + "\" + Directory$
                END IF
             ELSE
                Next.Directory$ = Directory.Search$ + Directory$
             END IF

             ' check recursion levels
             Recursion% = True
             IF Nested.Recurse > False THEN
                Nested.Levels = Nested.Levels + 1
                IF Nested.Levels >= Nested.Recurse THEN
                   Recursion% = False
                END IF
             END IF

             ' recursively search subdirectories
             IF Recursion% THEN
                CALL Directories(Next.Directory$)
             END IF
             IF Nested.Recurse > False THEN
                Nested.Levels = Nested.Levels - 1
             END IF

             ' restore data segment dta
             GOSUB Restore.DTA
          END IF
       END IF

       ' check windows dos
       IF Windows.Detected THEN
          ' find next long filename
          InregsX.AX = &H714F
          InregsX.BX = Wfile.Handle
          InregsX.SI = &H1
          InregsX.ES = VARSEG(TreeWDTA)
          InregsX.DI = VARPTR(TreeWDTA)
          CALL InterruptX(&H21, InregsX, OutregsX)
       ELSE
          ' find next directory
          InregsX.AX = &H4F00
          CALL InterruptX(&H21, InregsX, OutregsX)
       END IF

       ' check findnext error
       IF (OutregsX.Flags AND &H1) = &H1 THEN
          EXIT DO
       END IF
    LOOP
 END IF

 ' check windows dos
 IF Windows.Detected THEN
    ' close long filename search
    InregsX.AX = &H71A1
    InregsX.BX = Wfile.Handle
    CALL InterruptX(&H21, InregsX, OutregsX)
 END IF
 EXIT SUB

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

' check for page length
Page.Prompt:
 IF Display.Lines >= 22 THEN
    Display.Lines = False
    IF Continuous.Display = False THEN
       IF More.Display = False THEN
          Prompt$ = "More(y/n/c)?"
          CALL MorePrompt(Prompt$, "ync", Outpt2$)
          IF BreakIS THEN
             Outpt2$ = "n"
          END IF
          SELECT CASE Outpt2$
          CASE "c"
             More.Display = True
          CASE "n"
             Quit.Searching = True
          END SELECT
       END IF
    END IF
 END IF
 RETURN

' calculates line length,
' increments total lines displayed
Calc.Length:
 IF Length > 240 THEN
    Display.Lines = Display.Lines + 4
 ELSE
    IF Length > 160 THEN
       Display.Lines = Display.Lines + 3
    ELSE
       IF Length > 80 THEN
          Display.Lines = Display.Lines + 2
       ELSE
          Display.Lines = Display.Lines + 1
       END IF
    END IF
 END IF
 RETURN
END SUB

' routine to display extended directory attributes
SUB Display.List
 Length = False
 IF Windows.Detected THEN
    ' store file creation date\time
    COLOR Red, Black
    IF Creation.Time THEN
       CALL Make.Date1
       GOSUB Convert.Date
       GOSUB Convert.Time
       Outpt$ = File.Date$ + " " + File.Time$
       Length = Length + LEN(Outpt$)
       GOSUB Line.Check
       PRINT Outpt$;
    END IF
    IF Access.Time THEN
       CALL Make.Date2
       GOSUB Convert.Date
       IF Creation.Time THEN
          Length = Length + 1
          GOSUB Line.Check
          PRINT "\";
       END IF
       Outpt$ = File.Date$
       Length = Length + LEN(Outpt$)
       GOSUB Line.Check
       PRINT Outpt$;
    END IF
    IF Modified.Time THEN
       CALL Make.Date3
       GOSUB Convert.Date
       GOSUB Convert.Time
       IF Creation.Time OR Access.Time THEN
          Length = Length + 1
          GOSUB Line.Check
          PRINT "\";
       END IF
       Outpt$ = File.Date$ + " " + LEFT$(File.Time$, 5)
       Length = Length + LEN(Outpt$)
       GOSUB Line.Check
       PRINT Outpt$;
    END IF
 ELSE
    ' construct file date and time for display
    GOSUB Convert.Date
    GOSUB Convert.Time

    ' display file date\time
    Outpt$ = File.Date$ + " " + LEFT$(File.Time$, 5)
    Length = Length + LEN(Outpt$)
    GOSUB Line.Check
    COLOR Red, Black
    PRINT Outpt$;

    ' check extended directory date\time
    IF File.Access.Date > 0 THEN
       File.Work.Date = File.Access.Date
       GOSUB Convert.Date
       Outpt$ = "(" + File.Date$ + ")"
       Length = Length + LEN(Outpt$)
       GOSUB Line.Check
       COLOR Cyan, Black
       PRINT Outpt$;
    END IF
 END IF

 ' display file attributes
 IF (Attribute AND &H1) = &H1 THEN
    Outpt$ = " Read-only"
    Length = Length + LEN(Outpt$)
    GOSUB Line.Check
    COLOR White, Black
    PRINT Outpt$;
 END IF
 IF (Attribute AND &H2) = &H2 THEN
    Outpt$ = " Hidden"
    Length = Length + LEN(Outpt$)
    GOSUB Line.Check
    COLOR White, Black
    PRINT Outpt$;
 END IF
 IF (Attribute AND &H4) = &H4 THEN
    Outpt$ = " System"
    Length = Length + LEN(Outpt$)
    GOSUB Line.Check
    COLOR White, Black
    PRINT Outpt$;
 END IF
 IF (Attribute AND &H20) = &H20 THEN
    Outpt$ = " Archive"
    Length = Length + LEN(Outpt$)
    GOSUB Line.Check
    COLOR White, Black
    PRINT Outpt$;
 END IF
 IF Length THEN
    PRINT
 END IF
 Display.Lines = Display.Lines + Temp.Lines
 EXIT SUB

Convert.Date:
 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)
 RETURN

Convert.Time:
 File.Work.Time = INT(File.Work.Time) ' remove half-second
 HourTemp! = INT(File.Work.Time / 2048)
 MinuteTemp! = INT((File.Work.Time AND &H7E0) / 32)
 SecondsTemp! = INT((File.Work.Time AND &H1F) * 2)
 IF Millisecond >= 100 THEN ' add one second
    SecondsTemp! = SecondsTemp! + 1!
 END IF
 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)
 RETURN

' check for page length
Line.Check:
 ' calculate lines past current line display counter
 IF Length THEN
    Temp.Lines = 1
    IF Length > 80 THEN
       Temp.Lines = 2
    END IF
 END IF
 ' check overflow past line 22
 IF Display.Lines + Temp.Lines > 22 THEN
    ' page break
    IF Length THEN
       IF Continuous.Display = False THEN
          PRINT
       END IF
    END IF
    ' reset counters
    Length = False
    Display.Lines = False
    IF Continuous.Display = False THEN
       IF More.Display = False THEN
          ' prompt for more
          Prompt$ = "More(y/n/c)?"
          CALL MorePrompt(Prompt$, "ync", Outpt2$)
          IF BreakIS THEN
             Outpt2$ = "n"
          END IF
          SELECT CASE Outpt2$
          CASE "c"
             More.Display = True
          CASE "n"
             Quit.Searching = True
          END SELECT
       END IF
    END IF
 END IF
 RETURN
END SUB

SUB Make.Date
 IF Windows.Detected THEN
    ' store file creation date\time
    IF Creation.Time THEN
       CALL Make.Date1
    ELSE
       IF Access.Time THEN
          CALL Make.Date2
       ELSE
          IF Modified.Time THEN
             CALL Make.Date3
          END IF
       END IF
    END IF
 ELSE
    ' store file creation date\time
    File.Work.Time = ASC(MID$(TempDTA.FileTime, 2, 1))
    File.Work.Time = File.Work.Time * &H100 + ASC(MID$(TempDTA.FileTime, 1, 1))
    File.Work.Date = ASC(MID$(TempDTA.FileDate, 2, 1))
    File.Work.Date = File.Work.Date * &H100 + ASC(MID$(TempDTA.FileDate, 1, 1))
    CALL Get.Attributes
 END IF
END SUB

SUB Make.Date1
 File.Work.Time = ASC(MID$(SWDTA.CreateTime, 2, 1))
 File.Work.Time = File.Work.Time * &H100 + ASC(MID$(SWDTA.CreateTime, 1, 1))
 File.Work.Date = ASC(MID$(SWDTA.CreateTime, 4, 1))
 File.Work.Date = File.Work.Date * &H100 + ASC(MID$(SWDTA.CreateTime, 3, 1))
END SUB

SUB Make.Date2
 File.Work.Time = ASC(MID$(SWDTA.AccessTime, 2, 1))
 File.Work.Time = File.Work.Time * &H100 + ASC(MID$(SWDTA.AccessTime, 1, 1))
 File.Work.Date = ASC(MID$(SWDTA.AccessTime, 4, 1))
 File.Work.Date = File.Work.Date * &H100 + ASC(MID$(SWDTA.AccessTime, 3, 1))
END SUB

SUB Make.Date3
 File.Work.Time = ASC(MID$(SWDTA.ModTime, 2, 1))
 File.Work.Time = File.Work.Time * &H100 + ASC(MID$(SWDTA.ModTime, 1, 1))
 File.Work.Date = ASC(MID$(SWDTA.ModTime, 4, 1))
 File.Work.Date = File.Work.Date * &H100 + ASC(MID$(SWDTA.ModTime, 3, 1))
END SUB

' routine gets extended file date\time in dos 7.00
SUB Get.Attributes
 ' declare some variables
 DIM DTAfile2 AS DTAtype2
 DIM FCBfile AS FCBtype
 DIM Current.DTA.Seg AS INTEGER
 DIM Current.DTA.Off AS INTEGER

 ' reset file last access date
 File.Access.Date = False

 ' check for dos 7.00
 IF Windows.DOS = False THEN
    EXIT SUB
 END IF

 ' store current dta
 InregsX.AX = &H2F00
 CALL InterruptX(&H21, InregsX, OutregsX)
 Current.DTA.Seg = OutregsX.ES
 Current.DTA.Off = OutregsX.BX

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

 ' change to directory
 InregsX.AX = &H3B00
 InregsX.DS = VARSEG(ASCIIZ2)
 InregsX.DX = VARPTR(ASCIIZ2)
 CALL InterruptX(&H21, InregsX, OutregsX)

 ' check carry flag error
 IF (OutregsX.Flags AND &H1) = &H0 THEN
    ' store directory name
    FCBfile.ExtendedFCB = CHR$(255)
    FCBfile.FileAttribute = CHR$(&H37)
    FCBfile.Filename = "."
    FCBfile.Extension = ""
    FCBfile.DriveNumber = CHR$(ASC(Drive.Search) - 64)

    ' find first fcb
    InregsX.AX=&H1100
    InregsX.DS=VARSEG(FCBfile)
    InregsX.DX=VARPTR(FCBfile)
    CALL InterruptX(&H21,InregsX,OutregsX)

    ' check fcb error
    IF (OutregsX.AX AND &HFF) = &H0 THEN
       ' read extended date\time
       File.Access.Date = ASC(MID$(DTAfile2.LastAccessDate, 2, 1))
       File.Access.Date = File.Access.Date * &H100 + ASC(MID$(DTAfile2.LastAccessDate, 1, 1))
    END IF
 END IF

 ' restore current dta
 InregsX.AX = &H1A00
 InregsX.DS = Current.DTA.Seg
 InregsX.DX = Current.DTA.Off
 CALL InterruptX(&H21, InregsX, OutregsX)
END SUB

' 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
 IF Wide.Display THEN
    IF Display.Length THEN
       Display.Length = False
       PRINT
    END IF
 ENDIF
 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.Stree
 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
    InregsX2 = InregsX
    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
    InregsX = InregsX2
    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 Redirected.Input THEN
    DEF SEG = &H40
    X = PEEK(&H71)
    DEF SEG
    IF X = 64 THEN
       Var = True
    END IF
 END IF
 IF KeyIS THEN
    IF OutregsX.AX = False THEN
       Var = True
       DEF SEG = &H40
       POKE &H71, 64
       DEF SEG
    END IF
 END IF
 IF Var THEN
    Continuous.Display = True
 END IF
 BreakIS = Var
END FUNCTION

' checks keyboard buffer
FUNCTION KeyIS
 InregsX3 = InregsX
 InregsX.AX = &H0100
 CALL InterruptX(&H16, InregsX, OutregsX)
 InregsX = InregsX3
 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
