REM file: Renvol.bas - Public Domain DOS Utility
REM Version 1.0a created 05/22/1995
REM Version 1.1a created 10/14/1995
REM Version 1.2a created 12/06/1996

REM Compiling with Microsoft BASIC Professional Development System 7.1:
REM    BC RENVOL/FS/X/O;
REM    LINK RENVOL,,,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: 'dta.bi'
REM $INCLUDE: 'fcb.bi'
REM $INCLUDE: 'fcb2.bi'

' declare functions
DECLARE FUNCTION ParseLine (S$)

' initialize filename buffer
DIM ASCIZ AS STRING * 260

' initialize structures
DIM DTAfile AS DTAtype, FCBfile AS FCBType, FCBfile2 AS FCBtype2

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

' 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

' declare work variables
COMMON SHARED Continuous.Display AS INTEGER, Display.Errors AS INTEGER
COMMON SHARED Rename.Error 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
Inregs.AX = &H1900
CALL Interrupt(&H21, Inregs, Outregs)
Current.Drive = (Outregs.AX AND &HFF) + 1

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

' get switches from command line
Continuous.Display = ParseLine ("/C")
Display.Errors = ParseLine ("/Z")

' get new volume name from command line
Imbedded = INSTR(Command.Line, "/N")
IF Imbedded = False THEN
   GOTO Boot.Usage
END IF
New.Filename$ = MID$(Command.Line, Imbedded + 2)
Command.Line = LEFT$(Command.Line, Imbedded - 1)
Imbedded = INSTR(New.Filename$, ".")
IF Imbedded THEN
   New.Extension$ = MID$(New.Filename$, Imbedded + 1)
   New.Filename$ = LEFT$(New.Filename$, Imbedded - 1)
ELSE
   IF LEN(New.Filename$) > 8 THEN
      New.Extension$ = MID$(New.Filename$, 9, 3)
      New.Filename$ = LEFT$(New.Filename$, 8)
   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

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

' display search filename
IF Continuous.Display = False THEN
   ' make header
   COLOR White, False
   PRINT "Renvol v1.2a: Volume rename 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.Number = ASC(LEFT$(Command.Work, 1)) - 64
         Command.Work = MID$(Command.Work, 3)
      ELSE
	 Drive.Number = Current.Drive
      END IF

      ' get filename spec
      Filename.Search$ = Command.Work
      IF Filename.Search$ = NUL THEN
	 Filename.Search$ = "????????.???"
      END IF
      Command.Work = NUL

      ' change to drive
      Inregs.AX = &HE00
      Inregs.DX = Drive.Number - 1
      CALL Interrupt(&H21, Inregs, Outregs)
   
      ' make old volume name
      Old.Filename$ = Filename.Search$
      Imbedded = INSTR(Old.Filename$, ".")
      IF Imbedded THEN
         Old.Extension$ = MID$(Old.Filename$, Imbedded + 1)
         Old.Filename$ = LEFT$(Old.Filename$, Imbedded - 1)
      ELSE
         IF LEN(Old.Filename$) > 8 THEN
            Old.Extension$ = MID$(Old.Filename$, 9, 3)
            Old.Filename$ = LEFT$(Old.Filename$, 8)
	 END IF
      END IF

      ' check volume label name
      IF Old.Filename$ = "????????" THEN
	 IF Old.Extension$ = "???" THEN

            ' find volume label attribute
            ASCIZ = "\*.*" + CHR$(0)
            InregsX.AX = &H4E00
            InregsX.CX = &H08
            InregsX.DS = VARSEG(ASCIZ)
            InregsX.DX = VARPTR(ASCIZ)
            CALL InterruptX(&H21, InregsX, OutregsX)

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

               ' store volume label
               Volume.Filename$ = DTAfile.ASCIZfilename
               Imbedded = INSTR(Volume.Filename$, CHR$(0))
               IF Imbedded THEN
                  Volume.Filename$ = LEFT$(Volume.Filename$, Imbedded - 1)
               END IF
               Volume.Filename$ = RTRIM$(Volume.Filename$)
               IF LEN(Volume.Filename$) THEN
                  Old.Filename$ = Volume.Filename$
                  Old.Extension$ = NUL
                  Imbedded = INSTR(Old.Filename$, ".")
                  IF Imbedded THEN
                     Old.Extension$ = MID$(Old.Filename$, Imbedded + 1)
                     Old.Filename$ = LEFT$(Old.Filename$, Imbedded - 1)
                  ELSE
                     IF LEN(Old.Filename$) > 8 THEN
                        Old.Extension$ = MID$(Old.Filename$, 9, 3)
                        Old.Filename$ = LEFT$(Old.Filename$, 8)
                     END IF
		  END IF
	       END IF
	    END IF
	 END IF
      END IF

      ' store volume label in fcb
      FCBfile2.ExtendedFCB = CHR$(&HFF)
      FCBfile2.FileAttribute = CHR$(&H08)
      FCBfile2.DriveNumber = CHR$(Drive.Number)
      FCBfile2.Filename = "????????"
      FCBfile2.Extension = "???"
      FCBfile2.NewFilename = New.Filename$
      FCBfile2.NewExtension = New.Extension$

      ' rename volume label in fcb
      InregsX.AX = &H1700
      InregsX.DS = VARSEG(FCBfile2)
      InregsX.DX = VARPTR(FCBfile2)
      CALL InterruptX(&H21, InregsX, OutregsX)

      ' check fcb flag error
      IF (OutregsX.AX AND &HFF) = &HFF THEN

	 ' store volume label in fcb
         FCBfile.ExtendedFCB = CHR$(&HFF)
         FCBfile.FileAttribute = CHR$(&H08)
	 FCBfile.DriveNumber = CHR$(Drive.Number)
	 FCBfile.Filename = New.Filename$
	 FCBfile.Extension = New.Extension$

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

	 ' check create error
	 IF (OutregsX.AX AND &HFF) = &HFF THEN
            Rename.Error = True
	 END IF
      END IF

      ' display volume label changed
      IF Rename.Error THEN
         IF Display.Errors = False THEN
            COLOR White, Black
	    PRINT "Error renaming volume label."
	 END IF
      ELSE
	 ' display search filename
         COLOR Yellow, Black
         IF Continuous.Display = False THEN
            PRINT "Changing: "; Old.Filename$;
            IF RTRIM$(Old.Extension$) <> NUL THEN
               PRINT Old.Extension$;
            END IF
            PRINT " to ";
         END IF
         PRINT New.Filename$;
         IF RTRIM$(New.Extension$) <> NUL THEN
            PRINT New.Extension$;
	 END IF
         PRINT
      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
Inregs.AX = &HE00
Inregs.DX = Current.Drive - 1
CALL Interrupt(&H21, Inregs, Outregs)

' 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, False
 PRINT "Renvol v1.2a: Volume rename utility; "
 COLOR Yellow, Black
 PRINT "Usage:"
 PRINT "   Renvol [d:][volumename][/cnz]"
 PRINT "Where:"
 PRINT "   /c  continuous display"
 PRINT "   /n  new volume in form filename.ext"
 PRINT "   /z  supress error messages"
 COLOR Plain, Black
 END

Boot.Error:
 COLOR White, Black
 PRINT "Command line error. Type Renvol /? 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
