REM file: Treedel.bas - Public Domain DOS Utility
REM Version 1.0a created 05/22/1995
REM Version 1.1a created 08/30/1995
REM Version 1.2a created 02/20/1998
REM Version 1.3a created 06/11/1999
REM Version 1.4a created 03/06/2001
REM Version 1.5a created 09/13/2006

' 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 Plain = 7
CONST Red = 12
CONST White = 15
CONST Yellow = 14

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

' declare subroutines
DECLARE SUB TreeDirectories (D$)
DECLARE SUB Directories (D$)
DECLARE SUB DeleteFiles (D$)
DECLARE SUB DeleteDirectory (D$)
DECLARE SUB CheckAttribute (X%, V%)

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

' initialize filename buffers
DIM ASCIIZ AS STRING * 260
COMMON SHARED ASCIIZ.Sub AS STRING * 260, ASCIIZ.Tree AS STRING * 260

' initialize drive variables
COMMON SHARED Drive.Number AS INTEGER, Current.Drive AS INTEGER

' initialize directory variables
COMMON SHARED Current.Directory AS STRING * 260

' 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 work variables
COMMON SHARED Continuous.Display AS INTEGER, Display.Errors AS INTEGER
COMMON SHARED Prompt.Delete AS INTEGER, Quit.Searching AS INTEGER
COMMON SHARED Display.Lowercase AS INTEGER, Short.Display AS INTEGER
COMMON SHARED SubWDTA AS WDTAtype, TreeWDTA AS WDTAtype
COMMON SHARED Windows.Detected AS INTEGER, Add.Slash AS INTEGER

' declare attribute variables
COMMON SHARED No.Touch.Archive AS INTEGER, No.Touch.Hidden AS INTEGER
COMMON SHARED No.Touch.Readonly AS INTEGER, No.Touch.System AS INTEGER
COMMON SHARED No.Touch.Any AS INTEGER, Touch.Any AS INTEGER
COMMON SHARED Touch.Archive AS INTEGER, Touch.Hidden AS INTEGER
COMMON SHARED Touch.Readonly AS INTEGER, Touch.System 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
COMMON SHARED Last.Switch AS INTEGER, Pipe.Buffer AS STRING * 1
COMMON SHARED Redirected.Input 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$))
    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 

' 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

' 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

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

' get switches from command line
No.Touch.Archive = ParseLine ("//A")
No.Touch.Hidden = ParseLine ("//H")
No.Touch.Readonly = ParseLine ("//O")
No.Touch.System = ParseLine ("//S")
No.Touch.Any = ParseLine ("//Y")
Touch.Archive = ParseLine ("/A")
Touch.Hidden = ParseLine ("/H")
Touch.Readonly = ParseLine ("/O")
Touch.System = ParseLine ("/S")
Touch.Any = ParseLine ("/Y")
Continuous.Display = ParseLine ("/C")
Short.Display = ParseLine ("/D")
Prompt.Delete = ParseLine ("/P")
Display.Lowercase = ParseLine ("/U")
Add.Slash = ParseLine ("/X")
Display.Errors = ParseLine ("/Z")
Control.Break = ParseLine ("/~")
Var = ParseLine("/_")

' recheck command line
IF INSTR(Command.Line, "/") THEN
   GOTO Boot.Error
END IF
Command.Line = RTRIM$(Command.Line)
IF Last.Switch THEN
   IF LEN(Command.Line) > Last.Switch THEN
      GOTO Boot.Error
   END IF
END IF

' set searching work variables
Quit.Searching = False

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

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

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

      ' check error flag
      IF (OutregsX.Flags AND &H1) = &H0 THEN
         ' store current directory
         Directory.Search$ = LEFT$(ASCIIZ, INSTR(ASCIIZ, CHR$(0)) - 1)
         IF LEFT$(Command.Work, 1) = "\" THEN
            Directory.Search$ = Command.Work
         ELSE
            Directory.Search$ = Directory.Search$ + "\" + Command.Work
         END IF
         IF LEFT$(Directory.Search$, 1) <> "\" THEN
            Directory.Search$ = "\" + Directory.Search$
         END IF
         IF RIGHT$(Directory.Search$, 1) = "\" THEN
            Directory.Search$ = Directory.Search$ + "*.*"
         END IF
         Command.Work = NUL

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

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

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

         ' check error flag
         IF (OutregsX.Flags AND &H1) = &H0 THEN
            ' store directory
            IF LEN(Current.Directory) = False THEN
               Current.Directory = "\"
            END IF
            IF LEFT$(Current.Directory, 1) <> "\" THEN
               Current.Directory = "\" + Current.Directory
            END IF
            Current.Directory = Current.Directory + CHR$(0)

            ' check to display
            IF Continuous.Display = False THEN
               IF LEFT$(Directory.Search$, 2) = "\\" THEN
                  IF Display.Lowercase THEN
                     Prompt$ = LCASE$(Directory.Search$)
                  ELSE
                     IF Windows.Detected THEN
                        Prompt$ = Directory.Search$
                     ELSE
                        Prompt$ = UCASE$(Directory.Search$)
                     END IF
                  END IF
               ELSE
                  IF Display.Lowercase THEN
                     Prompt$ = LCASE$(CHR$(Drive.Number + 65) + ":" + Directory.Search$)
                  ELSE
                     IF Windows.Detected THEN
                        Prompt$ = CHR$(Drive.Number + 65) + ":" + Directory.Search$
                     ELSE
                        Prompt$ = UCASE$(CHR$(Drive.Number + 65) + ":" + Directory.Search$)
                     END IF
                  END IF
               END IF
               COLOR Yellow, Black
               PRINT "Searching: " + Prompt$
            END IF

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

            ' call routine to search for directories
            CALL TreeDirectories(Directory.Search$)

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

            ' check carry flag error
            IF (OutregsX.Flags AND &H1) = &H1 THEN
               ' reset to root directory
               Current.Directory = "\" + CHR$(0)

               ' check windows dos
               IF Windows.Detected THEN
                  ' restore current directory
                  InregsX.AX = &H713B
                  InregsX.DS = VARSEG(Current.Directory)
                  InregsX.DX = VARPTR(Current.Directory)
                  CALL InterruptX(&H21, InregsX, OutregsX)
               ELSE
                  ' restore current directory
                  InregsX.AX = &H3B00
                  InregsX.DS = VARSEG(Current.Directory)
                  InregsX.DX = VARPTR(Current.Directory)
                  CALL InterruptX(&H21, InregsX, OutregsX)
               END IF
            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.Treedel:

' 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
CALL InterruptX(&H21, InregsX, OutregsX)

' display end program
IF Continuous.Display = False THEN
   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 "Treedel v1.5a: Directory delete utility; "
 END IF
 RETURN

' display program usage
Boot.Usage:
 ' restore key trapping
 CALL RestInt
 Var$=Inkey$
 ' make header
 COLOR White, Black
 PRINT "Treedel v1.5a: Directory delete utility; "
 COLOR Yellow, Black
 PRINT "Usage:"
 PRINT "   Treedel [d:]\path\ [//ahosy][/cdpuyz]"
 PRINT "Where:"
 PRINT "   /c  continuous display"
 PRINT "   /d  short file display"
 PRINT "   /p  don't prompt before deleting"
 PRINT "   /u  display lowercase"
 PRINT "   /y  add trailing slash"
 PRINT "   /z  suppress error messages"
 PRINT "   delete directories with attributes:"
 PRINT "     // prefix to not delete directories with,"
 PRINT "     / prefix to delete directories only with,"
 PRINT "       a  archive, h  hidden, o  read-only, s  system, y  none"
 COLOR Plain, Black
 END

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

' subroutine to delete a directory
SUB DeleteDirectory (Directory$)
 ' declare subroutine variables
 DIM ASCIIZ AS STRING * 260

 ' store directory filename
 ASCIIZ = LEFT$(Directory$, LEN(Directory$) - 1) + CHR$(0)

 ' check windows dos
 IF Windows.Detected THEN
    ' delete directory
    InregsX.AX = &H713A
    InregsX.DS = VARSEG(ASCIIZ)
    InregsX.DX = VARPTR(ASCIIZ)
    CALL InterruptX(&H21, InregsX, OutregsX)
 ELSE
    ' delete directory
    InregsX.AX = &H3A00
    InregsX.DS = VARSEG(ASCIIZ)
    InregsX.DX = VARPTR(ASCIIZ)
    CALL InterruptX(&H21, InregsX, OutregsX)
 END IF
END SUB

' subroutine to delete files in a directory in dos
SUB DeleteFiles (Directory$)
 ' declare subroutine variables
 DIM ASCIIZ AS STRING * 260
 DIM ASCIIZ1 AS STRING * 260
 DIM ASCIIZ2 AS STRING * 261
 DIM FCBfile AS FCBtype

 ' make filename
 ASCIIZ = LEFT$(Directory$, LEN(Directory$) - 1) + CHR$(0)

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

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

    ' ambiguate path
    ASCIIZ1 = LEFT$(Directory$, LEN(Directory$) - 1) + CHR$(0)
    InregsX.AX = &H7160
    InregsX.CX = &H8001
    InregsX.DS = VARSEG(ASCIIZ1)
    InregsX.SI = VARPTR(ASCIIZ1)
    InregsX.ES = VARSEG(ASCIIZ2)
    InregsX.DI = VARPTR(ASCIIZ2)
    CALL InterruptX(&H21, InregsX, OutregsX)
    ASCIIZ = ASCIIZ2

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

 ' check error flag
 IF (OutregsX.Flags AND &H1) = &H0 THEN
    ' store fcb
    FCBfile.ExtendedFCB = CHR$(&HFF)
    FCBfile.FileAttribute = CHR$(&H27)
    FCBfile.DriveNumber = CHR$(Drive.Number + 1)
    FCBfile.Filename = "????????"
    FCBfile.Extension = "???"

    ' delete filenames
    OutregsX.Flags = &H0
    InregsX.AX = &H1300
    InregsX.DS = VARSEG(FCBfile)
    InregsX.DX = VARPTR(FCBfile)
    CALL InterruptX(&H21, InregsX, OutregsX)

    ' check fcb error flag
    IF (OutregsX.AX AND &HFF) = &HFF THEN
       ' check display errors flag
       IF Display.Errors = False THEN
          CALL DisplayError ("Error deleting files.")
       END IF
    END IF
 END IF

 ' change to root directory
 ASCIIZ = "\" + CHR$(0)
 InregsX.AX = &H3B00
 InregsX.DS = VARSEG(ASCIIZ)
 InregsX.DX = VARPTR(ASCIIZ)
 CALL InterruptX(&H21, InregsX, OutregsX)
END SUB

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

 ' make directory filename
 ASCIIZ.Tree = Directory.Search$ + CHR$(0)
 GOSUB Restore.TDTA

 ' check windows dos
 IF Windows.Detected THEN
    ' find first long filename
    InregsX.AX = &H714E
    InregsX.CX = &H37
    InregsX.SI = &H1
    InregsX.DS = VARSEG(ASCIIZ.Tree)
    InregsX.DX = VARPTR(ASCIIZ.Tree)
    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.Tree)
    InregsX.DX = VARPTR(ASCIIZ.Tree)
    CALL InterruptX(&H21, InregsX, OutregsX)
 END IF

 ' check findirst error
 IF (OutregsX.Flags AND &H1) = &H1 THEN
    IF OutregsX.AX <> &H12 THEN
       CALL DisplayError ("Error accessing directory.")
    END IF
    EXIT SUB
 END IF

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

    ' check to quit
    IF Quit.Searching THEN
       EXIT DO
    END IF

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

    ' check directory attributes
    CALL CheckAttribute (Attribute, Check)
    IF Check THEN
       Attribute = False
    END IF

    ' check directory
    IF (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 directory
          FOR Imbedded = LEN(Directory.Search$) TO 1 STEP -1
             IF MID$(Directory.Search$, Imbedded, 1) = "\" THEN
                Directory$ = LEFT$(Directory.Search$, Imbedded) + Directory$
                EXIT FOR
             END IF
          NEXT
          IF RIGHT$(Directory$, 1) <> "\" THEN
             Directory$ = Directory$ + "\"
          END IF

          ' check to prompt
          Delete.Flag = False
          IF Prompt.Delete = False THEN
             IF LEFT$(Directory$, 2) = "\\" THEN
                IF Display.Lowercase THEN
                   Prompt$ = LCASE$(Directory$)
                ELSE
                   IF Windows.Detected THEN
                      Prompt$ = Directory$
                   ELSE
                      Prompt$ = UCASE$(Directory$)
                   END IF
                END IF
             ELSE
                IF Display.Lowercase THEN
                   Prompt$ = LCASE$(CHR$(Drive.Number + 65) + ":" + Directory$)
                ELSE
                   IF Windows.Detected THEN
                      Prompt$ = CHR$(Drive.Number + 65) + ":" + Directory$
                   ELSE
                      Prompt$ = UCASE$(CHR$(Drive.Number + 65) + ":" + Directory$)
                   END IF
                END IF
             END IF
             Prompt$ = "Delete subdirectories in " + Prompt$
             Prompt2$ = ""
             IF (Attribute AND &H20) = &H20 THEN
                Prompt2$ = Prompt2$ + "/a"
             END IF
             IF (Attribute AND &H1) = &H1 THEN
                Prompt2$ = Prompt2$ + "/o"
             END IF
             IF (Attribute AND &H2) = &H2 THEN
                Prompt2$ = Prompt2$ + "/h"
             END IF
             IF (Attribute AND &H4) = &H4 THEN
                Prompt2$ = Prompt2$ + "/s"
             END IF
             IF LEN(Prompt2$) THEN
                Prompt$ = Prompt$ + "{" + MID$(Prompt2$, 2) + "}"
             END IF
             Prompt$ = Prompt$ + "(y/n/c/q)?"
             CALL MorePrompt(Prompt$, "yncq", Outpt$)
             IF BreakIS THEN
                Outpt$ = "q"
             END IF
             SELECT CASE Outpt$
             CASE "c"
                Prompt.Delete = True
             CASE "n"
                Delete.Flag = True
             CASE "q"
                Quit.Searching = True
                EXIT DO
             END SELECT
          END IF

          ' check to continue deleteing
          IF Delete.Flag = False THEN
             ' store directory filename
             Temp.Dir$ = LEFT$(Directory$, LEN(Directory$) - 1)

             ' display directory
             IF Short.Display = False THEN
                IF LEFT$(Temp.Dir$, 2) <> "\\" THEN
                   Temp.Dir$ = CHR$(Drive.Number + 65) + ":" + Temp.Dir$
                END IF
             END IF
             IF Display.Lowercase THEN
                Temp.Dir$ = LCASE$(Temp.Dir$)
             ELSE
                IF Windows.Detected = False THEN
                   Temp.Dir$ = UCASE$(Temp.Dir$)
                END IF
             END IF
             IF Add.Slash THEN
                Temp.Dir$ = Temp.Dir$ + "\"
             END IF
             COLOR Yellow, Black
             IF Continuous.Display = False THEN
                PRINT "Deleting: " + Temp.Dir$
             ELSE
                PRINT Temp.Dir$
             END IF

             ' routine to delete directories
             CALL Directories(Directory$)
             GOSUB Restore.TDTA
          END IF
       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

 ' 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

 ' delete directory
 CALL DeleteDirectory(Directory$)
 EXIT SUB

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

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

 ' make directory filename
 ASCIIZ.Sub = Directory.Search$ + "*.*" + CHR$(0)
 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(SubWDTA)
    InregsX.DI = VARPTR(SubWDTA)
    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
    IF OutregsX.AX <> &H12 THEN
       CALL DisplayError ("Error accessing directory.")
    END IF
    EXIT SUB
 END IF

 ' delete filenames
 CALL DeleteFiles(Directory.Search$)
 GOSUB Restore.DTA

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

    ' check to quit
    IF Quit.Searching THEN
       EXIT DO
    END IF

    ' check directory attribute
    IF Windows.Detected THEN
       Attribute = ASC(SubWDTA.FileBits)
    ELSE
       Attribute = ASC(DTAfile.FileBits)
    END IF

    ' check directory
    IF (Attribute AND &H10) = &H10 THEN

       ' store directory name
       IF Windows.Detected THEN
          Directory$ = SubWDTA.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
          Next.Directory$ = Directory.Search$ + Directory$ + "\"

          ' recursively search subdirectories
          CALL Directories(Next.Directory$)
          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(SubWDTA)
       InregsX.DI = VARPTR(SubWDTA)
       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

 ' 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

 ' delete directory
 CALL DeleteDirectory(Directory.Search$)
 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

SUB CheckAttribute (Attribute, Check)
 Check = False
 ' check for readonly file
 IF Touch.Readonly THEN
    IF (Attribute AND &H1) <> &H1 THEN
       Check = True
       EXIT SUB
    END IF
 END IF
 IF No.Touch.Readonly THEN
    IF (Attribute AND &H1) = &H1 THEN
       Check = True
       EXIT SUB
    END IF
 END IF

 ' check for hidden file
 IF Touch.Hidden THEN
     IF (Attribute AND &H2) <> &H2 THEN
       Check = True
       EXIT SUB
    END IF
 END IF
 IF No.Touch.Hidden THEN
    IF (Attribute AND &H2) = &H2 THEN
       Check = True
       EXIT SUB
    END IF
 END IF

 ' check for system file
 IF Touch.System THEN
    IF (Attribute AND &H4) <> &H4 THEN
       Check = True
       EXIT SUB
    END IF
 END IF
 IF No.Touch.System THEN
    IF (Attribute AND &H4) = &H4 THEN
       Check = True
       EXIT SUB
    END IF
 END IF

 ' check for archive file
 IF Touch.Archive THEN
    IF (Attribute AND &H20) <> &H20 THEN
       Check = True
       EXIT SUB
    END IF
 END IF
 IF No.Touch.Archive THEN
    IF (Attribute AND &H20) = &H20 THEN
       Check = True
       EXIT SUB
    END IF
 END IF

 ' check for no attributes
 IF Touch.Any THEN
    IF (Attribute AND &H1) = &H1 THEN
       Check = True
       EXIT SUB
    END IF
    IF (Attribute AND &H2) = &H2 THEN
       Check = True
       EXIT SUB
    END IF
    IF (Attribute AND &H4) = &H4 THEN
       Check = True
       EXIT SUB
    END IF
    IF (Attribute AND &H20) = &H20 THEN
       Check = True
       EXIT SUB
    END IF
 END IF
 IF No.Touch.Any THEN
    IF (Attribute AND &H1) = &H0 THEN
       IF (Attribute AND &H2) = &H0 THEN
          IF (Attribute AND &H4) = &H0 THEN
             IF (Attribute AND &H20) = &H0 THEN
                Check = True
                EXIT SUB
             END IF
          END IF
       END IF
    END IF
 END IF
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 57
    Temp.Outpt$ = "Media error."
 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 White, Black
 PRINT Temp.Outpt$
 Prompt$ = "Press R to retry, Q to quit, C to continue:"
 CALL MorePrompt(Prompt$, "rqc", Outpt$)
 IF BreakIS THEN
    Outpt$ = "q"
 END IF
 SELECT CASE Outpt$
 CASE "r"
    RESUME
 CASE "q"
    Error.Level = True
    RESUME End.Treedel
 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 flag
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
