REM file: Touchdir.bas - Public Domain DOS Utility
REM Version 1.0a created 09/29/1997

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

' declare subroutines
DECLARE SUB Directories (d$)
DECLARE SUB TouchDir (f$)

' 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: 'fcb.bi'
REM $INCLUDE: 'wdta.bi'

' declare functions
DECLARE FUNCTION ParseLine (S$)

' initialize filename buffer
DIM ASCIZ 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 Inregs AS RegType, Outregs AS RegType

' initialize switch variables
COMMON SHARED Continuous.Display AS INTEGER, Prompt.Files AS INTEGER
COMMON SHARED Touch.Archive AS INTEGER, Touch.Hidden AS INTEGER
COMMON SHARED Touch.System AS INTEGER, Touch.Modify AS INTEGER
COMMON SHARED Files.Counter AS INTEGER, Quit.Touching AS INTEGER
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 Touch.Any AS INTEGER, No.Touch.Any AS INTEGER
COMMON SHARED Touch.Readonly AS INTEGER, Display.Errors AS INTEGER
COMMON SHARED Touch.Create AS INTEGER, Touch.Access AS INTEGER
COMMON SHARED Windows.DOS AS INTEGER

' initialize count variables
COMMON SHARED File.Touched AS INTEGER

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

' initialize date/time work variables
COMMON SHARED Hour AS SINGLE, Minute AS INTEGER, Second  AS INTEGER
COMMON SHARED Month AS INTEGER, Day AS INTEGER, Year AS SINGLE
COMMON SHARED Millisecond AS INTEGER

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

' increase stack size
STACK STACK

' 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 

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

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

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

' check command line switches
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")
Prompt.Files = ParseLine ("/P")
Display.Errors = ParseLine ("/Z")

' get date/time from command line
File.Date$ = DATE$
Imbedded = INSTR(UCASE$(Command.Line), "/D")
IF Imbedded THEN
   File.Date$ = MID$(Command.Line, Imbedded + 2, 10)
   Command.Line = LEFT$(Command.Line, Imbedded - 1) + MID$(Command.Line, Imbedded + 12)
   IF LEN(File.Date$) <> 10 THEN
      GOTO Boot.Error
   END IF
END IF
Month = VAL(MID$(File.Date$, 1, 2))
Day = VAL(MID$(File.Date$, 4, 2))
Year = VAL(MID$(File.Date$, 7, 4))
File.Time$ = TIME$
Imbedded = INSTR(UCASE$(Command.Line), "/T")
IF Imbedded THEN
   File.Time$ = MID$(Command.Line, Imbedded + 2, 8)
   Command.Line = LEFT$(Command.Line, Imbedded - 1) + MID$(Command.Line, Imbedded + 10)
   IF LEN(File.Time$) <> 8 THEN
      GOTO Boot.Error
   END IF
END IF
Hour = VAL(MID$(File.Time$, 1, 2))
Minute = VAL(MID$(File.Time$, 4, 2))
Second = VAL(MID$(File.Time$, 7, 2))
' record the milliseconds when starting Touchdir.
Millisecond = CINT(ABS(TIMER - CSNG(Hour * 3600 + Minute * 60 + Second)) * 100)
IF INT(Second/2) <> Second/2 THEN
   Millisecond = Millisecond + 100
END IF
IF Millisecond > 199 THEN
   Millisecond = 199
END IF
Touch.Create = ParseLine ("/1")
Touch.Access = ParseLine ("/2")
Touch.Modify = ParseLine ("/3")
IF Touch.Create = False THEN
   IF Touch.Access = False THEN
      IF Touch.Modify = False THEN
         Touch.Create = True
      END IF
   END IF
END IF

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

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

' reset work variables
Files.Counter = False
File.Touched = False
Quit.Touching = False

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

' make header
IF Continuous.Display = False THEN
   COLOR White, Black
   PRINT "Touchdir v1.0a: Directory date/time update utility;"
END IF

' search through all input filenames
DO
   ' get standard input
   Redirected.Input = False
   Standard.Input$ = NUL
   Inregs.AX = &HB00
   CALL Interrupt(&H21, Inregs, Outregs)
   DO WHILE (Outregs.AX AND &HFF) = &HFF
      Redirected.Input = True
      Inregs.AX = &H800
      CALL Interrupt(&H21, Inregs, Outregs)
      Char$ = CHR$(Outregs.AX AND &HFF)
      SELECT CASE ASC(Char$)
      CASE 10, 26
      CASE 13
	 EXIT DO
      CASE ELSE
	 Standard.Input$ = Standard.Input$ + Char$
      END SELECT
      Inregs.AX = &HB00
      CALL Interrupt(&H21, Inregs, Outregs)
   LOOP

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

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

   ' filename processing loop
   DO

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

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

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

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

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

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

         ' store current directory
         Directory.Search$ = Command.Work
         Command.Work = NUL

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

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

         ' check carry flag error
         IF (OutregsX.Flags AND &H1) = &H0 THEN
            ' call routine to search for files
            IF Continuous.Display = False THEN
               COLOR Yellow, Black
               PRINT "Searching: " + Directory.Search$
            END IF
            CALL Directories(Directory.Search$)
         END IF
      END IF

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

   ' check for more filenames
   IF Standard.Input$ = NUL THEN
      EXIT DO
   END IF
LOOP
End.Copy:
' restore basic dta
InregsX.AX = &H1A00
InregsX.DS = BASIC.DTA.SEG
InregsX.DX = BASIC.DTA.OFF
CALL InterruptX(&H21, InregsX, OutregsX)

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

' display counters
IF Continuous.Display = False THEN
   COLOR Yellow, Black
   IF File.Touched THEN
      PRINT "Directory touched."
   ELSE
      PRINT "Directory not touched."
   END IF
   Prompt$ = "Press <enter> to exit to DOS:"
   CALL MorePrompt(Prompt$, CHR$(13), Outpt$)
END IF
COLOR Plain, Black
END

' display program usage
Boot.Usage:
 COLOR White, Black
 PRINT "Touchdir v1.0a: Directory date/time update utility;"
 COLOR Yellow, Black
 PRINT "Usage:"
 PRINT "   Touchdir [d:]\path\ [+/ahosy][/cdptz]"
 PRINT "Where:"
 PRINT "   /c  continuous display"
 PRINT "   /d  specify default date in form mm/dd/yyyy"
 PRINT "   /p  don't prompt before touching file"
 PRINT "   /t  specify default time in form hh:mm:ss"
 PRINT "   /z  suppress errors"
 PRINT "   touch time switches:"
 PRINT "     /1  creation time, /2  access time, /3  modify time"
 PRINT "   touch files with attributes:"
 PRINT "     + prefix to not touch files with,"
 PRINT "     / prefix to touch files only with,"
 PRINT "       a  archive, h  hidden, o  read-only, s  system, y  none"
 COLOR Plain, Black
 END

Boot.Error:
 COLOR White, Black
 PRINT "Command line error. Type Touch /? for help."
 COLOR Plain, Black
 END

' subroutine to access directory
SUB Directories (Directory.Search$)
 ' declare subroutine variables
 DIM Attribute AS INTEGER
 DIM DTAfile AS DTAtype
 DIM ASCIZ AS STRING * 260
 DIM WDTAfile AS WDTAtype
 DIM Wfile.Handle AS INTEGER

 ' make directory filename
 ASCIZ = 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(ASCIZ)
    InregsX.DX = VARPTR(ASCIZ)
    InregsX.ES = VARSEG(WDTAfile)
    InregsX.DI = VARPTR(WDTAfile)
    CALL InterruptX(&H21, InregsX, OutregsX)
    Wfile.Handle = OutregsX.AX
 ELSE
    ' find first directory
    InregsX.AX = &H4E00
    InregsX.CX = &H37
    InregsX.DS = VARSEG(ASCIZ)
    InregsX.DX = VARPTR(ASCIZ)
    CALL InterruptX(&H21, InregsX, OutregsX)
 END IF

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

    ' check directory attribute
    IF Windows.Detected THEN
       Attribute = ASC(WDTAfile.Fileattr)
    ELSE
       Attribute = ASC(DTAfile.Fileattr)
    END IF
    IF (Attribute AND &H10) = &H10 THEN
       ' touch directory name
       CALL TouchDir(Directory.Search$)
    END IF
 END IF
 GOSUB Restore.DTA

 ' 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

' subroutine to touch a directory
SUB TouchDir (Touch.Filename$)
 ' declare subroutine variables
 DIM ASCIZ AS STRING * 260
 DIM Attribute AS INTEGER
 DIM FCBfile AS FCBtype

 ' make filename
 ASCIZ = Touch.Filename$ + CHR$(0)

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

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

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

    ' store file attribute
    Attribute = OutregsX.CX

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

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

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

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

    ' check for no attributes
    IF Touch.Any THEN
       IF (Attribute AND &H1) = &H1 THEN
          EXIT SUB
       END IF
       IF (Attribute AND &H2) = &H2 THEN
          EXIT SUB
       END IF
       IF (Attribute AND &H4) = &H4 THEN
          EXIT SUB
       END IF
       IF (Attribute AND &H20) = &H20 THEN
          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
                   EXIT SUB
                END IF
             END IF
          END IF
       END IF
    END IF

    ' check for prompting
    IF Prompt.Files THEN
       COLOR Yellow, Black
       PRINT Touch.Filename$
    ELSE
       Prompt$ = "Touch " + Touch.Filename$ + "(y/n)?"
       CALL MorePrompt(Prompt$, "ynq", Outpt$)
       IF Outpt$ = "n" THEN
          EXIT SUB
       END IF
    END IF

    ' check windows dos
    IF Windows.Detected THEN
       ' touch file
       IF Touch.Create THEN
          InregsX.AX = &H7143
          InregsX.DS = VARSEG(ASCIZ)
          InregsX.DX = VARPTR(ASCIZ)
          InregsX.BX = &H07
          InregsX.DI = VAL("&H" + HEX$((Year - 1980) * 512))
          InregsX.DI = InregsX.DI + Month * 32 + Day
          InregsX.CX = VAL("&H" + HEX$(Hour * 2048))
          InregsX.CX = InregsX.CX + Minute * 32 + INT(Second / 2)
          InregsX.SI = Millisecond ' an approximation.
          CALL InterruptX(&H21, InregsX, OutregsX)

          ' display any errors
          CALL DisplayError ("Error touching directory creation date\time.")

          ' check carry flag error
          IF (OutregsX.Flags AND &H1) = &H0 THEN
             File.Touched = True
          END IF
       END IF
       IF Touch.Access THEN
          InregsX.AX = &H7143
          InregsX.DS = VARSEG(ASCIZ)
          InregsX.DX = VARPTR(ASCIZ)
          InregsX.BX = &H05
          InregsX.DI = VAL("&H" + HEX$((Year - 1980) * 512))
          InregsX.DI = InregsX.DI + Month * 32 + Day
          CALL InterruptX(&H21, InregsX, OutregsX)

          ' display any errors
          CALL DisplayError ("Error touching directory last access date\time.")

          ' check carry flag error
          IF (OutregsX.Flags AND &H1) = &H0 THEN
             File.Touched = True
          END IF
       END IF
       IF Touch.Modify THEN
          InregsX.AX = &H7143
          InregsX.DS = VARSEG(ASCIZ)
          InregsX.DX = VARPTR(ASCIZ)
          InregsX.BX = &H03
          InregsX.DI = VAL("&H" + HEX$((Year - 1980) * 512))
          InregsX.DI = InregsX.DI + Month * 32 + Day
          InregsX.CX = VAL("&H" + HEX$(Hour * 2048))
          InregsX.CX = InregsX.CX + Minute * 32 + INT(Second / 2)
          CALL InterruptX(&H21, InregsX, OutregsX)

          ' display any errors
          CALL DisplayError ("Error touching directory last modified date\time.")

          ' check carry flag error
          IF (OutregsX.Flags AND &H1) = &H0 THEN
             File.Touched = True
          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 Green, Black
 PRINT Temp.Outpt$
 Prompt$ = "Press R to retry, Q to quit, C to continue:"
 CALL MorePrompt(Prompt$, "rqc", Outpt$)
 SELECT CASE Outpt$
 CASE "r"
    RESUME
 CASE "q"
    Error.Level = True
    RESUME End.Copy
 CASE "c"
    OutregsX.Flags = &H1
    RESUME NEXT
 END SELECT
 END 0

SUB MorePrompt (Input.String$, Input.Mask$, Output.String$)
 COLOR White, Black
 PRINT Input.String$ + " ";
 Input.Char$ = NUL
 DO
    LOCATE , , 1
    Input.Char$ = INKEY$
    IF LEN(Input.Char$) THEN
       Input.Char$ = LCASE$(Input.Char$)
       IF INSTR(Input.Mask$, Input.Char$) THEN
	  PRINT Input.Char$
	  Output.String$ = Input.Char$
	  EXIT DO
       END IF
    END IF
 LOOP
END SUB

' 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
