View Issue Details

IDProjectCategoryView StatusLast Update
0036068FPCFCLpublic2019-09-20 22:25
ReporterValdir MarcosAssigned ToMichael Van Canneyt 
PrioritynormalSeverityminorReproducibilityalways
Status resolvedResolutionfixed 
Platform32 and 64 bitsOSWindowsOS Version10
Product Version3.0.4Product Build 
Target VersionFixed in Version3.3.1 
Summary0036068: unzipping a file gives no error when harddisk is full
Description"When I unzip a file, which is bigger than the free space on the destination harddisk, I get no error.
The file is just truncated.
I would expect to get an error, because the file is invalid."

Please, see this forum discussion:
unzipping a file gives no error when harddisk is full
https://forum.lazarus.freepascal.org/index.php/topic,46711.msg333448.html#msg333448
Steps To Reproduce{$mode objfpc}{$H+}

uses classes,sysutils,zipper;

function unzip_file(fspecZ,fspecP,destDir: ansistring): ansistring;
  {unzips packed file 'fspecP' from zipfile 'fspecZ' to destination 'destDir'}0
var
  Z: TUnZipper;
  SL: TStringList;
begin
     Z:=TUnZipper.Create;
     SL:=TStringList.Create;
     
     try
        SL.Add(fspecP);
        Z.FileName:=fspecZ;
        Z.OutputPath:=destDir;
        Z.UnZipFiles(SL);
        
        Z.Free;
        SL.Free;
        exit(''); {if no Error}
      except
        on E: EZipError do
        begin
          Z.Free; SL.Free; exit('Error 1 ' + E.Message);
        end;
        on E: Exception do {all other Exceptions: }
        begin
          Z.Free; SL.Free; exit('Error 2 ' + E.Message);
         end;
      end;
    end;
     
var
  fspecZ,fspecP,destDir,se: ansistring;

begin
  fspecZ:='h:\tmp\Dylan.zip';
  fspecP:='Dylan.wav'; // this file is 147 MB big
  destDir:='d:\Tst\unzip\'; // this drive has only 137 MB free
  se:=unzip_file(fspecZ,fspecP,destDir);
  writeln('result="', se, '"');
end.
Additional InformationAlternative solution:

    procedure TForm1.Button1Click(Sender: TObject);
    var
      Z: TUnZipper;
      i: Integer;
      TotalSize: Int64;
      EntrySize: Int64;
      FreeSpace: Int64;
    begin
      z := TUnZipper.Create;
      z.FileName := 'h:\tmp\Dylan.zip';
      z.OutputPath := 'd:\Tst\unzip\';
     
      z.Examine; // needed!!!
     
     
      { ** Total size of all files in the archive ** }
      TotalSize := 0;
      for i := 0 to z.Entries.Count - 1 do
      begin
        Inc(TotalSize, z.Entries.Entries[i].Size);
      end;
      ShowMessage('The size of archive is: ' + IntToStr(TotalSize) + ' bytes.');
      { ** }
     
     
      { ** Size of an entry in the archive ** }
      EntrySize := 0;
      for i := 0 to z.Entries.Count - 1 do
      begin
        if z.Entries[i].ArchiveFileName = 'Dylan.wav' then
        begin
          EntrySize := z.Entries[i].Size;
        end;
      end;
      ShowMessage('The size of entry is: ' + IntToStr(EntrySize) + ' bytes.');
      { ** }
     
     
      { ** how much free space is there? ** }
      FreeSpace := DiskFree(Ord('d') - 64); // "d" is the drive letter
      ShowMessage('There are : ' + IntToStr(FreeSpace) + ' bytes free.');
      { ** }
     
      if FreeSpace > EntrySize then // or TotalSize
      begin
        // do unzip here
      end
      else
      begin
        // error message
      end;
     
      z.Free;
    end;
TagsNo tags attached.
Fixed in Revision42975
FPCOldBugId
FPCTarget3.2.0
Attached Files
  • test2.lpi (1,996 bytes)
  • test2.pas (1,060 bytes)
    {$mode objfpc}{$H+}
    
    uses classes,sysutils,zipper;
    
    function unzip_file(fspecZ,fspecP,destDir: ansistring): ansistring;
       {unzips packed file 'fspecP' from zipfile 'fspecZ' to destination 'destDir'}
       var Z: TUnZipper;
           SL: TStringList;
       begin
       Z:=TUnZipper.Create;
       SL:=TStringList.Create;
    
       try
          SL.Add(fspecP);
          Z.FileName:=fspecZ;
          Z.OutputPath:=destDir;
          Z.UnZipFiles(SL);
    
          Z.Free;
          SL.Free;
          exit(''); {if no Error}
    
       except
          on E: EZipError do
             begin
             Z.Free; SL.Free; exit('Error 1 ' + E.Message);
             end;
          on E: Exception do  {all other Exceptions: }
             begin
             Z.Free; SL.Free; exit('Error 2 ' + E.Message);
             end;
       end;
       end;
    
    var fspecZ,fspecP,destDir,se: ansistring;
    
    begin
    fspecZ:='h:\tmp\Dylan.zip';
    fspecP:='Dylan.wav';       // this file is 147 MB big
    destDir:='d:\Tst\unzip\';  // this drive has only 137 MB free
    se:=unzip_file(fspecZ,fspecP,destDir);
    writeln('result="', se, '"');
    end.
    
    
    test2.pas (1,060 bytes)

Activities

Valdir Marcos

2019-09-12 04:58

reporter  

test2.lpi (1,996 bytes)
test2.pas (1,060 bytes)
{$mode objfpc}{$H+}

uses classes,sysutils,zipper;

function unzip_file(fspecZ,fspecP,destDir: ansistring): ansistring;
   {unzips packed file 'fspecP' from zipfile 'fspecZ' to destination 'destDir'}
   var Z: TUnZipper;
       SL: TStringList;
   begin
   Z:=TUnZipper.Create;
   SL:=TStringList.Create;

   try
      SL.Add(fspecP);
      Z.FileName:=fspecZ;
      Z.OutputPath:=destDir;
      Z.UnZipFiles(SL);

      Z.Free;
      SL.Free;
      exit(''); {if no Error}

   except
      on E: EZipError do
         begin
         Z.Free; SL.Free; exit('Error 1 ' + E.Message);
         end;
      on E: Exception do  {all other Exceptions: }
         begin
         Z.Free; SL.Free; exit('Error 2 ' + E.Message);
         end;
   end;
   end;

var fspecZ,fspecP,destDir,se: ansistring;

begin
fspecZ:='h:\tmp\Dylan.zip';
fspecP:='Dylan.wav';       // this file is 147 MB big
destDir:='d:\Tst\unzip\';  // this drive has only 137 MB free
se:=unzip_file(fspecZ,fspecP,destDir);
writeln('result="', se, '"');
end.

test2.pas (1,060 bytes)

Michael Van Canneyt

2019-09-12 07:39

administrator   ~0118048

Fixed, please test and close if OK. Thanks for reporting !

Valdir Marcos

2019-09-20 17:17

reporter   ~0118136

Please, take a look on wp's extra information:

https://forum.lazarus.freepascal.org/index.php/topic,46711.msg333492.html#msg333492
"procedure TStream.WriteBuffer(const Buffer; Count: Longint);
  var
    r,t : Longint;
 
    begin
      T:=0;
      Repeat
         r:=Write(PByte(@Buffer)[t],Count-t);
         inc(t,r);
      Until (t=count) or (r<=0);
      if (t<Count) then
         Raise EWriteError.Create(SWriteError);
    end;"

https://forum.lazarus.freepascal.org/index.php/topic,46711.msg333738.html#msg333738
"But let us remember that this Zip version works only with the old Zip format < 4 GB.
It will fail with the new version with the maximum of 16 Exabyte.
There should be a notice in the doc file."

https://forum.lazarus.freepascal.org/index.php/topic,46711.msg334173.html#msg334173
"BTW, I would not close this particular issue because it does not consider the argument brought in by sstvmaster (reply 0000010): The unzipper should check the available disk space *before* beginning to write to disk. The current solution allows to write gigabytes to the HD and notice only at the end that the disk is overrunning. I think Michael was not aware of this aspect when resolving the issue. At least it should be brought to his attention to make him reconsider his solution."

Thanks.

Marģers

2019-09-20 19:52

reporter   ~0118141

"But let us remember that this Zip version works only with the old Zip format < 4 GB."
It's only partial true. Fpc 3.2.0 unit zipper can zip files larger than 4 GB and can unzip them. External zip program (like 7zip) can unzip them. Unit zipper are unable to handle zip files created by 7zip if zip file itself or at least one zipped file is larger than 4 GB.
Never the less, this is not related with "full disk" problem. For this issue should be created new bug report.

Michael Van Canneyt

2019-09-20 22:25

administrator   ~0118142

Please open separate bug reports with clear descriptions and test programs.

The original issue is fixed. What you require here is a change in behaviour, i.e. a feature.

Issue History

Date Modified Username Field Change
2019-09-12 04:58 Valdir Marcos New Issue
2019-09-12 04:58 Valdir Marcos File Added: test2.lpi
2019-09-12 04:58 Valdir Marcos File Added: test2.pas
2019-09-12 07:39 Michael Van Canneyt Assigned To => Michael Van Canneyt
2019-09-12 07:39 Michael Van Canneyt Status new => resolved
2019-09-12 07:39 Michael Van Canneyt Resolution open => fixed
2019-09-12 07:39 Michael Van Canneyt Fixed in Version => 3.3.1
2019-09-12 07:39 Michael Van Canneyt Fixed in Revision => 42975
2019-09-12 07:39 Michael Van Canneyt FPCTarget => 3.2.0
2019-09-12 07:39 Michael Van Canneyt Note Added: 0118048
2019-09-20 17:17 Valdir Marcos Status resolved => feedback
2019-09-20 17:17 Valdir Marcos Resolution fixed => reopened
2019-09-20 17:17 Valdir Marcos Note Added: 0118136
2019-09-20 19:52 Marģers Note Added: 0118141
2019-09-20 22:25 Michael Van Canneyt Status feedback => resolved
2019-09-20 22:25 Michael Van Canneyt Resolution reopened => fixed
2019-09-20 22:25 Michael Van Canneyt Note Added: 0118142