REM file: Touchvol.bas - Public Domain DOS Utility
REM Version 1.0a created 04/30/1996
REM Version 1.1a created 04/15/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 Plain = 7
CONST Red = 12
CONST White = 15
CONST Yellow = 14

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

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

' initialize filename buffer
DIM ASCIIZ AS STRING * 260
COMMON SHARED Drive.Search AS STRING * 1
COMMON SHARED Current.Drive AS STRING * 1

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

' declare structures
DIM FCBfile AS FCBtype, DTAfile AS DTAtype

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

' declare work variables
COMMON SHARED Continuous.Display AS INTEGER, Display.Errors AS INTEGER
COMMON SHARED Update.Date AS INTEGER

' declare date work variables
COMMON SHARED FCBdate AS STRING * 2, FCBtime AS STRING * 2
COMMON SHARED System.Date1 AS INTEGER, System.Date2 AS INTEGER
COMMON SHARED System.Time1 AS INTEGER, System.Time2 AS INTEGER
COMMON SHARED File.Work.Date AS SINGLE, File.Work.Time AS SINGLE
COMMON SHARED MonthTemp AS SINGLE, DayTemp AS SINGLE, YearTemp AS SINGLE
COMMON SHARED HourTemp AS SINGLE, MinuteTemp AS SINGLE, SecondsTemp AS SINGLE
COMMON SHARED Default.Month AS INTEGER, Default.Day AS INTEGER
COMMON SHARED Default.Year AS INTEGER, Default.Hour AS INTEGER
COMMON SHARED Default.Minute AS INTEGER, Default.Seconds AS INTEGER

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

' declare external procedures
DECLARE SUB SetInt
DECLARE SUB RestInt

' backwards compatible for bc 7.1
REM $INCLUDE: 'bc7.inc'

' increase stack size
STACK STACK

' install new interrupt service routine
CALL SetInt

' declare standard error trap
ON ERROR GOTO Error.Routine

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

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

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

' check command line
SELECT CASE COMMAND$
CASE "/?"
   GOTO Boot.Usage
END SELECT

' store and parse command line
Command.Line = COMMAND$
IF Command.Line = NUL THEN
   Command.Line = UCASE$(ENVIRON$("TOUCHVOL"))
END IF

' get switches from command line
Continuous.Display = ParseLine ("/C")
Update.Date = ParseLine ("/X")
Display.Errors = ParseLine ("/Z")
Control.Break = ParseLine ("/~")

' get date\time from command line
File.Date$ = DATE$
Imbedded = INSTR(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)
END IF
IF LEN(File.Date$) <> 10 THEN
   GOTO Boot.Error
END IF
Default.Month = VAL(MID$(File.Date$, 1, 2))
Default.Day = VAL(MID$(File.Date$, 4, 2))
Default.Year = VAL(MID$(File.Date$, 7, 4))
File.Time$ = TIME$
Imbedded = INSTR(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)
END IF
IF LEN(File.Time$) <> 8 THEN
   GOTO Boot.Error
END IF
Default.Hour = VAL(MID$(File.Time$, 1, 2))
Default.Minute = VAL(MID$(File.Time$, 4, 2))
Default.Seconds = VAL(MID$(File.Time$, 7, 2))

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

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

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

' search through all input filenames
Redirected.Input = False
DO
   ' check control break
   IF BreakIS THEN
      EXIT DO
   END IF

   ' get standard input
   Standard.Input$ = NUL
   InregsX.AX = &HB00
   CALL InterruptX(&H21, InregsX, OutregsX)
   DO WHILE (OutregsX.AX AND &HFF) = &HFF
      Redirected.Input = True
      InregsX.AX = &H800
      CALL InterruptX(&H21, InregsX, OutregsX)
      Char$ = CHR$(OutregsX.AX AND &HFF)
      SELECT CASE ASC(Char$)
      CASE 10, 26
      CASE 13
	 EXIT DO
      CASE ELSE
	 Standard.Input$ = Standard.Input$ + Char$
      END SELECT
      InregsX.AX = &HB00
      CALL InterruptX(&H21, InregsX, OutregsX)
   LOOP

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

   ' check control break
   IF BreakIS THEN
      EXIT DO
   END IF

   ' check nul filename input
   IF Redirected.Input = False THEN
      IF Standard.Input$ = NUL THEN
         CALL RestInt ' restore Control-Break
         X$ = Inkey$ ' quits here
         CALL SetInt ' reset Control-Break
         IF X$ = CHR$(0) + CHR$(0) THEN
            EXIT DO
         END IF
      END IF
   END IF

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

   ' display header
   GOSUB Header

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

   DO
      ' store entire command
      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

      ' 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

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

      ' check for volume label on command line
      IF LEN(Command.Work) = False THEN

	 ' store global volume label
         Volume.Filename$ = "????????"
         Volume.Extension$ = "???"
      ELSE
   
	 ' store new volume label
         Volume.Label$ = Command.Work
   
	 ' check volume label name
         Imbedded = INSTR(Volume.Label$, ".")
         IF Imbedded THEN
            Volume.Label$ = LEFT$(Volume.Label$, Imbedded - 1) + MID$(Volume.Label$, Imbedded + 1)
	 END IF

	 ' trim volume label
	 Volume.Filename$ = MID$(Volume.Label$, 1, 8)
	 Volume.Extension$ = MID$(Volume.Label$, 9, 3)
	 Volume.Filename$ = RTRIM$(Volume.Filename$)
	 Volume.Extension$ = RTRIM$(Volume.Extension$)
      END IF

      ' store volume label
      ASCIIZ = "\" + Volume.Filename$ + "." + Volume.Extension$ + CHR$(0)

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

      ' check error flag
      IF (OutregsX.Flags AND &H1) = &H1 THEN
         IF OutregsX.AX <> &H12 THEN
            IF Display.Errors = False THEN
               COLOR Red, Black
               PRINT "Error reading volume label."
            END IF
         END IF
      END IF

      ' store volume date
      IF Update.Date THEN
	 FCBdate = DTAfile.FileDate
	 FCBtime = DTAfile.FileTime
      END IF

      ' store current volume label
      Volume.Label$ = RTRIM$(DTAfile.ASCIIZfilename)
      WHILE RIGHT$(Volume.Label$, 1) = CHR$(0)
	 Volume.Label$ = LEFT$(Volume.Label$, LEN(Volume.Label$) - 1)
	 Volume.Label$ = RTRIM$(Volume.Label$)
      WEND

      ' check volume label name
      Imbedded = INSTR(Volume.Label$, ".")
      IF Imbedded THEN
         Volume.Label$ = LEFT$(Volume.Label$, Imbedded - 1) + MID$(Volume.Label$, Imbedded + 1)
      END IF

      ' trim volume label
      Volume.Filename$ = MID$(Volume.Label$, 1, 8)
      Volume.Extension$ = MID$(Volume.Label$, 9, 3)
      Volume.Filename$ = RTRIM$(Volume.Filename$)
      Volume.Extension$ = RTRIM$(Volume.Extension$)

      ' store volume label
      FCBfile.ExtendedFCB = CHR$(255)
      FCBfile.FileAttribute = CHR$(&H08)
      FCBfile.Filename = Volume.Filename$
      FCBfile.Extension = Volume.Extension$
      FCBfile.DriveNumber = CHR$(ASC(Drive.Search) - 64)

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

      ' check error flag
      CALL DisplayError ("Error deleting volume label.")

      ' check volume flag
      IF (OutregsX.AX AND &HFF) = &HFF THEN
         IF Display.Errors = False THEN
            COLOR Red, Black
	    PRINT "Error deleting volume."
	 END IF
      END IF

      ' store system date
      InregsX.AX = &H2A00
      CALL InterruptX(&H21, InregsX, OutregsX)
      System.Date1 = OutregsX.CX
      System.Date2 = OutregsX.DX

      ' store system time
      InregsX.AX = &H2C00
      CALL InterruptX(&H21, InregsX, OutregsX)
      System.Time1 = OutregsX.CX
      System.Time2 = OutregsX.DX

      ' check update volume date
      IF Update.Date THEN

	 ' reset system date
	 File.Work.Date = ASC(MID$(FCBdate, 2, 1))
	 File.Work.Date = File.Work.Date * &H100 + ASC(MID$(FCBdate, 1, 1))
         YearTemp = INT(File.Work.Date / 512)
         MonthTemp = INT((File.Work.Date AND &H1E0) / 32)
         DayTemp = INT(File.Work.Date AND &H1F)
         YearTemp = YearTemp + 1980
         InregsX.CX = CINT(YearTemp)
         InregsX.DX = CINT(MonthTemp) * &H100 + CINT(DayTemp)
	 InregsX.AX = &H2B00
	 CALL InterruptX(&H21, InregsX, OutregsX)
	 IF (OutregsX.AX AND &HFF) = &HFF THEN
            IF Display.Errors = False THEN
               COLOR Red, Black
	       PRINT "Error setting system date."
	    END IF
	 END IF

	 ' reset system time
	 File.Work.Time = ASC(MID$(FCBtime, 2, 1))
	 File.Work.Time = File.Work.Time * &H100 + ASC(MID$(FCBtime, 1, 1))
         HourTemp = INT(File.Work.Time / 2048)
         MinuteTemp = INT((File.Work.Time AND &H7E0) / 32)
         SecondsTemp = INT(File.Work.Time AND &H1F) * 2
         InregsX.CX = CINT(HourTemp) * &H100 + CINT(MinuteTemp)
         InregsX.DX = CINT(SecondsTemp) * &H100 + 10
	 InregsX.AX = &H2D00
	 CALL InterruptX(&H21, InregsX, OutregsX)
	 IF (OutregsX.AX AND &HFF) = &HFF THEN
            IF Display.Errors = False THEN
               COLOR Red, Black
	       PRINT "Error setting system time."
	    END IF
	 END IF
      ELSE

	 ' reset system date
	 InregsX.CX = Default.Year
	 InregsX.DX = Default.Month * &H100 + Default.Day
	 InregsX.AX = &H2B00
	 CALL InterruptX(&H21, InregsX, OutregsX)
	 IF (OutregsX.AX AND &HFF) = &HFF THEN
            IF Display.Errors = False THEN
               COLOR Red, Black
	       PRINT "Error setting default volume date."
	    END IF
	 END IF

	 ' reset system time
	 InregsX.CX = Default.Hour * &H100 + Default.Minute
	 InregsX.DX = Default.Seconds * &H100 + 10
	 InregsX.AX = &H2D00
	 CALL InterruptX(&H21, InregsX, OutregsX)
	 IF (OutregsX.AX AND &HFF) = &HFF THEN
            IF Display.Errors = False THEN
               COLOR Red, Black
	       PRINT "Error setting default volume time."
	    END IF
	 END IF
      END IF

      ' store volume label
      FCBfile.ExtendedFCB = CHR$(255)
      FCBfile.FileAttribute = CHR$(&H08)
      FCBfile.Filename = Volume.Filename$
      FCBfile.Extension = Volume.Extension$
      FCBfile.DriveNumber = CHR$(ASC(Drive.Search) - 64)

      ' create volume label
      OutregsX.Flags = &H0
      InregsX.AX = &H1600
      InregsX.DS = VARSEG(FCBfile)
      InregsX.DX = VARPTR(FCBfile)
      CALL InterruptX(&H21, InregsX, OutregsX)

      ' check error flag
      CALL DisplayError ("Error creating volume label.")

      ' check volume flag
      IF (OutregsX.AX AND &HFF) = &HFF THEN
         IF Display.Errors = False THEN
            COLOR Red, Black
	    PRINT "Error creating volume."
	 END IF
      ELSE
	 ' display search filename
         COLOR Yellow, Black
         IF Continuous.Display = False THEN
            PRINT "Touching: ";
	 END IF
	 PRINT Volume.Label$
      END IF

      ' restore system date
      InregsX.CX = System.Date1
      InregsX.DX = System.Date2
      InregsX.AX = &H2B00
      CALL InterruptX(&H21, InregsX, OutregsX)
      IF (OutregsX.AX AND &HFF) = &HFF THEN
         IF Display.Errors = False THEN
            COLOR Red, Black
	    PRINT "Error resetting system date."
	 END IF
      END IF

      ' restore system time
      InregsX.CX = System.Time1
      InregsX.DX = System.Time2
      InregsX.AX = &H2D00
      CALL InterruptX(&H21, InregsX, OutregsX)
      IF (OutregsX.AX AND &HFF) = &HFF THEN
         IF Display.Errors = False THEN
            COLOR Red, Black
	    PRINT "Error resetting system time."
	 END IF
      END IF

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

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

End.Touchvol:

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

' 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

' display program usage
Boot.Usage:
 ' restore key trapping
 CALL RestInt
 Var$=Inkey$
 ' make header
 COLOR White, Black
 PRINT "Touchvol v1.1a: Volume update utility; "
 COLOR Yellow, Black
 PRINT "Usage:"
 PRINT "   Touchvol [d:][volumename][/cdtxz]"
 PRINT "Where:"
 PRINT "   /c  continuous display"
 PRINT "   /d  specify volume date in form mm/dd/yyyy"
 PRINT "   /t  specify volume time in form hh:mm:ss"
 PRINT "   /x  leave volume date\time unchanged"
 PRINT "   /z  suppress errors"
 COLOR Plain, Black
 END

Boot.Error:
 CALL RestInt
 Var$=Inkey$
 COLOR White, Black
 PRINT "Command line error. Type Touchvol /? for help."
 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 "Touchvol v1.1a: Volume update utility;"
 END IF
 RETURN
   
' critical error trap
Error.Routine:
 Data.Error = ERR
 IF Display.Errors THEN
    Error.Level = True
    OutregsX.Flags = &H1
    RESUME NEXT
 END IF
 SELECT CASE Data.Error
 CASE 53
    Temp.Outpt$ = "File not found."
 CASE 61
    Temp.Outpt$ = "Disk full."
 CASE 70
    Temp.Outpt$ = "Permission denied."
 CASE 71
    Temp.Outpt$ = "Disk not ready."
 CASE ELSE
    Temp.Outpt$ = "Untrapped error" + STR$(Data.Error) + "."
 END SELECT
 COLOR 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.Touchvol
 CASE "c"
    OutregsX.Flags = &H1
    RESUME NEXT
 END SELECT
 COLOR Plain, Black
 ' restore key trapping
 CALL RestInt
 END 0

' command line parser
FUNCTION ParseLine (X$)
 Imbedded = INSTR(Command.Line, 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 FUNCTION 

SUB MorePrompt (Input.String$, Input.Mask$, Output.String$)
 COLOR White, Black
 PRINT Input.String$ + " ";
 Input.Char$ = NUL
 DO
    LOCATE , , 1
    DO
       IF BreakIS THEN
          EXIT DO
       END IF
       IF KeyIS THEN
          IF OutregsX.AX <> 0 THEN
             InregsX.AX = &H0000
             CALL InterruptX(&H16, InregsX, OutregsX)
             Input.Char$=CHR$(OutregsX.AX AND &HFF)
             EXIT DO
          END IF
       END IF
    LOOP
    IF BreakIS THEN
       EXIT DO
    END IF
    IF LEN(Input.Char$) THEN
       Input.Char$ = LCASE$(Input.Char$)
       IF INSTR(Input.Mask$, Input.Char$) THEN
	  PRINT Input.Char$
	  Output.String$ = Input.Char$
	  EXIT DO
       END IF
    END IF
 LOOP
END SUB

' clears Control-Break flag
FUNCTION ClearBreak
 DEF SEG = &H40
 POKE &H71, &H0
 DEF SEG
 ClearBreak = True
END FUNCTION

' checks Control-Break
FUNCTION BreakIS
 STATIC Var AS INTEGER
 IF KeyIS THEN
    IF OutregsX.AX = 0 THEN
       Var = True
    END IF
 END IF
 IF Var THEN
    Continuous.Display = True
 END IF
 BreakIS = Var
END FUNCTION

' checks keyboard buffer
FUNCTION KeyIS
 InregsX.AX = &H0100
 CALL InterruptX(&H16, InregsX, OutregsX)
 IF (OutregsX.Flags AND &H40) = &H40 THEN
    KeyIS = False
 ELSE
    KeyIS = True
 END IF
END FUNCTION

' displays carry flag error
SUB DisplayError (Temp$)
 ' check carry flag error
 IF (OutregsX.Flags AND &H1) = &H1 THEN
    ' check display errors flag
    IF Display.Errors = False THEN
       ' display error
       COLOR Red, Black
       PRINT Temp$
    END IF
 END IF
END SUB
