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