10REM ARCER (BASIC)
20REM BY ANDREW BLACK
30REM VERSION 1.8
40REM (C) ANDREW SOFT
50REM" This program has been placed
60REM" into Public Domain.
70*FX14,6
80ONERRORPROCa(0)
90DIMb&20,c&10,d$(70):e$="":MODE7:VDU
23;8202;0;0;0;:VDU15:PROCf
100PROCg:END
110DEFPROCh:CLS:PRINT" Compressing Mod
e":PRINT:INPUT" How many files to compre
ss",i%:IFi%>30THENPROCh
120INPUT" Destination file",j$:e$="!":
k=OPENOUT(j$):FORQ=1TOi%:INPUT" Enter fi
le(s) to compress",d$(Q):NEXT:FORW=1TOi%
:l=OPENIN(d$(W)):IFl=0THENPROCa(1)
130m%=EXT#(l):n%=((m%/1024)*9)DIV1
140PRINT:PRINT" Compressing "d$(W):PRI
NT" Compression time is ";n%" secs.":PRO
Co:PRINT#k,d$(W),m%,p%,q%:FORZ=1TOm%:BPU
T#k,BGET#l:NEXT:CLOSE#l:NEXT:CLOSE#k:PRI
NT'" Transfer successful ":I$=INKEY$(2
00):ENDPROC
150DEFPROCr:$c=d$(W):!b=c:!(b+2)=p%:!(
b+6)=q%:X%=bMOD256:Y%=bDIV256:A%=2:CALL&
FFDD:X%=bMOD256:Y%=bDIV256:A%=3:CALL&FFD
D:ENDPROC
160DEFPROCs:CLS:PRINT" Decompressing M
ode":PRINT:INPUT" Input source file",t$:
W=1:e$="!":l=OPENIN(t$):IFl=0THENPROCa(1
)
170u%=EXT#l:n%=((u%/1024)*9)DIV1
180PRINT:PRINT" Decompress complete fi
le in ";n%" secs.":REPEAT:INPUT#l,d$(W),
m%,p%,q%:k=OPENOUT(d$(W)):PRINT:PRINT" D
ecompressing ";d$(W):FORZ=1TOm%:BPUT#k,B
GET#l:NEXT:CLOSE#k:PROCr:W=W+1:UNTILEOF#
l:CLOSE#0:PRINT'" Transfer successful
":I$=INKEY$(200):ENDPROC
190DEFPROCo:$c=d$(W):!b=c:X%=bMOD256:Y
%=bDIV256:A%=5:CALL&FFDD:p%=!(b+2):q%=!(
b+6):ENDPROC
200DEFPROCg:CLS:IFe$="!"THENPROCv
210INPUT" Which drive to use (0-3)",w%
:IFw%>3THENPROCg
220$&900="DR."+STR$(w%):X%=&00:Y%=&09:
CALL&FFF7:INPUT" Compress or decompress
file(s) (C/D)",e$:IFe$="C"THENPROCh
230IFe$="D"THENPROCs
240IFe$=""THENPROCgELSEPROCg
250ENDPROC
260DEFPROCa(x%):CLOSE#0:IFx%=1THENPRIN
T"File not found"
270REPORT:PRINT:ENVELOPE1,1,4,-4,4,10,
20,10,127,0,0,-5,126,126:SOUND1,1,100,10
0:END:ENDPROC
280DEFPROCf:PRINT"
pppppppppppppppppppp";:VDU134,157,141:PR
INT" File Compresser by Andrew Black":VD
U134,157,141:PRINT" File Compresser by A
ndrew Black":PRINT"
£££££££££££££££££££":VDU28,0,24,39,4:END
PROC
290DEFPROCv:e$="":CLS:INPUT" Exit (Y/N
)",y$:IFy$="N"THENGOTO100
300END:ENDPROC