home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / PASCAL / STREAM13.ZIP / HUFFCOMP.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-05-18  |  4.0 KB  |  124 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. uses
  9.   {$ifdef windows}
  10.   wobjects, wincrt,
  11.   {$else}
  12.   objects,
  13.   {$endif windows}
  14.   streams, huffman;
  15.  
  16. procedure SyntaxExit(s:string);
  17. begin
  18.   writeln;
  19.   writeln(s);
  20.   writeln;
  21.   writeln('Usage:  HUFFMAN Sourcefile Destfile [/X]');
  22.   writeln(' will compress the source file to the destination');
  23.   writeln(' file, or if /X flag is used, will expand source to destination.');
  24.   halt(99);
  25. end;
  26.  
  27. var
  28.   Source : PStream;   { We don't know in advance which will be compressed }
  29.   Dest   : PStream;
  30.   Fullsize:longint;
  31.   Filename : string;
  32.  
  33. begin
  34.   Case ParamCount of
  35.     2 : begin
  36.           {$ifdef windows}
  37.           Filename := Paramstr(1);
  38.           Filename[length(filename)+1] := #0;
  39.           Source := New(PBufStream, init(@filename[1], stOpenRead, 2048));
  40.           Filename := Paramstr(2);
  41.           Filename[length(filename)+1] := #0;
  42.           Dest   := New(PHuffmanFilter, init(New(PBufStream,
  43.                                              init(@filename[1],
  44.                                                   stCreate, 2048))));
  45.           {$else}                                                    
  46.           Source := New(PBufStream, init(Paramstr(1), stOpenRead, 2048));
  47.  
  48.           Dest   := New(PHuffmanFilter, init(New(PBufStream,
  49.                                              init(Paramstr(2),
  50.                                                   stCreate, 2048))));
  51.           {$endif windows}
  52.           Write('Compressing ',Paramstr(1),' (',Source^.GetSize,
  53.                 ' bytes) to ',Paramstr(2));
  54.  
  55.           { Count characters in source. }
  56.           FullSize := Source^.GetSize;
  57.           Dest^.Write(FullSize,sizeof(FullSize));
  58.           Dest^.CopyFrom(Source^,Source^.GetSize);
  59.           Source^.Seek(0);
  60.           With PHuffmanFilter(Dest)^ do
  61.           begin
  62.             Seek(0);
  63.             BuildCode;
  64.             StoreCode;
  65.             Learning := false;
  66.             Write(Fullsize,sizeof(Fullsize));
  67.           end;
  68.         end;
  69.     3 : begin
  70.           if (Paramstr(3) <> '/X') and (Paramstr(3) <> '/x') then
  71.             SyntaxExit('Unrecognized option '+Paramstr(3));
  72.           {$ifdef windows}
  73.           Filename := Paramstr(1);
  74.           Filename[length(filename)+1] := #0;
  75.           Source := New(PHuffmanFilter, init(New(PBufStream,
  76.                                              init(@filename[1],
  77.                                                   stOpenRead, 2048))));
  78.           Filename := Paramstr(2);
  79.           Filename[length(filename)+1] := #0;
  80.           Dest   := New(PBufStream, init(@filename[1], stCreate, 2048));
  81.           {$else}
  82.           Source := New(PHuffmanFilter, init(New(PBufStream,
  83.                                              init(Paramstr(1),
  84.                                                   stOpenRead, 2048))));
  85.           Dest   := New(PBufStream, init(Paramstr(2), stCreate, 2048));
  86.           {$endif}
  87.           Write('Expanding ',Paramstr(1),' (',
  88.                 PHuffmanFilter(Source)^.Base^.GetSize,' bytes) to ',
  89.                 Paramstr(2));
  90.           with PHuffmanFilter(Source)^ do
  91.           begin
  92.             LoadCode;
  93.             Learning := false;
  94.             Read(Fullsize,Sizeof(Fullsize));
  95.           end;
  96.         end;
  97.     else
  98.       SyntaxExit('Two or three parameters required.');
  99.   end;
  100.  
  101.   if (Source = nil) or (Source^.status <> stOk) then
  102.     SyntaxExit('Unable to open file '+ParamStr(1)+' for reading.');
  103.  
  104.   if (Dest = nil) or (Dest^.status <> stOk) then
  105.     SyntaxExit('Unable to create file '+Paramstr(2)+'.');
  106.  
  107.   Dest^.CopyFrom(Source^, FullSize);
  108.   if Dest^.status <> stOK then
  109.     SyntaxExit('File error during compression/expansion.');
  110.  
  111.   Case ParamCount of
  112.     2 : begin
  113.           Dest^.Flush;
  114.           Writeln(' (',PHuffmanFilter(Dest)^.Base^.GetSize,' bytes).');
  115.         end;
  116.     3 : Writeln(' (',FullSize,' bytes).');
  117.   end;
  118.  
  119.   Dispose(Source, done);
  120.   Dispose(Dest, done);
  121. end.
  122.  
  123. end.
  124.