paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-06-05 06:39:04 +02:00
Code Issues Packages Projects Releases Wiki Activity

* zip64 support by Reinier Olislagers, mantis #23533

Browse Source 
git-svn-id: trunk@25567 -
This commit is contained in:
marco 2013-09-25 11:04:35 +00:00
parent ca44693e4b
commit c34760677b
4 changed files with 1429 additions and 259 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

96
packages/paszlib/readme.txt
View File

@ -1,3 +1,99 @@
Contents:
zipper.pp/TZipper
- Introduction
- Zip standards compliance
- Zip file format
- Zip64 support notes
paszlib
- Introduction
- Change Log
- File list
- Legal issues
- Archive Locations
=================
zipper.pp/TZipper
=================
Introduction
============
Zipper.pp contains TZipper, an object-oriented wrapper for the paszlib units
that allows
- compressing/adding files/streams
- decompressing files/streams
- listing files
contained in a zip file.
Zip standards compliance
========================
TZipper is meant to help implement the most widely used and useful aspects of
the zip format, while following the official specifications
http://www.pkware.com/documents/casestudies/APPNOTE.TXT
(latest version reviewed for this readme: 6.3.3, September 1, 2012)
as much as possible.
Not all (de)compression methods specified in the zip standard [1] are supported.
Encryption (either zip 2.0 or AES) is not supported, nor are multiple disk sets (spanning/splitting).
Please see the fpdoc help and the zipper.pp for details on using the class.
Zip file format
===============
The standard mentioned above documents the zip file format authoratively
and in detail. However, a brief summary can be useful:
A zip file consists of
For each file:
local file header
(filename, uncompressed,compressed size etc)
optional extended file header
(e.g. zip64 extended info which overrides size above)
compressed file data
Central directory:
- for each file:
central directory header
(much the same data as local file header+position of local file header)
optional extended file header (e.g. zip64 extended info which overrides the
above)
if zip64 is used: one
zip64 end of central directory record
(mainly used to point to beginning of central directory)
zip64 end of central directory locator
(mainly used to point to zip64 end of central directory record)
in any case: one
end of central directory record
(contains position of central directory, zip file comment etc)
Zip64 support notes
===================
The zip64 extensions that allow large files are supported:
- total zip file size and uncompressed sizes of >4Gb (up to FPC's limit of int64
size for streams)
- > 65535 files per zip archive (up to FPC's limit of integer due to
collection.count)
Write support:
zip64 headers are added after local file headers only if the uncompressed or
compressed sizes overflow the local file header space. This avoids wasting space.
Each local zip64 file header variable overrides its corresponding variable in
the local file header only if it is not 0. If it is, the local version is used.
Each central directory zip64 file header variable overrides its corresponding
variable in the central directory file header only if it is not 0. If it is, the
central directory file header version is used.
If zip64 support is needed due to zip64 local/central file headers and/or the
number of files in the zip file, the zip64 alternatives to the end of central
diretory variables are always written. Although the zip standard doesn't seem to
require this explicitly, it doesn't forbid it either and other utilities such as
rar and Windows 7 built in zip support seem to require it.
=======
paszlib
=======
_____________________________________________________________________________
PASZLIB 1.0 May 11th, 1998

2
packages/paszlib/src/zinflate.pas
View File

@ -3,7 +3,7 @@ unit zinflate;
{ inflate.c -- zlib interface to inflate modules
Copyright (C) 1995-1998 Mark Adler
Pascal tranlastion
Pascal translation
Copyright (C) 1998 by Jacques Nomssi Nzali
For conditions of distribution and use, see copyright notice in readme.txt
}

987
packages/paszlib/src/zipper.pp
View File

File diff suppressed because it is too large Load Diff

603
packages/paszlib/tests/tczipper.pp
View File

@ -1,50 +1,114 @@
program tczipper;
{
This file is part of the Free Pascal packages.
Copyright (c) 1999-2012 by the Free Pascal development team
Copyright (c) 2012-2013 by the Free Pascal Development Team
Created by Reinier Olislagers
Tests zip/unzip functionality provided by the FPC zipper.pp unit.
If passed a zip file name as first argument, it will try and decompress
and list the contents of the zip file.
See the file COPYING.FPC, included in this distribution,
for details about the copyright.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
for details about the license.
**********************************************************************}
{$mode objfpc}{$h+}
uses SysUtils, classes, zipper, md5;
//Define this if you want to inspect the generated zips etc
{$define KEEPTESTFILES}
uses SysUtils, classes, zipper, unzip, zdeflate, zinflate, zip, md5, zstream, nullstream;
type
TCallBackHandler = class(TObject)
{ TCallBackHandler }
TCallBackHandler = class(TObject) //Callbacks used in zip/unzip processing
private
FPerformChecks: boolean;
FOriginalContent: string;
FShowContent: boolean;
FStreamResult: boolean;
public
property PerformChecks: boolean read FPerformChecks write FPerformChecks; //If false, do not perform any consistency checks
property OriginalContent: string read FOriginalContent write FOriginalContent; //Zip entry uncompressed content used in TestZipEntries
property ShowContent: boolean read FShowContent write FShowContent; //Show contents of zip when extracting?
property StreamResult: boolean read FStreamResult; //For handler to report success/failure
procedure EndOfFile(Sender:TObject; const Ratio:double);
procedure StartOfFile(Sender:TObject; const AFileName:string);
procedure DoCreateZipOutputStream(Sender: TObject; var AStream: TStream;
AItem: TFullZipFileEntry);
procedure DoDoneOutZipStream(Sender: TObject; var AStream: TStream;
AItem: TFullZipFileEntry); //Used to verify zip entry decompressed contents
constructor Create;
end;
procedure TCallBackHandler.EndOfFile(Sender : TObject; Const Ratio : Double);
procedure TCallBackHandler.EndOfFile(Sender: TObject; const Ratio: double);
begin
if (Ratio<0) then
writeln('End of file handler hit; ratio: '+floattostr(ratio));
if (FPerformChecks) and (Ratio<0) then
begin
writeln('Found compression ratio '+floattostr(Ratio)+', which should never be lower than 0.');
halt(3);
halt(1);
end;
end;
procedure TCallBackHandler.StartOfFile(Sender : TObject; Const AFileName : String);
procedure TCallBackHandler.StartOfFile(Sender: TObject; const AFileName: string);
begin
if AFileName='' then
writeln('Start of file handler hit; filename: '+AFileName);
if (FPerformChecks) and (AFileName='') then
begin
writeln('Archive filename should not be empty.');
halt(4);
halt(1);
end;
end;
procedure TCallBackHandler.DoCreateZipOutputStream(Sender: TObject; var AStream: TStream;
AItem: TFullZipFileEntry);
begin
AStream:=TMemoryStream.Create;
end;
procedure TCallBackHandler.DoDoneOutZipStream(Sender: TObject; var AStream: TStream;
AItem: TFullZipFileEntry);
var
DecompressedContent: string;
begin
//writeln('At end of '+AItem.ArchiveFileName);
AStream.Position:=0;
SetLength(DecompressedContent,Astream.Size);
if AStream.Size>0 then
(AStream as TMemoryStream).Read(DecompressedContent[1], AStream.Size);
if (FPerformChecks) and (DecompressedContent<>OriginalContent) then
begin
FStreamResult:=false;
writeln('TestZipEntries failed: found entry '+AItem.ArchiveFileName+
' has value ');
writeln('*'+DecompressedContent+'*');
writeln('expected ');
writeln('*'+OriginalContent+'*');
end;
if (FPerformChecks=false) and (ShowContent=true) then
begin
//display only
writeln('TestZipEntries info: found entry '+AItem.ArchiveFileName+
' has value ');
writeln('*'+DecompressedContent+'*');
end;
Astream.Free;
end;
constructor TCallBackHandler.Create;
begin
FOriginalContent:='A'; //nice short demo content
FStreamResult:=true;
FPerformChecks:=true; //perform verification by default
FShowContent:=true;
end;
function CompareCompressDecompress: boolean;
var
code: cardinal;
CallBackHandler: TCallBackHandler;
CompressedFile: string;
FileContents: TStringList;
@ -55,10 +119,10 @@ var
OurZipper: TZipper;
UnZipper: TUnZipper;
begin
code := 0;
result:=true;
UncompressedFile1:=SysUtils.GetTempFileName('', 'UNC');
UncompressedFile2:=SysUtils.GetTempFileName('', 'UNC');
CompressedFile:=SysUtils.GetTempFileName('', 'ZP');
CompressedFile:=SysUtils.GetTempFileName('', 'CC');
FileContents:=TStringList.Create;
OurZipper:=TZipper.Create;
@ -93,8 +157,10 @@ begin
end;
// Delete original files
{$IFNDEF KEEPTESTFILES}
DeleteFile(UncompressedFile1);
DeleteFile(UncompressedFile2);
{$ENDIF}
// Now unzip
Unzipper.FileName:=CompressedFile;
@ -109,7 +175,7 @@ begin
(not FileExists(UncompressedFile2)) then
begin
writeln('Unzip failed: could not find decompressed files.');
halt(6);
exit(false);
end;
// Compare hashes
@ -120,25 +186,510 @@ begin
then
begin
writeln('Unzip failed: uncompressed files are not the same as the originals.');
halt(7);
exit(false);
end;
if code = 0 then
writeln('Basic zip/unzip tests passed')
else
writeln('Basic zip/unzip test failed: ', code);
finally
FileContents.Free;
CallBackHandler.Free;
OurZipper.Free;
UnZipper.Free;
{$IFNDEF KEEPTESTFILES}
try
if FileExists(CompressedFile) then DeleteFile(CompressedFile);
if FileExists(UncompressedFile1) then DeleteFile(UncompressedFile1);
if FileExists(UncompressedFile2) then DeleteFile(UncompressedFile2);
finally
// Ignore errors; operating system should clean out temp files
end;
// Ignore errors: OS should eventually clean out temp files anyway
end;
{$ENDIF}
end;
end;
function CompressSmallStreams: boolean;
// Compresses some small streams using default compression and
// no compression (storage)
// Just storing is the best option; compression will enlarge the zip.
// Test verifies that the entries in the zip are not bigger than
// the originals.
var
DestFile: string;
z: TZipper;
zfe: TZipFileEntry;
s: string = 'abcd';
DefaultStream, StoreStream: TStringStream;
begin
result:=true;
DestFile:=SysUtils.GetTempFileName('', 'CS1');
z:=TZipper.Create;
z.FileName:=DestFile;
try
DefaultStream:=TStringStream.Create(s);
StoreStream:=TStringStream.Create(s);
//DefaultStream - compression level = Default
zfe:=z.Entries.AddFileEntry(DefaultStream, 'Compressed');
z.ZipAllFiles;
if (z.Entries[0].Size>zfe.Size) then
begin
result:=false;
writeln('Small stream test default compression failed: compressed size '+
inttostr(z.Entries[0].Size) + ' > original size '+inttostr(zfe.Size));
exit;
end;
finally
DefaultStream.Free;
StoreStream.Free;
z.Free;
end;
{$IFNDEF KEEPTESTFILES}
try
DeleteFile(DestFile);
except
// ignore mess
end;
{$ENDIF}
DestFile:=SysUtils.GetTempFileName('', 'CS2');
z:=TZipper.Create;
z.FileName:=DestFile;
try
DefaultStream:=TStringStream.Create(s);
StoreStream:=TStringStream.Create(s);
//StoreStream - compression level = Store
zfe:=z.Entries.AddFileEntry(StoreStream, 'Uncompressed');
zfe.CompressionLevel:=clnone;
z.ZipAllFiles;
if (z.Entries[0].Size>zfe.Size) then
begin
result:=false;
writeln('Small stream test uncompressed failed: compressed size '+
inttostr(z.Entries[0].Size) + ' > original size '+inttostr(zfe.Size));
exit;
end;
finally
DefaultStream.Free;
StoreStream.Free;
z.Free;
end;
{$IFNDEF KEEPTESTFILES}
try
DeleteFile(DestFile);
except
// ignore mess
end;
{$ENDIF}
//The result can be checked with the command (on Linux):
//unzip -v <DestFile>
//The column Size Shows that compressed files are bigger than source files
end;
function ShowZipFile(ZipFile: string): boolean;
// Reads zip file and lists entries
var
CallBackHandler: TCallBackHandler;
i: integer;
UnZipper: TUnZipper;
UnzipArchiveFiles: TStringList;
begin
result:=true;
UnZipper:=TUnZipper.Create;
CallBackHandler:=TCallBackHandler.Create;
UnzipArchiveFiles:=TStringList.Create;
try
CallBackHandler.PerformChecks:=false; //only display output
UnZipper.FileName:=ZipFile;
Unzipper.Examine;
writeln('ShowZipFile: zip file has '+inttostr(UnZipper.Entries.Count)+' entries');
i:=0;
Unzipper.OnCreateStream:=@CallBackHandler.DoCreateZipOutputStream;
Unzipper.OnDoneStream:=@CallBackHandler.DoDoneOutZipStream;
while i<Unzipper.Entries.Count do
begin
if CallBackHandler.StreamResult then
begin
UnzipArchiveFiles.Clear;
UnzipArchiveFiles.Add(Unzipper.Entries[i].ArchiveFileName);
Unzipper.UnZipFiles(UnzipArchiveFiles);
// This will kick off the DoCreateOutZipStream/DoDoneOutZipStream handlers
inc(i);
end
else
begin
break; // Handler has reported error; stop loop
end;
end;
finally
Unzipper.Free;
CallBackHandler.Free;
UnzipArchiveFiles.Free;
end;
end;
function TestZipEntries(Entries: qword): boolean;
// Adds Entries amount of zip file entries and reads them
// Starting from 65535 entries, the zip needs to be in zip64 format
var
CallBackHandler: TCallBackHandler;
DestFile: string;
i: qword;
OriginalContent: string = 'A'; //Uncompressed content for zip file entry
ContentStreams: TFPList;
ContentStream: TStringStream;
UnZipper: TUnZipper;
UnzipArchiveFiles: TStringList;
Zipper: TZipper;
begin
result:=true;
DestFile:=SysUtils.GetTempFileName('', 'E'+inttostr(Entries)+'_');
Zipper:=TZipper.Create;
Zipper.FileName:=DestFile;
ContentStreams:=TFPList.Create;
try
i:=0;
while i<Entries do
begin
ContentStream:=TStringStream.Create(OriginalContent);
ContentStreams.Add(ContentStream);
// Start filenames at 1
Zipper.Entries.AddFileEntry(TStringStream(ContentStreams.Items[i]), format('%U',[i+1]));
inc(i);
end;
Zipper.ZipAllFiles;
{
i:=0;
while i<Entries do
begin
ContentStreams.Delete(i);
end;
}
finally
ContentStreams.Free;
Zipper.Free;
end;
UnZipper:=TUnZipper.Create;
CallBackHandler:=TCallBackHandler.Create;
UnzipArchiveFiles:=TStringList.Create;
try
CallBackHandler.OriginalContent:=OriginalContent;
UnZipper.FileName:=DestFile;
Unzipper.Examine;
if (UnZipper.Entries.Count<>Entries) then
begin
result:=false;
writeln('TestZipEntries failed: found '+
inttostr(UnZipper.Entries.Count) + ' entries; expected '+inttostr(Entries));
exit;
end;
i:=0;
Unzipper.OnCreateStream:=@CallBackHandler.DoCreateZipOutputStream;
Unzipper.OnDoneStream:=@CallBackHandler.DoDoneOutZipStream;
while i<Entries do
begin
if CallBackHandler.StreamResult then
begin
UnzipArchiveFiles.Clear;
UnzipArchiveFiles.Add(Unzipper.Entries[i].ArchiveFileName);
Unzipper.UnZipFiles(UnzipArchiveFiles);
// This will kick off the DoCreateOutZipStream/DoDoneOutZipStream handlers
inc(i);
end
else
begin
break; // Handler has reported error; stop loop
end;
end;
finally
Unzipper.Free;
CallBackHandler.Free;
UnzipArchiveFiles.Free;
end;
{$IFNDEF KEEPTESTFILES}
try
DeleteFile(DestFile);
except
// ignore mess
end;
{$ENDIF}
end;
function TestEmptyZipEntries(Entries: qword): boolean;
// Same as TestZipEntries, except uses empty data:
// useful for testing large number of files
var
CallBackHandler: TCallBackHandler;
DestFile: string;
i: qword;
ContentStreams: TFPList;
ContentStream: TNullStream;
UnZipper: TUnZipper;
UnzipArchiveFiles: TStringList;
Zipper: TZipper;
begin
result:=true;
DestFile:=SysUtils.GetTempFileName('', 'EZ'+inttostr(Entries)+'_');
Zipper:=TZipper.Create;
Zipper.FileName:=DestFile;
ContentStreams:=TFPList.Create;
try
i:=0;
while i<Entries do
begin
ContentStream:=TNullStream.Create;
ContentStreams.Add(ContentStream);
// Start filenames at 1
Zipper.Entries.AddFileEntry(TStringStream(ContentStreams.Items[i]), format('%U',[i+1]));
inc(i);
end;
Zipper.ZipAllFiles;
{
i:=0;
while i<Entries do
begin
ContentStreams.Delete(i);
end;
}
finally
ContentStreams.Free;
Zipper.Free;
end;
UnZipper:=TUnZipper.Create;
UnzipArchiveFiles:=TStringList.Create;
CallBackHandler:=TCallBackHandler.Create;
try
// Use callbacks to dump zip output into the bit bucket
CallBackHandler.PerformChecks:=false;
CallBackHandler.ShowContent:=false;
Unzipper.OnCreateStream:=@CallBackHandler.DoCreateZipOutputStream;
Unzipper.OnDoneStream:=@CallBackHandler.DoDoneOutZipStream;
UnZipper.FileName:=DestFile;
Unzipper.Examine;
if (UnZipper.Entries.Count<>Entries) then
begin
result:=false;
writeln('TestEmptyZipEntries failed: found '+
inttostr(UnZipper.Entries.Count) + ' entries; expected '+inttostr(Entries));
exit;
end;
i:=0;
while i<Entries do
begin
UnzipArchiveFiles.Clear;
UnzipArchiveFiles.Add(Unzipper.Entries[i].ArchiveFileName);
Unzipper.UnZipFiles(UnzipArchiveFiles);
inc(i);
end;
finally
CallBackHandler.Free;
Unzipper.Free;
UnzipArchiveFiles.Free;
end;
{$IFNDEF KEEPTESTFILES}
try
DeleteFile(DestFile);
except
// ignore mess
end;
{$ENDIF}
end;
function TestLargeFileName: boolean;
// Zips/unzips 259-character filename
var
ArchiveFile: string;
DestFile: string;
s: string = 'a';
DefaultStream: TStringStream;
UnZipper: TUnZipper;
Zipper: TZipper;
begin
result:=true;
ArchiveFile:=StringOfChar('A',259);
DestFile:=SysUtils.GetTempFileName('', 'TL');
Zipper:=TZipper.Create;
Zipper.FileName:=DestFile;
try
DefaultStream:=TStringStream.Create(s);
Zipper.Entries.AddFileEntry(DefaultStream, ArchiveFile);
Zipper.ZipAllFiles;
finally
DefaultStream.Free;
Zipper.Free;
end;
UnZipper:=TUnZipper.Create;
try
UnZipper.FileName:=DestFile;
Unzipper.Examine;
if (Unzipper.Entries[0].ArchiveFileName<>ArchiveFile) then
begin
result:=false;
writeln('TestLargeFileName failed: found filename length '+
inttostr(Length(Unzipper.Entries[0].ArchiveFileName)));
writeln('*'+Unzipper.Entries[0].ArchiveFileName + '*');
writeln('Expected length '+inttostr(Length(ArchiveFile)));
writeln('*'+ArchiveFile+'*');
exit;
end;
finally
Unzipper.Free;
end;
{$IFNDEF KEEPTESTFILES}
try
DeleteFile(DestFile);
except
// ignore mess
end;
{$ENDIF}
end;
function TestLargeZip64: boolean;
// Tests single zip file with large uncompressed content
// which forces it to zip64 format
var
ArchiveFile: string;
Buffer: PChar;
DestFile: string;
ContentStream: TNullStream; //empty contents
UnZipper: TUnZipper;
Zipper: TZipper;
i: int64;
begin
result:=true;
DestFile:=SysUtils.GetTempFileName('', 'LZ');
Zipper:=TZipper.Create;
Zipper.FileName:=DestFile;
ArchiveFile:='HugeString.txt';
ContentStream:=TNullStream.Create;
// About 4Gb; content of 4 bytes+1 added
ContentStream.Size:=(1+$FFFFFFFF);
ContentStream.Position:=0;
writeln('Buffer created');
try
Zipper.Entries.AddFileEntry(ContentStream, ArchiveFile);
writeln('entry added');
Zipper.ZipAllFiles;
finally
ContentStream.Free;
Zipper.Free;
end;
UnZipper:=TUnZipper.Create;
try
UnZipper.FileName:=DestFile;
Unzipper.Examine;
if (UnZipper.Entries.Count<>1) then
begin
result:=false;
writeln('TestLargeZip64 failed: found '+
inttostr(UnZipper.Entries.Count) + ' entries; expected 1');
exit;
end;
if (Unzipper.Entries[0].ArchiveFileName<>ArchiveFile) then
begin
result:=false;
writeln('TestLargeZip64 failed: found filename length '+
inttostr(Length(Unzipper.Entries[0].ArchiveFileName)));
writeln('*'+Unzipper.Entries[0].ArchiveFileName + '*');
writeln('Expected length '+inttostr(Length(ArchiveFile)));
writeln('*'+ArchiveFile+'*');
exit;
end;
finally
Unzipper.Free;
end;
{$IFNDEF KEEPTESTFILES}
try
DeleteFile(DestFile);
except
// ignore mess
end;
{$ENDIF}
end;
var
code: cardinal; //test result code: 0 for success
begin
code:=0;
try
if FileExists(ParamStr(1)) then
begin
writeln('');
writeln('Started investigating file '+ParamStr(1));
ShowZipFile(ParamStr(1));
writeln('Finished investigating file '+ParamStr(1));
writeln('');
end;
writeln('CompareCompressDecompress started');
if not(CompareCompressDecompress) then code:=code+2; //1 already taken by callback handler
writeln('CompareCompressDecompress finished');
writeln('');
writeln('CompressSmallStreams started');
if not(CompressSmallStreams) then code:=code+4;
writeln('CompressSmallStreams finished');
writeln('');
writeln('TestZipEntries(2) started');
if not(TestZipEntries(2)) then code:=code+8;
writeln('TestZipEntries(2) finished');
writeln('');
writeln('TestLargeFileName started');
if not(TestLargeFileName) then code:=code+16;
writeln('TestLargeFileName finished');
writeln('');
writeln('TestEmptyZipEntries(10) started');
// Run testemptyzipentries with a small number to test the test itself... as
// well as zip structure generated with empty files.
if not(TestEmptyZipEntries(10)) then code:=code+32;
writeln('TestEmptyZipEntries(10) finished');
writeln('');
writeln('TestEmptyZipEntries(65537) started');
writeln('(note: this will take a long time)');
{Note: tested tools with this file:
- info-zip unzip 6.0
- Ionic's DotNetZip library unzip.exe utility verison 1.9.1.8 works
- 7zip's 7za 9.22 beta works.
}
if not(TestEmptyZipEntries(65537)) then code:=code+32;
writeln('TestEmptyZipEntries(65537) finished');
writeln('');
{ This test will take a very long time as it tries to zip a 4Gb memory block.
It is therefore commented out by default }
{
writeln('TestLargeZip64 - started');
if not(TestLargeZip64) then code:=code+thefollowingstatuscode;
writeln('TestLargeZip64 format - finished');
writeln('');
}
except
on E: Exception do
begin
writeln('');
writeln('Exception: ');
writeln(E.Message);
writeln('');
end;
end;
if code=0 then
writeln('Basic zip/unzip tests passed: code '+inttostr(code))
else
writeln('Basic zip/unzip tests failed: code '+inttostr(code));
Halt(code);
end.