home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / STREAM15.ZIP / COMPRESS.PAS next >
Encoding:
Pascal/Delphi Source File  |  1993-03-27  |  3.6 KB  |  102 lines
  1. {$B-}   { Use fast boolean evaluation. }
  2.  
  3. program Compress;
  4.  
  5. { Program to demonstrate use of TLZWFilter }
  6.  
  7. {$i stdefine.inc}
  8.  
  9. uses
  10.   {$ifdef windows}  wincrt,                    {$endif}
  11.   {$ifdef wobjects} wobjects, {$else} objects, {$endif}
  12.   streams;
  13.  
  14. procedure SyntaxExit(s:string);
  15. begin
  16.   writeln;
  17.   writeln(s);
  18.   writeln;
  19.   writeln('Usage:  COMPRESS Sourcefile Destfile [/X]');
  20.   writeln(' will compress the source file to the destination');
  21.   writeln(' file, or if /X flag is used, will expand source to destination.');
  22.   halt(99);
  23. end;
  24.  
  25. var
  26.   Source : PStream;   { We don't know in advance which will be compressed }
  27.   Dest   : PStream;
  28.   filename : string;
  29. begin
  30.   Case ParamCount of                          
  31.     2 : begin
  32.           {$ifdef windows}
  33.           Filename := Paramstr(1);
  34.           Filename[length(filename)+1] := #0;
  35.           Source := New(PBufStream, init(@filename[1], stOpenRead, 2048));
  36.           Filename := Paramstr(2);
  37.           Filename[length(filename)+1] := #0;
  38.           Dest   := New(PLZWFilter, init(New(PBufStream,
  39.                                              init(@filename[1],
  40.                                                   stCreate, 2048)),
  41.                                          stOpenWrite));
  42.           {$else}                                                    
  43.           Source := New(PBufStream, init(Paramstr(1), stOpenRead, 2048));
  44.  
  45.           Dest   := New(PLZWFilter, init(New(PBufStream,
  46.                                              init(Paramstr(2),
  47.                                                   stCreate, 2048)),
  48.                                          stOpenWrite));
  49.           {$endif windows}
  50.           Write('Compressing ',Paramstr(1),' (',Source^.GetSize,
  51.                 ' bytes) to ',Paramstr(2));
  52.         end;
  53.     3 : begin
  54.           if (Paramstr(3) <> '/X') and (Paramstr(3) <> '/x') then
  55.             SyntaxExit('Unrecognized option '+Paramstr(3));
  56.           {$ifdef windows}
  57.           Filename := Paramstr(2);
  58.           Filename[length(filename)+1] := #0;
  59.          Source := New(PLZWFilter, init(New(PBufStream,
  60.                                              init(@filename[1],
  61.                                                   stOpenRead, 2048)),
  62.                                          stOpenRead));
  63.           Filename := Paramstr(2);
  64.           Filename[length(filename)+1] := #0;
  65.           Dest   := New(PBufStream, init(@filename[1], stCreate, 2048));
  66.           {$else}
  67.           Source := New(PLZWFilter, init(New(PBufStream,
  68.                                              init(Paramstr(1),
  69.                                                   stOpenRead, 2048)),
  70.                                          stOpenRead));
  71.           Dest   := New(PBufStream, init(Paramstr(2), stCreate, 2048));
  72.           {$endif windows}
  73.           Write('Expanding ',Paramstr(1),' (',
  74.                 PLZWFilter(Source)^.Base^.GetSize,' bytes) to ',
  75.                 Paramstr(2));
  76.         end;
  77.     else
  78.       SyntaxExit('Two or three parameters required.');
  79.   end;
  80.  
  81.   if (Source = nil) or (Source^.status <> stOk) then
  82.     SyntaxExit('Unable to open file '+ParamStr(1)+' for reading.');
  83.  
  84.   if (Dest = nil) or (Dest^.status <> stOk) then
  85.     SyntaxExit('Unable to create file '+Paramstr(2)+'.');
  86.  
  87.   Dest^.CopyFrom(Source^, Source^.GetSize);
  88.   if Dest^.status <> stOK then
  89.     SyntaxExit('File error during compression/expansion.');
  90.  
  91.   Case ParamCount of
  92.     2 : begin
  93.           Dest^.Flush;
  94.           Writeln(' (',PLZWFilter(Dest)^.Base^.GetSize,' bytes).');
  95.         end;
  96.     3 : Writeln(' (',Dest^.GetSize,' bytes).');
  97.   end;
  98.  
  99.   Dispose(Source, done);
  100.   Dispose(Dest, done);
  101. end.
  102.