diff --git a/components/zlibar/docs/makedocs.sh b/components/zlibar/docs/makedocs.sh new file mode 100644 index 000000000..5147cd3b5 --- /dev/null +++ b/components/zlibar/docs/makedocs.sh @@ -0,0 +1,23 @@ +#!/bin/sh +# change these as needed +BASE_XCT_DIR=/home/andrew/programming/help/ + +RTL_XCT=$BASE_XCT_DIR"rtl.xct" +FCL_XCT=$BASE_XCT_DIR"fcl.xct" + +CSS=/home/andrew/programming/lazarus-svn/docs/html/fpdoc.css +TITLE="ZLib Archive Component" + +fpdoc --package=zlibar \ +--format=chm \ +--descr=zlibar.xml \ +--hide-protected \ +--output=zlibar.chm \ +--input=../zlibar.pas \ +--auto-toc \ +--auto-index \ +--make-searchable \ +--import=$RTL_XCT,ms-its:rtl.chm::/ \ +--import=$FCL_XCT,ms-its:fcl.chm::/ \ +--css-file=$CSS \ +--chm-title="$TITLE" diff --git a/components/zlibar/docs/zlibar.chm b/components/zlibar/docs/zlibar.chm new file mode 100644 index 000000000..a0fba50b4 Binary files /dev/null and b/components/zlibar/docs/zlibar.chm differ diff --git a/components/zlibar/docs/zlibar.xml b/components/zlibar/docs/zlibar.xml new file mode 100755 index 000000000..8c36e6224 --- /dev/null +++ b/components/zlibar/docs/zlibar.xml @@ -0,0 +1,725 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + Used internally + This holds temporarily the compressed size if a stream and it's MD5 checksum. + + + + The compressed size of a stream + + + + The TMD5Digest of the original uncompressed stream. + + + + Used to store the list of files to be compressed + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + Add a File to be compressed + Should be a fully qualified filename. Stored in the archive as just the filename without paths. To set a releative path for the file use AddPath. + + + + + + + + The index of the filename in the list + + + + Fully qualified FileName to be added + + + + Adds a FileName and a relative path + + + + + + + Index of added file name in the list + + + + Fully qualified filename to be compressed + + + + Relative path to be decompressed to + + + + Used to insert a file to be compressed into the list at a specific index + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + Deletes the filename at index from the list + + + + Index of the filename to be removed + + + + Removes all files from the list of files to be compressed + + + + Number of files in the list to be compressed + Zero based so to do a loop using Count you must do Count-1 + + + + The number of files in the list + + + + Used to retrieve the fully qualified filename that is to be compressed + + + + Index of the filename you wish to retrieve the FileName from. + + + + Used to retrieve the releative path the file should be extracted to + + + + Index of the filename you wish to retrieve the relative path from. + + + + Used internally to obtain the compressed size of the file + Only usefull after the file has been compressed + + + + + + + Index of the filename you wish to retrieve the TFileInfo from. + + + + The information at the beggining of a TZlibArchive + Contains vital information about the archive. + +Major Minor and Micro hold the version of the archive. + + + + The file identifier + The first four bytes of the file. Z A R #0. Used to verify the type of file. + + + + + + + + + + + + + + + + + + + + + + Length of the table of contents. + Used internally to be able to determine the lenght of the TOC + + + + Checksum of the uncompressed TOC + The table of contents is stored compressed in the archive. This is used to ensure that the TOC is intact. + + + + + + + + + + The structure of a table of contents entry + Used to manage various information about the size and position of a file in the TZlibArchive + + + + The file name only + This contains no path information. + + + + The desired relative path for the file to be extracted to. + + + + The position of the compressed stream in the TZLibArchive stream. + + + + The size of a compressed file + + + + The checksum used to verify the file is the same as the original + + + + Callback used to follow the progress of overall and current progress + Used to provide feedback to the user of the progress of compression. + + + + TZlibWriteArchive Object + + + + Index of the current file that is being compressed. + + + + + + + Total size of the InStream to be compressed + + + + Amount of the InStream that has been compressed. + + + + Callback for progress during decompression + + + + TZlibReadArchive object + + + + Total size of the InStream + + + + Current position of the InStream + + + + Error Callback + Used to catch error before an exception is raised. + + + + TZlibReadArchive or TZlibWriteArchive object + + + + Error code that has occured + Set to 0 to avoid an exception + + + + Description of the error. + + + + Object used to create ZibArchive files. + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + Creates an instance of the TZlibWriteArchive object + + + + + + + + + + + Compresses and write all the files in the list to OutStream + The Stream is written to starting from the beginning. The Previos contents of the stream are lost. + + + + True if successful False otherwise + + + + Callback used to intercept errors before an exception is raised + + + + Callback used to imform the user of the compression progress + + + + + + + Stream the compressed archive it written to + If this is not assigned a TMemoryStream is automatically created and assigned to OutStream. + + + + List of files to be compressed + + + + + + + Object to read and extract files made with TZLibWriteArchive + A TZlibReadArchive object is not capable of writing or changing an archive. You must use a TZLibWriteArchive object to do that. + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + Creates a TZlibReadArchive object and opens an archive from a TStream + + + + Creates an instance of the object + + + + Stream that you wish to be opened + + + + + + + + + + + Extract the file at Index to a user provided stream + + + + Index of the file to be extracted + + + + User provided stream for the compressed file to be decompressed into + + + + Retrieves the header of the file + + + + Contains information about the file in the archive + + + + + + + Index of the file you want information about + + + + Number of files in the archive + + + + Callback to intercept errors before they trigger an Exception + + + + + + + Callback used to monitor the progress of a file as it is being extracted + + + + + + + TStream that is currently loaded + Set to nil to close the file + + + + + + + + + + + + + + + + + + + + + + + + + + + + Error Code + The table of contents has been corrupted. A MD5 checksum is made before the TOC is compressed. If the checksum of the extracted TOC does not match this error occurs. + + + + Error Code + The file you are trying to open does not have the correct header, or is not a recognized file format. + + + + Error Code + The file you are trying to compress does not match the checksum of the original file before it was compressed. + + + + + + + + + + Compresses InStream into OutStream + Generic independant function to compress InStream into OutStream. + + + + + + + The size of the compressed stream in bytes + + + + The TStream that you wish to be compressed + InStream is read from the begining of InStream. + + + + The compressed stream + OutStream is written to from the current position of OutStream.Position. + + + + Decompresses InStream to OutStream + Decompresses InStream to OutStream. + + + + The Size of OutStream in bytes + + + + The Stream that you wish to compress + InStream is read from position 0 to the end. + + + + The stream that the decompressed data will be written into + OutStream is written to at the current position it happens to be in the stream. + + + + Creates a TMD5Digest from a TMemoryStream + Use this to create a TMD5Digest from a Stream. This is used to ensure that a file matches in every way by comparing it to a previous TMD5Digest. + + + + Returns a TMd5Digest + + + + The stream you wish to be scanned + + + + + diff --git a/components/zlibar/zlibar.pas b/components/zlibar/zlibar.pas new file mode 100755 index 000000000..55ecab830 --- /dev/null +++ b/components/zlibar/zlibar.pas @@ -0,0 +1,843 @@ +{ 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. + + diff --git a/components/zlibar/zlibar_package.lpk b/components/zlibar/zlibar_package.lpk new file mode 100755 index 000000000..64ff5bace --- /dev/null +++ b/components/zlibar/zlibar_package.lpk @@ -0,0 +1,43 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/components/zlibar/zlibar_package.pas b/components/zlibar/zlibar_package.pas new file mode 100755 index 000000000..ac09b61d8 --- /dev/null +++ b/components/zlibar/zlibar_package.pas @@ -0,0 +1,14 @@ +{ This file was automatically created by Lazarus. Do not edit! +This source is only used to compile and install the package. + } + +unit zlibar_package; + +interface + +uses + zlibar; + +implementation + +end.