Skip to content

Instantly share code, notes, and snippets.

@Al-Muhandis

Al-Muhandis/ungzip.pas

Last active December 13, 2023 21:36
Show Gist options

  • Select an option

    Learn more about clone URLs
  • Save Al-Muhandis/36b59bc0f34cabda6c0c1a763fe3cc3d to your computer and use it in GitHub Desktop.

Select an option

Learn more about clone URLs
Save Al-Muhandis/36b59bc0f34cabda6c0c1a763fe3cc3d to your computer and use it in GitHub Desktop.
Download ZIP

Revisions

  1. Al-Muhandis revised this gist Dec 13, 2023. 1 changed file with 1 addition and 1 deletion.
    2 changes: 1 addition & 1 deletion ungzip.pas
    View file
    Original file line number Diff line number Diff line change
    @@ -92,7 +92,7 @@ procedure file_uncompress (filename:string);
    {$pop}
    ioerr := IOResult;
    if (ioerr <> 0) then
    raise Exception.Create('open error: '+ioerr);
    raise Exception.Create('open error: '+ioerr.ToString);

    gz_uncompress (infile, outfile);
    end;
  2. Al-Muhandis created this gist Dec 13, 2023.
    100 changes: 100 additions & 0 deletions ungzip.pas
    View file
    Original file line number Diff line number Diff line change
    @@ -0,0 +1,100 @@
    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);

    gz_uncompress (infile, outfile);
    end;

    end.