10 REM ARCER (BASIC)
   20 REM BY ANDREW BLACK
   30 REM VERSION 1.8c
   40 REM (C) ANDREW SOFT
   50 REM Examine & menu added, JGH
   60 REM"ƒThis program has been placed
   70 REM"ƒinto Public Domain.
   80 *|FX14,6
   90 DIMb&20,c&100,d$(70):e$="":MODE7:mx%=HIMEM-TOP-2000:IFmx%>&FFFF mx%=&10000
  100 DIMdt%mx%:VDU23;8202;0;0;0;:VDU15:PROCf:PROChp
  110 ONERRORIFFNerr END
  120 REPEAT:UNTILFNg:PRINT:END
  130 DEFPROCh:PRINT'"ƒCompression Mode":INPUT" Destination file "j$:k%=OPENOUT(j$):PRINT"‚Enter filenames, dir names, *commands, ‚end with RETURN":REPEAT:REPEAT:REPEAT:INPUT"†File: "d$:IFLEFT$(d$,1)="*" PROCosc(d$)
  140 UNTILLEFT$(d$,1)<>"*":l%=0:IFd$<>"" l%=OPENIN(d$):IFl%=0 PRINT"�File not found"
  150 UNTILl%<>0 ORd$="":IFd$<>"" PROCo:IFr0%=1 m%=EXT#l%:PRINT#k%,d$,m%,p%,q%:PROCtr(l%,k%,m%):CLOSE#l% ELSE IFd$<>"" CLOSE#l%:PROCosc("DIR "+d$):PROCdir
  160 UNTILd$="":CLOSE#k%:PRINT'"ƒˆTransfer completed":ENDPROC
  170 DEFPROCr:$c=d$:X%=b:Y%=X%DIV256:!X%=c:X%!2=p%:X%!6=q%:A%=2:CALL&FFDD:A%=3:CALL&FFDD:ENDPROC
  180 DEFPROCs:PRINT'"ƒDecompression Mode":REPEAT:INPUT" Input source file: "t$:l%=OPENIN(t$):IFl%=0 PRINT"�File not found"
  190 n%=BGET#l%:PTR#l%=0:IFn%<>0:CLOSE#l%:l%=0:PRINT"�Not a Black archive"
  200 UNTILl%<>0:u%=EXT#l%:n%=((u%/1024)*9)DIV3.5
  210 PRINT'" Decompress complete file in ";n%" secs.":REPEAT:INPUT#l%,d$,m%,p%,q%:k%=OPENOUT(FNnm(d$)):PRINT'" Decompressing ";d$;:PROCtr(l%,k%,m%):CLOSE#k%:PROCr:UNTILEOF#l%:CLOSE#l%:PRINT'"ƒˆTransfer completed":ENDPROC
  220 DEFPROCo: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
  230 DEFFNg:VDU58:REPEATe$=GET$:IFe$>"`" e$=CHR$(ASCe$AND&DF)
  240 UNTILINSTR("CDXE?*",e$):VDU127:IFe$="C":PROCh
  250 IFe$="D"THENPROCs
  260 IFe$="E"THENPROCx
  270 IFe$="?" PROChp
  280 IFe$="*" INPUTLINE"‚*"e$:PROCosc(e$)
  290 =e$="X"
  300 DEFFNerr:REPORT:CLOSE#0:PRINT:=INKEY-1
  310 DEFPROCa(x%):CLOSE#0:IFx%=1THENPRINT"File not found"
  320 REPORT:PRINT:ENVELOPE1,1,4,-4,4,10,20,10,127,0,0,-5,126,126:SOUND1,1,100,100:END:ENDPROC
  330 DEFPROCf:PRINT"—"STRING$(39,"p");:VDU134,157,141:PRINT"„File Archiver by Andrew Black":VDU134,157,141:PRINT"�File Archiver by Andrew Black"'"”"STRING$(39,"`");:REM VDU129,157,135:PRINTSPC(10)"Modified by JGH":VDU28,0,24,39,4:EN.
  340 VDU28,0,24,39,4:PRINT:CLS:ENDPROC
  350 DEFPROCv:e$="":INPUT" Exit (Y/N)",y$:IFy$="N"ENDPROC
  360 END:ENDPROC
  370 DEFPROCx:PRINT'"ƒExamine archive":INPUT" Enter source file: "t$:l%=OPENIN(t$):IFl%=0 PRINT"�No file found":ENDPROC
  380 n%=BGET#l%:PTR#l%=0:IFn%<>0:CLOSE#l%:l%=0:PRINT"�Not a Black archive":ENDPROC
  390 PRINT"ƒ"t$" contains:":ln%=512:n%=0
  400 REPEATINPUT#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"Total size: ";ln%DIV1024;"K   ";n%;" files.":CLOSE#l%:ENDPROC
  410 DEFFNh2(A%):=RIGHT$(FNh(A%),4)
  420 DEFFNh(A%)=STRING$(8-LENSTR$~A%,"0")+STR$~A%
  430 DEFPROCosc($c):LOCALX%,Y%:X%=c:Y%=X%DIV256:CALL&FFF7:ENDPROC
  440 DEFPROChp:PRINT" (C)ompress files"TAB(20)"(D)ecompress files"'" (E)xamine archive"TAB(20)"(*)command"'" e(X)it program"TAB(20)"(?)Help":ENDPROC
  450 DEFPROCtr(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&FFD1:?b=c2%:b!1=dt%:b!5=l%:A%=2:CALL&FFD1:n%=n%-l%:UNTILn%<1:ENDPROC
  470 DEFFNnm(d$):IFFNfs<>4:=d$
  480 =LEFT$(d$,INSTR(d$,".")+7)
  490 DEFFNfs:LOCAL A%,E%,Y%:=USR&FFDA AND&FF
  500 DEFPROCdir:LOCALr%,i%,l%:i%=0:REPEATA%=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 PRINT"†File: "d$:l%=OPENINd$:m%=EXT#l%:PRINT#k%,d$,m%,p%,q%:PROCtr(l%,k%,m%):CLOSE#l%
  510 UNTILr%<>0:ENDPROC