REM file: Touchvol.bas - Public Domain DOS Utility
REM Version 1.0a created 04/30/1996

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

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

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

' 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 Month AS SINGLE, Day AS SINGLE, Year AS SINGLE
COMMON SHARED Hour AS SINGLE, Minute AS SINGLE, Seconds 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

' increase stack size
STACK STACK

' declare standard error trap
ON ERROR GOTO Error.Routine

' 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 

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

' 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

' display touchvol filename
IF Continuous.Display = False THEN
   ' make header
   COLOR White, Black
   PRINT "Touchvol v1.0a: Volume 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

   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
      ASCIZ = "\" + Volume.Filename$ + "." + Volume.Extension$ + CHR$(0)

      ' find volume label
      InregsX.AX = &H4E00
      InregsX.CX = &H08
      InregsX.DS = VARSEG(ASCIZ)
      InregsX.DX = VARPTR(ASCIZ)
      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.ASCIZfilename)
      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))
	 Year = INT(File.Work.Date / 512)
	 Month = INT((File.Work.Date AND &H1E0) / 32)
	 Day = INT(File.Work.Date AND &H1F)
	 Year = Year + 1980
	 InregsX.CX = CINT(Year)
	 InregsX.DX = CINT(Month) * &H100 + CINT(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 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))
	 Hour = INT(File.Work.Time / 2048)
	 Minute = INT((File.Work.Time AND &H7E0) / 32)
	 Seconds = INT(File.Work.Time AND &H1F) * 2
	 InregsX.CX = CINT(Hour) * &H100 + CINT(Minute)
	 InregsX.DX = CINT(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 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.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 = 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
COLOR Plain, Black
END

' display program usage
Boot.Usage:
 ' make header
 COLOR White, Black
 PRINT "Touchvol v1.0a: 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:
 COLOR White, Black
 PRINT "Command line error. Type Touchvol /? for help."
 COLOR Plain, Black
 END

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