home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / lzw4p12 / ex_arc.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-05-30  |  3.4 KB  |  134 lines
  1. (*
  2. **   EX_ARC.PAS     Copyright (C) 1994 by MarshallSoft Computing, Inc.
  3. **
  4. **   This program is used to extract a file from an archive created with MK_ARC.
  5. **   For example, to extract TEST.PAS from the archive PAS.ARF, type:
  6. **
  7. **      EX_ARC TEST.PAS PAS.ARF
  8. *)
  9.  
  10.  
  11. program EX_ARC;
  12. uses dos, crt, memory, rw_io, hex_io, lzw_errs, 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.   Requested    : String12;
  23.   MemoryP      : Pointer;
  24.   AllocMemoryP : Pointer;
  25.   FreeMemoryP  : Pointer;
  26.   ReaderP      : Pointer;
  27.   WriterP      : Pointer;
  28.   DummyP       : Pointer;
  29.   Size         : Integer;
  30.   Code         : Integer;
  31.   i, x         : Integer;
  32.   DirInfo      : SearchRec;
  33.   Ratio        : Real;
  34.   ReaderCnt    : Real;
  35.   WriterCnt    : Real;
  36.  
  37. begin (* main *)
  38.   (* get file specs *)
  39.   if ParamCount <> 2 then
  40.     begin
  41.       writeln('Usage: EX_ARC <extract_file> <arc_file>');
  42.       halt;
  43.     end;
  44.   (* sign on *)
  45.   writeln('EX_ARC 1.0: Type any key to abort...');
  46.   writeln;
  47.   (* open input *)
  48.   InpFileName := ParamStr(2);
  49.   Code := ReaderOpen(InpFileName);
  50.   if Code <> 0 then
  51.     begin
  52.       writeln('Cannot open ',InpFileName,' for input. IOResult = ',Code);
  53.       halt;
  54.     end;
  55.   (* get requested file to extract *)
  56.   Requested := ParamStr(1);
  57.   for I := 1 to 12 do
  58.     begin
  59.       Requested[I] := UpCase(Requested[I]);
  60.     end;
  61.   (* get pointers *)
  62.   AllocMemoryP := @AllocMemory;
  63.   FreeMemoryP  := @FreeMemory;
  64.   ReaderP := @Reader;
  65.   WriterP := @Writer;
  66.   DummyP  := @DummyWrite;
  67.   (* Initialize LZW *)
  68.   Code :=  InitLZW(AllocMemoryP,14);
  69.   while TRUE do
  70.   begin
  71.     (* user want to quit ? *)
  72.     if KeyPressed then
  73.       begin
  74.         writeln;
  75.         writeln('Aborted by USER');
  76.         Halt;
  77.       end;
  78.     (* get filename from archive *)
  79.     OutFileName := '';
  80.     (* get 1st character, skipping any leading 0 *)
  81.     x := Reader;
  82.     if x = 0 then x := Reader;
  83.     repeat
  84.       if x = -1 then
  85.         begin
  86.           (* close input *)
  87.           Code := ReaderClose;
  88.           (* Terminate LZW *)
  89.           Code := TermLZW(FreeMemoryP);
  90.           Halt;
  91.         end;
  92.       if x <> 0 then OutFileName := OutFileName + chr(x);
  93.       (* get next character from filename *)
  94.       x := Reader;
  95.     until x = 0;
  96.     (* writeln('<',OutFileName,'>'); *)
  97.     if OutFileName = Requested then
  98.       begin
  99.         (* open outut file *)
  100.         Code := WriterOpen(OutFileName);
  101.         if Code <> 0 then
  102.           begin
  103.             writeln('Cannot open ',OutFileName,' for output. IOResult = ',Code);
  104.             halt;
  105.           end;
  106.         (* expand *)
  107.         Write('EXPANDING ',OutFileName:12,' ');
  108.         Code := Expand(ReaderP,WriterP);
  109.         if Code < 0 then
  110.           begin
  111.             SayError(Code);
  112.             Halt;
  113.           end;
  114.         writeln('OK');
  115.         (* close output file *)
  116.         Code := WriterClose;
  117.         Code := ReaderClose;
  118.         Code := TermLZW(FreeMemoryP);
  119.         Halt;
  120.       end
  121.     else
  122.       begin
  123.         Write('Skipping ',OutFileName:12);
  124.         Code := Expand(ReaderP,DummyP);
  125.         if Code < 0 then
  126.           begin
  127.             WriteLn('Error');
  128.             SayError(Code);
  129.             Halt;
  130.           end;
  131.         WriteLn;
  132.       end;
  133.   end; (* while *)
  134. end.