home *** CD-ROM | disk | FTP | other *** search
/ RBBS in a Box Volume 1 #3.1 / RBBSIABOX31.cdr / v2eg / usq.pas < prev    next >
Pascal/Delphi Source File  |  1990-09-29  |  7KB  |  217 lines
  1. {$C-}
  2. program Unsqueeze;      { unsqueeze file from in_file to out_file }
  3.  
  4. {
  5.   This program unsqueezes a file which has been squeezed or compressed to
  6.   reduce the space required to store it on disk. The program was converted
  7.   from the original version written for CP/M in the C language.  This program
  8.   can be used to unsqueeze files which have been downloaded from RCP/M systems
  9.   where almost all files are saved in this squeezed format.
  10.  
  11.   The technique used is the Huffman encoding technique which converts the most
  12.   common characters in the input file to a compressed bit stream of data. This
  13.   program unsqueezes such a Huffman encoded file.
  14.  
  15.   PUBLIC DOMAIN - Feel free to distribute this program. Do not distribute it by
  16.   commercial means or make any charge for this pgm.
  17.  
  18.   Version 1.0  - 09/05/82  Scott Loftesness
  19.   Version 1.1  - 01/06/83  Added capability to strip off parity bit if
  20.                            output file is text. Ernie LeMay 71435,730
  21.   Version 1.2  - 07/20/84  converted to Turbo Pascal. Steve Freeman
  22. }
  23.  
  24.  
  25. const
  26.     recognize  = $FF76;
  27.     numvals    = 257;      { max tree size + 1 }
  28.     speof      = 256;      { special end of file marker }
  29.     dle: char  = #$90;
  30.  
  31. type
  32.     tree       = array [0..255,0..1] of integer;
  33.     hexstr     = string[4];
  34.  
  35. var
  36.     in_file, out_file: file of char;
  37.     in_FN: string[30];
  38.     dnode: tree;
  39.     inchar, curin, filecksum, bpos, i, repct, numnodes: integer;
  40.     c, lastchar: char;
  41.     origfile: string[14];
  42.     docfile, eofin, abort: boolean;
  43.     abortM: string[50];
  44.  
  45.  
  46. { iftext -- find out if output file is text and return true if so. EL }
  47. function iftext : boolean;
  48.   var answer: char;
  49.   begin
  50.     repeat
  51.       write('Is the output file a text file?  ');
  52.       read(kbd,answer);
  53.       answer := upcase(answer);
  54.     until (answer in ['Y','N']);
  55.     writeln(answer);
  56.     if answer='Y'
  57.       then iftext:=true
  58.       else iftext:=false;
  59.   end;
  60.  
  61.  
  62. function hex(num: integer): hexstr;
  63.   var i, j: integer;
  64.       h: string[16];
  65.       str: hexstr;
  66.   begin
  67.     str := '0000';   h := '0123456789ABCDEF';   j := num;
  68.     for i:=4 downto 1
  69.       do begin
  70.            str[i] := h[(j and 15)+1];
  71.            j := j shr 4;
  72.          end;
  73.     hex := str;
  74.   end;
  75.  
  76.  
  77. { getw - get a word value from the input file }
  78. function getw: integer;
  79.     var in1,in2: char;
  80.   begin
  81.     read(in_file,in1,in2);
  82.     getw := ord(in1) + ord(in2) shl 8;
  83.   end;
  84.  
  85.  
  86. function getc: integer;
  87.   var ch: char;
  88.   begin
  89.     read(in_file,ch);
  90.     getc := ord(ch);
  91.   end;
  92.  
  93. procedure initialize;
  94.   var str: string[14];
  95.   begin
  96.     abort := false;     { no error conditions presently exist }
  97.     repct:=0;   bpos:=99;   origfile:='';   eofin:=false;
  98.     clrscr;   gotoxy(1,5);   write('Enter the file to unsqueeze:');   readln(in_FN);
  99.     assign(in_file,in_FN);
  100.     {$I-}
  101.     reset(in_file);
  102.     {$I+}
  103.     if (IOresult<>0) then i := 0
  104.                      else if eof(in_file)
  105.                             then i := 0
  106.                             else i := getw;
  107.     if (recognize <> i)
  108.       then begin
  109.              abort  := true;
  110.              abortM := 'File is not a squeezed file';
  111.              numnodes := -1;
  112.            end
  113.       else begin
  114.              filecksum := getw;     { get checksum from chars 2 - 3 of file }
  115.              repeat    { build original file name }
  116.                  inchar:=getc;
  117.                  if inchar <> 0
  118.                    then origfile := origfile + chr(inchar);
  119.                until inchar = 0;
  120.              writeln('Original file name is ',origfile);
  121.              write('Output to (return to default) ? ');
  122.              readln(str);   if length(str)=0 then str:=origfile;
  123.              assign(out_file,str);   rewrite(out_file);
  124.              numnodes:=ord(getw); { get the number of nodes in this files tree }
  125.              if (numnodes<0) or (numnodes>=numvals)
  126.                then begin
  127.                       abort  := true;
  128.                       abortM := 'File has invalid decode tree size';
  129.                     end;
  130.            end;
  131.     if not(abort)
  132.       then begin
  133.              dnode[0,0]:= -(speof+1);
  134.              dnode[0,1]:= -(speof+1);
  135.              numnodes:=numnodes-1;
  136.              for i:=0 to numnodes
  137.                do begin
  138.                     dnode[i,0]:=getw;
  139.                     dnode[i,1]:=getw;
  140.                   end;
  141.              { following is for test }
  142.              {for i:=0 to numnodes
  143.                do writeln(lst,'#',i:3,' ',hex(dnode[i,0]),' ',hex(dnode[i,1]));}
  144.            end;
  145.   end;
  146.  
  147. procedure dochar(c: char;  text: boolean);
  148.   begin
  149.     if text then c:=chr(ord(c) and $7F); {strip off parity bit}
  150.     write(out_file,c);
  151.   end;
  152.  
  153. function getuhuff: char;
  154. var i: integer;
  155.   begin
  156.     i:=0;
  157.     repeat
  158.         bpos:=bpos+1;
  159.         if bpos>7 then begin
  160.                          curin := getc;
  161.                          bpos:=0;
  162.                        end
  163.                   else curin := curin shr 1;
  164.         i := ord(dnode[i,ord(curin and $0001)]);
  165.       until (i<0);
  166.     i := -(i+1);
  167.     if i=speof
  168.       then begin
  169.              eofin:=true;
  170.              getuhuff:=chr(26)
  171.            end
  172.       else getuhuff:=chr(i);
  173.   end;
  174.  
  175. function getcr: char;
  176. var c: char;
  177.   begin
  178.     if (repct>0)
  179.       then begin
  180.              repct:=repct-1;
  181.              getcr:=lastchar;
  182.            end
  183.       else begin
  184.              c:=getuhuff;
  185.              if c<>dle
  186.                then begin
  187.                       getcr:=c;
  188.                       lastchar:=c;
  189.                     end
  190.                else begin
  191.                       repct:=ord(getuhuff);
  192.                       if repct=0 then getcr:=dle
  193.                                  else begin
  194.                                         repct:=repct-2;
  195.                                         getcr:=lastchar;
  196.                                       end;
  197.                     end;
  198.            end;
  199.   end; {getcr}
  200.  
  201. begin { main }
  202.   initialize;
  203.   if not(abort)
  204.     then begin
  205.            docfile := iftext;
  206.            writeln(output,'Tree loaded sucessfully. Un-squeezing begins...');
  207.            while not(eof(in_file)) or not(eofin)
  208.              do begin
  209.                   c:=getcr;
  210.                   dochar(c,docfile);
  211.                 end;
  212.            close(out_file);
  213.          end
  214.     else writeln('Error -- ',AbortM);
  215.   close(in_file);
  216. end.
  217.