REM file: Xtree.bas - Public Domain DOS Utility
REM Version 1.0a created 10/09/2000
REM Version 1.1a created 03/03/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 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 subroutines
DECLARE SUB Directories (D$)

' 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

' 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 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 Quit.Searching AS INTEGER, More.Display 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

' declare directory variables
COMMON SHARED ASCIZ AS STRING * 260, ASCIZ2 AS STRING * 260
COMMON SHARED ASCIZ3 AS STRING * 260, ASCIZ.Sub AS STRING * 260
COMMON SHARED Directory.ASCIZ AS STRING * 260, Xtree.Dirs() AS STRING * 64
COMMON SHARED Dir.Count AS INTEGER, Max.Dirs AS INTEGER

' 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, Reverse.Sort AS INTEGER
COMMON SHARED Sort.Column AS INTEGER, 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 8192

' 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 

' reset counters
Dir.Count = False
Directories.Counted = 0!
Display.Lines = False
Max.Dirs = 128
More.Display = False
Nested.Levels = False
Quit.Searching = False
REDIM Xtree.Dirs(1 TO 128) AS STRING * 64

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

' check command line switches
Search.Archive = ParseLine ("/A")
Continuous.Display = ParseLine ("/C")
Check.Root = ParseLine ("/G")
Search.Hidden = ParseLine ("/H")
Search.Readonly = ParseLine ("/O")
Search.System = ParseLine ("/S")
Recurse.Directories = ParseLine ("/R")
Reverse.Sort = ParseLine ("/X")
Display.Errors = ParseLine ("/Z")
Control.Break = ParseLine ("/~")

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

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

' get sort column
Imbedded = INSTR(UCASE$(Command.Line), "/Y")
IF Imbedded THEN
   Command.Line = LEFT$(Command.Line, Imbedded - 1) + MID$(Command.Line, Imbedded + 2)
   GOSUB Get.Numeric
   Sort.Column = Var%
ELSE
   Sort.Column = 1
END IF

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

' 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 dos
IF Windows.Detected THEN
   ' get current directory
   InregsX.AX = &H7147
   InregsX.DX = ASC(Current.Drive) - 64
   InregsX.DS = VARSEG(Directory.ASCIZ)
   InregsX.SI = VARPTR(Directory.ASCIZ)
   CALL InterruptX(&H21, InregsX, OutregsX)
ELSE
   ' get current directory
   InregsX.AX = &H4700
   InregsX.DX = ASC(Current.Drive) - 64
   InregsX.DS = VARSEG(Directory.ASCIZ)
   InregsX.SI = VARPTR(Directory.ASCIZ)
   CALL InterruptX(&H21, InregsX, OutregsX)
END IF

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

' store directory
Directory.ASCIZ = "\" + RTRIM$(Directory.ASCIZ) + 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
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

   ' 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(ASCIZ)
         InregsX.SI = VARPTR(ASCIZ)
         CALL InterruptX(&H21, InregsX, OutregsX)
      ELSE
         ' get current directory
         InregsX.AX = &H4700
         InregsX.DX = ASC(Drive.Search) - 64
         InregsX.DS = VARSEG(ASCIZ)
         InregsX.SI = VARPTR(ASCIZ)
         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$(ASCIZ, INSTR(ASCIZ, 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
               PRINT "Searching: " + Directory.Search$
            END IF

            ' subroutine to search directory filenames
            CALL Directories(Directory.Search$)
         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
   IF Quit.Searching THEN
      EXIT DO
   END IF
LOOP

' check break flag
IF BreakIS THEN
   GOTO End.Xtree
END IF

' sort directories
Num = Dir.Count
Span = INT(Num / 2)
DO WHILE Span > False
   IF BreakIS THEN
      GOTO End.Xtree
   END IF
   FOR Start = Span TO Num - 1
      FOR Element = (Start - Span + 1) TO 1 STEP -Span
         Sort.Column1$ = MID$(Xtree.Dirs(Element), Sort.Column)
         Sort.Column2$ = MID$(Xtree.Dirs(Element + Span), Sort.Column)
	 IF Reverse.Sort THEN
	    IF Sort.Column2$ <= Sort.Column1$ THEN
	       EXIT FOR
	    END IF
	 ELSE
	    IF Sort.Column1$ <= Sort.Column2$ THEN
	       EXIT FOR
	    END IF
	 END IF
         SWAP Xtree.Dirs(Element), Xtree.Dirs(Element + Span)
         Swaps.Made = Swaps.Made + 1
      NEXT
   NEXT
   Span = INT(Span / 2)
LOOP

' check break flag
IF BreakIS THEN
   GOTO End.Xtree
END IF

' display directories
COLOR Yellow, Black
FOR Array.Line = 1 TO Dir.Count
   PRINT RTRIM$(Xtree.Dirs(Array.Line))
NEXT

End.Xtree:

' 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.ASCIZ)
   InregsX.DX = VARPTR(Directory.ASCIZ)
   CALL InterruptX(&H21, InregsX, OutregsX)
ELSE
   ' restore current directory
   InregsX.AX = &H3B00
   InregsX.DS = VARSEG(Directory.ASCIZ)
   InregsX.DX = VARPTR(Directory.ASCIZ)
   CALL InterruptX(&H21, InregsX, OutregsX)
END IF

' display counters
IF Continuous.Display = False THEN
   COLOR Yellow, Black
   PRINT "Directories counted"; Dir.Count
   PRINT "Swaps made"; Swaps.Made
   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 "Xtree v1.1a: Directory sort 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 "Xtree v1.1a: Directory sort utility;"
 COLOR Yellow, Black
 PRINT "Usage:"
 PRINT "   Xtree [d:\path\][/ahos][/cdgnrtxz][/123]"
 PRINT "Where:"
 PRINT "   /c  continuous display      /g  skip current directory"
 PRINT "   /r  recurse directories     /nxxx  recurse levels override"
 PRINT "   /x  reverse sort            /yxxx  sort by column"
 PRINT "   /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 Xtree /? 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
    ASCIZ.Sub = Directory.Search$ + CHR$(0)
 ELSE
    IF RIGHT$(Directory.Search$, 1) <> "\" THEN
       Directory.Search$ = Directory.Search$ + "\"
    END IF
    ASCIZ.Sub = Directory.Search$ + "*.*" + CHR$(0)
 END IF

 ' make directory filename for attribute search
 IF Directory.Search$ = "\" THEN
    ASCIZ2 = "\" + CHR$(0)
 ELSE
    IF INSTR(Directory.Search$, "?") OR INSTR(Directory.Search$, "*") THEN
       ASCIZ2 = Directory.Search$ + CHR$(0)
    ELSE
       ASCIZ2 = 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(ASCIZ.Sub)
    InregsX.DX = VARPTR(ASCIZ.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(ASCIZ.Sub)
    InregsX.DX = VARPTR(ASCIZ.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(ASCIZ2)
    InregsX.DX = VARPTR(ASCIZ2)
    InregsX.ES = VARSEG(SWDTA)
    InregsX.DI = VARPTR(SWDTA)
    CALL InterruptX(&H21, InregsX, OutregsX)
    Sfile.Handle = OutregsX.AX

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

    ' get windows short filename
    InregsX.AX = &H7160
    InregsX.CX = &H8001
    InregsX.DS = VARSEG(ASCIZ2)
    InregsX.SI = VARPTR(ASCIZ2)
    InregsX.ES = VARSEG(ASCIZ3)
    InregsX.DI = VARPTR(ASCIZ3)
    CALL InterruptX(&H21, InregsX, OutregsX)
    Directory$ = ASCIZ3
    Directory$ = LEFT$(Directory$, INSTR(Directory$, CHR$(0)) - 1)
 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(ASCIZ2)
    InregsX.DX = VARPTR(ASCIZ2)
    CALL InterruptX(&H21, InregsX, OutregsX)
    Directory$ = ASCIZ2
    Directory$ = LEFT$(Directory$, INSTR(Directory$, CHR$(0)) - 1)
    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(ASCIZ2)
    InregsX.DX = VARPTR(ASCIZ2)
    CALL InterruptX(&H21, InregsX, OutregsX)
 ELSE
    ' get file attributes
    InregsX.AX = &H4300
    InregsX.DS = VARSEG(ASCIZ2)
    InregsX.DX = VARPTR(ASCIZ2)
    CALL InterruptX(&H21, InregsX, OutregsX)
 END IF

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

    ' store attribute
    Attribute = OutregsX.CX

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

    ' check directory attribute
    Valid.Attribute = True

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

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

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

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

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

          ' store directory name
          Outpt$ = RTRIM$(Directory$)
          IF Outpt$ <> "\" THEN
             IF RIGHT$(Outpt$, 1) = "\" THEN
                Outpt$ = LEFT$(Outpt$, LEN(Outpt$) - 1)
             END IF
          END IF
          IF MID$(Outpt$, 2, 1) = ":" THEN
             Outpt$ = MID$(Outpt$, 3)
          END IF
          IF Outpt$ = "" THEN
             Outpt$ = "\"
          END IF

          ' set root directory flag
          Flag = True
          IF Check.Root THEN
             IF First.Dir = False THEN
                First.Dir = True
                Flag = False
             END IF
          END IF

          ' check directory flag
          IF Flag THEN
             ' increment directories counter
             Dir.Count = Dir.Count + 1
             ' compare counter to maximum array elements
             IF Dir.Count > Max.Dirs THEN
                ' increase maximum array elements
                Max.Dirs = Max.Dirs + 16
                ' resize directory array
                REDIM PRESERVE Xtree.Dirs(1 TO Max.Dirs) AS STRING * 64
             END IF
             ' store directory name in array
             Xtree.Dirs(Dir.Count) = Outpt$
          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
          Attribute = ASC(TreeWDTA.fileattr)
       ELSE
          Attribute = ASC(DTAfile.fileattr)
       END IF
       IF (Attribute AND &H10) = &H10 THEN

          ' store directory name
          IF Windows.Detected THEN
             Directory$ = TreeWDTA.ASCIZfull
          ELSE
             Directory$ = DTAfile.ASCIZfilename
          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
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 7
    Temp.Outpt$ = "Out of memory."
 CASE 9
    Temp.Outpt$ = "Subscript of out range."
 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.Xtree
 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

' 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

' 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

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 last modified 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 = 0

 ' 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(ASCIZ2)
 InregsX.DX = VARPTR(ASCIZ2)
 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
