home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / packer / arc / arctool / dearcunp.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-09-29  |  2.1 KB  |  130 lines
  1. {
  2.  
  3. * DESCRIPTION
  4. Turbo Pascal V4.0 DEARC unPacking routines.
  5.  
  6. * ASSOCIATED FILES
  7. DEARC.PAS
  8. DEARCABT.PAS
  9. DEARCGLB.PAS
  10. DEARCIO.PAS
  11. DEARCLZW.PAS
  12. DEARCUNP.PAS
  13. DEARCUSQ.PAS
  14. DEARC.TXT
  15.  
  16. }
  17. (**
  18.  *
  19.  *  Module:       dearcunp.pas
  20.  *  Description:  unPacking routines (run-length encoding)
  21.  *
  22.  *  Revision History:
  23.  *    7-26-88: unitized for Turbo v4.0
  24.  *
  25. **)
  26.  
  27.  
  28. unit dearcunp;
  29.  
  30. interface
  31.  
  32. uses
  33.   dearcglb,
  34.   dearcabt,
  35.   dearcio;
  36.  
  37.   procedure putc_unp(c : integer);
  38.   procedure putc_ncr(c : integer);
  39.   function getc_unp : integer;
  40.  
  41.  
  42. implementation
  43.  
  44. (*
  45.  *  definitions for unpack
  46.  *)
  47. Const
  48.   DLE = $90;
  49.  
  50. Var
  51.   lastc  : integer;
  52.  
  53. (**
  54.  *
  55.  *  Name:         procedure putc_unp
  56.  *  Description:  put one character to extracted file,  update CRC
  57.  *  Parameters:   value -
  58.  *                  c : integer - value to write
  59.  *
  60. **)
  61. procedure putc_unp(c : integer);
  62. begin
  63.   crcval := ((crcval shr 8) and $00FF) xor crctab[(crcval xor c) and $00FF];
  64.   put_ext(c)
  65. end; (* proc putc_unp *)
  66.  
  67.  
  68. (**
  69.  *
  70.  *  Name:         procedure putc_ncr
  71.  *  Description:  put one char,  checking for run-length compression
  72.  *  Parameters:   value -
  73.  *                  c : integer - value to write
  74.  *
  75. **)
  76. procedure putc_ncr(c : integer);
  77. begin
  78.   case state of
  79.     NOHIST :
  80.       if c = DLE then
  81.         state := INREP
  82.       else
  83.         begin
  84.           lastc := c;
  85.           putc_unp(c)
  86.         end;
  87.  
  88.     INREP  :
  89.       begin
  90.         if c = 0 then
  91.           putc_unp(DLE)
  92.         else
  93.           begin
  94.             c := c - 1;
  95.             while (c <> 0) do
  96.               begin
  97.                 putc_unp(lastc);
  98.                 c := c - 1
  99.               end
  100.             end;
  101.  
  102.         state := NOHIST
  103.       end
  104.   end  (* case *)
  105. end; (* proc putc_ncr *)
  106.  
  107.  
  108. (**
  109.  *
  110.  *  Name:         function getc_unp : integer
  111.  *  Description:  get one character from archive
  112.  *  Parameters:   none
  113.  *  Returns:      character read
  114.  *
  115. **)
  116. function getc_unp : integer;
  117. begin
  118.   if size = 0.0 then
  119.     getc_unp := -1
  120.   else
  121.     begin
  122.       size := size - 1;
  123.       getc_unp := get_arc
  124.     end;
  125. end; (* func getc_unp *)
  126.  
  127. end.
  128.  
  129. 
  130.