From 9391c0740fcf4ee3b71a854844692a6e74a3ec59 Mon Sep 17 00:00:00 2001 From: bergmann Date: Sun, 8 Jan 2017 11:00:32 +0100 Subject: [PATCH] * created package --- .gitignore | 4 + KAZip/KAZip.pas | 3343 ++++++++++++++++++++++++++++++++++++++++++++ KAZip/dzlib.pas | 461 ++++++ bitSpaceVFS.lpk | 64 + bitSpaceVFS.pas | 22 + uvfsTarArchive.pas | 6 +- uvfsUtils.pas | 10 +- 7 files changed, 3902 insertions(+), 8 deletions(-) create mode 100644 .gitignore create mode 100644 KAZip/KAZip.pas create mode 100644 KAZip/dzlib.pas create mode 100644 bitSpaceVFS.lpk create mode 100644 bitSpaceVFS.pas diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..6beb8aa --- /dev/null +++ b/.gitignore @@ -0,0 +1,4 @@ +lib/ +*.exe +*.log +*.dbg \ No newline at end of file diff --git a/KAZip/KAZip.pas b/KAZip/KAZip.pas new file mode 100644 index 0000000..21d3b84 --- /dev/null +++ b/KAZip/KAZip.pas @@ -0,0 +1,3343 @@ +{ +KAZip (C) Kiril Antonov, http://kadao.dir.bg/ +Slightly modified. +} + +{$WARNINGS OFF} +{$HINTS OFF} +{$NOTES OFF} + +unit KAZip; +interface +{$IFDEF FPC} +{$mode delphi} +{$ENDIF} +{.$DEFINE USE_BZIP2} +{$DEFINE USE_BUFFERED_IO} +uses + Windows, + SysUtils, + Classes, + Masks, + TypInfo, + {$IFDEF USE_BZIP2} + BZip2, + {$ENDIF} + ZLib + {$IFDEF FPC}, + dzlib + {$ENDIF} + {$IFDEF USE_BUFFERED_IO}, + uutlStreamHelper + {$ENDIF}; + +type + TKAZipEntries = class; + TKAZip = class; + TBytes = Array of Byte; + TZipSaveMethod = (FastSave, RebuildAll); + TZipCompressionType = (ctNormal, ctMaximum, ctFast, ctSuperFast, ctNone, ctUnknown); + TZipCompressionMethod = (cmStored, cmShrunk, cmReduced1, cmReduced2, cmReduced3, cmReduced4, cmImploded, cmTokenizingReserved, cmDeflated, cmDeflated64, cmDCLImploding, cmPKWAREReserved); + TOverwriteAction = (oaSkip,oaSkipAll,oaOverwrite,oaOverwriteAll); + + TOnDecompressFile=Procedure(Sender:TObject; Current, Total : Integer) of Object; + TOnCompressFile=Procedure(Sender:TObject; Current, Total : Integer) of Object; + TOnZipOpen=Procedure(Sender:TObject; Current, Total : Integer) of Object; + TOnZipChange=Procedure(Sender:TObject; ChangeType : Integer) of Object; + TOnAddItem=Procedure(Sender:TObject; ItemName : String) of Object; + TOnRebuildZip=Procedure(Sender:TObject; Current, Total : Integer) of Object; + TOnRemoveItems=Procedure(Sender:TObject; Current, Total : Integer) of Object; + TOnOverwriteFile=Procedure(Sender:TObject; Var FileName : String; Var Action : TOverwriteAction) of Object; + + { + 0 - The file is stored (no compression) + 1 - The file is Shrunk + 2 - The file is Reduced with compression factor 1 + 3 - The file is Reduced with compression factor 2 + 4 - The file is Reduced with compression factor 3 + 5 - The file is Reduced with compression factor 4 + 6 - The file is Imploded + 7 - Reserved for Tokenizing compression algorithm + 8 - The file is Deflated + 9 - Enhanced Deflating using Deflate64(tm) + 10 - PKWARE Data Compression Library Imploding + 11 - Reserved by PKWARE + 12 - File is compressed using BZIP2 algorithm + } + + {DoChange Events + 0 - Zip is Closed; + 1 - Zip is Opened; + 2 - Item is added to the zip + 3 - Item is removed from the Zip + 4 - Item comment changed + 5 - Item name changed + 6 - Item name changed + } + + TZLibStreamHeader = packed record + CMF : Byte; + FLG : Byte; + end; + + TLocalFile = packed record + LocalFileHeaderSignature : Cardinal; // 4 bytes (0x04034b50) + VersionNeededToExtract : WORD; // 2 bytes + GeneralPurposeBitFlag : WORD; // 2 bytes + CompressionMethod : WORD; // 2 bytes + LastModFileTimeDate : Cardinal; // 4 bytes + Crc32 : Cardinal; // 4 bytes + CompressedSize : Cardinal; // 4 bytes + UncompressedSize : Cardinal; // 4 bytes + FilenameLength : WORD; // 2 bytes + ExtraFieldLength : WORD; // 2 bytes + FileName : AnsiString; // variable size + ExtraField : AnsiString; // variable size + CompressedData : AnsiString; // variable size + end; + + TDataDescriptor = packed record + DescriptorSignature : Cardinal; // 4 bytes UNDOCUMENTED 0x08074B50 + Crc32 : Cardinal; // 4 bytes + CompressedSize : Cardinal; // 4 bytes + UncompressedSize : Cardinal; // 4 bytes + End; + + TCentralDirectoryFile = packed record + CentralFileHeaderSignature : Cardinal; // 4 bytes (0x02014b50) + VersionMadeBy : WORD; // 2 bytes + VersionNeededToExtract : WORD; // 2 bytes + GeneralPurposeBitFlag : WORD; // 2 bytes + CompressionMethod : WORD; // 2 bytes + LastModFileTimeDate : Cardinal; // 4 bytes + Crc32 : Cardinal; // 4 bytes + CompressedSize : Cardinal; // 4 bytes + UncompressedSize : Cardinal; // 4 bytes + FilenameLength : WORD; // 2 bytes + ExtraFieldLength : WORD; // 2 bytes + FileCommentLength : WORD; // 2 bytes + DiskNumberStart : WORD; // 2 bytes + InternalFileAttributes : WORD; // 2 bytes + ExternalFileAttributes : Cardinal; // 4 bytes + RelativeOffsetOfLocalHeader : Cardinal; // 4 bytes + FileName : AnsiString; // variable size + ExtraField : AnsiString; // variable size + FileComment : AnsiString; // variable size + end; + + TEndOfCentralDir = packed record + EndOfCentralDirSignature : Cardinal; // 4 bytes (0x06054b50) + NumberOfThisDisk : WORD; // 2 bytes + NumberOfTheDiskWithTheStart : WORD; // 2 bytes + TotalNumberOfEntriesOnThisDisk : WORD; // 2 bytes + TotalNumberOfEntries : WORD; // 2 bytes + SizeOfTheCentralDirectory : Cardinal; // 4 bytes + OffsetOfStartOfCentralDirectory : Cardinal; // 4 bytes + ZipfileCommentLength : WORD; // 2 bytes + end; + + + + TKAZipEntriesEntry = Class(TCollectionItem) + private + { Private declarations } + FParent : TKAZipEntries; + FCentralDirectoryFile : TCentralDirectoryFile; + FLocalFile : TLocalFile; + FIsEncrypted : Boolean; + FIsFolder : Boolean; + FDate : TDateTime; + FCompressionType : TZipCompressionType; + FSelected : Boolean; + + procedure SetSelected(const Value: Boolean); + function GetLocalEntrySize: Cardinal; + function GetCentralEntrySize: Cardinal; + procedure SetComment(const Value: String); + procedure SetFileName(const Value: String); + protected + { Protected declarations } + public + { Public declarations } + constructor Create(aCollection: TCollection); override; + destructor Destroy; override; + Function GetCompressedData : String;Overload; + Function GetCompressedData(Stream : TStream) : Integer;Overload; + procedure ExtractToFile(FileName: String); + procedure ExtractToStream(Stream: TStream); + procedure SaveToFile(FileName: String); + procedure SaveToStream(Stream: TStream); + Function Test:Boolean; + + Property FileName : String Read FCentralDirectoryFile.FileName Write SetFileName; + Property Comment : String Read FCentralDirectoryFile.FileComment Write SetComment; + Property SizeUncompressed : Cardinal Read FCentralDirectoryFile.UncompressedSize; + Property SizeCompressed : Cardinal Read FCentralDirectoryFile.CompressedSize; + Property Date : TDateTime Read FDate; + Property CRC32 : Cardinal Read FCentralDirectoryFile.CRC32; + Property Attributes : Cardinal Read FCentralDirectoryFile.ExternalFileAttributes; + Property LocalOffset : Cardinal Read FCentralDirectoryFile.RelativeOffsetOfLocalHeader; + Property IsEncrypted : Boolean Read FIsEncrypted; + Property IsFolder : Boolean Read FIsFolder; + Property BitFlag : Word Read FCentralDirectoryFile.GeneralPurposeBitFlag; + Property CompressionMethod : Word Read FCentralDirectoryFile.CompressionMethod; + Property CompressionType : TZipCompressionType Read FCompressionType; + Property LocalEntrySize : Cardinal Read GetLocalEntrySize; + Property CentralEntrySize : Cardinal Read GetCentralEntrySize; + Property Selected : Boolean Read FSelected Write SetSelected; + End; + + TKAZipEntries = class(TCollection) + private + { Private declarations } + FParent : TKAZip; + FIsZipFile : Boolean; + FLocalHeaderNumFiles : Integer; + + function GetHeaderEntry(Index: Integer): TKAZipEntriesEntry; + procedure SetHeaderEntry(Index: Integer; const Value: TKAZipEntriesEntry); + protected + { Protected declarations } + Function ReadBA(MS: TStream;Sz,Poz:Integer): TBytes; + function Adler32(adler : uLong; buf : pByte; len : uInt) : uLong; + function CalcCRC32(const UncompressedData : string): Cardinal; + function CalculateCRCFromStream(Stream: TStream): Cardinal; + Function RemoveRootName(Const FileName, RootName : String):String; + Procedure SortList(List : TList); + function FileTime2DateTime(FileTime: TFileTime): TDateTime; + //************************************************************************** + Function FindCentralDirectory(MS:TStream):Boolean; + function ParseCentralHeaders(MS: TStream): Boolean; + function GetLocalEntry(MS: TStream; Offset : Integer; HeaderOnly : Boolean): TLocalFile; + Procedure LoadLocalHeaders(MS: TStream); + Function ParseLocalHeaders(MS:TStream):Boolean; + + //************************************************************************** + procedure Remove(ItemIndex: Integer; Flush : Boolean);Overload; + procedure RemoveBatch(Files : TList); + procedure InternalExtractToFile(Item: TKAZipEntriesEntry; FileName: String); + //************************************************************************** + Function AddStreamFast(ItemName:String; FileAttr : Word; FileDate : TDateTime; Stream:TStream):TKAZipEntriesEntry;Overload; + Function AddStreamRebuild(ItemName:String; FileAttr : Word; FileDate : TDateTime; Stream:TStream):TKAZipEntriesEntry; + Function AddFolderChain(ItemName:String):Boolean;Overload; + Function AddFolderChain(ItemName:String; FileAttr : Word; FileDate : TDateTime):Boolean;Overload; + Function AddFolderEx(FolderName:String; RootFolder:String; WildCard:String; WithSubFolders : Boolean):Boolean; + //************************************************************************** + public + { Public declarations } + Procedure ParseZip(MS:TStream); + Constructor Create(AOwner : TKAZip; MS : TStream);Overload; + Constructor Create(AOwner : TKAZip);Overload; + Destructor Destroy; Override; + //************************************************************************** + Function IndexOf(Const FileName:String):Integer; + //************************************************************************** + Function AddFile(FileName, NewFileName: String):TKAZipEntriesEntry;Overload; + Function AddFile(FileName:String):TKAZipEntriesEntry;Overload; + Function AddFiles(FileNames:TStrings):Boolean; + Function AddFolder(FolderName:String; RootFolder:String; WildCard:String; WithSubFolders : Boolean):Boolean; + Function AddFilesAndFolders(FileNames:TStrings; RootFolder:String; WithSubFolders : Boolean):Boolean; + Function AddStream(FileName:String; FileAttr : Word; FileDate : TDateTime; Stream:TStream):TKAZipEntriesEntry;Overload; + Function AddStream(FileName: String; Stream : TStream):TKAZipEntriesEntry;Overload; + //************************************************************************** + Procedure Remove(ItemIndex:Integer);Overload; + Procedure Remove(Item:TKAZipEntriesEntry);Overload; + Procedure Remove(FileName:String);Overload; + Procedure RemoveFiles(List : TList); + Procedure RemoveSelected; + Procedure Rebuild; + //************************************************************************** + Procedure Select(WildCard : String); + Procedure SelectAll; + Procedure DeSelectAll; + Procedure InvertSelection; + //************************************************************************** + Procedure Rename(Item : TKAZipEntriesEntry; NewFileName: String);Overload; + Procedure Rename(ItemIndex : Integer; NewFileName: String);Overload; + Procedure Rename(FileName: String; NewFileName: String);Overload; + procedure CreateFolder(FolderName: String; FolderDate: TDateTime); + procedure RenameFolder(FolderName : String; NewFolderName : String); + procedure RenameMultiple(Names : TStringList; NewNames : TStringList); + + //************************************************************************** + procedure ExtractToFile (Item : TKAZipEntriesEntry; FileName: String);Overload; + procedure ExtractToFile (ItemIndex : Integer; FileName: String);Overload; + procedure ExtractToFile (FileName, DestinationFileName:String);Overload; + procedure ExtractToStream(Item : TKAZipEntriesEntry; Stream: TStream); + procedure ExtractAll(TargetDirectory:String); + procedure ExtractSelected(TargetDirectory:String); + //************************************************************************** + Property Items[Index : Integer] : TKAZipEntriesEntry read GetHeaderEntry write SetHeaderEntry; + end; + + TKAZip = class(TComponent) + private + { Private declarations } + FZipHeader : TKAZipEntries; + FIsDirty : Boolean; + FEndOfCentralDirPos : Cardinal; + FEndOfCentralDir : TEndOfCentralDir; + + FZipCommentPos : Cardinal; + FZipComment : TStringList; + + FRebuildECDP : Cardinal; + FRebuildCP : Cardinal; + + FIsZipFile : Boolean; + FHasBadEntries : Boolean; + FFileName : String; + FFileNames : TStringList; + FZipSaveMethod : TZipSaveMethod; + + FExternalStream : Boolean; + FStoreRelativePath : Boolean; + FZipCompressionType : TZipCompressionType; + + FCurrentDFS : Cardinal; + FOnDecompressFile : TOnDecompressFile; + FOnCompressFile : TOnCompressFile; + FOnZipChange : TOnZipChange; + FBatchMode : Boolean; + + NewLHOffsets : Array of Cardinal; + NewEndOfCentralDir : TEndOfCentralDir; + FOnZipOpen : TOnZipOpen; + FUseTempFiles : Boolean; + FStoreFolders : Boolean; + FOnAddItem : TOnAddItem; + FComponentVersion : String; + FOnRebuildZip : TOnRebuildZip; + FOnRemoveItems : TOnRemoveItems; + FOverwriteAction : TOverwriteAction; + FOnOverwriteFile : TOnOverwriteFile; + FReadOnly : Boolean; + FApplyAttributes : Boolean; + + procedure SetFileName(const Value: String); + procedure SetIsZipFile(const Value: Boolean); + function GetComment: TStrings; + procedure SetComment(const Value: TStrings); + procedure SetZipSaveMethod(const Value: TZipSaveMethod); + procedure SetActive(const Value: Boolean); + procedure SetZipCompressionType(const Value: TZipCompressionType); + function GetFileNames: TStrings; + procedure SetFileNames(const Value: TStrings); + procedure SetUseTempFiles(const Value: Boolean); + procedure SetStoreFolders(const Value: Boolean); + procedure SetOnAddItem(const Value: TOnAddItem); + procedure SetComponentVersion(const Value: String); + procedure SetOnRebuildZip(const Value: TOnRebuildZip); + procedure SetOnRemoveItems(const Value: TOnRemoveItems); + procedure SetOverwriteAction(const Value: TOverwriteAction); + procedure SetOnOverwriteFile(const Value: TOnOverwriteFile); + procedure SetReadOnly(const Value: Boolean); + procedure SetApplyAtributes(const Value: Boolean); + protected + { Protected declarations } + FZipStream : TStream; + //************************************************************************** + Procedure LoadFromFile(FileName:String); + Procedure LoadFromStream(MS : TStream); + //************************************************************************** + Procedure RebuildLocalFiles(MS : TStream); + Procedure RebuildCentralDirectory(MS : TStream); + Procedure RebuildEndOfCentralDirectory(MS : TStream); + //************************************************************************** + procedure OnDecompress(Sender:TObject); + procedure OnCompress(Sender:TObject); + Procedure DoChange(Sender:TObject; Const ChangeType : Integer);Virtual; + //************************************************************************** + public + { Public declarations } + Constructor Create(AOwner:TComponent);Override; + Destructor Destroy; Override; + //************************************************************************** + function GetDelphiTempFileName: String; + function GetFileName(S: String): String; + function GetFilePath(S: String): String; + //************************************************************************** + Procedure CreateZip(Stream:TStream);Overload; + Procedure CreateZip(FileName:String);Overload; + Procedure Open(FileName:String);Overload; + Procedure Open(MS : TStream);Overload; + Procedure SaveToStream(Stream:TStream); + Procedure Rebuild; + Procedure FixZip(MS : TStream); + Procedure Close; + //************************************************************************** + Function AddFile(FileName, NewFileName: String):TKAZipEntriesEntry;Overload; + Function AddFile(FileName:String):TKAZipEntriesEntry;Overload; + Function AddFiles(FileNames:TStrings):Boolean; + Function AddFolder(FolderName:String; RootFolder:String; WildCard:String; WithSubFolders : Boolean):Boolean; + Function AddFilesAndFolders(FileNames:TStrings; RootFolder:String; WithSubFolders : Boolean):Boolean; + Function AddStream(FileName:String; FileAttr : Word; FileDate : TDateTime; Stream:TStream):TKAZipEntriesEntry;Overload; + Function AddStream(FileName: String; Stream : TStream):TKAZipEntriesEntry;Overload; + //************************************************************************** + Procedure Remove(ItemIndex:Integer);Overload; + Procedure Remove(Item:TKAZipEntriesEntry);Overload; + Procedure Remove(FileName:String);Overload; + Procedure RemoveFiles(List : TList); + Procedure RemoveSelected; + //************************************************************************** + Procedure Select(WildCard : String); + Procedure SelectAll; + Procedure DeSelectAll; + Procedure InvertSelection; + //************************************************************************** + Procedure Rename(Item : TKAZipEntriesEntry; NewFileName: String);Overload; + Procedure Rename(ItemIndex : Integer; NewFileName: String);Overload; + Procedure Rename(FileName : String; NewFileName: String);Overload; + Procedure CreateFolder(FolderName : String; FolderDate : TDateTime); + Procedure RenameFolder(FolderName : String; NewFolderName : String); + procedure RenameMultiple(Names : TStringList; NewNames : TStringList); + //************************************************************************** + procedure ExtractToFile (Item : TKAZipEntriesEntry; FileName: String);Overload; + procedure ExtractToFile (ItemIndex : Integer; FileName: String);Overload; + procedure ExtractToFile (FileName, DestinationFileName:String);Overload; + procedure ExtractToStream(Item : TKAZipEntriesEntry; Stream: TStream); + procedure ExtractAll(TargetDirectory: String); + procedure ExtractSelected(TargetDirectory: String); + //************************************************************************** + Property Entries : TKAZipEntries Read FZipHeader; + Property HasBadEntries : Boolean Read FHasBadEntries; + published + { Published declarations } + Property FileName : String Read FFileName Write SetFileName; + Property IsZipFile : Boolean Read FIsZipFile Write SetIsZipFile; + Property SaveMethod : TZipSaveMethod Read FZipSaveMethod Write SetZipSaveMethod; + Property StoreRelativePath : Boolean Read FStoreRelativePath Write FStoreRelativePath; + Property StoreFolders : Boolean read FStoreFolders write SetStoreFolders; + Property CompressionType : TZipCompressionType Read FZipCompressionType Write SetZipCompressionType; + Property Comment : TStrings Read GetComment Write SetComment; + Property FileNames : TStrings Read GetFileNames Write SetFileNames; + Property UseTempFiles : Boolean read FUseTempFiles write SetUseTempFiles; + Property OverwriteAction : TOverwriteAction read FOverwriteAction write SetOverwriteAction; + Property ComponentVersion : String read FComponentVersion write SetComponentVersion; + Property ReadOnly : Boolean read FReadOnly write SetReadOnly; + Property ApplyAtributes : Boolean read FApplyAttributes write SetApplyAtributes; + Property OnDecompressFile : TOnDecompressFile Read FOnDecompressFile Write FOnDecompressFile; + Property OnCompressFile : TOnCompressFile Read FOnCompressFile Write FOnCompressFile; + Property OnZipChange : TOnZipChange Read FOnZipChange Write FOnZipChange; + Property OnZipOpen : TOnZipOpen Read FOnZipOpen Write FOnZipOpen; + Property OnAddItem : TOnAddItem read FOnAddItem write SetOnAddItem; + Property OnRebuildZip : TOnRebuildZip read FOnRebuildZip write SetOnRebuildZip; + Property OnRemoveItems : TOnRemoveItems read FOnRemoveItems write SetOnRemoveItems; + Property OnOverwriteFile : TOnOverwriteFile read FOnOverwriteFile write SetOnOverwriteFile; + Property Active : Boolean Read FIsZipFile Write SetActive; + end; + +procedure Register; +Function ToZipName(FileName:String):String; +Function ToDosName(FileName:String):String; + +implementation + +Const + ZL_DEF_COMPRESSIONMETHOD = $8; { Deflate } + ZL_ENCH_COMPRESSIONMETHOD = $9; { Enchanced Deflate } + ZL_DEF_COMPRESSIONINFO = $7; { 32k window for Deflate } + ZL_PRESET_DICT = $20; + + ZL_FASTEST_COMPRESSION = $0; + ZL_FAST_COMPRESSION = $1; + ZL_DEFAULT_COMPRESSION = $2; + ZL_MAXIMUM_COMPRESSION = $3; + + ZL_FCHECK_MASK = $1F; + ZL_CINFO_MASK = $F0; { mask out leftmost 4 bits } + ZL_FLEVEL_MASK = $C0; { mask out leftmost 2 bits } + ZL_CM_MASK = $0F; { mask out rightmost 4 bits } + + + ZL_MULTIPLE_DISK_SIG = $08074b50; // 'PK'#7#8 + ZL_DATA_DESCRIPT_SIG = $08074b50; // 'PK'#7#8 + ZL_LOCAL_HEADERSIG = $04034b50; // 'PK'#3#4 + ZL_CENTRAL_HEADERSIG = $02014b50; // 'PK'#1#2 + ZL_EOC_HEADERSIG = $06054b50; // 'PK'#5#6 + + const + CRCTable: array[0..255] of Cardinal = ( + $00000000, $77073096, $EE0E612C, $990951BA, $076DC419, $706AF48F, $E963A535, + $9E6495A3, $0EDB8832, $79DCB8A4, $E0D5E91E, $97D2D988, $09B64C2B, $7EB17CBD, + $E7B82D07, $90BF1D91, $1DB71064, $6AB020F2, $F3B97148, $84BE41DE, $1ADAD47D, + $6DDDE4EB, $F4D4B551, $83D385C7, $136C9856, $646BA8C0, $FD62F97A, $8A65C9EC, + $14015C4F, $63066CD9, $FA0F3D63, $8D080DF5, $3B6E20C8, $4C69105E, $D56041E4, + $A2677172, $3C03E4D1, $4B04D447, $D20D85FD, $A50AB56B, $35B5A8FA, $42B2986C, + $DBBBC9D6, $ACBCF940, $32D86CE3, $45DF5C75, $DCD60DCF, $ABD13D59, $26D930AC, + $51DE003A, $C8D75180, $BFD06116, $21B4F4B5, $56B3C423, $CFBA9599, $B8BDA50F, + $2802B89E, $5F058808, $C60CD9B2, $B10BE924, $2F6F7C87, $58684C11, $C1611DAB, + $B6662D3D, $76DC4190, $01DB7106, $98D220BC, $EFD5102A, $71B18589, $06B6B51F, + $9FBFE4A5, $E8B8D433, $7807C9A2, $0F00F934, $9609A88E, $E10E9818, $7F6A0DBB, + $086D3D2D, $91646C97, $E6635C01, $6B6B51F4, $1C6C6162, $856530D8, $F262004E, + $6C0695ED, $1B01A57B, $8208F4C1, $F50FC457, $65B0D9C6, $12B7E950, $8BBEB8EA, + $FCB9887C, $62DD1DDF, $15DA2D49, $8CD37CF3, $FBD44C65, $4DB26158, $3AB551CE, + $A3BC0074, $D4BB30E2, $4ADFA541, $3DD895D7, $A4D1C46D, $D3D6F4FB, $4369E96A, + $346ED9FC, $AD678846, $DA60B8D0, $44042D73, $33031DE5, $AA0A4C5F, $DD0D7CC9, + $5005713C, $270241AA, $BE0B1010, $C90C2086, $5768B525, $206F85B3, $B966D409, + $CE61E49F, $5EDEF90E, $29D9C998, $B0D09822, $C7D7A8B4, $59B33D17, $2EB40D81, + $B7BD5C3B, $C0BA6CAD, $EDB88320, $9ABFB3B6, $03B6E20C, $74B1D29A, $EAD54739, + $9DD277AF, $04DB2615, $73DC1683, $E3630B12, $94643B84, $0D6D6A3E, $7A6A5AA8, + $E40ECF0B, $9309FF9D, $0A00AE27, $7D079EB1, $F00F9344, $8708A3D2, $1E01F268, + $6906C2FE, $F762575D, $806567CB, $196C3671, $6E6B06E7, $FED41B76, $89D32BE0, + $10DA7A5A, $67DD4ACC, $F9B9DF6F, $8EBEEFF9, $17B7BE43, $60B08ED5, $D6D6A3E8, + $A1D1937E, $38D8C2C4, $4FDFF252, $D1BB67F1, $A6BC5767, $3FB506DD, $48B2364B, + $D80D2BDA, $AF0A1B4C, $36034AF6, $41047A60, $DF60EFC3, $A867DF55, $316E8EEF, + $4669BE79, $CB61B38C, $BC66831A, $256FD2A0, $5268E236, $CC0C7795, $BB0B4703, + $220216B9, $5505262F, $C5BA3BBE, $B2BD0B28, $2BB45A92, $5CB36A04, $C2D7FFA7, + $B5D0CF31, $2CD99E8B, $5BDEAE1D, $9B64C2B0, $EC63F226, $756AA39C, $026D930A, + $9C0906A9, $EB0E363F, $72076785, $05005713, $95BF4A82, $E2B87A14, $7BB12BAE, + $0CB61B38, $92D28E9B, $E5D5BE0D, $7CDCEFB7, $0BDBDF21, $86D3D2D4, $F1D4E242, + $68DDB3F8, $1FDA836E, $81BE16CD, $F6B9265B, $6FB077E1, $18B74777, $88085AE6, + $FF0F6A70, $66063BCA, $11010B5C, $8F659EFF, $F862AE69, $616BFFD3, $166CCF45, + $A00AE278, $D70DD2EE, $4E048354, $3903B3C2, $A7672661, $D06016F7, $4969474D, + $3E6E77DB, $AED16A4A, $D9D65ADC, $40DF0B66, $37D83BF0, $A9BCAE53, $DEBB9EC5, + $47B2CF7F, $30B5FFE9, $BDBDF21C, $CABAC28A, $53B39330, $24B4A3A6, $BAD03605, + $CDD70693, $54DE5729, $23D967BF, $B3667A2E, $C4614AB8, $5D681B02, $2A6F2B94, + $B40BBE37, $C30C8EA1, $5A05DF1B, $2D02EF8D); + + + +procedure Register; +begin + RegisterComponents('KA', [TKAZip]); +end; + +Function ToZipName(FileName:String):String; +Var + P : Integer; +Begin + Result := FileName; + Result := StringReplace(Result,'\','/',[rfReplaceAll]); + P := Pos(':/',Result); + if P > 0 Then + Begin + System.Delete(Result,1,P+1); + End; + P := Pos('//',Result); + if P > 0 Then + Begin + System.Delete(Result,1,P+1); + P := Pos('/',Result); + if P > 0 Then + Begin + System.Delete(Result,1,P); + P := Pos('/',Result); + if P > 0 Then System.Delete(Result,1,P); + End; + End; +End; + + +Function ToDosName(FileName:String):String; +Var + P : Integer; +Begin + Result := FileName; + Result := StringReplace(Result,'\','/',[rfReplaceAll]); + P := Pos(':/',Result); + if P > 0 Then + Begin + System.Delete(Result,1,P+1); + End; + P := Pos('//',Result); + if P > 0 Then + Begin + System.Delete(Result,1,P+1); + P := Pos('/',Result); + if P > 0 Then + Begin + System.Delete(Result,1,P); + P := Pos('/',Result); + if P > 0 Then System.Delete(Result,1,P); + End; + End; + Result := StringReplace(Result,'/','\',[rfReplaceAll]); +End; + +{ TKAZipEntriesEntry } + +constructor TKAZipEntriesEntry.Create(aCollection: TCollection); +begin + inherited Create(aCollection); + FParent := TKAZipEntries(aCollection); + FSelected := False; +end; + +destructor TKAZipEntriesEntry.Destroy; +begin + + inherited Destroy; +end; + +procedure TKAZipEntriesEntry.ExtractToFile(FileName: String); +begin + FParent.ExtractToFile(Self,FileName); +end; + +procedure TKAZipEntriesEntry.ExtractToStream(Stream: TStream); +begin + FParent.ExtractToStream(Self,Stream); +end; + +procedure TKAZipEntriesEntry.SaveToFile(FileName: String); +begin + ExtractToFile(FileName); +end; + +procedure TKAZipEntriesEntry.SaveToStream(Stream: TStream); +begin + ExtractToStream(Stream); +end; + + +function TKAZipEntriesEntry.GetCompressedData(Stream: TStream): Integer; +Var + FZLHeader : TZLibStreamHeader; + BA : TLocalFile; + ZLH : Word; + Compress : Byte; +begin + Result := 0; + if (CompressionMethod=8) Then + Begin + FZLHeader.CMF := (ZL_DEF_COMPRESSIONINFO shl 4); { 32k Window size } + FZLHeader.CMF := FZLHeader.CMF or ZL_DEF_COMPRESSIONMETHOD; { Deflate } + Compress := ZL_DEFAULT_COMPRESSION; + Case BitFlag AND 6 of + 0 : Compress := ZL_DEFAULT_COMPRESSION; + 2 : Compress := ZL_MAXIMUM_COMPRESSION; + 4 : Compress := ZL_FAST_COMPRESSION; + 6 : Compress := ZL_FASTEST_COMPRESSION; + End; + FZLHeader.FLG := FZLHeader.FLG or (Compress shl 6); + FZLHeader.FLG := FZLHeader.FLG and not ZL_PRESET_DICT; { no preset dictionary} + FZLHeader.FLG := FZLHeader.FLG and not ZL_FCHECK_MASK; + ZLH := (FZLHeader.CMF * 256) + FZLHeader.FLG; + Inc(FZLHeader.FLG, 31 - (ZLH mod 31)); + Result := Result + Stream.Write(FZLHeader,SizeOf(FZLHeader)); + End; + BA := FParent.GetLocalEntry(FParent.FParent.FZipStream,LocalOffset,False); + if BA.LocalFileHeaderSignature<>$04034b50 Then + Begin + Result := 0; + Exit; + End; + if SizeCompressed > 0 Then + Result := Result + Stream.Write(BA.CompressedData[1],SizeCompressed); +end; + +function TKAZipEntriesEntry.GetCompressedData: String; +Var + BA : TLocalFile; + FZLHeader : TZLibStreamHeader; + ZLH : Word; + Compress : Byte; +begin + Result := ''; + if (CompressionMethod=0) or (CompressionMethod=8) Then + Begin + BA := FParent.GetLocalEntry(FParent.FParent.FZipStream,LocalOffset,False); + if BA.LocalFileHeaderSignature<>$04034b50 Then Exit; + if (CompressionMethod=8) Then + Begin + FZLHeader.CMF := (ZL_DEF_COMPRESSIONINFO shl 4); { 32k Window size } + FZLHeader.CMF := FZLHeader.CMF or ZL_DEF_COMPRESSIONMETHOD; { Deflate } + Compress := ZL_DEFAULT_COMPRESSION; + Case BitFlag AND 6 of + 0 : Compress := ZL_DEFAULT_COMPRESSION; + 2 : Compress := ZL_MAXIMUM_COMPRESSION; + 4 : Compress := ZL_FAST_COMPRESSION; + 6 : Compress := ZL_FASTEST_COMPRESSION; + End; + FZLHeader.FLG := FZLHeader.FLG or (Compress shl 6); + FZLHeader.FLG := FZLHeader.FLG and not ZL_PRESET_DICT; { no preset dictionary} + FZLHeader.FLG := FZLHeader.FLG and not ZL_FCHECK_MASK; + ZLH := (FZLHeader.CMF * 256) + FZLHeader.FLG; + Inc(FZLHeader.FLG, 31 - (ZLH mod 31)); + SetLength(Result,SizeOf(FZLHeader)); + SetString(Result,PChar(@FZLHeader),SizeOf(FZLHeader)); + End; + Result := Result + BA.CompressedData; + End + Else + Begin + SetLength(Result,0); + End; +End; + +procedure TKAZipEntriesEntry.SetSelected(const Value: Boolean); +begin + FSelected := Value; +end; + +function TKAZipEntriesEntry.GetLocalEntrySize: Cardinal; +begin + Result := SizeOf(TLocalFile) - 3*SizeOf(String)+ + FCentralDirectoryFile.CompressedSize+ + FCentralDirectoryFile.FilenameLength+ + FCentralDirectoryFile.ExtraFieldLength; + if (FCentralDirectoryFile.GeneralPurposeBitFlag And (1 SHL 3)) > 0 Then + Begin + Result := Result + SizeOf(TDataDescriptor); + End; +end; + +function TKAZipEntriesEntry.GetCentralEntrySize: Cardinal; +begin + Result := SizeOf(TCentralDirectoryFile) - 3*SizeOf(String)+ + FCentralDirectoryFile.FilenameLength+ + FCentralDirectoryFile.ExtraFieldLength+ + FCentralDirectoryFile.FileCommentLength; +end; + +function TKAZipEntriesEntry.Test: Boolean; +Var + FS : TFileStream; + MS : TMemoryStream; + FN : String; +begin + Result := True; + Try + if NOT FIsEncrypted Then + Begin + if FParent.FParent.FUseTempFiles Then + Begin + FN := FParent.FParent.GetDelphiTempFileName; + FS := TFileStream.Create(FN,fmOpenReadWrite or FmCreate); + Try + ExtractToStream(FS); + FS.Position := 0; + Result := FParent.CalculateCRCFromStream(FS) = CRC32; + Finally + FS.Free; + DeleteFile(FN); + End; + End + Else + Begin + MS := TMemoryStream.Create; + Try + ExtractToStream(MS); + MS.Position := 0; + Result := FParent.CalculateCRCFromStream(MS) = CRC32; + Finally + MS.Free; + End; + End; + End; + Except + Result := False; + End; +end; + +procedure TKAZipEntriesEntry.SetComment(const Value: String); +begin + FCentralDirectoryFile.FileComment := Value; + FCentralDirectoryFile.FileCommentLength := Length(FCentralDirectoryFile.FileComment); + FParent.Rebuild; + if NOT FParent.FParent.FBatchMode Then + Begin + FParent.FParent.DoChange(FParent,4); + End; +end; + +procedure TKAZipEntriesEntry.SetFileName(const Value: String); +Var + FN : String; +begin + FN := ToZipName(Value); + if FParent.IndexOf(FN) > -1 Then Raise Exception.Create('File with same name already exists in Archive!'); + FCentralDirectoryFile.FileName := ToZipName(Value); + FCentralDirectoryFile.FilenameLength := Length(FCentralDirectoryFile.FileName); + if NOT FParent.FParent.FBatchMode Then + Begin + FParent.Rebuild; + FParent.FParent.DoChange(FParent,5); + End; +end; + +{ TKAZipEntries } +constructor TKAZipEntries.Create(AOwner : TKAZip); +begin + Inherited Create(TKAZipEntriesEntry); + FParent := AOwner; + FIsZipFile := False; +end; + +constructor TKAZipEntries.Create(AOwner : TKAZip; MS : TStream); +begin + Inherited Create(TKAZipEntriesEntry); + FParent := AOwner; + FIsZipFile := False; + FLocalHeaderNumFiles := 0; + ParseZip(MS); +end; + +destructor TKAZipEntries.Destroy; +begin + + inherited Destroy; +end; + +function TKAZipEntries.Adler32(adler : uLong; buf : pByte; len : uInt) : uLong; +const + BASE = uLong(65521); + NMAX = 3854; +var + s1, s2 : uLong; + k : Integer; +begin + s1 := adler and $ffff; + s2 := (adler shr 16) and $ffff; + + if not Assigned(buf) then + begin + adler32 := uLong(1); + exit; + end; + + while (len > 0) do + begin + if len < NMAX then + k := len + else + k := NMAX; + Dec(len, k); + while (k > 0) do + begin + Inc(s1, buf^); + Inc(s2, s1); + Inc(buf); + Dec(k); + end; + s1 := s1 mod BASE; + s2 := s2 mod BASE; + end; + adler32 := (s2 shl 16) or s1; +end; + +function TKAZipEntries.CalcCRC32(const UncompressedData : string): Cardinal; +var + X : Integer; +begin + Result := $FFFFFFFF; + for X := 0 to Length(UncompressedData) - 1 do + Begin + Result := (Result SHR 8) XOR (CRCTable[Byte(Result) XOR Ord(UncompressedData[X+1])]); + End; + Result := Result XOR $FFFFFFFF; +end; + + +function TKAZipEntries.CalculateCRCFromStream(Stream: TStream): Cardinal; +var + Buffer: array[1..8192] of Byte; + I, ReadCount: Integer; + TempResult: Longword; +begin + TempResult := $FFFFFFFF; + while (Stream.Position <> Stream.Size) do begin + ReadCount := Stream.Read(Buffer, SizeOf(Buffer)); + for I := 1 to ReadCount do + TempResult := ((TempResult shr 8) and $FFFFFF) xor CRCTable[(TempResult xor Longword(Buffer[I])) and $FF]; + end; + Result := not TempResult; +end; + +Function TKAZipEntries.RemoveRootName(Const FileName, RootName : String):String; +Var + P : Integer; + S : String; +Begin + Result := FileName; + P := Pos(AnsiLowerCase(RootName),AnsiLowerCase(FileName)); + if P=1 Then + Begin + System.Delete(Result,1,Length(RootName)); + S := Result; + if (Length(S) > 0) AND (S[1]='\') Then + Begin + System.Delete(S,1,1); + Result := S; + End; + End; +End; + +Procedure TKAZipEntries.SortList(List : TList); +Var + X : Integer; + I1 : Cardinal; + I2 : Cardinal; + NoChange : Boolean; +Begin + if List.Count=1 Then Exit; + Repeat + NoChange := True; + For X := 0 To List.Count-2 Do + Begin + I1 := Integer(List.Items[X]); + I2 := Integer(List.Items[X+1]); + if I1 > I2 Then + Begin + List.Exchange(X,X+1); + NoChange := False; + End; + End; + Until NoChange; +End; + + + + +function TKAZipEntries.FileTime2DateTime(FileTime: TFileTime): TDateTime; +var + LocalFileTime: TFileTime; + SystemTime: TSystemTime; +begin + FileTimeToLocalFileTime(FileTime, LocalFileTime) ; + FileTimeToSystemTime(LocalFileTime, SystemTime) ; + Result := SystemTimeToDateTime(SystemTime) ; +end; + +function TKAZipEntries.GetHeaderEntry(Index: Integer): TKAZipEntriesEntry; +begin + Result := TKAZipEntriesEntry(Inherited Items[Index]); +end; + +procedure TKAZipEntries.SetHeaderEntry(Index: Integer; const Value: TKAZipEntriesEntry); +begin + Inherited Items[Index] := TCollectionItem(Value); +end; + +Function TKAZipEntries.ReadBA(MS: TStream; Sz, Poz:Integer): TBytes; +Begin + SetLength(Result,SZ); + MS.Position := Poz; + MS.Read(Result[0],SZ); +End; + +function TKAZipEntries.FindCentralDirectory(MS: TStream): Boolean; +Var + SeekStart : Integer; + Poz : Integer; + BR : Integer; + Byte_ : Array[0..3] of Byte; + +begin + Result := False; + if MS.Size < 22 Then Exit; + if MS.Size < 256 Then + SeekStart := MS.Size + Else + SeekStart := 256; + Poz := MS.Size-22; + BR := SeekStart; + Repeat + MS.Position := Poz; + MS.Read(Byte_,4); + If Byte_[0]=$50 Then + Begin + if (Byte_[1]=$4B) + And (Byte_[2]=$05) + And (Byte_[3]=$06) Then + Begin + MS.Position := Poz; + FParent.FEndOfCentralDirPos := MS.Position; + MS.Read(FParent.FEndOfCentralDir,SizeOf(FParent.FEndOfCentralDir)); + FParent.FZipCommentPos := MS.Position; + FParent.FZipComment.Clear; + Result := True; + End + Else + Begin + Dec(Poz,4); + Dec(BR ,4); + End; + End + Else + Begin + Dec(Poz); + Dec(BR) + End; + if BR < 0 Then + Begin + Case SeekStart of + 256 : Begin + SeekStart := 1024; + Poz := MS.Size-(256+22); + BR := SeekStart; + End; + 1024 : Begin + SeekStart := 65536; + Poz := MS.Size-(1024+22); + BR := SeekStart; + End; + 65536 : Begin + SeekStart := -1; + End; + End; + End; + if BR < 0 Then SeekStart := -1; + if MS.Size < SeekStart Then SeekStart := -1; + Until (Result) or (SeekStart=-1); +end; + + +function TKAZipEntries.ParseCentralHeaders(MS: TStream): Boolean; +Var + X : Integer; + Entry : TKAZipEntriesEntry; + CDFile : TCentralDirectoryFile; +begin + Result := False; + Try + MS.Position := FParent.FEndOfCentralDir.OffsetOfStartOfCentralDirectory; + For X := 0 To FParent.FEndOfCentralDir.TotalNumberOfEntriesOnThisDisk-1 do + Begin + FillChar(CDFile,SizeOf(TCentralDirectoryFile)-3*SizeOf(String),0); + MS.Read(CDFile,SizeOf(TCentralDirectoryFile)-3*SizeOf(String)); + Entry := TKAZipEntriesEntry.Create(Self); + Entry.FDate := FileDateToDateTime(CDFile.LastModFileTimeDate); + if (CDFile.GeneralPurposeBitFlag And 1) > 0 Then + Entry.FIsEncrypted := True + Else + Entry.FIsEncrypted := False; + If CDFile.FilenameLength > 0 Then + Begin + SetLength(CDFile.FileName,CDFile.FilenameLength); + MS.Read(CDFile.FileName[1], CDFile.FilenameLength) + End; + If CDFile.ExtraFieldLength > 0 Then + Begin + SetLength(CDFile.ExtraField,CDFile.ExtraFieldLength); + MS.Read(CDFile.ExtraField[1], CDFile.ExtraFieldLength); + End; + If CDFile.FileCommentLength > 0 Then + Begin + SetLength(CDFile.FileComment,CDFile.FileCommentLength); + MS.Read(CDFile.FileComment[1],CDFile.FileCommentLength); + End; + Entry.FIsFolder := (CDFile.ExternalFileAttributes and faDirectory) > 0; + + Entry.FCompressionType := ctUnknown; + if (CDFile.CompressionMethod=8) or (CDFile.CompressionMethod=9) Then + Begin + Case CDFile.GeneralPurposeBitFlag AND 6 of + 0 : Entry.FCompressionType := ctNormal; + 2 : Entry.FCompressionType := ctMaximum; + 4 : Entry.FCompressionType := ctFast; + 6 : Entry.FCompressionType := ctSuperFast + End; + End; + Entry.FCentralDirectoryFile := CDFile; + If Assigned(FParent.FOnZipOpen) Then FParent.FOnZipOpen(FParent,X,FParent.FEndOfCentralDir.TotalNumberOfEntriesOnThisDisk); + End; + Except + Exit; + End; + Result := Count=FParent.FEndOfCentralDir.TotalNumberOfEntriesOnThisDisk; +end; + + +procedure TKAZipEntries.ParseZip(MS: TStream); +begin + FIsZipFile := False; + Clear; + if FindCentralDirectory(MS) Then + Begin + if ParseCentralHeaders(MS) Then + Begin + FIsZipFile := True; + LoadLocalHeaders(MS); + End; + End + Else + Begin + if ParseLocalHeaders(MS) Then + Begin + FIsZipFile := Count > 0; + if FIsZipFile Then FParent.FHasBadEntries := True; + End; + End; +end; + + +function TKAZipEntries.GetLocalEntry(MS: TStream; Offset : Integer; HeaderOnly : Boolean): TLocalFile; +Var + Byte_ : Array[0..4] of Byte; + DataDescriptor : TDataDescriptor; + ddvalid : boolean; + fp,fp2 : Int64; +begin + FillChar(Result,SizeOf(Result),0); + MS.Position := Offset; + MS.Read(Byte_,4); + if (Byte_[0] = $50) + And (Byte_[1] = $4B) + And (Byte_[2] = $03) + And (Byte_[3] = $04) Then + Begin + MS.Position := Offset; + MS.Read(Result,SizeOf(Result)-3*SizeOf(AnsiString)); + if Result.FilenameLength > 0 Then + Begin + SetLength(Result.FileName,Result.FilenameLength); + MS.Read(Result.FileName[1],Result.FilenameLength); + End; + if Result.ExtraFieldLength > 0 Then + Begin + SetLength(Result.ExtraField,Result.ExtraFieldLength); + MS.Read(Result.ExtraField[1],Result.ExtraFieldLength); + End; + if (Result.GeneralPurposeBitFlag And (1 SHL 3)) > 0 Then + Begin + fp:= MS.Position; + ddvalid:= false; + repeat + MS.Read(Byte_,4); + if (Byte_[0] = $50) And (Byte_[1] = $4B) And (Byte_[2] = $07) And (Byte_[3] = $08) then begin + MS.Seek(-4, soFromCurrent); + fp2:= MS.Position; + MS.Read(DataDescriptor,SizeOf(TDataDescriptor)); + if DataDescriptor.CompressedSize=fp2-fp then begin + ddvalid:= true; + break; + end else + MS.Position:= fp2+4; + end; + MS.Seek(-3,soFromCurrent); + until MS.position=MS.Size; + + MS.Position:= fp; + if ddvalid then begin + Result.Crc32 := DataDescriptor.Crc32; + Result.CompressedSize := DataDescriptor.CompressedSize; + Result.UnCompressedSize := DataDescriptor.UnCompressedSize; + end else + raise Exception.CreateFmt('Missing data descriptor for file "%s"',[Result.FileName]); + End; + if Not HeaderOnly Then + Begin + if Result.CompressedSize > 0 Then + Begin + SetLength(Result.CompressedData,Result.CompressedSize); + MS.Read(Result.CompressedData[1],Result.CompressedSize); + End; + End; + End + Else + Begin + End; +end; + +procedure TKAZipEntries.LoadLocalHeaders(MS: TStream); +Var + X : Integer; +begin + FParent.FHasBadEntries := False; + For X := 0 To Count-1 do + Begin + If Assigned(FParent.FOnZipOpen) Then FParent.FOnZipOpen(FParent,X,FParent.FEndOfCentralDir.TotalNumberOfEntriesOnThisDisk); + Items[X].FLocalFile := GetLocalEntry(MS,Items[X].FCentralDirectoryFile.RelativeOffsetOfLocalHeader,True); + if Items[X].FLocalFile.LocalFileHeaderSignature<>$04034b50 Then FParent.FHasBadEntries := True; + End; +end; + +function TKAZipEntries.ParseLocalHeaders(MS: TStream): Boolean; +Var + Poz : Integer; + NLE : Integer; + Byte_ : Array[0..4] of Byte; + LocalFile : TLocalFile; + DataDescriptor : TDataDescriptor; + Entry : TKAZipEntriesEntry; + CDFile : TCentralDirectoryFile; + CDSize : Cardinal; + L : Integer; + NoMore : Boolean; + fp, fp2 : Int64; + ddvalid : boolean; +begin + Result := False; + FLocalHeaderNumFiles := 0; + Clear; + Try + Poz := 0; + NLE := 0; + CDSize := 0; + Repeat + NoMore := True; + MS.Position := Poz; + MS.Read(Byte_,4); + if (Byte_[0] = $50) + And (Byte_[1] = $4B) + And (Byte_[2] = $03) + And (Byte_[3] = $04) Then + Begin + Result := True; + Inc(FLocalHeaderNumFiles); + NoMore := False; + MS.Position := Poz; + MS.Read(LocalFile,SizeOf(TLocalFile)-3*SizeOf(String)); + if LocalFile.FilenameLength > 0 Then + Begin + SetLength(LocalFile.FileName,LocalFile.FilenameLength); + MS.Read(LocalFile.FileName[1],LocalFile.FilenameLength); + End; + if LocalFile.ExtraFieldLength > 0 Then + Begin + SetLength(LocalFile.ExtraField,LocalFile.ExtraFieldLength); + MS.Read(LocalFile.ExtraField[1],LocalFile.ExtraFieldLength); + End; + if (LocalFile.GeneralPurposeBitFlag And (1 SHL 3)) > 0 Then + Begin + fp:= MS.Position; + ddvalid:= false; + repeat + MS.Read(Byte_,4); + if (Byte_[0] = $50) And (Byte_[1] = $4B) And (Byte_[2] = $07) And (Byte_[3] = $08) then begin + MS.Seek(-4, soFromCurrent); + fp2:= MS.Position; + MS.Read(DataDescriptor,SizeOf(TDataDescriptor)); + if DataDescriptor.CompressedSize=fp2-fp then begin + ddvalid:= true; + break; + end else + MS.Position:= fp2+4; + end; + MS.Seek(-3,soFromCurrent); + until MS.position=MS.Size; + + MS.Position:= fp; + if ddvalid then begin + LocalFile.Crc32 := DataDescriptor.Crc32; + LocalFile.CompressedSize := DataDescriptor.CompressedSize; + LocalFile.UnCompressedSize := DataDescriptor.UnCompressedSize; + end else + raise Exception.CreateFmt('Missing data descriptor for file "%s"',[LocalFile.FileName]); + End; + MS.Position := MS.Position+LocalFile.CompressedSize; + + FillChar(CDFile,SizeOf(TCentralDirectoryFile)-3*Sizeof(String),0); + CDFile.CentralFileHeaderSignature := $02014B50; + CDFile.VersionMadeBy := 20; + CDFile.VersionNeededToExtract := LocalFile.VersionNeededToExtract; + CDFile.GeneralPurposeBitFlag := LocalFile.GeneralPurposeBitFlag; + CDFile.CompressionMethod := LocalFile.CompressionMethod; + CDFile.LastModFileTimeDate := LocalFile.LastModFileTimeDate; + CDFile.Crc32 := LocalFile.Crc32; + CDFile.CompressedSize := LocalFile.CompressedSize; + CDFile.UncompressedSize := LocalFile.UncompressedSize; + CDFile.FilenameLength := LocalFile.FilenameLength; + CDFile.ExtraFieldLength := LocalFile.ExtraFieldLength; + CDFile.FileCommentLength := 0; + CDFile.DiskNumberStart := 0; + CDFile.InternalFileAttributes := LocalFile.VersionNeededToExtract; + CDFile.ExternalFileAttributes := faArchive; + CDFile.RelativeOffsetOfLocalHeader := Poz; + CDFile.FileName := LocalFile.FileName; + L := Length(CDFile.FileName); + if L > 0 Then + Begin + if CDFile.FileName[L]='/' Then CDFile.ExternalFileAttributes := faDirectory; + End; + CDFile.ExtraField := LocalFile.ExtraField; + CDFile.FileComment := ''; + + Entry := TKAZipEntriesEntry.Create(Self); + Entry.FDate := FileDateToDateTime(CDFile.LastModFileTimeDate); + if (CDFile.GeneralPurposeBitFlag And 1) > 0 Then + Entry.FIsEncrypted := True + Else + Entry.FIsEncrypted := False; + Entry.FIsFolder := (CDFile.ExternalFileAttributes and faDirectory) > 0; + Entry.FCompressionType := ctUnknown; + if (CDFile.CompressionMethod=8) or (CDFile.CompressionMethod=9) Then + Begin + Case CDFile.GeneralPurposeBitFlag AND 6 of + 0 : Entry.FCompressionType := ctNormal; + 2 : Entry.FCompressionType := ctMaximum; + 4 : Entry.FCompressionType := ctFast; + 6 : Entry.FCompressionType := ctSuperFast + End; + End; + Entry.FCentralDirectoryFile := CDFile; + Poz := MS.Position; + Inc(NLE); + CDSize := CDSize+Entry.CentralEntrySize; + End; + Until NoMore; + + FParent.FEndOfCentralDir.EndOfCentralDirSignature := $06054b50; + FParent.FEndOfCentralDir.NumberOfThisDisk := 0; + FParent.FEndOfCentralDir.NumberOfTheDiskWithTheStart := 0; + FParent.FEndOfCentralDir.TotalNumberOfEntriesOnThisDisk := NLE; + FParent.FEndOfCentralDir.SizeOfTheCentralDirectory := CDSize; + FParent.FEndOfCentralDir.OffsetOfStartOfCentralDirectory := MS.Position; + FParent.FEndOfCentralDir.ZipfileCommentLength := 0; + Except + Exit; + End; +end; + +procedure TKAZipEntries.Remove(ItemIndex: Integer; Flush : Boolean); +Var + TempStream : TFileStream; + TempMSStream : TMemoryStream; + TempFileName : String; + BUF : String; + ZipComment : String; + OSL : Cardinal; + //********************************************* + X : Integer; + TargetPos : Cardinal; + Border : Cardinal; + + NR : Integer; + NW : Integer; + BufStart : Integer; + BufLen : Integer; + ShiftSize : Cardinal; + NewSize : Cardinal; +begin + TargetPos := Items[ItemIndex].FCentralDirectoryFile.RelativeOffsetOfLocalHeader; + ShiftSize := Items[ItemIndex].LocalEntrySize; + BufStart := TargetPos+ShiftSize; + BufLen := FParent.FZipStream.Size-BufStart; + Border := TargetPos; + Delete(ItemIndex); + if (FParent.FZipSaveMethod=FastSave) AND (Count > 0) Then + Begin + ZipComment := FParent.Comment.Text; + + SetLength(BUF,BufLen); + FParent.FZipStream.Position := BufStart; + NR := FParent.FZipStream.Read(BUF[1],BufLen); + + FParent.FZipStream.Position := TargetPos; + NW := FParent.FZipStream.Write(BUF[1],BufLen); + SetLength(BUF,0); + + For X := 0 to Count-1 do + Begin + if Items[X].FCentralDirectoryFile.RelativeOffsetOfLocalHeader > Border Then + Begin + Dec(Items[X].FCentralDirectoryFile.RelativeOffsetOfLocalHeader, ShiftSize); + TargetPos := TargetPos+Items[X].LocalEntrySize; + End + End; + + FParent.FZipStream.Position := TargetPos; + //************************************ MARK START OF CENTRAL DIRECTORY + FParent.FEndOfCentralDir.OffsetOfStartOfCentralDirectory := FParent.FZipStream.Position; + //************************************ SAVE CENTRAL DIRECTORY + For X := 0 To Count-1 do + Begin + FParent.FZipStream.Write(Self.Items[X].FCentralDirectoryFile,SizeOf(Self.Items[X].FCentralDirectoryFile)-3*SizeOf(String)); + if Self.Items[X].FCentralDirectoryFile.FilenameLength > 0 Then + FParent.FZipStream.Write(Self.Items[X].FCentralDirectoryFile.FileName[1],Self.Items[X].FCentralDirectoryFile.FilenameLength); + if Self.Items[X].FCentralDirectoryFile.ExtraFieldLength > 0 Then + FParent.FZipStream.Write(Self.Items[X].FCentralDirectoryFile.ExtraField[1],Self.Items[X].FCentralDirectoryFile.ExtraFieldLength); + if Self.Items[X].FCentralDirectoryFile.FileCommentLength > 0 Then + FParent.FZipStream.Write(Self.Items[X].FCentralDirectoryFile.FileComment[1],Self.Items[X].FCentralDirectoryFile.FileCommentLength); + End; + //************************************ SAVE END CENTRAL DIRECTORY RECORD + FParent.FEndOfCentralDirPos := FParent.FZipStream.Position; + FParent.FEndOfCentralDir.SizeOfTheCentralDirectory := FParent.FEndOfCentralDirPos-FParent.FEndOfCentralDir.OffsetOfStartOfCentralDirectory; + Dec(FParent.FEndOfCentralDir.TotalNumberOfEntriesOnThisDisk); + Dec(FParent.FEndOfCentralDir.TotalNumberOfEntries); + FParent.FZipStream.Write(FParent.FEndOfCentralDir, SizeOf(TEndOfCentralDir)); + //************************************ SAVE ZIP COMMENT IF ANY + FParent.FZipCommentPos := FParent.FZipStream.Position; + if Length(ZipComment) > 0 Then + Begin + FParent.FZipStream.Write(ZipComment[1],Length(ZipComment)); + End; + FParent.FZipStream.Size := FParent.FZipStream.Position; + End + Else + Begin + if FParent.FUseTempFiles Then + Begin + TempFileName := FParent.GetDelphiTempFileName; + TempStream := TFileStream.Create(TempFileName,fmOpenReadWrite or FmCreate); + Try + FParent.SaveToStream(TempStream); + TempStream.Position := 0; + OSL := FParent.FZipStream.Size; + Try + FParent.FZipStream.Size := TempStream.Size; + Except + FParent.FZipStream.Size := OSL; + Raise; + End; + FParent.FZipStream.Position := 0; + FParent.FZipStream.CopyFrom(TempStream,TempStream.Size); + //********************************************************************* + FParent.FZipHeader.ParseZip(FParent.FZipStream); + //********************************************************************* + Finally + TempStream.Free; + DeleteFile(TempFileName) + End; + End + Else + Begin + NewSize := 0; + For X := 0 To Count-1 do + Begin + NewSize := NewSize+Items[X].LocalEntrySize+Items[X].CentralEntrySize; + if Assigned(FParent.FOnRemoveItems) Then FParent.FOnRemoveItems(FParent,X,Count-1); + End; + NewSize := NewSize+SizeOf(FParent.FEndOfCentralDir)+FParent.FEndOfCentralDir.ZipfileCommentLength; + TempMSStream := TMemoryStream.Create; + Try + TempMSStream.SetSize(NewSize); + TempMSStream.Position := 0; + FParent.SaveToStream(TempMSStream); + TempMSStream.Position := 0; + OSL := FParent.FZipStream.Size; + Try + FParent.FZipStream.Size := TempMSStream.Size; + Except + FParent.FZipStream.Size := OSL; + Raise; + End; + FParent.FZipStream.Position := 0; + FParent.FZipStream.CopyFrom(TempMSStream,TempMSStream.Size); + //********************************************************************* + FParent.FZipHeader.ParseZip(FParent.FZipStream); + //********************************************************************* + Finally + TempMSStream.Free; + End; + End; + End; + FParent.FIsDirty := True; + if NOT FParent.FBatchMode Then + Begin + FParent.DoChange(FParent,3); + End; +end; + +procedure TKAZipEntries.Remove(ItemIndex: Integer); +Begin + Remove(ItemIndex,True); +End; + +procedure TKAZipEntries.Remove(Item: TKAZipEntriesEntry); +Var + X : Integer; +begin + For X := 0 To Count-1 do + Begin + if Self.Items[X]=Item Then + Begin + Remove(X); + Exit; + End; + End; +end; + +procedure TKAZipEntries.Remove(FileName: String); +Var + I : Integer; +begin + I := IndexOf(FileName); + if I <> -1 Then Remove(I); +end; + +procedure TKAZipEntries.RemoveBatch(Files:TList); +Var + X : Integer; + OSL : Integer; + NewSize : Cardinal; + TempStream : TFileStream; + TempMSStream : TMemoryStream; + TempFileName : String; +Begin + For X := Files.Count-1 DownTo 0 do + Begin + Delete(Integer(Files.Items[X])); + if Assigned(FParent.FOnRemoveItems) Then FParent.FOnRemoveItems(FParent,Files.Count-X,Files.Count); + End; + NewSize := 0; + if FParent.FUseTempFiles Then + Begin + TempFileName := FParent.GetDelphiTempFileName; + TempStream := TFileStream.Create(TempFileName,fmOpenReadWrite or FmCreate); + Try + FParent.SaveToStream(TempStream); + TempStream.Position := 0; + OSL := FParent.FZipStream.Size; + Try + FParent.FZipStream.Size := TempStream.Size; + Except + FParent.FZipStream.Size := OSL; + Raise; + End; + FParent.FZipStream.Position := 0; + FParent.FZipStream.CopyFrom(TempStream,TempStream.Size); + //********************************************************************* + FParent.FZipHeader.ParseZip(FParent.FZipStream); + //********************************************************************* + Finally + TempStream.Free; + DeleteFile(TempFileName) + End; + End + Else + Begin + For X := 0 To Count-1 do + Begin + NewSize := NewSize+Items[X].LocalEntrySize+Items[X].CentralEntrySize; + if Assigned(FParent.FOnRemoveItems) Then FParent.FOnRemoveItems(FParent,X,Count-1); + End; + NewSize := NewSize+SizeOf(FParent.FEndOfCentralDir)+FParent.FEndOfCentralDir.ZipfileCommentLength; + TempMSStream := TMemoryStream.Create; + Try + TempMSStream.SetSize(NewSize); + TempMSStream.Position := 0; + FParent.SaveToStream(TempMSStream); + TempMSStream.Position := 0; + OSL := FParent.FZipStream.Size; + Try + FParent.FZipStream.Size := TempMSStream.Size; + Except + FParent.FZipStream.Size := OSL; + Raise; + End; + FParent.FZipStream.Position := 0; + FParent.FZipStream.CopyFrom(TempMSStream,TempMSStream.Size); + //********************************************************************* + FParent.FZipHeader.ParseZip(FParent.FZipStream); + //********************************************************************* + Finally + TempMSStream.Free; + End; + End; +End; + +Function TKAZipEntries.IndexOf(Const FileName:String):Integer; +Var + X : Integer; + FN : String; +Begin + Result := -1; + FN := ToZipName(FileName); + For X := 0 To Count-1 do + Begin + if AnsiCompareText(FN,ToZipName(Items[X].FCentralDirectoryFile.FileName))=0 Then + Begin + Result := X; + Exit; + End; + End; +End; + + +Function TKAZipEntries.AddStreamFast( ItemName : String; + FileAttr : Word; + FileDate : TDateTime; + Stream : TStream):TKAZipEntriesEntry; +Var + Compressor : TCompressionStream; + CS : TStringStream; + CM : WORD; + S : String; + X : Integer; + I : Integer; + UL : Integer; + CL : Integer; + FCRC32 : Cardinal; + SizeToAppend : Integer; + ZipComment : String; + Level : TCompressionLevel; + OBM : Boolean; +begin + //*********************************** COMPRESS DATA + ZipComment := FParent.Comment.Text; + + if NOT FParent.FStoreRelativePath Then + ItemName := ExtractFileName(ItemName); + + ItemName := ToZipName(ItemName); + I := IndexOf(ItemName); + if I > -1 Then + Begin + OBM := FParent.FBatchMode; + Try + if OBM=False Then FParent.FBatchMode := True; + Remove(I); + Finally + FParent.FBatchMode := OBM; + End; + End; + + CS := TStringStream.Create(''); + CS.Position := 0; + Try + UL := Stream.Size-Stream.Position; + SetLength(S,UL); + CM := 0; + if UL > 0 Then + Begin + Stream.Read(S[1],UL); + CM := 8; + End; + FCRC32 := CalcCRC32(S); + FParent.FCurrentDFS := UL; + + + Level := clDefault; + Case FParent.FZipCompressionType of + ctNormal : Level := clDefault; + ctMaximum : Level := clMax; + ctFast : Level := clFastest; + ctSuperFast : Level := clFastest; + ctNone : Level := clNone; + End; + + if CM = 8 Then + Begin + Compressor := TCompressionStream.Create(Level,CS); + Try + Compressor.OnProgress := FParent.OnCompress; + Compressor.Write(S[1],UL); + Finally + Compressor.Free; + End; + S := Copy(CS.DataString, 3, Length(CS.DataString)-6); + End; + Finally + CS.Free; + End; + //*********************************** + CL := Length(S); + //*********************************** FILL RECORDS + Result := TKAZipEntriesEntry(Self.Add); + With Result.FLocalFile do + Begin + LocalFileHeaderSignature := $04034B50; + VersionNeededToExtract := 20; + GeneralPurposeBitFlag := 0; + CompressionMethod := CM; + LastModFileTimeDate := DateTimeToFileDate(FileDate); + Crc32 := FCRC32; + CompressedSize := CL; + UncompressedSize := UL; + FilenameLength := Length(ItemName); + ExtraFieldLength := 0; + FileName := ItemName; + ExtraField := ''; + CompressedData := ''; + End; + + With Result.FCentralDirectoryFile Do + Begin + CentralFileHeaderSignature := $02014B50; + VersionMadeBy := 20; + VersionNeededToExtract := 20; + GeneralPurposeBitFlag := 0; + CompressionMethod := CM; + LastModFileTimeDate := DateTimeToFileDate(FileDate); + Crc32 := FCRC32; + CompressedSize := CL; + UncompressedSize := UL; + FilenameLength := Length(ItemName); + ExtraFieldLength := 0; + FileCommentLength := 0; + DiskNumberStart := 0; + InternalFileAttributes := 0; + ExternalFileAttributes := FileAttr; + RelativeOffsetOfLocalHeader := FParent.FEndOfCentralDir.OffsetOfStartOfCentralDirectory; + FileName := ItemName; + ExtraField := ''; + FileComment := ''; + End; + + //************************************ EXPAND ZIP STREAM SIZE + SizeToAppend := 0; + SizeToAppend := SizeToAppend+SizeOf(Result.FLocalFile)-3*SizeOf(String); + SizeToAppend := SizeToAppend+Result.FLocalFile.FilenameLength; + SizeToAppend := SizeToAppend+CL; + SizeToAppend := SizeToAppend+SizeOf(Result.FCentralDirectoryFile)-3*SizeOf(String); + SizeToAppend := SizeToAppend+Result.FCentralDirectoryFile.FilenameLength; + FParent.FZipStream.Size := FParent.FZipStream.Size+SizeToAppend; + + //************************************ SAVE LOCAL HEADER AND COMPRESSED DATA + FParent.FZipStream.Position := Result.FCentralDirectoryFile.RelativeOffsetOfLocalHeader; + FParent.FZipStream.Write(Result.FLocalFile,SizeOf(Result.FLocalFile)-3*SizeOf(String)); + if Result.FLocalFile.FilenameLength > 0 Then FParent.FZipStream.Write(Result.FLocalFile.FileName[1],Result.FLocalFile.FilenameLength); + if CL > 0 Then FParent.FZipStream.Write(S[1],CL); + + //************************************ MARK START OF CENTRAL DIRECTORY + FParent.FEndOfCentralDir.OffsetOfStartOfCentralDirectory := FParent.FZipStream.Position; + + //************************************ SAVE CENTRAL DIRECTORY + For X := 0 To Count-1 do + Begin + FParent.FZipStream.Write(Self.Items[X].FCentralDirectoryFile,SizeOf(Self.Items[X].FCentralDirectoryFile)-3*SizeOf(String)); + if Self.Items[X].FCentralDirectoryFile.FilenameLength > 0 Then + FParent.FZipStream.Write(Self.Items[X].FCentralDirectoryFile.FileName[1],Self.Items[X].FCentralDirectoryFile.FilenameLength); + if Self.Items[X].FCentralDirectoryFile.ExtraFieldLength > 0 Then + FParent.FZipStream.Write(Self.Items[X].FCentralDirectoryFile.ExtraField[1],Self.Items[X].FCentralDirectoryFile.ExtraFieldLength); + if Self.Items[X].FCentralDirectoryFile.FileCommentLength > 0 Then + FParent.FZipStream.Write(Self.Items[X].FCentralDirectoryFile.FileComment[1],Self.Items[X].FCentralDirectoryFile.FileCommentLength); + End; + + //************************************ SAVE END CENTRAL DIRECTORY RECORD + FParent.FEndOfCentralDirPos := FParent.FZipStream.Position; + FParent.FEndOfCentralDir.SizeOfTheCentralDirectory := FParent.FEndOfCentralDirPos-FParent.FEndOfCentralDir.OffsetOfStartOfCentralDirectory; + Inc(FParent.FEndOfCentralDir.TotalNumberOfEntriesOnThisDisk); + Inc(FParent.FEndOfCentralDir.TotalNumberOfEntries); + FParent.FZipStream.Write(FParent.FEndOfCentralDir, SizeOf(TEndOfCentralDir)); + + //************************************ SAVE ZIP COMMENT IF ANY + FParent.FZipCommentPos := FParent.FZipStream.Position; + if Length(ZipComment) > 0 Then + Begin + FParent.FZipStream.Write(ZipComment[1],Length(ZipComment)); + End; + + Result.FDate := FileDate; + + if (Result.FCentralDirectoryFile.GeneralPurposeBitFlag And 1) > 0 Then + Result.FIsEncrypted := True + Else + Result.FIsEncrypted := False; + Result.FIsFolder := (Result.FCentralDirectoryFile.ExternalFileAttributes and faDirectory) > 0; + Result.FCompressionType := ctUnknown; + if (Result.FCentralDirectoryFile.CompressionMethod=8) or (Result.FCentralDirectoryFile.CompressionMethod=9) Then + Begin + Case Result.FCentralDirectoryFile.GeneralPurposeBitFlag AND 6 of + 0 : Result.FCompressionType := ctNormal; + 2 : Result.FCompressionType := ctMaximum; + 4 : Result.FCompressionType := ctFast; + 6 : Result.FCompressionType := ctSuperFast + End; + End; + FParent.FIsDirty := True; + if NOT FParent.FBatchMode Then + Begin + FParent.DoChange(FParent,2); + End; +end; + +Function TKAZipEntries.AddStreamRebuild( ItemName : String; + FileAttr : Word; + FileDate : TDateTime; + Stream : TStream):TKAZipEntriesEntry; +Var + Compressor : TCompressionStream; + CS : TStringStream; + CM : Word; + S : String; + UL : Integer; + CL : Integer; + I : Integer; + X : Integer; + FCRC32 : Cardinal; + OSL : Cardinal; + NewSize : Cardinal; + ZipComment : String; + TempStream : TFileStream; + TempMSStream : TMemoryStream; + TempFileName : String; + Level : TCompressionLevel; + OBM : Boolean; +Begin + if FParent.FUseTempFiles Then + Begin + TempFileName := FParent.GetDelphiTempFileName; + TempStream := TFileStream.Create(TempFileName,fmOpenReadWrite or FmCreate); + Try + //*********************************** SAVE ALL OLD LOCAL ITEMS + FParent.RebuildLocalFiles(TempStream); + //*********************************** COMPRESS DATA + ZipComment := FParent.Comment.Text; + if NOT FParent.FStoreRelativePath Then + ItemName := ExtractFileName(ItemName); + ItemName := ToZipName(ItemName); + I := IndexOf(ItemName); + if I > -1 Then + Begin + OBM := FParent.FBatchMode; + Try + if OBM=False Then FParent.FBatchMode := True; + Remove(I); + Finally + FParent.FBatchMode := OBM; + End; + End; + + CM := 0; + CS := TStringStream.Create(''); + CS.Position := 0; + Try + UL := Stream.Size-Stream.Position; + SetLength(S,UL); + if UL > 0 Then + Begin + Stream.Read(S[1],UL); + CM := 8; + End; + FCRC32 := CalcCRC32(S); + FParent.FCurrentDFS := UL; + + Level := clDefault; + Case FParent.FZipCompressionType of + ctNormal : Level := clDefault; + ctMaximum : Level := clMax; + ctFast : Level := clFastest; + ctSuperFast : Level := clFastest; + ctNone : Level := clNone; + End; + + if CM=8 Then + Begin + Compressor := TCompressionStream.Create(Level,CS); + Try + Compressor.OnProgress := FParent.OnCompress; + Compressor.Write(S[1],UL); + Finally + Compressor.Free; + End; + S := Copy(CS.DataString, 3, Length(CS.DataString)-6); + End; + Finally + CS.Free; + End; + //************************************************************************ + CL := Length(S); + //*********************************** FILL RECORDS + Result := TKAZipEntriesEntry(Self.Add); + With Result.FLocalFile do + Begin + LocalFileHeaderSignature := $04034B50; + VersionNeededToExtract := 20; + GeneralPurposeBitFlag := 0; + CompressionMethod := CM; + LastModFileTimeDate := DateTimeToFileDate(FileDate); + Crc32 := FCRC32; + CompressedSize := CL; + UncompressedSize := UL; + FilenameLength := Length(ItemName); + ExtraFieldLength := 0; + FileName := ItemName; + ExtraField := ''; + CompressedData := ''; + End; + + With Result.FCentralDirectoryFile Do + Begin + CentralFileHeaderSignature := $02014B50; + VersionMadeBy := 20; + VersionNeededToExtract := 20; + GeneralPurposeBitFlag := 0; + CompressionMethod := CM; + LastModFileTimeDate := DateTimeToFileDate(FileDate); + Crc32 := FCRC32; + CompressedSize := CL; + UncompressedSize := UL; + FilenameLength := Length(ItemName); + ExtraFieldLength := 0; + FileCommentLength := 0; + DiskNumberStart := 0; + InternalFileAttributes := 0; + ExternalFileAttributes := FileAttr; + RelativeOffsetOfLocalHeader := TempStream.Position; + FileName := ItemName; + ExtraField := ''; + FileComment := ''; + End; + + //************************************ SAVE LOCAL HEADER AND COMPRESSED DATA + TempStream.Write(Result.FLocalFile,SizeOf(Result.FLocalFile)-3*SizeOf(String)); + if Result.FLocalFile.FilenameLength > 0 Then TempStream.Write(Result.FLocalFile.FileName[1],Result.FLocalFile.FilenameLength); + if CL > 0 Then TempStream.Write(S[1],CL); + //************************************ + FParent.NewLHOffsets[Count-1] := Result.FCentralDirectoryFile.RelativeOffsetOfLocalHeader; + FParent.RebuildCentralDirectory(TempStream); + FParent.RebuildEndOfCentralDirectory(TempStream); + //************************************ + TempStream.Position := 0; + OSL := FParent.FZipStream.Size; + Try + FParent.FZipStream.Size := TempStream.Size; + Except + FParent.FZipStream.Size := OSL; + Raise; + End; + FParent.FZipStream.Position := 0; + FParent.FZipStream.CopyFrom(TempStream,TempStream.Size); + Finally + TempStream.Free; + DeleteFile(TempFileName) + End; + End + Else + Begin + TempMSStream := TMemoryStream.Create; + NewSize := 0; + For X := 0 To Count-1 do + Begin + NewSize := NewSize+Items[X].LocalEntrySize+Items[X].CentralEntrySize; + if Assigned(FParent.FOnRemoveItems) Then FParent.FOnRemoveItems(FParent,X,Count-1); + End; + NewSize := NewSize+SizeOf(FParent.FEndOfCentralDir)+FParent.FEndOfCentralDir.ZipfileCommentLength; + Try + TempMSStream.SetSize(NewSize); + TempMSStream.Position := 0; + //*********************************** SAVE ALL OLD LOCAL ITEMS + FParent.RebuildLocalFiles(TempMSStream); + //*********************************** COMPRESS DATA + ZipComment := FParent.Comment.Text; + if NOT FParent.FStoreRelativePath Then + ItemName := ExtractFileName(ItemName); + ItemName := ToZipName(ItemName); + I := IndexOf(ItemName); + if I > -1 Then + Begin + OBM := FParent.FBatchMode; + Try + if OBM=False Then FParent.FBatchMode := True; + Remove(I); + Finally + FParent.FBatchMode := OBM; + End; + End; + + CM := 0; + CS := TStringStream.Create(''); + CS.Position := 0; + Try + UL := Stream.Size-Stream.Position; + SetLength(S,UL); + if UL > 0 Then + Begin + Stream.Read(S[1],UL); + CM := 8; + End; + FCRC32 := CalcCRC32(S); + FParent.FCurrentDFS := UL; + + Level := clDefault; + Case FParent.FZipCompressionType of + ctNormal : Level := clDefault; + ctMaximum : Level := clMax; + ctFast : Level := clFastest; + ctSuperFast : Level := clFastest; + ctNone : Level := clNone; + End; + + if CM=8 Then + Begin + Compressor := TCompressionStream.Create(Level,CS); + Try + Compressor.OnProgress := FParent.OnCompress; + Compressor.Write(S[1],UL); + Finally + Compressor.Free; + End; + S := Copy(CS.DataString, 3, Length(CS.DataString)-6); + End; + Finally + CS.Free; + End; + //************************************************************************ + CL := Length(S); + //*********************************** FILL RECORDS + Result := TKAZipEntriesEntry(Self.Add); + With Result.FLocalFile do + Begin + LocalFileHeaderSignature := $04034B50; + VersionNeededToExtract := 20; + GeneralPurposeBitFlag := 0; + CompressionMethod := CM; + LastModFileTimeDate := DateTimeToFileDate(FileDate); + Crc32 := FCRC32; + CompressedSize := CL; + UncompressedSize := UL; + FilenameLength := Length(ItemName); + ExtraFieldLength := 0; + FileName := ItemName; + ExtraField := ''; + CompressedData := ''; + End; + + With Result.FCentralDirectoryFile Do + Begin + CentralFileHeaderSignature := $02014B50; + VersionMadeBy := 20; + VersionNeededToExtract := 20; + GeneralPurposeBitFlag := 0; + CompressionMethod := CM; + LastModFileTimeDate := DateTimeToFileDate(FileDate); + Crc32 := FCRC32; + CompressedSize := CL; + UncompressedSize := UL; + FilenameLength := Length(ItemName); + ExtraFieldLength := 0; + FileCommentLength := 0; + DiskNumberStart := 0; + InternalFileAttributes := 0; + ExternalFileAttributes := FileAttr; + RelativeOffsetOfLocalHeader := TempMSStream.Position; + FileName := ItemName; + ExtraField := ''; + FileComment := ''; + End; + + //************************************ SAVE LOCAL HEADER AND COMPRESSED DATA + TempMSStream.Write(Result.FLocalFile,SizeOf(Result.FLocalFile)-3*SizeOf(String)); + if Result.FLocalFile.FilenameLength > 0 Then TempMSStream.Write(Result.FLocalFile.FileName[1],Result.FLocalFile.FilenameLength); + if CL > 0 Then TempMSStream.Write(S[1],CL); + //************************************ + FParent.NewLHOffsets[Count-1] := Result.FCentralDirectoryFile.RelativeOffsetOfLocalHeader; + FParent.RebuildCentralDirectory(TempMSStream); + FParent.RebuildEndOfCentralDirectory(TempMSStream); + //************************************ + TempMSStream.Position := 0; + OSL := FParent.FZipStream.Size; + Try + FParent.FZipStream.Size := TempMSStream.Size; + Except + FParent.FZipStream.Size := OSL; + Raise; + End; + FParent.FZipStream.Position := 0; + FParent.FZipStream.CopyFrom(TempMSStream,TempMSStream.Size); + Finally + TempMSStream.Free; + End; + End; + + Result.FDate := FileDateToDateTime(Result.FCentralDirectoryFile.LastModFileTimeDate); + if (Result.FCentralDirectoryFile.GeneralPurposeBitFlag And 1) > 0 Then + Result.FIsEncrypted := True + Else + Result.FIsEncrypted := False; + Result.FIsFolder := (Result.FCentralDirectoryFile.ExternalFileAttributes and faDirectory) > 0; + Result.FCompressionType := ctUnknown; + if (Result.FCentralDirectoryFile.CompressionMethod=8) or (Result.FCentralDirectoryFile.CompressionMethod=9) Then + Begin + Case Result.FCentralDirectoryFile.GeneralPurposeBitFlag AND 6 of + 0 : Result.FCompressionType := ctNormal; + 2 : Result.FCompressionType := ctMaximum; + 4 : Result.FCompressionType := ctFast; + 6 : Result.FCompressionType := ctSuperFast + End; + End; + FParent.FIsDirty := True; + if NOT FParent.FBatchMode Then + Begin + FParent.DoChange(FParent,2); + End; +End; + +function TKAZipEntries.AddFolderChain(ItemName: String; FileAttr: Word; + FileDate: TDateTime): Boolean; +Var + FN : String; + TN : String; + INCN : String; + P : Integer; + MS : TMemoryStream; + NoMore : Boolean; +Begin + Result := False; + FN := ExtractFilePath(ToDosName(ToZipName(ItemName))); + TN := FN; + INCN := ''; + MS := TMemoryStream.Create; + Try + Repeat + NoMore := True; + P := Pos('\',TN); + if P > 0 Then + Begin + INCN := INCN+Copy(TN,1,P); + System.Delete(TN,1,P); + MS.Position := 0; + MS.Size := 0; + If IndexOf(INCN) = -1 Then + Begin + if FParent.FZipSaveMethod = FastSave Then + AddStreamFast(INCN,FileAttr,FileDate,MS) + Else + if FParent.FZipSaveMethod = RebuildAll Then + AddStreamRebuild(INCN,FileAttr,FileDate,MS); + End; + NoMore := False; + End; + Until NoMore; + Result := True; + Finally + MS.Free; + End; +End; + +Function TKAZipEntries.AddFolderChain(ItemName : String):Boolean; +begin + Result := AddFolderChain(ItemName,faDirectory,Now); +end; + +function TKAZipEntries.AddStream(FileName : String; FileAttr : Word; FileDate : TDateTime; Stream : TStream):TKAZipEntriesEntry; +Begin + Result := Nil; + if (FParent.FStoreFolders) AND (FParent.FStoreRelativePath) Then AddFolderChain(FileName); + if FParent.FZipSaveMethod = FastSave Then + Result := AddStreamFast(FileName,FileAttr,FileDate,Stream) + Else + if FParent.FZipSaveMethod = RebuildAll Then + Result := AddStreamRebuild(FileName,FileAttr,FileDate,Stream); + if Assigned(FParent.FOnAddItem) Then FParent.FOnAddItem(FParent,FileName); +End; + +Function TKAZipEntries.AddStream(FileName: String; Stream : TStream):TKAZipEntriesEntry; +begin + Result := AddStream(FileName,faArchive,Now,Stream); +end; + +Function TKAZipEntries.AddFile(FileName, NewFileName: String):TKAZipEntriesEntry; +Var + FS : TFileStream; + Dir : TSearchRec; + Res : Integer; +begin + Result := Nil; + Res := FindFirst(FileName,faAnyFile,Dir); + if Res=0 Then + Begin + FS := TFileStream.Create(FileName,fmOpenRead or fmShareDenyNone); + Try + FS.Position := 0; + Result := AddStream(NewFileName,Dir.Attr,FileDateToDateTime(Dir.Time),FS) + Finally + FS.Free; + End; + End; + FindClose(Dir); +end; + +Function TKAZipEntries.AddFile(FileName: String):TKAZipEntriesEntry; +begin + Result := AddFile(FileName,FileName); +end; + +function TKAZipEntries.AddFiles(FileNames: TStrings): Boolean; +Var + X : Integer; +begin + Result := False; + FParent.FBatchMode := True; + Try + For X := 0 To FileNames.Count-1 do AddFile(FileNames.Strings[X]); + Except + FParent.FBatchMode := False; + FParent.DoChange(FParent,2); + Exit; + End; + FParent.FBatchMode := False; + FParent.DoChange(FParent,2); + Result := True; +end; + +Function TKAZipEntries.AddFolderEx(FolderName:String; RootFolder:String; WildCard : String; WithSubFolders : Boolean):Boolean; +Var + Res : Integer; + Dir : TSearchRec; + FN : String; +Begin + Res := FindFirst(FolderName+'\*.*',faAnyFile,Dir); + While Res=0 Do + Begin + if (Dir.Attr and faDirectory) > 0 Then + Begin + if (Dir.Name <> '..') And (Dir.Name <> '.') Then + Begin + FN := FolderName+'\'+Dir.Name; + if (FParent.FStoreFolders) AND (FParent.FStoreRelativePath) Then + AddFolderChain(RemoveRootName(FN+'\',RootFolder),Dir.Attr,FileDateToDateTime(Dir.Time)); + if WithSubFolders Then + Begin + AddFolderEx(FN, RootFolder, WildCard, WithSubFolders); + End; + End + Else + Begin + if (Dir.Name = '.') Then AddFolderChain(RemoveRootName(FolderName+'\',RootFolder),Dir.Attr,FileDateToDateTime(Dir.Time)); + End; + End + Else + Begin + FN := FolderName+'\'+Dir.Name; + if MatchesMask(FN,WildCard) Then + Begin + AddFile(FN,RemoveRootName(FN,RootFolder)); + End; + End; + Res := FindNext(Dir); + End; + FindClose(Dir); + Result := True; +End; + +Function TKAZipEntries.AddFolder(FolderName:String; RootFolder:String; WildCard : String; WithSubFolders : Boolean):Boolean; +Begin + FParent.FBatchMode := True; + Try + Result := AddFolderEx(FolderName,RootFolder,WildCard,WithSubFolders); + Finally + FParent.FBatchMode := False; + FParent.DoChange(FParent,2); + End; +End; + +Function TKAZipEntries.AddFilesAndFolders(FileNames:TStrings; RootFolder:String; WithSubFolders : Boolean):Boolean; +Var + X : Integer; + Res : Integer; + Dir : TSearchRec; +Begin + FParent.FBatchMode := True; + Try + For X := 0 To FileNames.Count-1 do + Begin + Res := FindFirst(FileNames.Strings[X],faAnyFile,Dir); + if Res=0 Then + Begin + if (Dir.Attr and faDirectory) > 0 Then + Begin + if (Dir.Name <> '..') And (Dir.Name <> '.') Then + Begin + AddFolderEx(FileNames.Strings[X],RootFolder,'*.*',WithSubFolders); + End; + End + Else + Begin + AddFile(FileNames.Strings[X],RemoveRootName(FileNames.Strings[X],RootFolder)); + End; + End; + FindClose(Dir); + End; + Finally + FParent.FBatchMode := False; + FParent.DoChange(FParent,2); + End; + Result := True; +End; + + +procedure TKAZipEntries.RemoveFiles(List: TList); +begin + if List.Count=1 Then + Begin + Remove(Integer(List.Items[0])); + End + Else + Begin + SortList(List); + FParent.FBatchMode := True; + Try + RemoveBatch(List); + Finally + FParent.FBatchMode := False; + FParent.DoChange(Self,3); + End; + End; +end; + +Procedure TKAZipEntries.RemoveSelected; +Var + X : Integer; + List : TList; +Begin + FParent.FBatchMode := True; + List := TList.Create; + Try + For X := 0 to Count-1 do + Begin + if Self.Items[X].Selected Then List.Add(Pointer(X)); + End; + RemoveBatch(List); + Finally + List.Free; + FParent.FBatchMode := False; + FParent.DoChange(Self,3); + End; +End; + + +procedure TKAZipEntries.ExtractToStream(Item : TKAZipEntriesEntry; Stream: TStream); +Var + SFS : TMemoryStream; + TFS : TStream; + BUF : String; + NR : Cardinal; + Decompressor : TDecompressionStream; + {$IFDEF USE_BZIP2} + DecompressorBZ2 : TBZDecompressionStream; + {$ENDIF} +begin + if ( + (Item.CompressionMethod=8) or + {$IFDEF USE_BZIP2} + (Item.CompressionMethod=12) or + {$ENDIF} + (Item.CompressionMethod=0) + ) + And (NOT Item.FIsEncrypted) Then + Begin + SFS := TMemoryStream.Create; + TFS := Stream; + Try + if Item.GetCompressedData(SFS) > 0 Then + Begin + SFS.Position := 0; + FParent.FCurrentDFS := Item.SizeUncompressed; + //****************************************************** DEFLATE + if (Item.CompressionMethod=8) Then + Begin + Decompressor := TDecompressionStream.Create(SFS); + Decompressor.OnProgress := FParent.OnDecompress; + SetLength(BUF,FParent.FCurrentDFS); + Try + NR := Decompressor.Read(BUF[1],FParent.FCurrentDFS); + if NR=FParent.FCurrentDFS Then TFS.Write(BUF[1],FParent.FCurrentDFS); + Finally + Decompressor.Free; + End; + End + //******************************************************* BZIP2 + {$IFDEF USE_BZIP2} + Else + If Item.CompressionMethod=12 Then + Begin + DecompressorBZ2 := TBZDecompressionStream.Create(SFS); + DecompressorBZ2.OnProgress := FParent.OnDecompress; + SetLength(BUF,FParent.FCurrentDFS); + Try + NR := DecompressorBZ2.Read(BUF[1],FParent.FCurrentDFS); + if NR=FParent.FCurrentDFS Then TFS.Write(BUF[1],FParent.FCurrentDFS); + Finally + DecompressorBZ2.Free; + End; + End + {$ENDIF} + //****************************************************** STORED + Else + If Item.CompressionMethod=0 Then + Begin + TFS.CopyFrom(SFS,FParent.FCurrentDFS); + End; + End; + Finally + SFS.Free; + End; + End + Else + Begin + Raise Exception.Create('Cannot process this file: '+Item.FileName+' '); + End; +end; + +procedure TKAZipEntries.InternalExtractToFile(Item: TKAZipEntriesEntry; + FileName: String); +Var + TFS : TFileStream; + Attr : Integer; +begin + if Item.IsFolder Then + Begin + ForceDirectories(FileName); + End + Else + Begin + TFS := TFileStream.Create(FileName,fmCreate or fmOpenReadWrite or fmShareDenyNone); + Try + ExtractToStream(Item,TFS); + Finally + TFS.Free; + End; + If FParent.FApplyAttributes Then + Begin + Attr := faArchive; + if Item.FCentralDirectoryFile.ExternalFileAttributes And faHidden > 0 Then Attr := Attr Or faHidden; + if Item.FCentralDirectoryFile.ExternalFileAttributes And faSysFile > 0 Then Attr := Attr Or faSysFile; + if Item.FCentralDirectoryFile.ExternalFileAttributes And faReadOnly > 0 Then Attr := Attr Or faReadOnly; + FileSetAttr(FileName,Attr); + End; + End; +end; + + +procedure TKAZipEntries.ExtractToFile(Item: TKAZipEntriesEntry; FileName: String); +var + Can : Boolean; + OA : TOverwriteAction; +Begin + OA := FParent.FOverwriteAction; + Can := True; + if ((OA<>oaOverwriteAll) And (OA<>oaSkipAll)) And (Assigned(FParent.FOnOverwriteFile)) Then + Begin + if FileExists(FileName) Then + Begin + FParent.FOnOverwriteFile(FParent,FileName,OA); + End + Else + Begin + OA := oaOverwrite; + End; + End; + Case OA Of + oaSkip : Can := False; + oaSkipAll : Can := False; + oaOverwrite : Can := True; + oaOverwriteAll : Can := True; + End; + if Can Then InternalExtractToFile(Item, FileName); +End; + +procedure TKAZipEntries.ExtractToFile(ItemIndex: Integer; FileName: String); +var + Can : Boolean; + OA : TOverwriteAction; +Begin + OA := FParent.FOverwriteAction; + Can := True; + if ((OA<>oaOverwriteAll) And (OA<>oaSkipAll)) And (Assigned(FParent.FOnOverwriteFile)) Then + Begin + if FileExists(FileName) Then + Begin + FParent.FOnOverwriteFile(FParent,FileName,OA); + End + Else + Begin + OA := oaOverwrite; + End; + End; + Case OA Of + oaSkip : Can := False; + oaSkipAll : Can := False; + oaOverwrite : Can := True; + oaOverwriteAll : Can := True; + End; + if Can Then InternalExtractToFile(Items[ItemIndex],FileName); +end; + +procedure TKAZipEntries.ExtractToFile(FileName, DestinationFileName: String); +Var + I : Integer; + Can : Boolean; + OA : TOverwriteAction; +Begin + OA := FParent.FOverwriteAction; + Can := True; + if ((OA<>oaOverwriteAll) And (OA<>oaSkipAll)) And (Assigned(FParent.FOnOverwriteFile)) Then + Begin + if FileExists(DestinationFileName) Then + Begin + FParent.FOnOverwriteFile(FParent,DestinationFileName,OA); + End + Else + Begin + OA := oaOverwrite; + End; + End; + Case OA Of + oaSkip : Can := False; + oaSkipAll : Can := False; + oaOverwrite : Can := True; + oaOverwriteAll : Can := True; + End; + if Can Then + Begin + I := IndexOf(FileName); + InternalExtractToFile(Items[I],DestinationFileName); + End; +end; + +procedure TKAZipEntries.ExtractAll(TargetDirectory: String); +Var + FN : String; + DN : String; + X : Integer; + Can : Boolean; + OA : TOverwriteAction; + FileName : String; +begin + OA := FParent.FOverwriteAction; + Can := True; + Try + For X := 0 To Count-1 do + Begin + FN := FParent.GetFileName(Items[X].FileName); + DN := FParent.GetFilePath(Items[X].FileName); + if DN <> '' Then ForceDirectories(TargetDirectory+'\'+DN); + FileName := TargetDirectory+'\'+DN+FN; + if ((OA<>oaOverwriteAll) And (OA<>oaSkipAll)) And (Assigned(FParent.FOnOverwriteFile)) Then + Begin + if FileExists(FileName) Then + Begin + FParent.FOnOverwriteFile(FParent,FileName,OA); + End; + End; + Case OA Of + oaSkip : Can := False; + oaSkipAll : Can := False; + oaOverwrite : Can := True; + oaOverwriteAll : Can := True; + End; + if Can Then InternalExtractToFile(Items[X],FileName); + End; + Finally + End; +end; + +procedure TKAZipEntries.ExtractSelected(TargetDirectory: String); +Var + FN : String; + DN : String; + X : Integer; + OA : TOverwriteAction; + Can : Boolean; + FileName : String; +begin + OA := FParent.FOverwriteAction; + Can := True; + Try + For X := 0 To Count-1 do + Begin + if Items[X].FSelected Then + Begin + FN := FParent.GetFileName(Items[X].FileName); + DN := FParent.GetFilePath(Items[X].FileName); + if DN <> '' Then ForceDirectories(TargetDirectory+'\'+DN); + FileName := TargetDirectory+'\'+DN+FN; + if ((OA<>oaOverwriteAll) And (OA<>oaSkipAll)) And (Assigned(FParent.FOnOverwriteFile)) Then + Begin + if FileExists(FileName) Then + Begin + FParent.FOnOverwriteFile(FParent,FileName,OA); + End; + End; + Case OA Of + oaSkip : Can := False; + oaSkipAll : Can := False; + oaOverwrite : Can := True; + oaOverwriteAll : Can := True; + End; + if Can Then InternalExtractToFile(Items[X],TargetDirectory+'\'+DN+FN); + End; + End; + Finally + End; +end; + + + +procedure TKAZipEntries.DeSelectAll; +Var + X : Integer; +begin + For X := 0 To Count-1 do Items[X].Selected := False; +end; + +procedure TKAZipEntries.InvertSelection; +Var + X : Integer; +begin + For X := 0 To Count-1 do Items[X].Selected := Not Items[X].Selected; +end; + +procedure TKAZipEntries.SelectAll; +Var + X : Integer; +begin + For X := 0 To Count-1 do Items[X].Selected := True; +end; + +procedure TKAZipEntries.Select(WildCard: String); +Var + X : Integer; +begin + For X := 0 To Count-1 do + Begin + if MatchesMask(ToDosName(Items[X].FileName),WildCard) Then + Items[X].Selected := True; + End; +end; + + +procedure TKAZipEntries.Rebuild; +begin + FParent.Rebuild; +end; + +procedure TKAZipEntries.Rename(Item: TKAZipEntriesEntry; NewFileName: String); +begin + Item.FileName := NewFileName; +end; + +procedure TKAZipEntries.Rename(ItemIndex: Integer; NewFileName: String); +begin + Rename(Items[ItemIndex],NewFileName); +end; + +procedure TKAZipEntries.Rename(FileName, NewFileName: String); +Var + I : Integer; +begin + I := IndexOf(FileName); + Rename(I,NewFileName); +end; + + +procedure TKAZipEntries.CreateFolder(FolderName: String; FolderDate: TDateTime); +Var + FN : String; +begin + FN := IncludeTrailingPathDelimiter(FolderName); + AddFolderChain(FN,faDirectory,FolderDate); + FParent.FIsDirty := True; +end; + +procedure TKAZipEntries.RenameFolder(FolderName : String; NewFolderName : String); +Var + FN : String; + NFN : String; + S : String; + X : Integer; + L : Integer; +begin + FN := ToZipName(IncludeTrailingPathDelimiter(FolderName)); + NFN := ToZipName(IncludeTrailingPathDelimiter(NewFolderName)); + L := Length(FN); + if IndexOf(NFN) = -1 Then + Begin + For X := 0 To Count-1 do + Begin + S := Items[X].FileName; + if Pos(FN,S) = 1 Then + Begin + System.Delete(S,1,L); + S := NFN+S; + Items[X].FileName := S; + FParent.FIsDirty := True; + End; + End; + If (FParent.FIsDirty) And (FParent.FBatchMode=False) Then Rebuild; + End; +end; + +procedure TKAZipEntries.RenameMultiple(Names : TStringList; NewNames : TStringList); +Var + X : Integer; + BR : Integer; + L : Integer; +Begin + If Names.Count <> NewNames.Count Then + Begin + Raise Exception.Create('Names and NewNames must have equal count'); + End + Else + Begin + FParent.FBatchMode := True; + Try + For X := 0 To Names.Count-1 do + Begin + L := Length(Names.Strings[X]); + if (L>0) And ((Names.Strings[X][L]='\') or (Names.Strings[X][L]='/')) Then + Begin + RenameFolder(Names.Strings[X],NewNames.Strings[X]); + Inc(BR); + End + Else + Begin + Rename(Names.Strings[X],NewNames.Strings[X]); + Inc(BR); + End; + End; + Finally + FParent.FBatchMode := False; + End; + If BR > 0 Then + Begin + Rebuild; + FParent.DoChange(FParent,6); + End; + End; +End; + + +{ TKAZip } +constructor TKAZip.Create(AOwner: TComponent); +begin + Inherited Create(AOwner); + FZipStream := Nil; + FOnDecompressFile := Nil; + FOnCompressFile := Nil; + FOnZipChange := Nil; + FOnZipOpen := Nil; + FOnAddItem := Nil; + FOnOverwriteFile := Nil; + FComponentVersion := '2.0'; + FBatchMode := False; + FFileNames := TStringList.Create; + FZipHeader := TKAZipEntries.Create(Self); + FZipComment := TStringList.Create; + FIsZipFile := False; + FFileName := ''; + FCurrentDFS := 0; + FExternalStream := False; + FIsDirty := True; + FHasBadEntries := False; + FReadOnly := False; + + FApplyAttributes := True; + FOverwriteAction := oaSkip; + FZipSaveMethod := FastSave; + FUseTempFiles := False; + FStoreRelativePath := True; + FStoreFolders := True; + FZipCompressionType := ctMaximum; +end; + + +destructor TKAZip.Destroy; +begin + if Assigned(FZipStream) AND (NOT FExternalStream) Then FZipStream.Free; + FZipHeader.Free; + FZipComment.Free; + FFileNames.Free; + inherited Destroy; +end; + +procedure TKAZip.DoChange(Sender: TObject; Const ChangeType : Integer); +begin + if Assigned(FOnZipChange) Then FOnZipChange(Self, ChangeType); +end; + + +function TKAZip.GetFileName(S: String): String; +Var + FN : String; + P : Integer; +begin + FN := S; + FN := StringReplace(FN,'//','\',[rfReplaceAll]); + FN := StringReplace(FN,'/','\',[rfReplaceAll]); + P := Pos(':\',FN); + if P > 0 Then System.Delete(FN,1,P+1); + Result := ExtractFileName(StringReplace(FN,'/','\',[rfReplaceAll])); +end; + +function TKAZip.GetFilePath(S: String): String; +Var + FN : String; + P : Integer; +begin + FN := S; + FN := StringReplace(FN,'//','\',[rfReplaceAll]); + FN := StringReplace(FN,'/','\',[rfReplaceAll]); + P := Pos(':\',FN); + if P > 0 Then System.Delete(FN,1,P+1); + Result := ExtractFilePath(StringReplace(FN,'/','\',[rfReplaceAll])); +end; + + +procedure TKAZip.LoadFromFile(FileName: String); +Var + Res : Integer; + Dir : TSearchRec; +begin + Res := FindFirst(FileName,faAnyFile,Dir); + If Res=0 Then + Begin + if Dir.Attr And faReadOnly > 0 Then + Begin + FZipStream := TFileStream.Create(FileName,fmOpenRead or fmShareDenyNone); + FReadOnly := True; + End + Else + Begin + FZipStream := TFileStream.Create(FileName,fmOpenReadWrite or fmShareDenyNone); + FReadOnly := False; + End; + {$IFDEF USE_BUFFERED_IO} + FZipStream:= TutlPagedBufferStream.Create(FZipStream, 64*1024, true); // Martok: Buffer for TOC reads + {$ENDIF} + LoadFromStream(FZipStream); + FindClose(Dir); + End + Else + Begin + Raise Exception.Create('File "'+FileName+'" not found!'); + End; +end; + +procedure TKAZip.LoadFromStream(MS : TStream); +begin + FZipStream := MS; + FZipHeader.ParseZip(MS); + FIsZipFile := FZipHeader.FIsZipFile; + if Not FIsZipFile Then Close; + FIsDirty := True; + DoChange(Self,1); +end; + +procedure TKAZip.Close; +begin + Entries.Clear; + if Assigned(FZipStream) AND (NOT FExternalStream) Then FZipStream.Free; + FExternalStream := False; + FZipStream := Nil; + FIsZipFile := False; + FIsDirty := True; + FReadOnly := False; + DoChange(Self,0); +end; + +procedure TKAZip.SetFileName(const Value: String); +begin + FFileName := Value; +end; + +procedure TKAZip.Open(FileName: String); +begin + Close; + LoadFromFile(FileName); + FFileName := FileName; +end; + +procedure TKAZip.Open(MS: TStream); +begin + Try + Close; + LoadFromStream(MS); + Finally + FExternalStream := True; + End; +end; + +procedure TKAZip.SetIsZipFile(const Value: Boolean); +begin + //**************************************************************************** +end; + +function TKAZip.GetDelphiTempFileName: String; +Var + TmpDir, TmpFn: AnsiString; +Begin + Result := GetCurrentDir; + SetLength(TmpDir, GetTempPath(0,nil)+2); + SetLength(TmpDir, GetTempPath(Length(TmpDir)-1, PAnsiChar(TmpDir))); + if TmpDir>'' then begin + SetLength(TmpFn, Length(Tmpdir)+30); + if GetTempFileName(PAnsiChar(TmpDir),'',0,PAnsiChar(TmpFN)) <> 0 Then + Result := StrPas(PAnsiChar(TmpFN)); + End; +End; + +procedure TKAZip.OnDecompress(Sender: TObject); +Var + DS : TStream; +begin + DS := TStream(Sender); + if Assigned(FOnDecompressFile) Then FOnDecompressFile(Self,DS.Position,FCurrentDFS); +end; + +procedure TKAZip.OnCompress(Sender: TObject); +Var + CS : TStream; +begin + CS := TStream(Sender); + if Assigned(FOnCompressFile) Then FOnCompressFile(Self,CS.Position,FCurrentDFS); +end; + +procedure TKAZip.ExtractToFile(Item : TKAZipEntriesEntry; FileName: String); +begin + Entries.ExtractToFile(Item,FileName); +end; + +procedure TKAZip.ExtractToFile(ItemIndex: Integer; FileName: String); +begin + Entries.ExtractToFile(ItemIndex,FileName); +end; + +procedure TKAZip.ExtractToFile(FileName, DestinationFileName: String); +begin + Entries.ExtractToFile(FileName,DestinationFileName); +end; + +procedure TKAZip.ExtractToStream(Item : TKAZipEntriesEntry; Stream: TStream); +begin + Entries.ExtractToStream(Item,Stream); +end; + +procedure TKAZip.ExtractAll(TargetDirectory: String); +begin + Entries.ExtractAll(TargetDirectory); +end; + +procedure TKAZip.ExtractSelected(TargetDirectory: String); +Begin + Entries.ExtractSelected(TargetDirectory); +End; + +function TKAZip.AddFile(FileName, NewFileName: String): TKAZipEntriesEntry; +begin + Result := Entries.AddFile(FileName, NewFileName); +end; + +function TKAZip.AddFile(FileName: String): TKAZipEntriesEntry; +begin + Result := Entries.AddFile(FileName); +end; + +function TKAZip.AddFiles(FileNames: TStrings): Boolean; +begin + Result := Entries.AddFiles(FileNames); +end; + +function TKAZip.AddFolder(FolderName, RootFolder, WildCard: String; + WithSubFolders: Boolean): Boolean; +begin + Result := Entries.AddFolder(FolderName,RootFolder,WildCard,WithSubFolders); +end; + +function TKAZip.AddFilesAndFolders(FileNames: TStrings; RootFolder: String; + WithSubFolders: Boolean): Boolean; +begin + Result := Entries.AddFilesAndFolders(FileNames,RootFolder,WithSubFolders); +end; + +function TKAZip.AddStream(FileName: String; FileAttr: Word; FileDate: TDateTime; Stream: TStream): TKAZipEntriesEntry; +begin + Result := Entries.AddStream(FileName,FileAttr,FileDate,Stream); +end; + +function TKAZip.AddStream(FileName: String; Stream: TStream): TKAZipEntriesEntry; +begin + Result := Entries.AddStream(FileName,Stream); +end; + + +procedure TKAZip.Remove(Item: TKAZipEntriesEntry); +begin + Entries.Remove(Item); +end; + +procedure TKAZip.Remove(ItemIndex: Integer); +begin + Entries.Remove(ItemIndex); +end; + +procedure TKAZip.Remove(FileName: String); +begin + Entries.Remove(FileName); +end; + +procedure TKAZip.RemoveFiles(List: TList); +begin + Entries.RemoveFiles(List); +end; + +procedure TKAZip.RemoveSelected; +begin + Entries.RemoveSelected;; +end; + +function TKAZip.GetComment: TStrings; +Var + S : String; +begin + Result := FZipComment; + FZipComment.Clear; + if FIsZipFile Then + Begin + if FEndOfCentralDir.ZipfileCommentLength > 0 Then + Begin + FZipStream.Position := FZipCommentPos; + SetLength(S,FEndOfCentralDir.ZipfileCommentLength); + FZipStream.Read(S[1],FEndOfCentralDir.ZipfileCommentLength); + FZipComment.Text := S; + End; + End; +end; + +procedure TKAZip.SetComment(const Value: TStrings); +Var + Comment : String; + L : Integer; +begin + //**************************************************************************** + if FZipComment.Text=Value.Text Then Exit; + FZipComment.Clear; + if FIsZipFile Then + Begin + FZipComment.Assign(Value); + Comment := FZipComment.Text; + L := Length(Comment); + FEndOfCentralDir.ZipfileCommentLength := L; + FZipStream.Position := FEndOfCentralDirPos; + FZipStream.Write(FEndOfCentralDir,SizeOf(TEndOfCentralDir)); + FZipCommentPos := FZipStream.Position; + if L > 0 Then + Begin + FZipStream.Write(Comment[1],L) + End + Else + Begin + FZipStream.Size := FZipStream.Position; + End; + End; +end; + +procedure TKAZip.DeSelectAll; +begin + Entries.DeSelectAll; +end; + +procedure TKAZip.Select(WildCard : String); +begin + Entries.Select(WildCard); +end; + +procedure TKAZip.InvertSelection; +begin + Entries.InvertSelection; +end; + +procedure TKAZip.SelectAll; +begin + Entries.SelectAll; +end; + +procedure TKAZip.RebuildLocalFiles(MS: TStream); +Var + X : Integer; + LF : TLocalFile; +begin + //************************************************* RESAVE ALL LOCAL BLOCKS + SetLength(NewLHOffsets,Entries.Count+1); + For X := 0 To Entries.Count-1 do + Begin + NewLHOffsets[X] := MS.Position; + LF := Entries.GetLocalEntry(FZipStream,Entries.Items[X].LocalOffset,False); + MS.Write(LF, SizeOf(LF)-3*SizeOf(String)); + if LF.FilenameLength > 0 Then MS.Write(LF.FileName[1] ,LF.FilenameLength); + if LF.ExtraFieldLength > 0 Then MS.Write(LF.ExtraField[1],LF.ExtraFieldLength); + if LF.CompressedSize > 0 Then MS.Write(LF.CompressedData[1],LF.CompressedSize); + if Assigned(FOnRebuildZip) Then FOnRebuildZip(Self,X,Entries.Count-1); + End; +end; + +procedure TKAZip.RebuildCentralDirectory(MS: TStream); +Var + X : Integer; + CDF : TCentralDirectoryFile; +begin + NewEndOfCentralDir := FEndOfCentralDir; + NewEndOfCentralDir.TotalNumberOfEntriesOnThisDisk := Entries.Count; + NewEndOfCentralDir.TotalNumberOfEntries := Entries.Count; + NewEndOfCentralDir.OffsetOfStartOfCentralDirectory := MS.Position; + For X := 0 To Entries.Count-1 do + Begin + CDF := Entries.Items[X].FCentralDirectoryFile; + CDF.RelativeOffsetOfLocalHeader := NewLHOffsets[X]; + MS.Write(CDF,SizeOf(CDF)-3*SizeOf(String)); + if CDF.FilenameLength > 0 Then + MS.Write(CDF.FileName[1],CDF.FilenameLength); + if CDF.ExtraFieldLength > 0 Then + MS.Write(CDF.ExtraField[1],CDF.ExtraFieldLength); + if CDF.FileCommentLength > 0 Then + MS.Write(CDF.FileComment[1],CDF.FileCommentLength); + if Assigned(FOnRebuildZip) Then FOnRebuildZip(Self,X,Entries.Count-1); + End; + NewEndOfCentralDir.SizeOfTheCentralDirectory := MS.Position-NewEndOfCentralDir.OffsetOfStartOfCentralDirectory; +end; + +procedure TKAZip.RebuildEndOfCentralDirectory(MS: TStream); +Var + ZipComment : String; +begin + ZipComment := Comment.Text; + FRebuildECDP := MS.Position; + MS.Write(NewEndOfCentralDir,SizeOf(NewEndOfCentralDir)); + FRebuildCP := MS.Position; + if NewEndOfCentralDir.ZipfileCommentLength > 0 Then + Begin + MS.Write(ZipComment[1],NewEndOfCentralDir.ZipfileCommentLength); + End; + if Assigned(FOnRebuildZip) Then FOnRebuildZip(Self,100,100); +end; + +Procedure TKAZip.FixZip(MS : TStream); +Var + X : Integer; + Y : Integer; + NewCount : Integer; + LF : TLocalFile; + CDF : TCentralDirectoryFile; + ZipComment : String; +Begin + ZipComment := Comment.Text; + Y := 0; + SetLength(NewLHOffsets,Entries.Count+1); + For X := 0 To Entries.Count-1 do + Begin + LF := Entries.GetLocalEntry(FZipStream,Entries.Items[X].LocalOffset,False); + if (LF.LocalFileHeaderSignature=$04034b50) And (Entries.Items[X].Test) Then + Begin + NewLHOffsets[Y] := MS.Position; + MS.Write(LF, SizeOf(LF)-3*SizeOf(String)); + if LF.FilenameLength > 0 Then MS.Write(LF.FileName[1] ,LF.FilenameLength); + if LF.ExtraFieldLength > 0 Then MS.Write(LF.ExtraField[1],LF.ExtraFieldLength); + if LF.CompressedSize > 0 Then MS.Write(LF.CompressedData[1],LF.CompressedSize); + if Assigned(FOnRebuildZip) Then FOnRebuildZip(Self,X,Entries.Count-1); + Inc(Y); + End + Else + Begin + Entries.Items[X].FCentralDirectoryFile.CentralFileHeaderSignature := 0; + if Assigned(FOnRebuildZip) Then FOnRebuildZip(Self,X,Entries.Count-1); + End; + End; + + NewCount := Y; + Y := 0; + NewEndOfCentralDir := FEndOfCentralDir; + NewEndOfCentralDir.TotalNumberOfEntriesOnThisDisk := NewCount; + NewEndOfCentralDir.TotalNumberOfEntries := NewCount; + NewEndOfCentralDir.OffsetOfStartOfCentralDirectory := MS.Position; + For X := 0 To Entries.Count-1 do + Begin + CDF := Entries.Items[X].FCentralDirectoryFile; + if CDF.CentralFileHeaderSignature=$02014b50 Then + Begin + CDF.RelativeOffsetOfLocalHeader := NewLHOffsets[Y]; + MS.Write(CDF,SizeOf(CDF)-3*SizeOf(String)); + if CDF.FilenameLength > 0 Then + MS.Write(CDF.FileName[1],CDF.FilenameLength); + if CDF.ExtraFieldLength > 0 Then + MS.Write(CDF.ExtraField[1],CDF.ExtraFieldLength); + if CDF.FileCommentLength > 0 Then + MS.Write(CDF.FileComment[1],CDF.FileCommentLength); + if Assigned(FOnRebuildZip) Then FOnRebuildZip(Self,X,Entries.Count-1); + Inc(Y); + End; + End; + NewEndOfCentralDir.SizeOfTheCentralDirectory := MS.Position-NewEndOfCentralDir.OffsetOfStartOfCentralDirectory; + + FRebuildECDP := MS.Position; + MS.Write(NewEndOfCentralDir,SizeOf(NewEndOfCentralDir)); + FRebuildCP := MS.Position; + if NewEndOfCentralDir.ZipfileCommentLength > 0 Then + Begin + MS.Write(ZipComment[1],NewEndOfCentralDir.ZipfileCommentLength); + End; + if Assigned(FOnRebuildZip) Then FOnRebuildZip(Self,100,100); +End; + + +Procedure TKAZip.SaveToStream(Stream:TStream); +Begin + RebuildLocalFiles(Stream); + RebuildCentralDirectory(Stream); + RebuildEndOfCentralDirectory(Stream); +End; + +Procedure TKAZip.Rebuild; +var + TempStream : TFileStream; + TempMSStream : TMemoryStream; + TempFileName : String; +Begin + if FUseTempFiles Then + Begin + TempFileName := GetDelphiTempFileName; + TempStream := TFileStream.Create(TempFileName,fmOpenReadWrite or FmCreate); + Try + SaveToStream(TempStream); + FZipStream.Position := 0; + FZipStream.Size := 0; + TempStream.Position := 0; + FZipStream.CopyFrom(TempStream,TempStream.Size); + Entries.ParseZip(FZipStream); + Finally + TempStream.Free; + DeleteFile(TempFileName) + End; + End + Else + Begin + TempMSStream := TMemoryStream.Create; + Try + SaveToStream(TempMSStream); + FZipStream.Position := 0; + FZipStream.Size := 0; + TempMSStream.Position := 0; + FZipStream.CopyFrom(TempMSStream,TempMSStream.Size); + Entries.ParseZip(FZipStream); + Finally + TempMSStream.Free; + End; + End; + FIsDirty := True; +End; + +Procedure TKAZip.CreateZip(Stream:TStream); +Var + ECD : TEndOfCentralDir; +Begin + ECD.EndOfCentralDirSignature := $06054b50; + ECD.NumberOfThisDisk := 0; + ECD.NumberOfTheDiskWithTheStart := 0; + ECD.TotalNumberOfEntriesOnThisDisk := 0; + ECD.TotalNumberOfEntries := 0; + ECD.SizeOfTheCentralDirectory := 0; + ECD.OffsetOfStartOfCentralDirectory := 0; + ECD.ZipfileCommentLength := 0; + Stream.Write(ECD,SizeOf(ECD)); +End; + + +Procedure TKAZip.CreateZip(FileName:String); +var + FS : TFileStream; +Begin + FS := TFileStream.Create(FileName,fmOpenReadWrite or FmCreate); + Try + CreateZip(FS); + Finally + FS.Free; + End; +End; + +procedure TKAZip.SetZipSaveMethod(const Value: TZipSaveMethod); +begin + FZipSaveMethod := Value; +end; + +procedure TKAZip.SetActive(const Value: Boolean); +begin + if FFileName='' Then Exit; + if Value Then Open(FFileName) Else Close; +end; + +procedure TKAZip.SetZipCompressionType(const Value: TZipCompressionType); +begin + FZipCompressionType := Value; + if FZipCompressionType = ctUnknown Then FZipCompressionType := ctNormal; +end; + +function TKAZip.GetFileNames: TStrings; +Var + X : Integer; +begin + if FIsDirty Then + Begin + FFileNames.Clear; + For X := 0 To Entries.Count-1 do + Begin + FFileNames.Add(GetFilePath(Entries.Items[X].FileName)+GetFileName(Entries.Items[X].FileName)); + End; + FIsDirty := False; + End; + Result := FFileNames; +end; + +procedure TKAZip.SetFileNames(const Value: TStrings); +begin + //*************************************************** READ ONLY +end; + + +procedure TKAZip.SetUseTempFiles(const Value: Boolean); +begin + FUseTempFiles := Value; +end; + +procedure TKAZip.Rename(Item: TKAZipEntriesEntry; NewFileName: String); +begin + Entries.Rename(Item,NewFileName); +end; + +procedure TKAZip.Rename(ItemIndex: Integer; NewFileName: String); +begin + Entries.Rename(ItemIndex,NewFileName); +end; + +procedure TKAZip.Rename(FileName, NewFileName: String); +begin + Entries.Rename(FileName, NewFileName); +end; + +procedure TKAZip.RenameMultiple(Names, NewNames: TStringList); +begin + Entries.RenameMultiple(Names, NewNames); +end; + + +procedure TKAZip.SetStoreFolders(const Value: Boolean); +begin + FStoreFolders := Value; +end; + +procedure TKAZip.SetOnAddItem(const Value: TOnAddItem); +begin + FOnAddItem := Value; +end; + +procedure TKAZip.SetComponentVersion(const Value: String); +begin + //**************************************************************************** +end; + +procedure TKAZip.SetOnRebuildZip(const Value: TOnRebuildZip); +begin + FOnRebuildZip := Value; +end; + +procedure TKAZip.SetOnRemoveItems(const Value: TOnRemoveItems); +begin + FOnRemoveItems := Value; +end; + +procedure TKAZip.SetOverwriteAction(const Value: TOverwriteAction); +begin + FOverwriteAction := Value; +end; + +procedure TKAZip.SetOnOverwriteFile(const Value: TOnOverwriteFile); +begin + FOnOverwriteFile := Value; +end; + +procedure TKAZip.CreateFolder(FolderName: String; FolderDate: TDateTime); +begin + Entries.CreateFolder(FolderName,FolderDate); +end; + +procedure TKAZip.RenameFolder(FolderName : String; NewFolderName : String); +begin + Entries.RenameFolder(FolderName,NewFolderName); +end; + +procedure TKAZip.SetReadOnly(const Value: Boolean); +begin + FReadOnly := Value; +end; + +procedure TKAZip.SetApplyAtributes(const Value: Boolean); +begin + FApplyAttributes := Value; +end; + + +end. + diff --git a/KAZip/dzlib.pas b/KAZip/dzlib.pas new file mode 100644 index 0000000..bfd10d1 --- /dev/null +++ b/KAZip/dzlib.pas @@ -0,0 +1,461 @@ +{*******************************************************} +{ } +{ Delphi Supplemental Components } +{ ZLIB Data Compression Interface Unit } +{ } +{ Copyright (c) 1997 Borland International } +{ Copyright (c) 1998 Jacques Nomssi Nzali } +{ Copyright (c) 2006 Graeme Geldenhuys } +{ } +{*******************************************************} + +unit dzlib; + +{$WARNINGS OFF} +{$HINTS OFF} + +{$MODE OBJFPC}{$H+} + +{ At least FPC 2.0.2 is required } +{$if defined(ver1) or (defined(ver2_0) and (fpc_patch<2))} + {$fatal Lazarus requires at least FPC 2.0.2} +{$ELSEIF (defined(ver2_0) and (fpc_patch=2))} + {$DEFINE FPC202} +{$ELSE} + {$DEFINE FPC202OrAbove} +{$ENDIF} + + +interface +uses + zbase, Sysutils, Classes; + + +type + { Internal structure. Ignore. } + TZStreamRec = z_stream; + + +const + FBufSize = 8192; +type + { Abstract ancestor class } + TCustomZlibStream = class(TStream) + private + FStrm: TStream; + FStrmPos: Integer; + FOnProgress: TNotifyEvent; + FZRec: TZStreamRec; + FBuffer: array [0..FBufSize-1] of Char; + protected + procedure Progress(Sender: TObject); dynamic; + property OnProgress: TNotifyEvent read FOnProgress write FOnProgress; + constructor Create(Strm: TStream); + end; + +{ TCompressionStream compresses data on the fly as data is written to it, and + stores the compressed data to another stream. + + TCompressionStream is write-only and strictly sequential. Reading from the + stream will raise an exception. Using Seek to move the stream pointer + will raise an exception. + + Output data is cached internally, written to the output stream only when + the internal output buffer is full. All pending output data is flushed + when the stream is destroyed. + + The Position property returns the number of uncompressed bytes of + data that have been written to the stream so far. + + CompressionRate returns the on-the-fly percentage by which the original + data has been compressed: (1 - (CompressedBytes / UncompressedBytes)) * 100 + If raw data size = 100 and compressed data size = 25, the CompressionRate + is 75% + + The OnProgress event is called each time the output buffer is filled and + written to the output stream. This is useful for updating a progress + indicator when you are writing a large chunk of data to the compression + stream in a single call.} + + + TCompressionLevel = (clNone, clFastest, clDefault, clMax); + + TCompressionStream = class(TCustomZlibStream) + private + function GetCompressionRate: Single; + public + constructor Create(CompressionLevel: TCompressionLevel; Dest: TStream); + destructor Destroy; override; + function Read(var Buffer; Count: Longint): Longint; override; + function Write(const Buffer; Count: Longint): Longint; override; + function Seek(Offset: Longint; Origin: Word): Longint; override; + property CompressionRate: Single read GetCompressionRate; + property OnProgress; + end; + +{ TDecompressionStream decompresses data on the fly as data is read from it. + + Compressed data comes from a separate source stream. TDecompressionStream + is read-only and unidirectional; you can seek forward in the stream, but not + backwards. The special case of setting the stream position to zero is + allowed. Seeking forward decompresses data until the requested position in + the uncompressed data has been reached. Seeking backwards, seeking relative + to the end of the stream, requesting the size of the stream, and writing to + the stream will raise an exception. + + The Position property returns the number of bytes of uncompressed data that + have been read from the stream so far. + + The OnProgress event is called each time the internal input buffer of + compressed data is exhausted and the next block is read from the input stream. + This is useful for updating a progress indicator when you are reading a + large chunk of data from the decompression stream in a single call.} + + TDecompressionStream = class(TCustomZlibStream) + public + constructor Create(Source: TStream); + destructor Destroy; override; + function Read(var Buffer; Count: Longint): Longint; override; + function Write(const Buffer; Count: Longint): Longint; override; + function Seek(Offset: Longint; Origin: Word): Longint; override; + property OnProgress; + end; + + +{ CompressBuf compresses data, buffer to buffer, in one call. + In: InBuf = ptr to compressed data + InBytes = number of bytes in InBuf + Out: OutBuf = ptr to newly allocated buffer containing decompressed data + OutBytes = number of bytes in OutBuf } +procedure CompressBuf(const InBuf: Pointer; InBytes: Integer; + out OutBuf: Pointer; out OutBytes: Integer); + + +{ DecompressBuf decompresses data, buffer to buffer, in one call. + In: InBuf = ptr to compressed data + InBytes = number of bytes in InBuf + OutEstimate = zero, or est. size of the decompressed data + Out: OutBuf = ptr to newly allocated buffer containing decompressed data + OutBytes = number of bytes in OutBuf } +procedure DecompressBuf(const InBuf: Pointer; InBytes: Integer; + OutEstimate: Integer; out OutBuf: Pointer; out OutBytes: Integer); + + +type + EZlibError = class(Exception); + ECompressionError = class(EZlibError); + EDecompressionError = class(EZlibError); + + +implementation +uses + {$ifdef fpc202} + zutil, + {$endif} + zDeflate, zInflate; + + +function zlibAllocMem(AppData: Pointer; Items, Size: Cardinal): Pointer; +begin + GetMem(Result, Items*Size); +end; + + +procedure zlibFreeMem(AppData, Block: Pointer); +begin + FreeMem(Block); +end; + + +function zlibCheck(code: Integer): Integer; +begin + Result := code; + if code < 0 then + raise EZlibError.Create('error'); {!!} +end; + + +function CCheck(code: Integer): Integer; +begin + Result := code; + if code < 0 then + raise ECompressionError.Create('error'); {!!} +end; + + +function DCheck(code: Integer): Integer; +begin + Result := code; + if code < 0 then + raise EDecompressionError.Create('error'); {!!} +end; + + +procedure CompressBuf(const InBuf: Pointer; InBytes: Integer; + out OutBuf: Pointer; out OutBytes: Integer); +var + strm: TZStreamRec; + P: Pointer; +begin + FillChar(strm, sizeof(strm), 0); + {$ifdef fpc202} + strm.zalloc := @zlibAllocMem; + strm.zfree := @zlibFreeMem; + {$endif} + OutBytes := ((InBytes + (InBytes div 10) + 12) + 255) and not 255; + GetMem(OutBuf, OutBytes); + try + strm.next_in := InBuf; + strm.avail_in := InBytes; + strm.next_out := OutBuf; + strm.avail_out := OutBytes; + CCheck(deflateInit_(@strm, Z_BEST_COMPRESSION, zlib_version, sizeof(strm))); + try + while deflate(strm, Z_FINISH) <> Z_STREAM_END do + begin + P := OutBuf; + Inc(OutBytes, 256); + ReallocMem(OutBuf, OutBytes); + strm.next_out := {$ifdef fpc202}PBytef{$else}PByte{$endif}(Integer(OutBuf) + (Integer(strm.next_out) - Integer(P))); + strm.avail_out := 256; + end; + finally + CCheck(deflateEnd(strm)); + end; + ReallocMem(OutBuf, strm.total_out); + OutBytes := strm.total_out; + except + zlibFreeMem(NIL, OutBuf); + raise + end; +end; + + +procedure DecompressBuf(const InBuf: Pointer; InBytes: Integer; + OutEstimate: Integer; out OutBuf: Pointer; out OutBytes: Integer); +var + strm: TZStreamRec; + P: Pointer; + BufInc: Integer; +begin + FillChar(strm, sizeof(strm), 0); + {$ifdef fpc202} + strm.zalloc := @zlibAllocMem; + strm.zfree := @zlibFreeMem; + {$endif} + BufInc := (InBytes + 255) and not 255; + if OutEstimate = 0 then + OutBytes := BufInc + else + OutBytes := OutEstimate; + GetMem(OutBuf, OutBytes); + try + strm.next_in := InBuf; + strm.avail_in := InBytes; + strm.next_out := OutBuf; + strm.avail_out := OutBytes; + DCheck(inflateInit_(@strm, zlib_version, sizeof(strm))); + try + while inflate(strm, Z_FINISH) <> Z_STREAM_END do + begin + P := OutBuf; + Inc(OutBytes, BufInc); + ReallocMem(OutBuf, OutBytes); + strm.next_out := {$ifdef fpc202}pBytef{$else}PByte{$endif}(Integer(OutBuf) + (Integer(strm.next_out) - Integer(P))); + strm.avail_out := BufInc; + end; + finally + DCheck(inflateEnd(strm)); + end; + ReallocMem(OutBuf, strm.total_out); + OutBytes := strm.total_out; + except + zlibFreeMem(NIL, OutBuf); + raise + end; +end; + + +{ TCustomZlibStream } + +constructor TCustomZLibStream.Create(Strm: TStream); +begin + inherited Create; + FStrm := Strm; + FStrmPos := Strm.Position; + {$ifdef fpc202} + FZRec.zalloc := @zlibAllocMem; + FZRec.zfree := @zlibFreeMem; + {$endif} +end; + + +procedure TCustomZLibStream.Progress(Sender: TObject); +begin + if Assigned(FOnProgress) then FOnProgress(Sender); +end; + + +{ TCompressionStream } + +constructor TCompressionStream.Create(CompressionLevel: TCompressionLevel; + Dest: TStream); +const + Levels: array [TCompressionLevel] of ShortInt = + (Z_NO_COMPRESSION, Z_BEST_SPEED, Z_DEFAULT_COMPRESSION, Z_BEST_COMPRESSION); +begin + inherited Create(Dest); + FZRec.next_out := PByte(@FBuffer); + FZRec.avail_out := sizeof(FBuffer); + CCheck(deflateInit_(@FZRec, Levels[CompressionLevel], zlib_version, sizeof(FZRec))); +end; + + +destructor TCompressionStream.Destroy; +begin + FZRec.next_in := nil; + FZRec.avail_in := 0; + try + if FStrm.Position <> FStrmPos then FStrm.Position := FStrmPos; + while (CCheck(deflate(FZRec, Z_FINISH)) <> Z_STREAM_END) + and (FZRec.avail_out = 0) do + begin + FStrm.WriteBuffer(FBuffer, sizeof(FBuffer)); + FZRec.next_out := PByte(@FBuffer); + FZRec.avail_out := sizeof(FBuffer); + end; + if FZRec.avail_out < sizeof(FBuffer) then + FStrm.WriteBuffer(FBuffer, sizeof(FBuffer) - FZRec.avail_out); + finally + deflateEnd(FZRec); + end; + inherited Destroy; +end; + + +function TCompressionStream.Read(var Buffer; Count: Longint): Longint; +begin + raise ECompressionError.Create('Invalid stream operation'); +end; + + +function TCompressionStream.Write(const Buffer; Count: Longint): Longint; +begin + FZRec.next_in := @Buffer; + FZRec.avail_in := Count; + if FStrm.Position <> FStrmPos then FStrm.Position := FStrmPos; + while (FZRec.avail_in > 0) do + begin + CCheck(deflate(FZRec, 0)); + if FZRec.avail_out = 0 then + begin + FStrm.WriteBuffer(FBuffer, sizeof(FBuffer)); + FZRec.next_out := PByte(@FBuffer); + FZRec.avail_out := sizeof(FBuffer); + FStrmPos := FStrm.Position; + Progress(Self); + end; + end; + Result := Count; +end; + + +function TCompressionStream.Seek(Offset: Longint; Origin: Word): Longint; +begin + if (Offset = 0) and (Origin = soFromCurrent) then + Result := FZRec.total_in + else + raise ECompressionError.Create('Invalid stream operation'); +end; + + +function TCompressionStream.GetCompressionRate: Single; +begin + if FZRec.total_in = 0 then + Result := 0 + else + Result := (1.0 - (FZRec.total_out / FZRec.total_in)) * 100.0; +end; + + +{ TDecompressionStream } + +constructor TDecompressionStream.Create(Source: TStream); +begin + inherited Create(Source); + FZRec.next_in := PByte(@FBuffer); + FZRec.avail_in := 0; + DCheck(inflateInit_(@FZRec, zlib_version, sizeof(FZRec))); +end; + + +destructor TDecompressionStream.Destroy; +begin + inflateEnd(FZRec); + inherited Destroy; +end; + + +function TDecompressionStream.Read(var Buffer; Count: Longint): Longint; +begin + FZRec.next_out := @Buffer; + FZRec.avail_out := Count; + if FStrm.Position <> FStrmPos then FStrm.Position := FStrmPos; + while (FZRec.avail_out > 0) do + begin + if FZRec.avail_in = 0 then + begin + FZRec.avail_in := FStrm.Read(FBuffer, sizeof(FBuffer)); + if FZRec.avail_in = 0 then + begin + Result := Count - FZRec.avail_out; + Exit; + end; + FZRec.next_in := PByte(@FBuffer); + FStrmPos := FStrm.Position; + Progress(Self); + end; + CCheck(inflate(FZRec, 0)); + end; + Result := Count; +end; + + +function TDecompressionStream.Write(const Buffer; Count: Longint): Longint; +begin + raise EDecompressionError.Create('Invalid stream operation'); +end; + + +function TDecompressionStream.Seek(Offset: Longint; Origin: Word): Longint; +var + I: Integer; + Buf: array [0..4095] of Char; +begin + if (Offset = 0) and (Origin = soFromBeginning) then + begin + DCheck(inflateReset(FZRec)); + FZRec.next_in := PByte(@FBuffer); + FZRec.avail_in := 0; + FStrm.Position := 0; + FStrmPos := 0; + end + else if ((Offset >= 0) and (Origin = soFromCurrent)) or + (((Offset - FZRec.total_out) > 0) and (Origin = soFromBeginning)) then + begin + if Origin = soFromBeginning then Dec(Offset, FZRec.total_out); + if Offset > 0 then + begin + for I := 1 to Offset div sizeof(Buf) do + ReadBuffer(Buf, sizeof(Buf)); + ReadBuffer(Buf, Offset mod sizeof(Buf)); + end; + end + else + raise EDecompressionError.Create('Invalid stream operation'); + Result := FZRec.total_out; +end; + + +end. + diff --git a/bitSpaceVFS.lpk b/bitSpaceVFS.lpk new file mode 100644 index 0000000..7cc2d5f --- /dev/null +++ b/bitSpaceVFS.lpk @@ -0,0 +1,64 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/bitSpaceVFS.pas b/bitSpaceVFS.pas new file mode 100644 index 0000000..fb397f4 --- /dev/null +++ b/bitSpaceVFS.pas @@ -0,0 +1,22 @@ +{ This file was automatically created by Lazarus. Do not edit! + This source is only used to compile and install the package. + } + +unit bitSpaceVFS; + +{$warn 5023 off : no warning about unused units} +interface + +uses + uvfsFolder, uvfsManager, uvfsSpecialFolder, uvfsTarArchive, uvfsUtils, uvfsZipArchive, dzlib, KAZip, + LazarusPackageIntf; + +implementation + +procedure Register; +begin +end; + +initialization + RegisterPackage('bitSpaceVFS', @Register); +end. diff --git a/uvfsTarArchive.pas b/uvfsTarArchive.pas index 805059f..87ad88c 100644 --- a/uvfsTarArchive.pas +++ b/uvfsTarArchive.pas @@ -7,7 +7,7 @@ interface uses Classes, SysUtils, libtar, syncobjs, - uvfsManager, uutlExceptions; + uvfsManager; type //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// @@ -132,7 +132,7 @@ begin Stream := TvfsStreamHandleRead.Create(ms); end; else - raise ENotSupported.Create('tar archive only supports read operations'); + raise ENotSupportedException.Create('tar archive only supports read operations'); end; result := Assigned(Stream); @@ -193,7 +193,7 @@ var begin fFileSpec := FileSpec; if not FileExists(fFileSpec) then - EFileNotFound.Create(fFileSpec); + EFileNotFoundException.Create(fFileSpec); fs := TFileStream.Create(fFileSpec, fmOpenRead); Create(fs, true); end; diff --git a/uvfsUtils.pas b/uvfsUtils.pas index fd773a0..0f38acc 100644 --- a/uvfsUtils.pas +++ b/uvfsUtils.pas @@ -5,9 +5,9 @@ unit uvfsUtils; interface uses - Classes, SysUtils, - uutlSerialization; + Classes, SysUtils; +{ type //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// TvfsFileWriter = class(TInterfacedObject, IutlFileWriter) @@ -19,12 +19,12 @@ type public function LoadStream(const aFilename: String; const aStream: TStream): Boolean; end; - + } implementation uses uvfsManager; - + { //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TvfsFileReader//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// @@ -48,6 +48,6 @@ begin raise EvfsError.Create('unable to create file: ' + aFilename); s.GetStream.CopyFrom(aStream, aStream.Size - aStream.Position); end; - + } end.