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