REM file: Nameit.bas - Public Domain DOS Utility
REM Version 1.0a created 09/22/1997
REM Version 1.1a created 12/13/2000
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'

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

' initialize filename buffer
COMMON SHARED OldASCIIZ AS STRING * 260, NewASCIIZ AS STRING * 260

' declare registers
COMMON SHARED InregsX AS RegTypeX, OutregsX AS RegTypeX
COMMON SHARED InregsX2 AS RegtypeX, InregsX3 AS RegtypeX

' declare work variables
COMMON SHARED Continuous.Display AS INTEGER, Display.Errors AS INTEGER
COMMON SHARED Windows.Detected AS INTEGER, Lower.Case AS INTEGER
COMMON SHARED New.Name 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
COMMON SHARED Last.Switch AS INTEGER, Pipe.Buffer AS STRING * 1
COMMON SHARED Redirected.Input 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, LCASE$(X$))
 IF Imbedded THEN
    Command.Line = LEFT$(Command.Line, Imbedded - 1) + MID$(Command.Line, Imbedded + LEN(X$))
    Last.Switch = Imbedded - 1
    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$))
       Last.Switch = Imbedded - 1
       ParseLine = True
    ELSE
       ParseLine = False
    END IF
 END IF
END FUNCTION 

' check windows
Windows.Detected = True
If Load.Windows = False Then
   InregsX.AX = &H160A
   CALL InterruptX(&H2F, InregsX, OutregsX)
   IF OutregsX.AX > 0 THEN
      InregsX.AX = &H4A33
      CALL InterruptX(&H2F, InregsX, OutregsX)
      IF OutregsX.AX = 0 THEN
         Windows.Detected = 0 ' DOS 7.00
      END IF
   END IF
END IF
IF INSTR(COMMAND$, "/_") THEN
   Windows.Detected = 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 = ENVIRON$("NAMEIT")
END IF
Command.Line = RTRIM$(Command.Line)

' get switches from command line
Continuous.Display = ParseLine ("/C")
Lower.Case = ParseLine ("/L")
Display.Errors = ParseLine ("/Z")
Control.Break = ParseLine ("/~")
Command.Line = RTRIM$(Command.Line)
Var = ParseLine("/_")

IF Last.Switch THEN
   IF LEN(Command.Line) > Last.Switch THEN
      GOTO Boot.Error
   END IF
END IF

' get new filename from command line
Command.Line = Rtrim$(Command.Line)
New.Name = False
NewASCIIZ = CHR$(0)
Imbedded = INSTR(UCASE$(Command.Line), "/N")
IF Imbedded THEN
   IF INSTR(Imbedded + 1, Command.Line, "/") THEN
      GOTO Boot.Error
   END IF
   New.Name = True
   New.File$ = MID$(Command.Line, Imbedded + 2)
   IF LEFT$(New.File$, 1) = CHR$(34) AND RIGHT$(New.File$, 1) = CHR$(34) THEN
      New.File$ = MID$(New.File$, 2)
      New.File$ = LEFT$(New.File$, LEN(New.File$) - 1)
   ELSE
      IF INSTR(New.File$, " ") THEN
         GOTO Boot.Error
      END IF
   END IF
   NewASCIIZ = New.File$ + CHR$(0)
   Command.Line = LEFT$(Command.Line, Imbedded - 1)
END IF

' recheck command line
IF INSTR(Command.Line, "/") THEN
   GOTO Boot.Error
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

' check pipe length
InregsX.AX = &H4202 ' eof
InregsX.BX = 0 ' stdin
InregsX.CX = 0
InregsX.DX = 0
Call InterruptX(&H21, InregsX, OutregsX)
If OutregsX.AX > 0 Then
   Pipe.Redirect = True
   InregsX.AX = &H4200
   InregsX.BX = 0 ' stdin
   InregsX.CX = 0
   InregsX.DX = 0
   Call InterruptX(&H21, InregsX, OutregsX)
Endif
If Pipe.Redirect = False Then
   DEF SEG = &H40
   X = PEEK(&H71)
   DEF SEG
   IF X = 64 THEN
      DEF SEG = &H40
      POKE &H71, 0
      DEF SEG
   END IF
Endif
DO
   ' check control break
   IF BreakIS THEN
      EXIT DO
   END IF

   ' get standard input
   Standard.Input$ = NUL

   If Pipe.Redirect Then
      DO

         ' read from device
         InregsX.AX = &H3F00
         InregsX.BX = 0 ' stdin
         InregsX.CX = 1 ' char
         InregsX.DS = VARSEG(Pipe.Buffer)
         InregsX.DX = VARPTR(Pipe.Buffer)
         Call InterruptX(&H21, InregsX, OutregsX)
         If (OutregsX.Flags AND &H1) = &H1 Then
            Exit Do
         Endif
         If (OutregsX.Flags AND &H1) = &H0 Then
            If OutregsX.AX = 0 Then
               Exit Do
            Endif

            ' store input
            Redirected.Input = True

            ' store character
            Char$ = Pipe.Buffer

            ' check input character
            SELECT CASE ASC(Char$)
            CASE 10, 26
            CASE 13
               EXIT DO
            CASE ELSE
               Standard.Input$ = Standard.Input$ + Char$
            END SELECT
         END IF
      LOOP
   END IF

   ' 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 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
         Command.Work = MID$(Command.Work, 3)
      END IF

      ' store current filename
      OldASCIIZ = Command.Work + CHR$(0)
      Command.Work = NUL

      ' rename filename
      IF New.Name = False THEN
         NewASCIIZ = OldASCIIZ
         New.File$ = LEFT$(NewASCIIZ, INSTR(NewASCIIZ, CHR$(0)) - 1)
      END IF
      IF Lower.Case THEN
         NewASCIIZ = LCASE$(NewASCIIZ)
      END IF
      IF Windows.Detected THEN
         InregsX.AX = &H7156
         InregsX.DS = VARSEG(OldASCIIZ)
         InregsX.DX = VARPTR(OldASCIIZ)
         InregsX.ES = VARSEG(NewASCIIZ)
         InregsX.DI = VARPTR(NewASCIIZ)
         CALL InterruptX(&H21, InregsX, OutregsX)
      ELSE
         InregsX.AX = &H5600
         InregsX.DS = VARSEG(OldASCIIZ)
         InregsX.DX = VARPTR(OldASCIIZ)
         InregsX.ES = VARSEG(NewASCIIZ)
         InregsX.DI = VARPTR(NewASCIIZ)
         CALL InterruptX(&H21, InregsX, OutregsX)
      END IF

      ' display any errors
      CALL DisplayError ("Error renaming filename.")

      ' check carry flag error
      IF (OutregsX.Flags AND &H1) = &H0 THEN
         ' display search filename
         COLOR Yellow, Black
         PRINT New.File$
      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.Nameit:

' 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 "Nameit v1.2a: File rename utility; "
 COLOR Yellow, Black
 PRINT "Usage:"
 PRINT "   Nameit [\path\]filename.ext [/n][/clz]"
 PRINT "Where:"
 PRINT "   /nfilename.ext  new filename"
 PRINT "   /c  continuous display"
 PRINT "   /l  force to lowercase"
 PRINT "   /z  suppress error messages"
 COLOR Plain, Black
 END

Boot.Error:
 CALL RestInt
 Var$=Inkey$
 COLOR White, Black
 PRINT "Command line error. Type Nameit /? 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, False
    PRINT "Nameit v1.2a: File 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 Green, 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.Nameit
 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
    InregsX2 = InregsX
    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
       ' release time slice.
       InregsX.AX = &H1680
       InregsX.BX = &H0000
       CALL InterruptX(&H2F, InregsX, OutregsX)
    LOOP
    InregsX = InregsX2
    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 Redirected.Input THEN
    DEF SEG = &H40
    X = PEEK(&H71)
    DEF SEG
    IF X = 64 THEN
       Var = True
    END IF
 END IF
 IF KeyIS THEN
    IF OutregsX.AX = 0 THEN
       Var = True
       DEF SEG = &H40
       POKE &H71, 64
       DEF SEG
    END IF
 END IF
 IF Var THEN
    Continuous.Display = True
 END IF
 BreakIS = Var
END FUNCTION

' checks keyboard buffer
FUNCTION KeyIS
 InregsX3 = InregsX
 InregsX.AX = &H0100
 CALL InterruptX(&H16, InregsX, OutregsX)
 InregsX = InregsX3
 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
