10 DEFFNS="Arch_De" 20 REM 8.3.95 0831 30 ONERROR:CLS:REPORT:PRINTERL:IF ERR<>17:OSCLI"FX21":PRINT"Press a key":REPEATUNTILGET ELSE END 40 MODE7 50 VDU23;8202;0;0;0; 60 D%=&4000 70 U%=&2000 80 HIMEM=D% 90 B%=&900 100 REPEAT 110 PROCscreen 120 IFA$="1"PROCcompact 130 IFA$="2"PROCdecompact 140 IFA$="3":CLS:OSCLI".":INPUT'"ƒArchive to examine: "A$:PROCexam:OSCLI"FX21":PRINT''"‚Press a key.":REPEATUNTILGET 150 IFA$="*":CLS:INPUT"*"A$:OSCLIA$:OSCLI"FX21":PRINT'"Press a key.":REPEATUNTILGET 160 UNTILFALSE 170 DEFPROCcompact 180 CLS 190 *. 200 PRINT'"1.†Start a new archive." 210 PRINT"2.†Add to existing archive." 220 *FX 21 230 REPEAT 240 A$=GET$ 250 UNTILINSTR("12",A$) 260 IF A$="1" PROCstartnew 270 IF A$="2" PROCaddone 280 ENDPROC 290 DEFPROCstartnew 300 CLS 310 PRINT 320 *. 330 INPUT'"ƒFile name for new archive. "A$ 340 OSCLI"SA. "+A$+" 0+1" 350 F%=OPENOUT A$ 360 FORL%=1TO51 370 PRINT#F%,0 380 NEXT 390 PROCfill 400 ENDPROC 410 DEFPROCfill 420 REPEAT 430 CLS 440 PRINT 450 *. 460 *FX21 470 PRINT'"‚Next file orRETURN‚to finish:" 480 INPUT A$ 490 IF A$<>"" PROCadd 500 UNTILA$="" 510 CLOSE#F% 520 ENDPROC 530 DEFPROCaddone 540 CLS 550 PRINT 560 *. 570 INPUT'"‚Archive to add to: "A$ 580 IFFNcheck ENDPROC 590 F%=OPENUP A$ 600 PROCfill 610 ENDPROC 620 DEFPROCadd 630 G%=OPENIN A$ 640 H%=EXT#G% 650 PTR#F%=0 660 L%=0 670 REPEAT 680 L%=L%+1 690 INPUT#F%,A% 700 UNTIL A%=0 OR L%=51 710 IF L%=51:PRINT'"‚THERE IS NO MORE ROOM! PRESS A KEY":OSCLI"FX 21 ":REPEATUNTILGET:CLOSE#G%:ENDPROC 720 PTR#F%=PTR#F%-5 730 C%=EXT#F% 740 PRINT#F%,C% 750 PTR#F%=C% 760 PROCreadinfo 770 IF EXT#G%EXT#G% PROCload(G%):PROCsave(F%) 830 CLOSE#G% 840 ENDPROC 850 DEFPROCdecompact 860 CLS 870 PRINT 880 *. 890 INPUT'"‚File to de-archive? "A$ 900 IFFNcheck ENDPROC 910 PROCexam 920 PRINT''"1.ƒDe-archive all." 930 PRINT"2.ƒDe-archive one."' 940 *FX21 950 REPEAT 960 B$=GET$ 970 UNTILINSTR("12",B$) 980 IF B$="1"PROCdecompactall 990 IF B$="2"PROCdecompactone 1000 ENDPROC 1010 DEFPROCdecompactall 1020 M%=0 1030 PRINT'"Name";TAB(12);"Load";TAB(21);"Execute";TAB(30);"Length"' 1040 FORZ%=1TO50 1050 G%=OPENIN A$ 1060 PTR#G%=M% 1070 INPUT#G%,N% 1080 M%=PTR#G% 1090 IF N%<>0:PTR#G%=N% 1100 IF N%<>0:PROCgetout ELSE CLOSE#G% 1110 NEXT 1120 *FX21 1130 PRINT'"†Press a key." 1140 REPEATUNTILGET 1150 ENDPROC 1160 DEFPROCdecompactone 1170 G%=OPENIN A$ 1180 *FX21 1190 INPUT'"†Which file to recover? "B$ 1200 B$=FNcon(B$) 1210 PRINT 1220 M%=0 1230 REPEAT 1240 PTR#G%=M% 1250 INPUT#G%,N% 1260 M%=PTR#G% 1270 IF N%<>0:PTR#G%=N% 1280 IF N%<>0 INPUT#G%,C$:C$=FNcon(C$) 1290 UNTIL C$=B$ OR N%=0 1300 IF N%<>0 IF C$=B$:PTR#G%=N%:PRINT"Name";TAB(12);"Load";TAB(21);"Execute";TAB(30);"Length"':PROCgetout 1310 *FX21 1320 IF N%=0 PRINT'"NOT FOUND!":CLOSE#G%:PRINT'"…Press a key.":REPEATUNTILGET:ENDPROC 1330 PRINT'TAB(5)"†(C)hain *(R)un (E)nd" 1340 PRINT'TAB(6)"„ƒSelect C, R or E œ" 1350 REPEAT 1360 A$=GET$ 1370 UNTILINSTR("CcRrEe",A$) 1380 IF INSTR("Cc",A$):CHAIN B$ 1390 IF INSTR("Rr",A$):OSCLI"RUN "+B$ 1400 ENDPROC 1410 DEFFNcon(Z$) 1420 Y$="" 1430 FORK%=1TOLENZ$ 1440 IF MID$(Z$,K%,1)=" ":NEXT:=Y$ 1450 Y$=Y$+CHR$(ASC(MID$(Z$,K%,1)) OR 32) 1460 NEXT 1470 =Y$ 1480 DEFPROCgetout 1490 INPUT#G%,C$ 1500 INPUT#G%,Q% 1510 INPUT#G%,R% 1520 INPUT#G%,S% 1530 INPUT#G%,T% 1540 OSCLI"SA. "+C$+" 0+1" 1550 F%=OPENOUT C$ 1560 PRINTC$;TAB(12);STRING$(8-LEN(STR$~(Q%)),"0");~Q%;TAB(21);STRING$(8-LEN(STR$~(R%)),"0");~R%;TAB(30);~S% 1570 IF S%0 PROCload(G%):PROCsave(F%) 1590 PROCwriteinfo 1600 CLOSE#F% 1610 CLOSE#G% 1620 ENDPROC 1630 DEFPROCexam 1640 IFFNcheck ENDPROC 1650 F%=OPENIN A$ 1660 CLS 1670 PRINT'"†";A$;" contains:"' 1680 M%=0 1690 FORL%=1 TO 50 1700 PTR#F%=M% 1710 INPUT#F%,A% 1720 M%=PTR#F% 1730 IFA%<>0:PTR#F%=A%:INPUT#F%,B$:PRINTB$; 1740 NEXT 1750 CLOSE#F% 1760 ENDPROC 1770 DEFPROCload(V%) 1780 A%=4 1790 X%=B% MOD 256 1800 Y%=B% DIV 256 1810 B%?0=V% 1820 B%!1=D% 1830 B%!5=I% 1840 CALL&FFD1 1850 ENDPROC 1860 DEFPROCsave(V%) 1870 A%=2 1880 X%=B% MOD 256 1890 Y%=B% DIV 256 1900 B%?0=V% 1910 B%!1=D% 1920 B%!5=I% 1930 CALL&FFD1 1940 ENDPROC 1950 DEFPROCscreen 1960 CLS 1970 PRINT'TAB(6);"File Archive/De-archive" 1980 PRINTTAB(6)"ƒFile Archive/De-archive" 1990 PRINT''TAB(8)"„ƒBy C.J.Richardson. œ" 2000 PRINT'TAB(8,11)"1.ƒArchive Files." 2010 PRINTTAB(8)"2.ƒDe-Archive Files." 2020 PRINTTAB(8)"3.ƒExamine Archive." 2030 PRINT''TAB(3,19)"„ƒChoose 1 - 3 or * Command. œ" 2040 *FX21 2050 REPEAT 2060 A$=GET$ 2070 UNTILINSTR("123*",A$) 2080 ENDPROC 2090 DEFPROCreadinfo 2100 X%=B%MOD256 2110 Y%=B%DIV256 2120 A%=5 2130 A$=A$+STRING$(10-LEN(A$)," ") 2140 $(B%+&13)=A$ 2150 B%?0=(B%+&13) MOD 256 2160 B%?1=(B%+&13) DIV 256 2170 CALL&FFDD 2180 PRINT#F%,A$ 2190 PRINT #F%,B%!2 2200 PRINT #F%,B%!6 2210 PRINT #F%,B%!10 2220 PRINT #F%,B%!14 2230 ENDPROC 2240 DEFPROCwriteinfo 2250 X%=B%MOD256 2260 Y%=B%DIV256 2270 A%=1 2280 $(B%+&13)=C$ 2290 B%?0=(B%+&13) MOD 256 2300 B%?1=(B%+&13) DIV 256 2310 B%!2=Q% 2320 B%!6=R% 2330 B%!10=S% 2340 B%!14=T% 2350 CALL&FFDD 2360 ENDPROC 2370 DEFFNcheck 2380 F%=OPENINA$ 2390 IF EXT#F%<&FF:CLOSE#F%:OSCLI"FX 21":PRINT'"Not an archive. Press a key.":REPEATUNTILGET:=TRUE 2400 Z%=0 2410 REPEAT 2420 Z%=Z%+5 2430 PTR#F%=Z% 2440 IFBGET#F%<>&40:Z%=&FA:UNTILZ%=&FA:CLOSE#F%:OSCLI"FX 21":PRINT'"Not an archive. Press a key.":REPEATUNTILGET:=TRUE 2450 UNTILZ%=&FA 2460 CLOSE#F% 2470 =FALSE