8-Bit Software Online Conversion
:2.$.Arch_De - Listing
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