One simple procedure for unzip GZip file (uses native fcl gzio.pas)

ungzip.pas

unit ungzip;

{$mode ObjFPC}{$H+}

interface

uses
  Classes, SysUtils
  ;

procedure file_uncompress (filename:string);

implementation

uses
  gzio
  ;

const
  BUFLEN       = 16384 ;
  GZ_SUFFIX    = '.gz' ;

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

procedure gz_uncompress (infile:gzFile; var outfile:file);
var
  len     : longint;
  written : cardinal;
  ioerr   : integer;
  err     : SmallInt;
begin
  err:=0;
  written:=0;
  while true do begin

    len := gzread (infile, @buf, BUFLEN);
    if (len < 0)
      then raise Exception.Create(gzerror(infile, err));
    if (len = 0)
      then break;

    {$push}{$I-}
    blockwrite (outfile, buf, len, written);
    {$pop}
    if (written <> len)
      then raise Exception.Create('write error');

  end; {WHILE}

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

  if (gzclose (infile) <> 0{Z_OK})
    then raise Exception.Create('gzclose error');
end;

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
    raise Exception.Create('Can''t gzopen '+inname);
  end;

  Assign (outfile, outname);
  {$push}{$I-}
  Rewrite (outfile,1);
  {$pop}
  ioerr := IOResult;
  if (ioerr <> 0) then
    raise Exception.Create('open error: '+ioerr.ToString);

  gz_uncompress (infile, outfile);
end;

end.