10REM ARCER (BASIC) 20REM BY ANDREW BLACK 30REM VERSION 1.8c 40REM (C) ANDREW SOFT 50REM Examine & menu added, JGH 60REM" This program has been placed 70REM" into Public Domain. 80*|FX14,6 90DIMb&20,c&100,d$(70):e$="":MODE7:mx %=HIMEM-TOP-2000:IFmx%>&FFFF mx%=&10000 100DIMdt%mx%:VDU23;8202;0;0;0;:VDU15:P ROCf:PROChp 110ONERRORIFFNerr END 120REPEAT:UNTILFNg:PRINT:END 130DEFPROCh:PRINT'" Compression Mode": INPUT" Destination file "j$:k%=OPENOUT(j $):PRINT" Enter filenames, dir names, *c ommands, end with RETURN":REPEAT:REPEAT :REPEAT:INPUT" File: "d$:IFLEFT$(d$,1)=" *" PROCosc(d$) 140UNTILLEFT$(d$,1)<>"*":l%=0:IFd$<>"" l%=OPENIN(d$):IFl%=0 PRINT" File not fo und" 150UNTILl%<>0 ORd$="":IFd$<>"" PROCo:I Fr0%=1 m%=EXT#l%:PRINT#k%,d$,m%,p%,q%:PR OCtr(l%,k%,m%):CLOSE#l% ELSE IFd$<>"" CL OSE#l%:PROCosc("DIR "+d$):PROCdir 160UNTILd$="":CLOSE#k%:PRINT'" Transf er completed":ENDPROC 170DEFPROCr:$c=d$:X%=b:Y%=X%DIV256:!X% =c:X%!2=p%:X%!6=q%:A%=2:CALL&FFDD:A%=3:C ALL&FFDD:ENDPROC 180DEFPROCs:PRINT'" Decompression Mode ":REPEAT:INPUT" Input source file: "t$:l %=OPENIN(t$):IFl%=0 PRINT" File not foun d" 190n%=BGET#l%:PTR#l%=0:IFn%<>0:CLOSE#l %:l%=0:PRINT" Not a Black archive" 200UNTILl%<>0:u%=EXT#l%:n%=((u%/1024)* 9)DIV3.5 210PRINT'" Decompress complete file in ";n%" secs.":REPEAT:INPUT#l%,d$,m%,p%,q %:k%=OPENOUT(FNnm(d$)):PRINT'" Decompres sing ";d$;:PROCtr(l%,k%,m%):CLOSE#k%:PRO Cr:UNTILEOF#l%:CLOSE#l%:PRINT'" Transfe r completed":ENDPROC 220DEFPROCo:LOCALX%,Y%,A%:$c=d$:!b=c:X %=b:Y%=X%DIV256:A%=5:r0%=USR&FFDD AND&FF :p%=b!2:q%=b!6:ENDPROC 230DEFFNg:VDU58:REPEATe$=GET$:IFe$>"£" e$=CHR$(ASCe$AND&DF) 240UNTILINSTR("CDXE?*",e$):VDU127:IFe$ ="C":PROCh 250IFe$="D"THENPROCs 260IFe$="E"THENPROCx 270IFe$="?" PROChp 280IFe$="*" INPUTLINE" *"e$:PROCosc(e$ ) 290=e$="X" 300DEFFNerr:REPORT:CLOSE#0:PRINT:=INKE Y-1 310DEFPROCa(x%):CLOSE#0:IFx%=1THENPRIN T"File not found" 320REPORT:PRINT:ENVELOPE1,1,4,-4,4,10, 20,10,127,0,0,-5,126,126:SOUND1,1,100,10 0:END:ENDPROC 330DEFPROCf:PRINT" STRINGV DU134,157,141:PRINT" File Archiver by An drew Black":VDU134,157,141:PRINT" File A rchiver by Andrew Black"'" STRING £");:REM VDU129,157,135:PRINTSPC(10)"Mod ified by JGH":VDU28,0,24,39,4:EN. 340VDU28,0,24,39,4:PRINT:CLS:ENDPROC 350DEFPROCv:e$="":INPUT" Exit (Y/N)",y $:IFy$="N"ENDPROC 360END:ENDPROC 370DEFPROCx:PRINT'" Examine archive":I NPUT" Enter source file: "t$:l%=OPENIN(t $):IFl%=0 PRINT" No file found":ENDPROC 380n%=BGET#l%:PTR#l%=0:IFn%<>0:CLOSE#l %:l%=0:PRINT" Not a Black archive":ENDPR OC 390PRINT" "t$" contains:":ln%=512:n%=0 400REPEATINPUT#l%,n$,m%,p%,q%:ln%=ln%+ m%+256-(m%AND&FF):PRINT" "n$;SPC(13-LENn $);FNh(p%);"+";FNh2(m%);" ";FNh(q%):PTR# l%=PTR#l%+m%:n%=n%+1:UNTILEOF#l%:PRINT"T otal size: ";ln%DIV1024;"K ";n%;" file s.":CLOSE#l%:ENDPROC 410DEFFNh2(A%):=RIGHT$(FNh(A%),4) 420DEFFNh(A%)=STRING$(8-LENSTR$÷A%,"0" )+STR$÷A% 430DEFPROCosc($c):LOCALX%,Y%:X%=c:Y%=X %DIV256:CALL&FFF7:ENDPROC 440DEFPROChp:PRINT" (C)ompress files"T AB(20)"(D)ecompress files"'" (E)xamine a rchive"TAB(20)"(*)command"'" e(X)it prog ram"TAB(20)"(?)Help":ENDPROC 450DEFPROCtr(c1%,c2%,n%):LOCALl%:X%=b: Y%=X%DIV256:REPEAT:l%=dt%:IFn%<l% l%=n% 460?b=c1%:b!1=dt%:b!5=l%:A%=4:CALL&FFD 1:?b=c2%:b!1=dt%:b!5=l%:A%=2:CALL&FFD1:n %=n%-l%:UNTILn%<1:ENDPROC 470DEFFNnm(d$):IFFNfs<>4:=d$ 480=LEFT$(d$,INSTR(d$,".")+7) 490DEFFNfs:LOCAL A%,E%,Y%:=USR&FFDA AN D&FF 500DEFPROCdir:LOCALr%,i%,l%:i%=0:REPEA TA%=8:X%=c+20:Y%=X%DIV256:X%!1=c:X%!5=1: X%!9=i%:CALL&FFD1:i%=X%!9:r%=X%!5:IFr%=0 :c?(1+?c)=13:d$=$(c+1):PROCo:IFr0%=1 PRI NT" File: "d$:l%=OPENINd$:m%=EXT#l%:PRIN T#k%,d$,m%,p%,q%:PROCtr(l%,k%,m%):CLOSE# l% 510UNTILr%<>0:ENDPROC