10 ! FLOPPY DISK UTILITY (RT11 COMPATABLE) 15 DIM R$(512%),H%(506%),M%(30%) 20 ! COMMAND MODE 25 INPUT "ENTER COMMAND";C$ 26 IF C$="EX" THEN GOTO 3000 35 L%=LEN(C$) : P1%=1% : P%=0% : F%=1% : T%=0% : S%=0% 36 C$(I%)="" FOR I%=1% TO 4% 40 C1$=MID(C$,P1%+P%,1%) 42 IF C1$=":" THEN GOTO 60 ELSE IF C1$="." THEN GOTO 70 ELSE IF C1$="<" OR C1$="=" THEN GOTO 80 ELSE IF C1$<>"/" THEN GOTO 44 43 S%=1% : F%=2% : GOTO 82 44 IF C1$>="A" AND C1$<="Z" THEN GOTO 48 46 IF C1$>="0" AND C1$<="9" GOTO 48 : GOTO 450 48 IF L%=P1%+P% THEN GOTO 50 ELSE P%=P%+1% : GOTO 40 50 ! LOOP END - RUN OUT OF CHARS IN C$ 52 IF F%<3% THEN GOTO 450 54 F%=4% : P%=P%+1% : GOTO 82 60 ! GOT A ":" CHAR 62 IF F%<>1% AND F%<>3% OR P%>3% OR P%<2% THEN GOTO 451 64 C$(F%)=MID(C$,P1%,P%+1%) : F%=F%+1% 66 P1%=P1%+P%+1% : P%=0% 67 IF P1%>L% THEN GOTO 110 ELSE IF S%=0% THEN GOTO 40 68 IF L%>P1% THEN GOTO 452 ELSE GOTO 110 70 ! GOT A "." CHAR 72 IF P%>6% OR P%=0% OR T%=1% THEN GOTO 450 73 IF F%=1% OR F%=3% THEN F%=F%+1% 74 C$(F%)=MID(C$,P1%,P%) 76 C$(F%)=C$(F%)+" " WHILE LEN(C$(F%))<6% 78 C$(F%)=C$(F%)+"." : T%=1% : GOTO 66 80 IF F%>2% THEN GOTO 450 ELSE F%=2% 82 IF T%=1% GOTO 100 86 IF P%<>0% THEN GOTO 90 87 F%=3% : GOTO 66 90 IF P%>6% THEN GOTO 450 91 C$(F%)=MID(C$,P1%,P%) 92 C$(F%)=C$(F%)+" " WHILE LEN(C$(F%))<6% 94 C$(F%)=C$(F%)+".BAS" : GOTO 87 100 T%=0% 102 IF P%>3% THEN GOTO 450 104 C$(F%)=C$(F%)+MID(C$,P1%,P%) 106 C$(F%)=C$(F%)+" " WHILE LEN(C$(F%))<10% 108 GOTO 87 110 IF C$(2%)<>"" THEN GOTO 120 111 IF C$(4%)<>"" THEN GOTO 115 112 IF S%=0% THEN GOTO 450 ELSE GOTO 160 115 C$(2%)=C$(4%) : GOTO 125 120 IF C$(4%)<>"" THEN GOTO 125 122 C$(4%)=C$(2%) 125 IF S%=1% THEN GOTO 160 130 IF LEFT(C$(1%),2%)="DX" THEN GOTO 134 ELSE IF LEFT(C$(3%),2%)="DX" THEN GOTO 145 ELSE GOTO 451 134 D5$=MID(C$(1%),3%,1%) 135 IF D5$="0" THEN U8$="0" ELSE IF D5$=":" THEN U8$="0" ELSE IF D5$="1" THEN U8$="1" ELSE GOTO 451 139 IF C$(3%)="" OR C$(3%)="RK:" OR C$(3%)="SY:" OR C$(3%)="DK:" THEN GOTO 500 ELSE GOTO 451 145 D5$=MID(C$(3%),3%,1%) 147 IF D5$="0" THEN U9$="0" ELSE IF D5$=":" THEN U9$="0" ELSE IF D5$="1" THEN U9$="1" ELSE GOTO 451 149 IF C$(1%)="" OR C$(1%)="RK:" OR C$(1%)="DK:" OR C$(1%)="SY:" THEN GOTO 600 ELSE GOTO 451 160 ! DEAL WITH SWITCH COMMAND 161 S$=MID(C$,P1%,1%) 162 IF S$="D" THEN GOTO 1000 ELSE IF S$="Z" THEN GOTO 1100 ELSE IF S$="L" THEN GOTO 1200 ELSE IF S$="S" THEN GOTO 1400 ELSE GOTO 452 450 PRINT "COME AGAIN ?" : GOTO 20 451 PRINT "BAD DEVICE NAME" : GOTO 20 452 PRINT "BAD SWITCH" : GOTO 20 500 ! COPY DX:<"" 504 F%=1% : U$=U8$ : ON ERROR GOTO 506 : GOTO 508 506 PRINT "ERROR #";ERR;" OPENING FLOPPY" 507 CLOSE F% : RESUME 20 508 GOSUB 2000 : IF A%=0% GOTO 599 : ON ERROR GOTO 510 509 IF I%<496% THEN GOTO 512 : PRINT "DIRECTORY FULL" : GOTO 599 510 PRINT "ERROR #";ERR;" OPENING DISK FILE" 511 CLOSE 3% : RESUME 20 512 OPEN C$(4%) FOR INPUT AS FILE #3%,RECORDSIZE 512% 513 FIELD #3%,512% AS D$ : FIELD #1%,512% AS D1$ 514 !O.K. READY TO COPY FILE ACROSS 516 ON ERROR GOTO 522 : B%=0% 518 GET #3% : LSET D1$=D$ : PUT #1%,RECORD A%*4%+32767%+1% 520 A%=A%+1% : B%=B%+1% : IF A%<494% THEN GOTO 518 521 PRINT "ERROR - FLOPPY OVERFLOW" : GOTO 530 522 IF ERR<>11 THEN GOTO 524 ELSE RESUME 526 524 PRINT "ERROR #";ERR;" IN GET-PUT LOOP" 525 CLOSE F% : CLOSE 3% : RESUME 20 526 ! FINISHED COPY - NOW UPDATE DIRECTORY 528 GOSUB 2050 ! ADD ENTRY TO DIRECTORY 530 CLOSE #1% : CLOSE #3% : GOTO 20 599 CLOSE F% : GOTO 20 600 ! COPY ""1024% THEN GOTO 638 620 IF LEFT(C$(4%),3%)<>RAD$(H%(I%+1%)) THEN GOTO 638 ELSE IF MID(C$(4%),4%,3%)<>RAD$(H%(I%+2%)) THEN GOTO 638 ELSE IF RIGHT(C$(4%),8%)<>RAD$(H%(I%+3%)) THEN GOTO 638 622 L%=H%(I%+4%) ! CHECK LENGTH OF FILE 624 IF L%>0% AND L%<481% THEN GOTO 630 626 PRINT "DIRECTORY ENTRY IS CORRUPT" 628 CLOSE #2% : GOTO 20 630 OPEN C$(2%) FOR OUTPUT AS FILE #3%,RECORDSIZE 512% 631 FIELD #3%,512% AS D$ : FIELD #2%,512% AS D1$ : ON ERROR GOTO 524 632 GET #2,RECORD A%*4%+32767%+1% : LSET D$=D1$ : PUT #3% 634 L%=L%-1% : A%=A%+1% : IF L%>0% GOTO 632 636 CLOSE #2% : CLOSE #3% : GOTO 20 638 A%=A%+H%(I%+4%) : I%=I%+7%+H9%(3%) : GOTO 616 642 PRINT "FILE ISN'T ON FLOPPY" 644 CLOSE #2% : GOTO 20 1000 ! D (DELETE) SWITCH 1003 IF C$(1%)="DX:" OR C$(1%)="DX0:" THEN U8$="0" ELSE IF C$(1%)="DX1:" THEN U8$="1" ELSE GOTO 451 1004 F1%=0% ! DELETE FLAG 1005 F%=1% : U$=U8$ : ON ERROR GOTO 506 1007 GOSUB 2000 : IF A%=0% GOTO 599 1010 I%=0% 1012 IF H%(I%)=2048% THEN GOTO 1035 1014 IF H%(I%)=1024% THEN GOTO 1020 ELSE GOTO 1030 1020 IF RAD$(H%(I%+1%))<>LEFT(C$(2%),3%) THEN GOTO 1030 ELSE IF RAD$(H%(I%+2%))<>MID(C$(2%),4%,3%) THEN GOTO 1030 ELSE IF RAD$(H%(I%+3%))<>RIGHT(C$(2%),8%) THEN GOTO 1030 1025 H%(I%)=512% : F1%=1% ! SET DELETE FLAG 1030 I%=I%+7%+H9%(3%) : GOTO 1012 1035 IF F1%=1% THEN GOTO 1040 1037 PRINT "FILE NOT FOUND" : GOTO 1042 1040 GOSUB 2062 ! WRITE OUT NEW DIRECTORY TO FLOPPY 1042 CLOSE #1% : GOTO 20 1100 ! Z (INITIALISE) SWITCH 1103 IF C$(1%)="DX:" OR C$(1%)="DX0:" THEN U8$="0" ELSE IF C$(1%)="DX1:" THEN U8$="1" ELSE GOTO 451 1105 PRINT "INITIALISE DX";U8$;" ARE YOU SURE ?"; 1106 INPUT D$ : IF LEFT(D$,1)<>"Y" THEN GOTO 20 1110 OPEN "DX"+U8$+":" AS FILE #1%,RECORDSIZE 512%,MODE 16384% 1112 FIELD #1%,2%*I% AS D$,2% AS R$(I%) FOR I%=0% TO 255% 1114 LSET R$(0%)=CVT%$(SWAP%(4%)) 1115 LSET R$(1%)=CVT%$(SWAP%(0%)) 1116 LSET R$(2%)=CVT%$(SWAP%(1%)) 1117 LSET R$(3%)=CVT%$(SWAP%(0%)) 1118 LSET R$(4%)=CVT%$(SWAP%(14%)) 1119 LSET R$(5%)=CVT%$(SWAP%(512%)) 1120 LSET R$(I%)=CVT%$(SWAP%(0%)) FOR I%=6% TO 11% 1122 LSET R$(9%)=CVT%$(SWAP%(480%)) 1124 LSET R$(12%)=CVT%$(SWAP%(2048%)) 1126 PUT #1%,RECORD 6%*4%+32767%+1% 1128 CLOSE 1% : GOTO 20 1200 ! L (LIST DIRECTORY) SWITCH 1203 IF C$(1%)="DX:" OR C$(1%)="DX0:" THEN U8$="0" ELSE IF C$(1%)="DX1:" THEN U8$="1" ELSE GOTO 451 1205 F%=1% : U$=U8$ : ON ERROR GOTO 506 1207 GOSUB 2000 : IF A%=0% GOTO 599 1208 PRINT 1209 PRINT "FILENAME BLOCKS" 1210 I%=0% 1212 IF H%(I%)=2048% THEN GOTO 1224 1214 IF H%(I%)=1024% THEN GOTO 1218 1216 PRINT "", : GOTO 1220 1218 PRINT RAD$(H%(I%+1%))+RAD$(H%(I%+2%))+"."+RAD$(H%(I%+3%)), 1220 PRINT H%(I%+4%) 1222 I%=I%+7%+H9%(3%) : GOTO 1212 1224 PRINT : CLOSE 1% : GOTO 20 1400 ! S (SQUEEZE TOGETHER) SWITCH 1403 IF C$(1%)="DX:" OR C$(1%)="DX0:" THEN U8$="0" ELSE IF C$(1%)="DX1:" THEN U8$="1" ELSE GOTO 451 1405 F%=1% : U$=U8$ : ON ERROR GOTO 506 1407 GOSUB 2000 : IF A%=0% GOTO 599 1408 FIELD #1%,512% AS D$ 1410 I%=0% : J%=0% : F1%=0% : P%=0% : P1%=H9%(4%) 1412 IF H%(I%)=2048% THEN GOTO 1440 1414 IF H%(I%)<>1024% THEN GOTO 1438 1416 IF F1%=0% THEN GOTO 1432 1420 K%=0% 1422 R%=P1%+P%+K% 1424 GET #1%,RECORD R%*4%+32767%+1% 1425 R%=P1%+K% 1426 PUT #1%,RECORD R%*4%+32767%+1% 1428 K%=K%+1% : IF K%31% OR H9%(0%)<1% THEN GOTO 2044 ELSE IF H9%(3%)>8% OR H9%(3%)<0% THEN GOTO 2044 ELSE IF H9%(4%)<8% OR H9%(4%)>50% THEN GOTO 2044 ELSE IF H9%(1%)<>0% THEN GOTO 2046 ELSE IF H9%(2%)<>1% THEN GOTO 2044 2019 ! LOOKS LIKE IT HAS A DIRECTORY - READ IT IN 2020 H%(I%)=SWAP%(CVT$%(R$(I%+5%))) FOR I%=0% TO 250 2022 GET #F%,RECORD 7%*4%+32767%+1% 2024 H%(I%+251%)=SWAP%(CVT$%(R$(I%))) FOR I%=0% TO 255% 2026 ! CHECK DIRECTORY FOR OBVIOUS FAULTS 2028 A%=H9%(4%) : I%=0% : F1%=0% 2030 IF H%(I%)=2048% THEN GOTO 2040 2032 IF H%(I%)=1024% THEN A%=A%+F1%+H%(I%+4%) ELSE GOTO 2036 2034 F1%=0% : GOTO 2038 2036 IF H%(I%)=256% OR H%(I%)=512% THEN F1%=F1%+H%(I%+4%) ELSE GOTO 2042 2038 I%=I%+7%+H9%(3%) : GOTO 2030 2040 IF I%>0% THEN GOTO 2049 2042 PRINT "FAULTY DIRECTORY" : GOTO 2048 2044 PRINT "UNINITIALISED FLOPPY" : GOTO 2048 2046 PRINT "FLOPPY CONTAINS TOO MANY FILES TO HANDLE - SORRY" 2048 A%=0% : CLOSE #F% 2049 RETURN 2050 ! SUBROUTINE TO ADD ENTRY TO DX DIRECTORY 2051 I1%=I%+6%+H9%(3%) : H%(I1%+1%)=2048% 2052 FOR J%=I% TO I1% 2053 H%(J%)=H%(J%-7%-H9%(3%)) : NEXT J% 2054 H%(I%+4%)=H%(I%+4%)-B% 2056 H%(I%-7%-H9%(3%))=1024% 2057 CHANGE SYS(CHR$(6%)+CHR$(-10%)+C$(2%)) TO M% 2058 H%(I%-6%-H9%(3%)+J%)=M%(2%*J%+7%)+SWAP%(M%(2%*J%+8%)) FOR J%=0%TO2% 2061 H%(I%-3%-H9%(3%))=B% 2062 FIELD #F%,I%*2 AS D$,2% AS R$(I%) FOR I%=0% TO 255% 2064 LSET R$(I%)=CVT%$(SWAP%(H9%(I%))) FOR I%=0% TO 4% 2066 LSET R$(I%+5%)=CVT%$(SWAP%(H%(I%))) FOR I%=0% TO 250% 2068 PUT #F%,RECORD 6%*4%+32767%+1% 2070 LSET R$(I%)=CVT%$(SWAP%(H%(I%+251%))) FOR I%=0% TO 255% 2072 PUT #F%,RECORD 7%*4%+32767%+1% 2074 RETURN 3000 END