PRINT "                   File name:  CHATTRIB.BAS"
PRINT
PRINT "                    PROTECTED FILE UTILITY"
PRINT "      CHANGE FILE PROTECTION,  ERASE A PROTECTIED FILE,"
PRINT "                             or"
PRINT "        OVERWRITE A PROTECTED FILE WITH ANOTHER FILE"
PRINT " "
PRINT "                   BY BRUCE ROSS, HIMSELF"
PRINT "                       AUGUST 2, 1994"
PRINT "      Dedicated to the world as a Public Domain Program"
PRINT "                      rev  May 4, 1995"
PRINT
X! = TIMER
tx: IF TIMER < X! + 1 THEN GOTO tx
DIRX$ = "SDIR /P "    ' DIRECTORY LISTER
DIRFOO$ = DIRX$       ' DEFAULT DIRECTORY

ON ERROR GOTO 6630    ' error handler

GOOD:
SHELL DIRFOO$                                ' GET DIRECTORY
'SHELL "CAT"
PRINT "Change File Attribute, Overwrite, or Erase file. "
PRINT "X or Q to quit.  DIR path\name for directory"
INPUT " NAME of FILE TO BE CHANGED, OVERWRITTEN, or ERASED.<> "; Q$:
GOSUB 5350: OLD$ = Q$
IF Q$ = "X" THEN SYSTEM
IF Q$ = "Q" THEN SYSTEM
IF INSTR(OLD$, "DIR") > 0 THEN GOTO DIRECT   ' GET PARTIAL DIRECTORY

CONTINUE:
DIRFOO$ = DIRX$                              ' RESET DEFAULT DIRECTORY
IF OLD$ <> "" THEN GOTO ORELSE
PRINT "NO NAMED FILE WILL PERMIT CHANGING ATTRIBUTE OF ALL FILES IN DIRECTORY. "
INPUT " OK TO CHANGE ALL OF THEM?  Y/N/X/Q <N>"; Q$: GOSUB 5350
IF Q$ = "" THEN Q$ = "N"
IF Q$ = "X" THEN GOSUB 6541
IF Q$ = "Q" THEN GOSUB 6541
IF Q$ <> "Y" THEN GOTO GOOD

ORELSE:
PRINT "(CR to just change attribute of "; OLD$; "   E.E to erase."
INPUT "NAME OF FILE TO BE COPIED, or E.E   <>"; Q$
GOSUB 5350: NEW$ = Q$
IF NEW$ = "E.E" THEN GOTO KILLIT
IF Q$ = "X" THEN GOSUB 6541
IF Q$ = "Q" THEN GOSUB 6541
GOTO CONTUUU

KILLIT:                                 ' ERASE PROTECTED FILE
PRINT "verify  -- REMOVE "; OLD$; : INPUT " Y/N <N>"; Q$: GOSUB 5350
IF Q$ = "" THEN Q$ = "N"
IF Q$ = "N" THEN GOTO CONTUUU
IF Q$ = "X" THEN GOSUB 6541
IF Q$ = "Q" THEN GOSUB 6541
SHELL "ATTRIB " + OLD$ + " " + "-R"     ' REMOVE PROTECTION
KILL OLD$:  PRINT OLD$; " IS ERASED"    ' ERASE FILE
GOTO FUP

CONTUUU:                                ' CHANGE ATTRIBUTE OR COPY FILE
SHELL "SDIR " + OLD$
PRINT "+r, -r, +a, -a, +h, -h, /s  see DOS manual ATTRIB"
PRINT "NEW ATTRIBUTE. for `"; OLD$; : INPUT " ' <+R>  ( . for no change)"; ATTR$
IF ATTR$ = "" THEN ATTR$ = "+R"
IF INSTR(ATTR$, ".") THEN ATTR$ = ""

IF NEW$ = "" THEN GOTO FINISHUP
SHELL "ATTRIB " + OLD$ + " " + "-R"     ' REMOVE PROTECTION
SHELL "COPY " + NEW$ + " " + OLD$
PRINT NEW$; "  ----->  "; OLD$

FINISHUP:
SHELL "ATTRIB " + OLD$ + " " + ATTR$    ' SET NEW ATTRIBUTES
FUP:
PRINT "RESULT ---- "
SHELL "SDIR " + OLD$                    ' DISPLAY CHANGED DIRECTORY ENTRIES
PRINT : INPUT "another? X or Q to quit, CR to continue.  "; Q$: GOSUB 6442: GOTO GOOD

DIRECT:                                 ' VERIFY THAT IT IS A DIRECTORY CALL
OLD$ = RTRIM$(OLD$) + " "               ' DROP OFF RIGHT SPACES
OLD$ = LTRIM$(OLD$)
IF LEFT$(OLD$, 4) = "DIR " THEN OLD$ = "S" + OLD$
IF LEFT$(OLD$, 5) = "SDIR " THEN DIRFOO$ = RTRIM$(OLD$): GOTO GOOD   ' UP THE DIRECTORY
OLD$ = RTRIM$(OLD$)
GOTO CONTINUE


5330 '====================================================
5340 '--------------------- SUBROUTINES ------------------
5350 '[--------- all capitals ----------]
5370 Q$ = UCASE$(Q$)
5400 RETURN
5410 '
6520 '------------------------------------
6530 '[-------- whadyawant keyboard interrupt ----------]
6540 Q$ = INKEY$: IF Q$ = "" THEN RETURN
6541 DEF SEG = 0: POKE 1050, PEEK(1052) ' clear keyboard buffer
6542 DEF SEG : POKE 106, 0              ' clear basic input buffer
6550 INPUT " whadya want? .  X or Q to quit.  CR TO CONTINUE."; Q$ ' pause for instructions
6442 Q$ = UCASE$(Q$)                    ' all capitals
6560 IF Q$ = "Q" THEN 6600
6570 IF Q$ = "X" THEN 6600
6572 IF Q$ <> "" THEN 6541
6580 RETURN
6590 '
6600 LOCATE 25, 1: PRINT STRING$(80, " "); : LOCATE 25, 1: CLOSE : BEEP: SYSTEM
6602 '
6610 '----------------------------------------
6620 '
6630 ' --------- error handler -------
6640 PRINT "Error # "; ERR; "  at line "; ERL; ".   Device error # "; ERDEV; "  "; ERDEV$
6642 BEEP
     IF ERR = 9 THEN PRINT "subscript out of range"
6650 IF ERR = 64 THEN GOTO fileerr
6660 IF ERR = 68 THEN PRINT "device unavailable"
6670 IF ERR = 75 THEN GOTO fileerr
6680 IF ERR = 76 THEN GOTO fileerr
6690 IF ERR = 25 THEN PRINT "device fault"
6700 IF ERR = 27 THEN PRINT "out of paper"
6710 IF ERR = 51 THEN PRINT "internal error"
6720 IF ERR = 53 THEN GOTO fileerr
6730 IF ERR = 55 THEN GOTO fileerr
6740 IF ERR = 57 THEN PRINT "device I/O error"
6750 IF ERDEV = 10 THEN PRINT " Printer off line?"
6760 INPUT "Fix Problem.  Then CR to continue   X or Q to quit. "; Q$: GOSUB 5350:
6770 GOSUB 6560        ' question answers
6780 RESUME            ' back to line whence the error occured
6781 '

fileerr:
6785 SHELL " cat"
6786 IF ERR = 64 THEN PRINT "bad file name -- "; SOURCEFILE$
6787 IF ERR = 75 THEN PRINT "path / file access error"
6788 IF ERR = 53 THEN PRINT "File  not found."
6789 IF ERR = 76 THEN PRINT "path not found"
6791 IF ERR = 55 THEN PRINT "file already open"
6792 PRINT "FILE ACCESS TROUBLES ARE USUALLY PATH OR NAMING ERRORS."
6793 PRINT "   TROUBLE WITH FILE NAMED?   ` "; OLD$; " '"
6795 GOTO 6760
6800 '--------------------------------------
6810 END '--------- END OF CODE ------------