home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / STREAM15.ZIP / HUFFCOMP.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-03-27  |  4.1 KB  |  123 lines
  1. {$B-}   { Use fast boolean evaluation. }
  2.  
  3. Program HuffComp;
  4.  
  5. { Simple compression program using Huffman compression.  Much like
  6.   COMPRESS.PAS. }
  7.  
  8. {$i StDefine.inc}
  9.  
  10. uses
  11.   {$ifdef wobjects}  wobjects, {$else}  objects, {$endif}
  12.   {$ifdef windows}   wincrt,                     {$endif}
  13.   streams, huffman;
  14.  
  15. procedure SyntaxExit(s:string);
  16. begin
  17.   writeln;
  18.   writeln(s);
  19.   writeln;
  20.   writeln('Usage:  HUFFMAN 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.   Fullsize:longint;
  30.   Filename : string;
  31.  
  32. begin
  33.   Case ParamCount of
  34.     2 : begin
  35.           {$ifdef windows}
  36.           Filename := Paramstr(1);
  37.           Filename[length(filename)+1] := #0;
  38.           Source := New(PBufStream, init(@filename[1], stOpenRead, 2048));
  39.           Filename := Paramstr(2);
  40.           Filename[length(filename)+1] := #0;
  41.           Dest   := New(PHuffmanFilter, init(New(PBufStream,
  42.                                              init(@filename[1],
  43.                                                   stCreate, 2048))));
  44.           {$else}                                                    
  45.           Source := New(PBufStream, init(Paramstr(1), stOpenRead, 2048));
  46.  
  47.           Dest   := New(PHuffmanFilter, init(New(PBufStream,
  48.                                              init(Paramstr(2),
  49.                                                   stCreate, 2048))));
  50.           {$endif windows}
  51.           Write('Compressing ',Paramstr(1),' (',Source^.GetSize,
  52.                 ' bytes) to ',Paramstr(2));
  53.  
  54.           { Count characters in source. }
  55.           FullSize := Source^.GetSize;
  56.           Dest^.Write(FullSize,sizeof(FullSize));
  57.           Dest^.CopyFrom(Source^,Source^.GetSize);
  58.           Source^.Seek(0);
  59.           With PHuffmanFilter(Dest)^ do
  60.           begin
  61.             Seek(0);
  62.             BuildCode;
  63.             StoreCode;
  64.             Learning := false;
  65.             Write(Fullsize,sizeof(Fullsize));
  66.           end;
  67.         end;
  68.     3 : begin
  69.           if (Paramstr(3) <> '/X') and (Paramstr(3) <> '/x') then
  70.             SyntaxExit('Unrecognized option '+Paramstr(3));
  71.           {$ifdef windows}
  72.           Filename := Paramstr(1);
  73.           Filename[length(filename)+1] := #0;
  74.           Source := New(PHuffmanFilter, init(New(PBufStream,
  75.                                              init(@filename[1],
  76.                                                   stOpenRead, 2048))));
  77.           Filename := Paramstr(2);
  78.           Filename[length(filename)+1] := #0;
  79.           Dest   := New(PBufStream, init(@filename[1], stCreate, 2048));
  80.           {$else}
  81.           Source := New(PHuffmanFilter, init(New(PBufStream,
  82.                                              init(Paramstr(1),
  83.                                                   stOpenRead, 2048))));
  84.           Dest   := New(PBufStream, init(Paramstr(2), stCreate, 2048));
  85.           {$endif}
  86.           Write('Expanding ',Paramstr(1),' (',
  87.                 PHuffmanFilter(Source)^.Base^.GetSize,' bytes) to ',
  88.                 Paramstr(2));
  89.           with PHuffmanFilter(Source)^ do
  90.           begin
  91.             LoadCode;
  92.             Learning := false;
  93.             Read(Fullsize,Sizeof(Fullsize));
  94.           end;
  95.         end;
  96.     else
  97.       SyntaxExit('Two or three parameters required.');
  98.   end;
  99.  
  100.   if (Source = nil) or (Source^.status <> stOk) then
  101.     SyntaxExit('Unable to open file '+ParamStr(1)+' for reading.');
  102.  
  103.   if (Dest = nil) or (Dest^.status <> stOk) then
  104.     SyntaxExit('Unable to create file '+Paramstr(2)+'.');
  105.  
  106.   Dest^.CopyFrom(Source^, FullSize);
  107.   if Dest^.status <> stOK then
  108.     SyntaxExit('File error during compression/expansion.');
  109.  
  110.   Case ParamCount of
  111.     2 : begin
  112.           Dest^.Flush;
  113.           Writeln(' (',PHuffmanFilter(Dest)^.Base^.GetSize,' bytes).');
  114.         end;
  115.     3 : Writeln(' (',FullSize,' bytes).');
  116.   end;
  117.  
  118.   Dispose(Source, done);
  119.   Dispose(Dest, done);
  120. end.
  121.  
  122. end.
  123.