home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / ENTERPRS / CPM / UTILS / A / ARC20.ARC / ARCPACK.INC < prev    next >
Text File  |  1989-11-10  |  3KB  |  92 lines
  1. (* ARCPACK.INC  TR 071189 *)
  2.  
  3. (* Datei aus ARC-File extrahieren und expandieren *)
  4.  
  5. procedure unpack(var source,dest:binfile; var hdr:headtype);
  6. begin
  7.   crcval:=0; siz:=hdr.size; dec_long(siz);
  8.   init_ncr; init_crypt;
  9.   case hdr.vers of
  10.     1,2   : while siz.hi>=0 do putc_dir(dest,crypt(getc_decsiz(source)));
  11.     3     : while siz.hi>=0 do putc_ncr(dest,crypt(getc_decsiz(source)));
  12.     4     : unsqueeze(source,dest);
  13.     5,6,7,9 : begin
  14.               writeln('Sorry, style ',hdr.vers,' not (yet?) implemented!');
  15.               fskip(source,hdr.size);
  16.               exit; end;
  17.     8     : uncrunch_lzw(source,dest);
  18.     else    begin
  19.               if warn then begin
  20.                 writeln('I dont know how to unpack file ',pstring(hdr.name));
  21.                 writeln('I think you need a newer version of ARC');
  22.                 end;
  23.               fskip(source,hdr.size);
  24.               exit; end;
  25.     end;
  26.   if (crcval<>hdr.crc) then if warn then
  27.     writeln('WARNING: File ',pstring(hdr.name),' fails CRC check!');
  28.   end;
  29.  
  30. (* Datei u.U. komprimiert in Archiv einspeichern *)
  31.  
  32. procedure pack(var source,dest:binfile; var hdr:headtype);
  33. var  stdlen                  : longword;
  34.      crn_nam                 : filenam;
  35.      crn_file                : binfile;
  36.      r_std,r_ncr,r_squ,r_lzw : real;
  37.      dum                     : byte;
  38. begin
  39.   stdlen:=source.fsize; hdr.length:=stdlen; crcval:=0;
  40.   if note then if kludge and not force then
  41.     write(' analyzing..., ') else write(' ............, ');
  42.   if not (kludge or force) then begin
  43.     ncrlen:=stdlen; squlen:=stdlen; lzwlen:=stdlen;    (* STORE *)
  44.     while not source.feof do dum:=getc_dir(source);     (* CRC! *)
  45.     end
  46.   else begin
  47.     init_ncr;
  48.     makefnam(arcname,'.CRN',crn_nam); fopen_write(crn_nam,crn_file);
  49.     crunch_lzw(source,crn_file); fclose(crn_file);
  50.     if force then begin                        (* nur Crunch *)
  51.       ncrlen:=lzwlen; inc_long(ncrlen); squlen:=ncrlen; stdlen:=ncrlen;
  52.       end
  53.     else begin    (* weitere Kompressionen (Squeeze, Squash) *)
  54.       predict_squ;
  55.       end;
  56.     end;
  57.   r_std:=long_to_real(stdlen);
  58.   r_ncr:=long_to_real(ncrlen);
  59.   r_squ:=long_to_real(squlen);
  60.   r_lzw:=long_to_real(lzwlen);
  61.   freset(source); init_crypt; hdr.crc:=crcval;
  62.   if (r_std<=r_ncr) and (r_std<=r_lzw) and (r_std<=r_squ) then begin
  63.     if note then write('storing..., ');
  64.     hdr.vers:=2; hdr.size:=stdlen;
  65.     writehdr(hdr,dest);
  66.     filecopy(source,dest,stdlen,true);
  67.     end
  68.   else if (r_ncr<=r_lzw) and (r_ncr<=r_squ) then begin
  69.     if note then write('packing..., ');
  70.     hdr.vers:=3; hdr.size:=ncrlen;
  71.     writehdr(hdr,dest);
  72.     init_ncr; ncrend:=source.feof;
  73.     while not ncrend do fputc(dest,crypt(getc_ncr(source)));
  74.     end
  75.   else if r_squ<r_lzw then begin
  76.     if note then write('squeezing..., ');
  77.     hdr.vers:=4; hdr.size:=squlen;
  78.     writehdr(hdr,dest);
  79.     squeeze(source,dest);
  80.     end
  81.   else begin
  82.     if note then write('crunching..., ');
  83.     hdr.vers:=8; hdr.size:=lzwlen;
  84.     writehdr(hdr,dest);
  85.     bdummy:=fopen_read(crn_nam,crn_file);
  86.     filecopy(crn_file,dest,lzwlen,true);
  87.     end;
  88.   deinit_squ;
  89.   if kludge or force then begin close(crn_file.id); erase(crn_file.id); end;
  90.   if note then writeln('done.');
  91.   end;
  92.