minigzip.pas

来自「本系统在一些大中型企业(跨多达24个区域)一直都在很好的服务过」· PAS 代码 · 共 273 行

program minigzip;

{
 minigzip.c -- simulate gzip using the zlib compression library
 Copyright (C) 1995-1998 Jean-loup Gailly.

 minigzip is a minimal implementation of the gzip utility. This is
 only an example of using zlib and isn't meant to replace the
 full-featured gzip. No attempt is made to deal with file systems
 limiting names to 14 or 8+3 characters, etc... Error checking is
 very limited. So use minigzip only for testing; use gzip for the
 real thing. On MSDOS, use only on file names without extension
 or in pipe mode.

  Pascal tranlastion
  Copyright (C) 1998 by Jacques Nomssi Nzali
  For conditions of distribution and use, see copyright notice in readme.txt
}

uses gzio, zutil{, zlib};

const

  BUFLEN       = 16384 ;
  GZ_SUFFIX    = '.gz' ;

{$DEFINE MAXSEF_64K}

var

  buf  : array [0..BUFLEN-1] of byte; { Global uses BSS instead of stack }
  prog : string;

{ ERROR =====================================================================

  Display error message and exit

============================================================================}

procedure error (msg:string);

begin

  writeln (prog,': ',msg);
  halt(1);

end;


{ GZ_COMPRESS ===============================================================

  Compress input to output then close both files

============================================================================}

procedure gz_compress (var infile:file; outfile:gzFile);

var

  len   : word;
  ioerr : integer;
  err   : int;

begin

  while true do begin

    {$I-}
    blockread (infile, buf, BUFLEN, len);
    {$I+}
    ioerr := IOResult;
    if (ioerr <> 0) then begin
      writeln ('read error: ',ioerr);
      halt(1);
    end;

    if (len = 0) then break;

    if (gzwrite (outfile, @buf, len) <> len)
      then error (gzerror (outfile, err));

  end; {WHILE}

  close (infile);
  if (gzclose (outfile) <> 0{Z_OK})
    then error ('gzclose error');

end;


{ GZ_UNCOMPRESS =============================================================

  Uncompress input to output then close both files

============================================================================}

procedure gz_uncompress (infile:gzFile; var outfile:file);

var

  len     : int;
  written : word;
  ioerr   : integer;
  err     : int;

begin

  while true do begin

    len := gzread (infile, @buf, BUFLEN);
    if (len < 0)
      then error (gzerror (infile, err));
    if (len = 0)
      then break;

    {$I-}
    blockwrite (outfile, buf, len, written);
    {$I+}
    if (written <> len)
      then error ('write error');

  end; {WHILE}

  {$I-}
  close (outfile);
  {$I+}
  ioerr := IOResult;
  if (ioerr <> 0) then begin
    writeln ('close error: ',ioerr);
    halt(1);
  end;

  if (gzclose (infile) <> 0{Z_OK})
    then error ('gzclose error');

end;


{ FILE_COMPRESS =============================================================

  Compress the given file:
  create a corresponding .gz file and remove the original

============================================================================}

procedure file_compress (filename:string; mode:string);

var

  infile  : file;
  outfile : gzFile;
  ioerr   : integer;
  outname : string;

begin

  Assign (infile, filename);
  {$I-}
  Reset (infile,1);
  {$I+}
  ioerr := IOResult;
  if (ioerr <> 0) then begin
    writeln ('open error: ',ioerr);
    halt(1);
  end;

  outname := filename + GZ_SUFFIX;
  outfile := gzopen (outname, mode);

  if (outfile = NIL) then begin
    writeln (prog,': can''t gzopen ',outname);
    halt(1);
  end;

  gz_compress(infile, outfile);
  erase (infile);

end;


{ FILE_UNCOMPRESS ===========================================================

  Uncompress the given file and remove the original

============================================================================}

procedure file_uncompress (filename:string);

var

  inname  : string;
  outname : string;
  infile  : gzFile;
  outfile : file;
  ioerr   : integer;
  len     : integer;

begin

  len := Length(filename);

  if (copy(filename,len-2,3) = GZ_SUFFIX) then begin
    inname := filename;
    outname := copy(filename,0,len-3);
  end
  else begin
    inname := filename + GZ_SUFFIX;
    outname := filename;
  end;

  infile := gzopen (inname, 'r');
  if (infile = NIL) then begin
    writeln (prog,': can''t gzopen ',inname);
    halt(1);
  end;

  Assign (outfile, outname);
  {$I-}
  Rewrite (outfile,1);
  {$I+}
  ioerr := IOResult;
  if (ioerr <> 0) then begin
    writeln ('open error: ',ioerr);
    halt(1);
  end;

  gz_uncompress (infile, outfile);

{ erase (infile); }

end;


{ MINIGZIP =================================================================}

var

  uncompr : boolean;
  outmode : string[20];
  i       : integer;
  option  : string;

begin

  uncompr := false;
  outmode := 'w6 ';
  prog := ParamStr(0);

  if (ParamCount = 0) then begin
    writeln ('Error: STDIO/STDOUT not supported yet');
    writeln;
    writeln ('Usage:  minigzip [-d] [-f] [-h] [-1 to -9] <file>');
    writeln ('  -d : decompress');
    writeln ('  -f : compress with Z_FILTERED');
    writeln ('  -h : compress with Z_HUFFMAN_ONLY');
    writeln ('  -1 to -9 : compression level');
    exit;
  end;

  for i:=1 to ParamCount do begin
    option := ParamStr(i);
    if (option = '-d') then uncompr := true;
    if (option = '-f') then outmode[3] := 'f';
    if (option = '-h') then outmode[3] := 'h';
    if (option[1] = '-') and (option[2] >= '1') and (option[2] <= '9')
      then outmode[2] := option[2];
  end;

  if (uncompr = true)
    then file_uncompress (ParamStr(ParamCount))
    else file_compress (ParamStr(ParamCount), outmode);

end.