REM file: Newname.bas - Public Domain DOS Utility for 8.3 files.
REM Version 1.0a created 05/22/1995
REM Version 1.1a created 10/14/1995
REM Version 1.2a 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: 'dta.bi'
REM $INCLUDE: 'fcb2.bi'

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

' initialize filename buffer
DIM ASCIIZ AS STRING * 260, New.ASCIIZ AS STRING * 260

' initialize filename variables
DIM Old.Filename AS STRING * 8, Old.Extension AS STRING * 3
DIM New.Filename AS STRING * 8, New.Extension AS STRING * 3

' initialize structures
DIM DTAfile AS DTAtype, FCBfile 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

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

' 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 Rename.Error AS INTEGER, Rename.Directories AS INTEGER
COMMON SHARED Rename.Volume AS INTEGER, Windows.Detected 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

' 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

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

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

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

' check windows dos
IF Windows.Detected THEN
   ' get current directory
   InregsX.AX = &H7147
   InregsX.DX = Current.Drive + 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 = Current.Drive + 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 carry flag error
IF (OutregsX.Flags AND &H1) = &H1 THEN
   GOTO End.Newname
END IF

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

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

' get switches from command line
Continuous.Display = ParseLine ("/C")
Rename.Directories = ParseLine ("/D")
Rename.Volume = ParseLine ("/V")
Display.Errors = ParseLine ("/Z")
Control.Break = ParseLine ("/~")

' get new filename from command line
New.Extension = NUL
New.Filename = NUL
Imbedded1 = INSTR(Command.Line, "/N")
IF Imbedded1 = 0 THEN
   GOTO Boot.Usage
END IF
New.ASCIIZ = MID$(Command.Line, Imbedded1 + 2)
Imbedded2 = INSTR(New.ASCIIZ, ".")
IF Imbedded2 THEN
   New.Extension = MID$(New.ASCIIZ, Imbedded2 + 1)
   New.ASCIIZ = LEFT$(New.ASCIIZ, Imbedded2 - 1)
END IF
New.Filename = New.ASCIIZ
IF RTRIM$(New.Filename) = "*" THEN
   New.Filename = "????????"
END IF
Command.Line = LEFT$(Command.Line, Imbedded1 - 1)

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

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

   ' filename processing loop
   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)) - 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 carry flag error
      IF (OutregsX.Flags AND &H1) = &H1 THEN
         GOTO End.Newname
      END IF

      ' store current directory
      Directory.Search$ = "\" + LEFT$(ASCIIZ, INSTR(ASCIIZ, CHR$(0)) - 1)
      Imbedded1 = INSTR(Command.Work, "\")
      Imbedded2 = Imbedded1
      WHILE Imbedded1
         Imbedded2 = Imbedded1
         Imbedded1 = INSTR(Imbedded1 + 1, Command.Work, "\")
      WEND
      IF Imbedded2 THEN
         Directory.Search$ = LEFT$(Command.Work, Imbedded2)
         Command.Work = MID$(Command.Work, Imbedded2 + 1)
      END IF
   
      ' get filename spec
      Filename.Search$ = Command.Work
      IF Filename.Search$ = NUL THEN
	 Filename.Search$ = "????????.???"
      END IF
      Command.Work = NUL

      ' change to drive
      InregsX.AX = &HE00
      InregsX.DX = Drive.Number
      CALL InterruptX(&H21, InregsX, OutregsX)
   
      ' make directory filename
      ASCIIZ = Directory.Search$ + CHR$(0)

      ' check windows dos
      IF Windows.Detected THEN
         ' change to new directory
         InregsX.AX = &H713B
         InregsX.DS = VARSEG(ASCIIZ)
         InregsX.DX = VARPTR(ASCIIZ)
         CALL InterruptX(&H21, InregsX, OutregsX)
      ELSE
         ' change to new directory
         InregsX.AX = &H3B00
         InregsX.DS = VARSEG(ASCIIZ)
         InregsX.DX = VARPTR(ASCIIZ)
         CALL InterruptX(&H21, InregsX, OutregsX)
      END IF

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

      ' check carry flag error
      IF (OutregsX.Flags AND &H1) = &H1 THEN
         GOTO End.Newname
      END IF

      ' make filename
      Imbedded = INSTR(Filename.Search$, ".")
      Old.Extension = NUL
      IF Imbedded THEN
         Old.Extension = MID$(Filename.Search$, Imbedded + 1)
         Old.Filename = LEFT$(Filename.Search$, Imbedded - 1)
      ELSE
	 Old.Filename = Filename.Search$
      END IF

      ' rename files
      Rename.Error = False

      ' store fcb type
      FCBfile.ExtendedFCB = CHR$(&HFF)

      ' store attribute to change
      IF Rename.Volume THEN
         FCBfile.FileAttribute = CHR$(&H8)
      ELSE
	 IF Rename.Directories THEN
            FCBfile.FileAttribute = CHR$(&H37)
	 ELSE
            FCBfile.FileAttribute = CHR$(&H27)
	 END IF
      END IF

      ' store fcb
      FCBfile.DriveNumber = CHR$(Drive.Number + 1)
      FCBfile.Filename = Old.Filename
      FCBfile.Extension = Old.Extension
      FCBfile.NewFilename = New.Filename
      FCBfile.NewExtension = New.Extension

      ' use fcb to rename file
      OutregsX.Flags = &H0
      InregsX.AX = &H1700
      InregsX.DS = VARSEG(FCBfile)
      InregsX.DX = VARPTR(FCBfile)
      CALL InterruptX(&H21, InregsX, OutregsX)

      ' check fcb error flag
      IF (OutregsX.AX AND &HFF) = &HFF THEN
         IF Continuous.Display = False THEN
            IF Display.Errors = False THEN
               COLOR Red, Black
	       PRINT "Error renaming files."
	    END IF
	 END IF
      ELSE
         ' display search filename
         COLOR Yellow, Black
         IF Rename.Volume = False THEN
            PRINT UCASE$(Directory.Search$); "\";
         END IF
         PRINT UCASE$(RTRIM$(New.Filename));
         IF RTRIM$(New.Extension) <> "" THEN
            PRINT "."; UCASE$(RTRIM$(New.Extension));
         ENDIF
         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.Newname:

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

' check windows dos
IF Windows.Detected THEN
   ' restore current directory
   InregsX.AX = &H173B
   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

' 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 "Newname v1.2a: 8.3 File/directory rename utility; "
 COLOR Yellow, Black
 PRINT "Usage:"
 PRINT "   Newname [d:][path]filename.ext [/cdnvz]"
 PRINT "Where:"
 PRINT "   /c  continuous display"
 PRINT "   /d  rename directory"
 PRINT "   /n  new filename in form filename.ext"
 PRINT "   /v  rename volume label"
 PRINT "   /z  suppress error messages"
 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 "Newname v1.2a: 8.3 File/directory rename 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.Newname
 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
    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 flag
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
