4610b73091
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@2301 8e941d3f-bd1b-0410-a28a-d453659cc2b4
844 lines
24 KiB
ObjectPascal
Executable File
844 lines
24 KiB
ObjectPascal
Executable File
{ zlibar.pas can create and read a file that contains many compressed files
|
|
Copyright (C) 2005 Andrew Haines
|
|
|
|
This library is free software; you can redistribute it and/or
|
|
modify it under the terms of the GNU Lesser General Public
|
|
License as published by the Free Software Foundation; either
|
|
version 2.1 of the License, or (at your option) any later version.
|
|
|
|
This library 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. See the GNU
|
|
Lesser General Public License for more details.
|
|
|
|
You should have received a copy of the GNU Lesser General Public
|
|
License along with this library; if not, write to the Free Software
|
|
Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
|
|
}
|
|
{
|
|
See also the file COPYING.modifiedLGPL included with this file
|
|
}
|
|
unit zlibar;
|
|
|
|
// This Unit Provides methods to compress multiple files into an archive of one file and retrieve them
|
|
// Also you can use CompressStream and ExtractStream to just compress and decompress a tmemorystream
|
|
|
|
{$mode objfpc}{$H+}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, SysUtils, paszlib, md5;
|
|
|
|
type
|
|
|
|
PFileInfo = ^TFileInfo;
|
|
TFileInfo = record
|
|
CompressedSize: Int64;
|
|
Md5Sum: TMD5Digest;
|
|
end;
|
|
|
|
{ TZlibFilesList }
|
|
TZlibFilesList = class(TObject)
|
|
private
|
|
FFileList: TFpList;
|
|
FPathList: TFpList;
|
|
FFileInfoList: TFpList;
|
|
function GetFileName(AIndex: Integer): String;
|
|
function GetPath(AIndex: Integer): String;
|
|
procedure SetFileName(AIndex: Integer; AFIleName: String);
|
|
procedure SetPath(AIndex: Integer; APath: String);
|
|
function GetFileInfo(AIndex: Integer): TFileInfo;
|
|
procedure SetFileInfo(AIndex: Integer; AFileInfo: TFileInfo);
|
|
public
|
|
constructor Create;
|
|
destructor Destroy; override;
|
|
public
|
|
function Add(AFileName: String): Integer;
|
|
function AddPath(AFileName: String; APath: String): Integer;
|
|
function Insert(AIndex: Integer; AFileName: String): Integer;
|
|
function InsertPath(AIndex: Integer; AFileName: String; APath: String): Integer;
|
|
procedure Delete(AIndex: Integer);
|
|
procedure Clear;
|
|
function Count: Integer;
|
|
public
|
|
// this contains the full path to the file name on the current filesystem
|
|
property FileName[Index: Integer]: String read GetFileName write SetFileName;
|
|
// this is the relative path that you would like the file extracted to
|
|
property Path[Index: Integer]: String read GetPath write SetPath;
|
|
// used internally
|
|
property FileInfo[Index: Integer]: TFileInfo read GetFileInfo write SetFileInfo;
|
|
end;
|
|
TZlibArchiveHeader = packed record
|
|
FileType: array [0..3] of char;// = ('Z','A','R', 0);
|
|
MajorVersion,
|
|
MinorVersion,
|
|
MicroVersion: LongInt;
|
|
TOCLength: Int64; // overkill? :)
|
|
TOCMD5Sum: TMD5Digest;
|
|
end;
|
|
|
|
PTOCEntry = ^TTOCEntry;
|
|
TTOCEntry = packed record
|
|
FileName: String;
|
|
FilePath: String;
|
|
Position: Int64;
|
|
CompressedSize: Int64;
|
|
Md5sum: TMD5Digest;
|
|
end;
|
|
(*
|
|
A TOC Entry will stored like so:
|
|
1. Write File Name to be in archive
|
|
2 Write Empty Byte.
|
|
3. Write File Path
|
|
4. Write Empty Byte
|
|
5. Write File Position (Int64) 8 bytes
|
|
6. Write File Compressed Size(Int64)
|
|
7. Write md5sum (TMD5Digest)
|
|
Repeat 1-4
|
|
*)
|
|
|
|
TZlibCompressProgProc = procedure (Sender: TObject; FileIndex: Integer; FileSize, FilePos: Int64) of object;
|
|
|
|
TZlibExtractProgProc = procedure (Sender: TObject; FileSize, FilePos: Int64) of object;
|
|
|
|
TZlibErrorProc = procedure(Sender: TObject; var ErrorCode: Integer; ErrorStr: String) of object;
|
|
|
|
{ TZlibArchive }
|
|
|
|
{ TZlibWriteArchive }
|
|
|
|
TZlibWriteArchive = class(TObject)
|
|
private
|
|
fInputFiles: TZlibFilesList;
|
|
fOnCompress: TZlibCompressProgProc;
|
|
fOnError: TZlibErrorProc;
|
|
fStream: TStream;
|
|
fStreamOwner: Boolean;
|
|
procedure WriteHeader(AHeader: TZlibArchiveHeader);
|
|
procedure WriteTOCEntry(Entry: TTOCEntry; TOCStream: TStream);
|
|
procedure CheckStreamAssigned;
|
|
procedure DoError(ErrorCode: Integer; ErrorString: String);
|
|
function InternalCompressStream(FileIndex: Integer; InStream: TStream; OutStream: TStream): Integer;
|
|
procedure SetStream(AValue: TStream);
|
|
public
|
|
constructor Create;
|
|
destructor Destroy; override;
|
|
public
|
|
function CreateArchive: boolean;
|
|
property OnError: TZlibErrorProc read fOnError write fOnError;
|
|
property OnCompress : TZlibCompressProgProc read fOnCompress write fOnCompress;
|
|
published
|
|
property OutStream: TStream read fStream write SetStream;
|
|
property InputFiles: TZlibFilesList read fInputFiles;
|
|
end;
|
|
|
|
{ TZLibReadArchive }
|
|
|
|
TZLibReadArchive = class(TObject)
|
|
private
|
|
fTOCList: TFpList;
|
|
fOnError: TZlibErrorProc;
|
|
fOnExtract: TZlibExtractProgProc;
|
|
fHeader: TZlibArchiveHeader;
|
|
fStream: TStream;
|
|
fFileName: String;
|
|
procedure SetStream(AStream: TStream);
|
|
procedure VerifyFile;
|
|
procedure ReadTOC;
|
|
procedure FreeTOC;
|
|
function GetCount: Integer;
|
|
function GetTOCEntry(AIndex: Integer): TTOCEntry;
|
|
procedure DoError(ErrorCode: Integer; ErrorString: String);
|
|
function InternalExtractStream(InStream: TStream;var OutStream: TStream): Integer;
|
|
function FindFilePath(const AFilePath: String): Integer;
|
|
public
|
|
constructor Create;
|
|
constructor Create(InStream: TStream);
|
|
destructor Destroy; override;
|
|
public
|
|
procedure ExtractFileToStream(AIndex: Integer; Stream: TStream);
|
|
procedure ExtractFileToStream(const AFileName: String; Stream: TStream);
|
|
procedure ExtractFileToStream(const AFileName , APath: String; Stream: TStream);
|
|
property Header: TZlibArchiveHeader read fHeader;
|
|
property FilesInArchive[Index: Integer]: TTOCEntry read GetTOCEntry;
|
|
property Count: Integer read GetCount;
|
|
property OnError: TZlibErrorProc read fOnError write fOnError;
|
|
property OnExtract: TZlibExtractProgProc read fOnExtract write fOnExtract;
|
|
published
|
|
property InStream: TStream read fStream write SetStream;
|
|
end;
|
|
const
|
|
ZLibFileType: array [0..3] of char = ('Z','A','R', #0);
|
|
|
|
ZAR_MAJOR_VERSION : LongInt = 1;
|
|
ZAR_MINOR_VERSION : LongInt = 0;
|
|
ZAR_MICRO_VERSION : LongInt = 0;
|
|
|
|
ERR_CORRUPT_TOC = 1;
|
|
ERR_CORRUPT_FILE = 2;
|
|
ERR_CHECKSUM_FAILED = 3;
|
|
ERR_FILENAME_NOT_FOUND = 4;
|
|
ERR_UNKOWN_ERROR = 6;
|
|
|
|
function CompressStream(InStream: TStream; OutStream: TStream): Integer; //returns size of compressed file
|
|
function ExtractStream(InStream: TStream; OutStream: TStream): Integer;
|
|
function StreamMD5(Stream: TStream): TMD5Digest; // creates a md5digest from a tstream
|
|
|
|
implementation
|
|
|
|
///////////////////////////////////
|
|
// Generic Functions //
|
|
///////////////////////////////////
|
|
|
|
{*******************************************************************************
|
|
* This performs an md5 sum on the file and returns it as a TMD5Digest *
|
|
* *
|
|
*******************************************************************************}
|
|
function StreamMD5(Stream: TStream): TMD5Digest;
|
|
var
|
|
Buf : array [0..1023] of byte;
|
|
Context: TMD5Context;
|
|
Count : Longint;
|
|
begin
|
|
Stream.Position := 0;
|
|
MD5Init(Context);
|
|
repeat
|
|
Count := 1024;
|
|
Count := Stream.Read(Buf, Count);
|
|
If (Count>0) then
|
|
MD5Update(Context, Buf, Count);
|
|
until (Count<1024);
|
|
MD5Final(Context, Result);
|
|
end;
|
|
|
|
{*******************************************************************************
|
|
* This decompresses the data from InStream and Writes the decompressed data *
|
|
* to OutputStream *
|
|
*******************************************************************************}
|
|
function ExtractStream(InStream: TStream; OutStream: TStream): Integer;
|
|
var
|
|
err : integer;
|
|
z : TZstream;
|
|
const
|
|
MAX_IN_BUF_SIZE = 1024;
|
|
MAX_OUT_BUF_SIZE = 1024;
|
|
var
|
|
input_buffer : array[0..MAX_IN_BUF_SIZE-1] of byte;
|
|
output_buffer : array[0..MAX_OUT_BUF_SIZE-1] of byte;
|
|
FlushType: LongInt;
|
|
begin
|
|
Result := 0;
|
|
|
|
FillChar(z, SizeOf(z), 0);
|
|
|
|
FillChar(input_buffer, SizeOf(input_buffer), 0);
|
|
err := inflateInit(z);
|
|
InStream.Position := 0;
|
|
|
|
while InStream.Position < InStream.Size do
|
|
begin
|
|
z.next_in := @input_buffer;
|
|
z.avail_in := InStream.Read(input_buffer, MAX_IN_BUF_SIZE);
|
|
|
|
// wouldn't work for files > 2GB
|
|
//z.next_in := TMemoryStream(InStream).Memory;
|
|
//z.avail_in := InStream.Size;
|
|
if InStream.Position = InStream.Size then
|
|
FlushType := Z_FINISH
|
|
else
|
|
FlushType := Z_SYNC_FLUSH;
|
|
repeat
|
|
z.next_out := @output_buffer;
|
|
z.avail_out := MAX_OUT_BUF_SIZE;
|
|
|
|
err := inflate(z, FlushType);
|
|
Result += OutStream.Write(output_buffer, MAX_OUT_BUF_SIZE - z.avail_out);
|
|
if err = Z_STREAM_END then Break;
|
|
until Z.avail_out > 0;
|
|
if (err <> Z_OK) and (err <> Z_BUF_ERROR) then begin
|
|
break;
|
|
end;
|
|
end;
|
|
err := inflateEnd(z);
|
|
end;
|
|
|
|
{*******************************************************************************
|
|
* This compresses the data from InStream and Writes the compressed data *
|
|
* to OutputStream *
|
|
*******************************************************************************}
|
|
function CompressStream(InStream: TStream; OutStream: TStream): Integer;
|
|
var
|
|
err : integer;
|
|
z : TZstream;
|
|
|
|
const
|
|
MAX_IN_BUF_SIZE = 1024;
|
|
MAX_OUT_BUF_SIZE = 1024;
|
|
var
|
|
input_buffer : array[0..MAX_IN_BUF_SIZE-1] of byte;
|
|
output_buffer : array[0..MAX_OUT_BUF_SIZE-1] of byte;
|
|
FlushType: LongInt;
|
|
begin
|
|
Result := 0;
|
|
|
|
FillChar(input_buffer, SizeOf(input_buffer), 0);
|
|
err := deflateInit(z, -1); //default
|
|
InStream.Position := 0;
|
|
|
|
while InStream.Position < InStream.Size do
|
|
begin
|
|
z.next_in := @input_buffer;
|
|
z.avail_in := InStream.Read(input_buffer, MAX_IN_BUF_SIZE);
|
|
|
|
// wouldn't work for files > 2 gb :(
|
|
//z.next_in := TMemoryStream(InStream).Memory;
|
|
//z.avail_in := InStream.Size;
|
|
if InStream.Position = InStream.Size then
|
|
FlushType := Z_FINISH
|
|
else
|
|
FlushType := Z_NO_FLUSH;
|
|
repeat
|
|
z.next_out := @output_buffer;
|
|
z.avail_out := MAX_OUT_BUF_SIZE;
|
|
err := deflate(z, FlushType);
|
|
Result += OutStream.Write(output_buffer, MAX_OUT_BUF_SIZE - z.avail_out);
|
|
until Z.avail_out > 0;
|
|
|
|
if (err <> Z_OK) and (err <> Z_BUF_ERROR) then begin
|
|
break;
|
|
end;
|
|
end;
|
|
|
|
err := deflateEnd(z);
|
|
end;
|
|
|
|
////////////////////////////////
|
|
// Objects //
|
|
////////////////////////////////
|
|
|
|
{ TZlibArchive }
|
|
|
|
procedure TZlibWriteArchive.WriteHeader(AHeader: TZlibArchiveHeader);
|
|
var
|
|
X: Integer;
|
|
CompressedTOCStream: TMemoryStream;
|
|
TOCStream: TMemoryStream;
|
|
Position: Int64;
|
|
TOCEntry: TTOCEntry;
|
|
FileInfo:TFileInfo;
|
|
begin
|
|
try
|
|
CheckStreamAssigned;
|
|
TOCStream := TMemoryStream.Create;
|
|
Position := 0;
|
|
OutStream.Position := 0;
|
|
for X := 0 to fInputFiles.Count-1 do begin
|
|
TOCEntry.FileName := fInputFiles.FileName[X];
|
|
TOCEntry.FilePath := fInputFiles.Path[X];
|
|
TOCEntry.Position := Position;
|
|
FileInfo := fInputFiles.FileInfo[X];
|
|
TOCEntry.CompressedSize := FileInfo.CompressedSize;
|
|
TocEntry.Md5sum := FileInfo.Md5Sum;
|
|
WriteTOCEntry(TOCEntry, TOCStream);
|
|
Position += TOCEntry.CompressedSize;
|
|
end;
|
|
CompressedTOCStream:= TMemoryStream.Create;
|
|
CompressStream(TOCStream, CompressedTOCStream);
|
|
CompressedTOCStream.Position := 0;
|
|
AHeader.TOCLength := NtoLE(CompressedTOCStream.Size);
|
|
AHeader.TOCMd5Sum := StreamMd5(TOCStream);
|
|
OutStream.Write(AHeader, SizeOf(TZlibArchiveHeader));
|
|
OutStream.CopyFrom(CompressedTOCStream, CompressedTOCStream.Size);
|
|
finally
|
|
TOCStream.Free;
|
|
CompressedTOCStream.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TZlibWriteArchive.WriteTOCEntry(Entry: TTOCEntry; TOCStream: TStream);
|
|
var
|
|
Str: array [0..255]of char;
|
|
EmptyByte: Byte =0;
|
|
begin
|
|
Str := ExtractFileName(Entry.FileName);
|
|
TOCStream.Write(Str, Length(Trim(Str)));
|
|
TOCStream.WriteByte(EmptyByte);
|
|
Str := Entry.FilePath;
|
|
TOCStream.Write(Str, Length(Trim(Str)));
|
|
TOCStream.WriteByte(EmptyByte);
|
|
Entry.Position := NtoLE(Entry.Position);
|
|
TOCStream.Write(Entry.Position, SizeOf(Int64));
|
|
Entry.CompressedSize := NtoLE(Entry.CompressedSize);
|
|
TOCStream.Write(Entry.CompressedSize, SizeOf(Int64));
|
|
TOCStream.Write(Entry.Md5sum, SizeOf(TMD5Digest));
|
|
|
|
end;
|
|
|
|
|
|
procedure TZlibWriteArchive.CheckStreamAssigned;
|
|
begin
|
|
if fStream = nil then begin
|
|
fStream := TMemoryStream.Create;
|
|
fStreamOwner := True;
|
|
end;
|
|
end;
|
|
|
|
procedure TZlibWriteArchive.DoError(ErrorCode: Integer; ErrorString: String);
|
|
var
|
|
fErrCode: Integer;
|
|
begin
|
|
fErrCode := ErrorCode;
|
|
if Assigned(fOnError) then fOnError(Self, fErrCode, ErrorString);
|
|
if fErrCode <> 0 then Raise Exception.Create('ZLibError('+IntToStr(fErrCode)+') '+ErrorString);
|
|
end;
|
|
|
|
function TZlibWriteArchive.InternalCompressStream(FileIndex: Integer;
|
|
InStream: TStream; OutStream: TStream): Integer;
|
|
var
|
|
err : integer;
|
|
z : TZstream;
|
|
|
|
const
|
|
MAX_IN_BUF_SIZE = 1024;
|
|
MAX_OUT_BUF_SIZE = 1024;
|
|
var
|
|
input_buffer : array[0..MAX_IN_BUF_SIZE-1] of byte;
|
|
output_buffer : array[0..MAX_OUT_BUF_SIZE-1] of byte;
|
|
FlushType: LongInt;
|
|
begin
|
|
Result := 0;
|
|
|
|
FillChar(z, 0 , SizeOf(z));
|
|
|
|
FillChar(input_buffer, SizeOf(input_buffer), 0);
|
|
err := deflateInit(z, -1); //default
|
|
InStream.Position := 0;
|
|
|
|
while InStream.Position < InStream.Size do
|
|
begin
|
|
z.next_in := @input_buffer;
|
|
z.avail_in := InStream.Read(input_buffer, MAX_IN_BUF_SIZE);
|
|
|
|
// wouldn't work for files > 2 gb :(
|
|
//z.next_in := TMemoryStream(InStream).Memory;
|
|
//z.avail_in := InStream.Size;
|
|
if InStream.Position = InStream.Size then
|
|
FlushType := Z_FINISH
|
|
else
|
|
FlushType := Z_NO_FLUSH;
|
|
repeat
|
|
z.next_out := @output_buffer;
|
|
z.avail_out := MAX_OUT_BUF_SIZE;
|
|
err := deflate(z, FlushType);
|
|
Result += OutStream.Write(output_buffer, MAX_OUT_BUF_SIZE - z.avail_out);
|
|
until Z.avail_out > 0;
|
|
if fOnCompress <> nil then fOnCompress(Self, FileIndex, InStream.Size, InStream.Position);
|
|
if (err <> Z_OK) and (err <> Z_BUF_ERROR) then begin
|
|
break;
|
|
end;
|
|
end;
|
|
|
|
err := deflateEnd(z);
|
|
end;
|
|
|
|
procedure TZlibWriteArchive.SetStream(AValue: TStream);
|
|
begin
|
|
if AValue <> fStream then fStreamOwner := False;
|
|
fStream := AValue;
|
|
end;
|
|
|
|
constructor TZlibWriteArchive.Create;
|
|
begin
|
|
fInputFiles := TZlibFilesList.Create;
|
|
fStream := nil;
|
|
end;
|
|
|
|
destructor TZlibWriteArchive.Destroy;
|
|
begin
|
|
fInputFiles.Free;
|
|
if fStreamOwner then fStream.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TZlibWriteArchive.CreateArchive: boolean;
|
|
var
|
|
X: Integer;
|
|
AHeader: TZlibArchiveHeader;
|
|
TmpStream: TMemoryStream; // this holds all the compressed files temporarily
|
|
//TmpFile: TMemoryStream; // this holds the current file to be added to TmpStream
|
|
TmpFile: TFileStream; // this holds the current file to be added to TmpStream
|
|
FileInfo: TFileInfo;
|
|
begin
|
|
Result := False;
|
|
try
|
|
CheckStreamAssigned;
|
|
TmpStream := TMemoryStream.Create;
|
|
|
|
AHeader.FileType := ZLibFileType;
|
|
AHeader.MajorVersion := NtoLE(ZAR_MAJOR_VERSION);
|
|
AHeader.MinorVersion := NtoLE(ZAR_MINOR_VERSION);
|
|
AHeader.MicroVersion := NtoLE(ZAR_MICRO_VERSION);
|
|
|
|
for X := 0 to fInputFiles.Count-1 do begin
|
|
if FileExists(fInputFiles.FileName[X]) then begin
|
|
try
|
|
TmpFile := TFileStream.Create(fInputFiles.FileName[X],fmOpenRead or fmShareDenyNone);
|
|
FileInfo.CompressedSize := InternalCompressStream(X, TmpFile, TmpStream);
|
|
FileInfo.Md5Sum := StreamMD5(TmpFile);
|
|
fInputFiles.FileInfo[X] := FileInfo;//records the compressed length/size
|
|
finally
|
|
TmpFile.Free;
|
|
end;
|
|
end;
|
|
end;
|
|
//Write file header and Table of contents
|
|
WriteHeader(AHeader);
|
|
//WriteFiles
|
|
TmpStream.Position := 0;
|
|
|
|
OutStream.CopyFrom(TmpStream, TmpStream.Size);
|
|
Result := True;
|
|
finally
|
|
TmpStream.Free;
|
|
end;
|
|
end;
|
|
|
|
{ TZLibReadArchive }
|
|
|
|
procedure TZLibReadArchive.SetStream(AStream: TStream);
|
|
begin
|
|
fStream := AStream;
|
|
if AStream <> nil then begin
|
|
fStream.Position := 0;
|
|
fStream.Read(fHeader,SizeOf(TZlibArchiveHeader));
|
|
fHeader.MajorVersion := LEtoN(Header.MajorVersion);
|
|
fHeader.MinorVersion := LEtoN(Header.MinorVersion);
|
|
fHeader.MicroVersion := LetoN(Header.MicroVersion);
|
|
fHeader.TOCLength := LEtoN(Header.TOCLength);
|
|
VerifyFile;
|
|
ReadTOC;
|
|
end
|
|
else begin
|
|
FreeTOC;
|
|
end;
|
|
end;
|
|
|
|
procedure TZLibReadArchive.VerifyFile;
|
|
begin
|
|
if (fHeader.FileType <> ZLibFileType) then DoError(ERR_CORRUPT_FILE,'corrupt file or not a correct file type');
|
|
end;
|
|
|
|
procedure TZLibReadArchive.ReadTOC;
|
|
var
|
|
Entry: PTOCEntry;
|
|
PositionOffset: Int64;
|
|
fChar: Char;
|
|
TmpStream: TMemoryStream; // used to temporarily hold the compressed TOC
|
|
TOCStream: TMemoryStream; // the TOC will be extracted into this
|
|
begin
|
|
TmpStream:= TMemoryStream.Create;
|
|
TOCStream := TMemoryStream.Create;
|
|
try
|
|
fStream.Position := SizeOf(fHeader);
|
|
//Read The Compressed TOC into the TmpStream from the main fStream
|
|
TmpStream.CopyFrom(fStream, fHeader.TOCLength);
|
|
//Decompress TOC into TOCStream
|
|
ExtractStream(TmpStream, TOCStream);
|
|
if MD5Match(fHeader.TOCMD5Sum, StreamMd5(TOCStream)) = False then DoError(ERR_CORRUPT_TOC, 'corrupted table of contents');
|
|
|
|
TOCStream.Position := 0;
|
|
PositionOffset := fHeader.TOCLength + SizeOf(fHeader);
|
|
while TOCStream.Position <> TOCStream.Size do begin
|
|
Entry := New(pTocEntry);
|
|
fTOCList.Add(Entry);
|
|
// Read FileName
|
|
fChar := Char(TOCStream.ReadByte);
|
|
while fChar <> #0 do begin
|
|
Entry^.FileName += fChar;
|
|
fChar := Char(TOCStream.ReadByte);
|
|
end;
|
|
//Read FilePath
|
|
fChar := Char(TOCStream.ReadByte);
|
|
while fChar <> #0 do begin
|
|
Entry^.FilePath += fChar;
|
|
fChar := Char(TOCStream.ReadByte);
|
|
end;
|
|
//Read Position
|
|
TOCStream.Read(Entry^.Position, SizeOf(Int64));
|
|
Entry^.Position := LEtoN(Entry^.Position) + PositionOffset;
|
|
//Read Compressed Size
|
|
TOCStream.Read(Entry^.CompressedSize, SizeOf(Int64));
|
|
Entry^.CompressedSize := LEtoN(Entry^.CompressedSize);
|
|
//Read Md5sum
|
|
TOCStream.Read(Entry^.Md5sum, SizeOf(TMD5Digest));
|
|
end;
|
|
finally
|
|
TmpStream.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TZLibReadArchive.FreeTOC;
|
|
var
|
|
X: Integer;
|
|
begin
|
|
for X := 0 to fTOCList.Count-1 do begin
|
|
Dispose(PTOCEntry(fTocList.Items[X]));
|
|
fTocList.Items[X] := nil;
|
|
end;
|
|
fTOCList.Clear;
|
|
end;
|
|
|
|
function TZLibReadArchive.GetCount: Integer;
|
|
begin
|
|
Result := fTOCList.Count;
|
|
end;
|
|
|
|
function TZLibReadArchive.GetTOCEntry(AIndex: Integer): TTOCEntry;
|
|
begin
|
|
Result := PTOCEntry(fTOCList.Items[AIndex])^;
|
|
end;
|
|
|
|
procedure TZLibReadArchive.DoError(ErrorCode: Integer; ErrorString: String);
|
|
var
|
|
fErrCode: Integer;
|
|
begin
|
|
fErrCode := ErrorCode;
|
|
if Assigned(fOnError) then fOnError(Self, fErrCode, ErrorString);
|
|
if fErrCode <> 0 then Raise Exception.Create('ZLibError('+IntToStr(fErrCode)+') '+ErrorString);
|
|
end;
|
|
|
|
function TZLibReadArchive.InternalExtractStream(InStream: TStream;
|
|
var OutStream: TStream): Integer;
|
|
var
|
|
err : integer;
|
|
z : TZstream;
|
|
const
|
|
MAX_IN_BUF_SIZE = 1024;
|
|
MAX_OUT_BUF_SIZE = 1024;
|
|
var
|
|
input_buffer : array[0..MAX_IN_BUF_SIZE-1] of byte;
|
|
output_buffer : array[0..MAX_OUT_BUF_SIZE-1] of byte;
|
|
FlushType: LongInt;
|
|
begin
|
|
Result := 0;
|
|
|
|
FillChar(z, 0 , SizeOf(z));
|
|
|
|
FillChar(input_buffer, SizeOf(input_buffer), 0);
|
|
err := inflateInit(z);
|
|
InStream.Position := 0;
|
|
while InStream.Position < InStream.Size do
|
|
begin
|
|
z.next_in := @input_buffer;
|
|
z.avail_in := InStream.Read(input_buffer, MAX_IN_BUF_SIZE);
|
|
|
|
// wouldn't work for files > 2GB
|
|
//z.next_in := TMemoryStream(InStream).Memory;
|
|
//z.avail_in := InStream.Size;
|
|
if InStream.Position = InStream.Size then
|
|
FlushType := Z_FINISH
|
|
else
|
|
FlushType := Z_SYNC_FLUSH;
|
|
repeat
|
|
z.next_out := @output_buffer;
|
|
z.avail_out := MAX_OUT_BUF_SIZE;
|
|
|
|
err := inflate(z, FlushType);
|
|
Result += OutStream.Write(output_buffer, MAX_OUT_BUF_SIZE - z.avail_out);
|
|
if err = Z_STREAM_END then Break;
|
|
until Z.avail_out > 0;
|
|
if fOnExtract <> nil then fOnExtract(Self, InStream.Size, InStream.Position);
|
|
if (err <> Z_OK) and (err <> Z_BUF_ERROR) then begin
|
|
break;
|
|
end;
|
|
end;
|
|
err := inflateEnd(z);
|
|
end;
|
|
|
|
function TZLibReadArchive.FindFilePath(const AFilePath: String): Integer;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
Result:= -1;
|
|
for i:= 0 to fTOCList.Count - 1 do begin
|
|
if AFilePath = PTOCEntry(fTOCList[i])^.FilePath+PTOCEntry(fTOCList[i])^.FileName then
|
|
begin
|
|
Result:=i;
|
|
Break;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
constructor TZLibReadArchive.Create;
|
|
begin
|
|
fStream := TMemoryStream.Create;
|
|
fFileName := '';
|
|
fTOCList := TFpList.Create;
|
|
end;
|
|
|
|
constructor TZLibReadArchive.Create(InStream: TStream);
|
|
begin
|
|
Create;
|
|
SetStream(InStream);
|
|
end;
|
|
|
|
destructor TZLibReadArchive.Destroy;
|
|
begin
|
|
FreeTOC;
|
|
fTOCList.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TZLibReadArchive.ExtractFileToStream(AIndex: Integer; Stream: TStream);
|
|
var
|
|
TmpStream: TMemoryStream;
|
|
Md5Sum: TMD5Digest;
|
|
begin
|
|
if Stream = nil then Stream := TMemoryStream.Create;
|
|
Stream.Position := 0;
|
|
Stream.Size := 0;
|
|
TmpStream := TMemoryStream.Create;
|
|
try
|
|
// Move to the position of the compressed file in the archive
|
|
fStream.Position := FilesInArchive[AIndex].Position;
|
|
// read the compressed file into a temp stream
|
|
TmpStream.CopyFrom(fStream, FilesInArchive[AIndex].CompressedSize);
|
|
// decompress the tmp stream into the output stream
|
|
InternalExtractStream(TmpStream, Stream);
|
|
//Check Md5 sum
|
|
Md5Sum := StreamMD5(Stream);
|
|
if not MD5Match(Md5Sum, FilesInArchive[AIndex].Md5sum) then begin
|
|
DoError(ERR_CHECKSUM_FAILED, 'Saved=' + MD5Print(FilesInArchive[AIndex].Md5sum) +' Found='+ MD5Print(Md5sum));
|
|
end;
|
|
finally
|
|
TmpStream.Free;
|
|
end;
|
|
|
|
end;
|
|
|
|
procedure TZLibReadArchive.ExtractFileToStream(const AFileName: String; Stream: TStream);
|
|
begin
|
|
ExtractFileToStream(AFileName,'/',Stream);
|
|
end;
|
|
|
|
procedure TZLibReadArchive.ExtractFileToStream(const AFileName, APath: String; Stream: TStream);
|
|
var
|
|
i: Integer;
|
|
begin
|
|
i:=FindFilePath(APath+AFileName);
|
|
if i <> -1 then
|
|
ExtractFileToStream(i,Stream)
|
|
else
|
|
DoError(ERR_FILENAME_NOT_FOUND,'Could not find '+APath+AFileName+' in '+fFileName);
|
|
end;
|
|
|
|
{ TZlibFilesList }
|
|
|
|
function TZlibFilesList.GetFileName(AIndex: Integer): String;
|
|
begin
|
|
Result := PString(FFileList.Items[AIndex])^;
|
|
end;
|
|
|
|
function TZlibFilesList.GetPath(AIndex: Integer): String;
|
|
begin
|
|
Result := PString(FPathList.Items[AIndex])^;
|
|
end;
|
|
|
|
procedure TZlibFilesList.SetFileName(AIndex: Integer; AFIleName: String);
|
|
begin
|
|
PString(FFileList.Items[AIndex])^ := AFileName;
|
|
end;
|
|
|
|
procedure TZlibFilesList.SetPath(AIndex: Integer; APath: String);
|
|
begin
|
|
PString(FPathList.Items[AIndex])^ := APath;
|
|
end;
|
|
|
|
function TZlibFilesList.GetFileInfo(AIndex: Integer): TFileInfo;
|
|
begin
|
|
Result := PFileInfo(FFileInfoList.Items[AIndex])^;
|
|
end;
|
|
|
|
procedure TZlibFilesList.SetFileInfo(AIndex: Integer; AFileInfo: TFileInfo);
|
|
begin
|
|
PFileInfo(FFileInfoList.Items[AIndex])^ := AFileInfo;
|
|
end;
|
|
|
|
constructor TZlibFilesList.Create;
|
|
begin
|
|
FFileList := TFpList.Create;
|
|
FPathList := TFpList.Create;
|
|
FFileInfoList := TFpList.Create;
|
|
end;
|
|
|
|
destructor TZlibFilesList.Destroy;
|
|
begin
|
|
Clear;
|
|
Inherited Destroy;
|
|
end;
|
|
|
|
function TZlibFilesList.Add(AFileName: String): Integer;
|
|
begin
|
|
Result := InsertPath(Count, AFileName,'/');
|
|
end;
|
|
|
|
function TZlibFilesList.AddPath(AFileName: String; APath: String): Integer;
|
|
begin
|
|
Result := InsertPath(Count, AFileName, APath);
|
|
end;
|
|
|
|
function TZlibFilesList.Insert(AIndex: Integer; AFileName: String): Integer;
|
|
begin
|
|
Result := InsertPath(AIndex, AFileName, '/');
|
|
end;
|
|
|
|
function TZlibFilesList.InsertPath(AIndex: Integer; AFileName: String;
|
|
APath: String): Integer;
|
|
var
|
|
FFile,
|
|
FPath: PString;
|
|
FFileInfo: PFileInfo;
|
|
begin
|
|
Result := 0;
|
|
if AIndex > Count then Result := Count
|
|
else Result := AIndex;
|
|
|
|
FFile := New(PString);
|
|
FPath := New(PString);
|
|
FFileInfo := New(PFileInfo);
|
|
|
|
FFile^ := AFileName;
|
|
FPath^ := APAth;
|
|
|
|
FFileList.Insert(AIndex, FFile);
|
|
FPathList.Insert(AIndex, FPath);
|
|
FFileInfoList.Insert(AIndex, FFileInfo);
|
|
end;
|
|
|
|
procedure TZlibFilesList.Delete(AIndex: Integer);
|
|
begin
|
|
Dispose(PString(FFileList.Items[AIndex]));
|
|
Dispose(PString(FPathList.Items[AIndex]));
|
|
Dispose(PFileInfo(FFileInfoList.Items[AIndex]));
|
|
|
|
FFileList.Delete(AIndex);
|
|
FPathList.Delete(AIndex);
|
|
FFileInfoList.Delete(AIndex);
|
|
end;
|
|
|
|
procedure TZlibFilesList.Clear;
|
|
begin
|
|
While Count > 0 do
|
|
Delete(Count-1);
|
|
end;
|
|
|
|
function TZlibFilesList.Count: Integer;
|
|
begin
|
|
Result := FFileList.Count;
|
|
end;
|
|
|
|
end.
|
|
|
|
|