home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / packer / lzwp13 / see_arc.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-09-09  |  2.5 KB  |  102 lines
  1. (*
  2. **   SEE_ARC.PAS     Copyright (C) 1993 by MarshallSoft Computing, Inc.
  3. **
  4. **   This program is used to expand archive created with MK_ARC. For
  5. **   example, to un-archive all the files in 'PAS.ARF', type:
  6. **
  7. **      SEE_ARC PAS.ARF
  8. *)
  9.  
  10.  
  11. program SEE_ARC;
  12. uses dos, crt, memory, rw_io, hex_io, lzw_errs, dummy_io, LZW4P;
  13.  
  14. type
  15.   String12 = String[12];
  16.   AllocMemoryType = function(Size : Word) : Pointer;
  17.   FreeMemoryType  = function(P : Pointer; Size : Word) : Integer;
  18.  
  19. Var
  20.   InpFileName  : String12;
  21.   OutFileName  : String12;
  22.   MemoryP      : Pointer;
  23.   AllocMemoryP : Pointer;
  24.   FreeMemoryP  : Pointer;
  25.   ReaderP      : Pointer;
  26.   WriterP      : Pointer;
  27.   Size         : Integer;
  28.   Code         : Integer;
  29.   i, x         : Integer;
  30.   DirInfo      : SearchRec;
  31.   Ratio        : Real;
  32.   ReaderCnt    : Real;
  33.   WriterCnt    : Real;
  34.   Count        : Integer;
  35.   AccumCnt     : Integer;
  36.  
  37. begin  (* SEE_ARC *)
  38.   (* get file specs *)
  39.   if ParamCount <> 1 then
  40.     begin
  41.       writeln('Usage: SEE_ARC <arc_file>');
  42.       halt;
  43.     end;
  44.   (* sign on *)
  45.   writeln('SEE_ARC 1.0: Type any key to abort...');
  46.   writeln;
  47.   Count := 0;
  48.   (* open input *)
  49.   InpFileName := ParamStr(1);
  50.   Code := ReaderOpen(InpFileName);
  51.   if Code <> 0 then
  52.     begin
  53.       writeln('Cannot open ',InpFileName,' for input. IOResult = ',Code);
  54.       halt;
  55.     end;
  56.   (* get pointers *)
  57.   AllocMemoryP := @AllocMemory;
  58.   FreeMemoryP  := @FreeMemory;
  59.   ReaderP := @Reader;
  60.   WriterP := @Dummy;
  61.   (* Initialize LZW *)
  62.   Code :=  InitLZW(AllocMemoryP,14);
  63.   while TRUE do
  64.   begin
  65.     if KeyPressed then
  66.       begin
  67.         writeln;
  68.         writeln('Aborted by USER');
  69.         Halt;
  70.       end;
  71.     (* get filename from archive *)
  72.     OutFileName := '';
  73.     (* get 1st character, skipping any leading 0 *)
  74.     x := Reader;
  75.     if x = 0 then x := Reader;
  76.     repeat
  77.       if x = -1 then
  78.         begin
  79.           (* close input *)
  80.           Code := ReaderClose;
  81.           (* Terminate LZW *)
  82.           writeln;
  83.           writeln(Count,' files.');
  84.           Code := TermLZW(FreeMemoryP);
  85.           Halt;
  86.         end;
  87.       if x <> 0 then OutFileName := OutFileName + chr(x);
  88.       (* get next character from filename *)
  89.       x := Reader;
  90.     until x = 0;
  91.     Count := Count + 1;
  92.     (* open outut file *)
  93.     writeln(Count:3,' ',OutFileName);
  94.     Code := Expand(ReaderP,WriterP);
  95.     if Code < 0 then
  96.       begin
  97.         SayError(Code);
  98.         Halt;
  99.       end;
  100.   end; (* while *)
  101. end.
  102.