WebSVN – decoder – Blame – /trunk/VCL_KAZIP/Kopie von KAZip.pas

Rev	Author	Line No.	Line
2	daniel-mar	1	unit KAZip;
		2
		3	// Ver�ndert f�r (De)Coder 4.x
		4	// Ver�nderungen gekennzeichnet mit "Marschall"
		5	// Keine Compilerwarnungen mehr...
		6
		7	// Schutz von freiem Speicherplatz
		8	// Gekennzeichnet mit "Sicherheitsbestimmung"
		9
		10	// Marschall
		11	{$WARN SYMBOL_PLATFORM OFF}
		12
		13	interface
		14	{$DEFINE USE_BZIP2}
		15	uses
		16	Windows,
		17	SysUtils,
		18	Classes,
		19	Masks,
		20	TypInfo,
		21	{$IFDEF USE_BZIP2}
		22	BZip2,
		23	{$ENDIF}
		24	ZLib,
		25	// Sicherheitsbestimmung
		26	decutil;
		27
		28	type
		29	TKAZipEntries = class;
		30	TKAZip = class;
		31	TBytes = Array of Byte;
		32	TZipSaveMethod = (FastSave, RebuildAll);
		33	TZipCompressionType = (ctNormal, ctMaximum, ctFast, ctSuperFast, ctNone, ctUnknown);
		34	TZipCompressionMethod = (cmStored, cmShrunk, cmReduced1, cmReduced2, cmReduced3, cmReduced4, cmImploded, cmTokenizingReserved, cmDeflated, cmDeflated64, cmDCLImploding, cmPKWAREReserved);
		35	TOverwriteAction = (oaSkip,oaSkipAll,oaOverwrite,oaOverwriteAll);
		36
		37	TOnDecompressFile=Procedure(Sender:TObject; Current, Total : Integer) of Object;
		38	TOnCompressFile=Procedure(Sender:TObject; Current, Total : Integer) of Object;
		39	TOnZipOpen=Procedure(Sender:TObject; Current, Total : Integer) of Object;
		40	TOnZipChange=Procedure(Sender:TObject; ChangeType : Integer) of Object;
		41	TOnAddItem=Procedure(Sender:TObject; ItemName : String) of Object;
		42	TOnRebuildZip=Procedure(Sender:TObject; Current, Total : Integer) of Object;
		43	TOnRemoveItems=Procedure(Sender:TObject; Current, Total : Integer) of Object;
		44	TOnOverwriteFile=Procedure(Sender:TObject; Var FileName : String; Var Action : TOverwriteAction) of Object;
		45
		46	{
		47
		48	1 - The file is Shrunk
		49	2 - The file is Reduced with compression factor 1
		50	3 - The file is Reduced with compression factor 2
		51	4 - The file is Reduced with compression factor 3
		52	5 - The file is Reduced with compression factor 4
		53	6 - The file is Imploded
		54	7 - Reserved for Tokenizing compression algorithm
		55	8 - The file is Deflated
		56	9 - Enhanced Deflating using Deflate64(tm)
		57	10 - PKWARE Data Compression Library Imploding
		58	11 - Reserved by PKWARE
		59	12 - File is compressed using BZIP2 algorithm
		60	}
		61
		62	{DoChange Events
		63
		64	1 - Zip is Opened;
		65	2 - Item is added to the zip
		66	3 - Item is removed from the Zip
		67	4 - Item comment changed
		68	5 - Item name changed
		69	6 - Item name changed
		70	}
		71
		72	TZLibStreamHeader = packed record
		73	CMF : Byte;
		74	FLG : Byte;
		75	end;
		76
		77	TLocalFile = packed record
		78	LocalFileHeaderSignature : Cardinal; // 4 bytes (0x04034b50)
		79	VersionNeededToExtract : WORD; // 2 bytes
		80	GeneralPurposeBitFlag : WORD; // 2 bytes
		81	CompressionMethod : WORD; // 2 bytes
		82	LastModFileTimeDate : Cardinal; // 4 bytes
		83	Crc32 : Cardinal; // 4 bytes
		84	CompressedSize : Cardinal; // 4 bytes
		85	UncompressedSize : Cardinal; // 4 bytes
		86	FilenameLength : WORD; // 2 bytes
		87	ExtraFieldLength : WORD; // 2 bytes
		88	FileName : AnsiString; // variable size
		89	ExtraField : AnsiString; // variable size
		90	CompressedData : AnsiString; // variable size
		91	end;
		92
		93	TDataDescriptor = packed record
		94	DescriptorSignature : Cardinal; // 4 bytes UNDOCUMENTED
		95	Crc32 : Cardinal; // 4 bytes
		96	CompressedSize : Cardinal; // 4 bytes
		97	UncompressedSize : Cardinal; // 4 bytes
		98	End;
		99
		100	TCentralDirectoryFile = packed record
		101	CentralFileHeaderSignature : Cardinal; // 4 bytes (0x02014b50)
		102	VersionMadeBy : WORD; // 2 bytes
		103	VersionNeededToExtract : WORD; // 2 bytes
		104	GeneralPurposeBitFlag : WORD; // 2 bytes
		105	CompressionMethod : WORD; // 2 bytes
		106	LastModFileTimeDate : Cardinal; // 4 bytes
		107	Crc32 : Cardinal; // 4 bytes
		108	CompressedSize : Cardinal; // 4 bytes
		109	UncompressedSize : Cardinal; // 4 bytes
		110	FilenameLength : WORD; // 2 bytes
		111	ExtraFieldLength : WORD; // 2 bytes
		112	FileCommentLength : WORD; // 2 bytes
		113	DiskNumberStart : WORD; // 2 bytes
		114	InternalFileAttributes : WORD; // 2 bytes
		115	ExternalFileAttributes : Cardinal; // 4 bytes
		116	RelativeOffsetOfLocalHeader : Cardinal; // 4 bytes
		117	FileName : AnsiString; // variable size
		118	ExtraField : AnsiString; // variable size
		119	FileComment : AnsiString; // variable size
		120	end;
		121
		122	TEndOfCentralDir = packed record
		123	EndOfCentralDirSignature : Cardinal; // 4 bytes (0x06054b50)
		124	NumberOfThisDisk : WORD; // 2 bytes
		125	NumberOfTheDiskWithTheStart : WORD; // 2 bytes
		126	TotalNumberOfEntriesOnThisDisk : WORD; // 2 bytes
		127	TotalNumberOfEntries : WORD; // 2 bytes
		128	SizeOfTheCentralDirectory : Cardinal; // 4 bytes
		129	OffsetOfStartOfCentralDirectory : Cardinal; // 4 bytes
		130	ZipfileCommentLength : WORD; // 2 bytes
		131	end;
		132
		133
		134
		135	TKAZipEntriesEntry = Class(TCollectionItem)
		136	private
		137	{ Private declarations }
		138	FParent : TKAZipEntries;
		139	FCentralDirectoryFile : TCentralDirectoryFile;
		140	FLocalFile : TLocalFile;
		141	FIsEncrypted : Boolean;
		142	FIsFolder : Boolean;
		143	FDate : TDateTime;
		144	FCompressionType : TZipCompressionType;
		145	FSelected : Boolean;
		146
		147	procedure SetSelected(const Value: Boolean);
		148	function GetLocalEntrySize: Cardinal;
		149	function GetCentralEntrySize: Cardinal;
		150	procedure SetComment(const Value: String);
		151	procedure SetFileName(const Value: String);
		152	protected
		153	{ Protected declarations }
		154	public
		155	{ Public declarations }
		156	constructor Create(Collection: TCollection); override;
		157	destructor Destroy; override;
		158	Function GetCompressedData : String;Overload;
		159	Function GetCompressedData(Stream : TStream) : Integer;Overload;
		160	procedure ExtractToFile(FileName: String);
		161	procedure ExtractToStream(Stream: TStream);
		162	procedure SaveToFile(FileName: String);
		163	procedure SaveToStream(Stream: TStream);
		164	Function Test:Boolean;
		165
		166	Property FileName : String Read FCentralDirectoryFile.FileName Write SetFileName;
		167	Property Comment : String Read FCentralDirectoryFile.FileComment Write SetComment;
		168	Property SizeUncompressed : Cardinal Read FCentralDirectoryFile.UncompressedSize;
		169	Property SizeCompressed : Cardinal Read FCentralDirectoryFile.CompressedSize;
		170	Property Date : TDateTime Read FDate;
		171	Property CRC32 : Cardinal Read FCentralDirectoryFile.CRC32;
		172	Property Attributes : Cardinal Read FCentralDirectoryFile.ExternalFileAttributes;
		173	Property LocalOffset : Cardinal Read FCentralDirectoryFile.RelativeOffsetOfLocalHeader;
		174	Property IsEncrypted : Boolean Read FIsEncrypted;
		175	Property IsFolder : Boolean Read FIsFolder;
		176	Property BitFlag : Word Read FCentralDirectoryFile.GeneralPurposeBitFlag;
		177	Property CompressionMethod : Word Read FCentralDirectoryFile.CompressionMethod;
		178	Property CompressionType : TZipCompressionType Read FCompressionType;
		179	Property LocalEntrySize : Cardinal Read GetLocalEntrySize;
		180	Property CentralEntrySize : Cardinal Read GetCentralEntrySize;
		181	Property Selected : Boolean Read FSelected Write SetSelected;
		182	End;
		183
		184	TKAZipEntries = class(TCollection)
		185	private
		186	{ Private declarations }
		187	FParent : TKAZip;
		188	FIsZipFile : Boolean;
		189	FLocalHeaderNumFiles : Integer;
		190
		191	function GetHeaderEntry(Index: Integer): TKAZipEntriesEntry;
		192	procedure SetHeaderEntry(Index: Integer; const Value: TKAZipEntriesEntry);
		193	protected
		194	{ Protected declarations }
		195	Function ReadBA(MS: TStream;Sz,Poz:Integer): TBytes;
		196	function Adler32(adler : uLong; buf : pByte; len : uInt) : uLong;
		197	function CalcCRC32(const UncompressedData : string): Cardinal;
		198	function CalculateCRCFromStream(Stream: TStream): Cardinal;
		199	Function RemoveRootName(Const FileName, RootName : String):String;
		200	Procedure SortList(List : TList);
		201	function FileTime2DateTime(FileTime: TFileTime): TDateTime;
		202	//**************************************************************************
		203	Function FindCentralDirectory(MS:TStream):Boolean;
		204	function ParseCentralHeaders(MS: TStream): Boolean;
		205	function GetLocalEntry(MS: TStream; Offset : Integer; HeaderOnly : Boolean): TLocalFile;
		206	Procedure LoadLocalHeaders(MS: TStream);
		207	Function ParseLocalHeaders(MS:TStream):Boolean;
		208
		209	//**************************************************************************
		210	procedure Remove(ItemIndex: Integer; Flush : Boolean);Overload;
		211	procedure RemoveBatch(Files : TList);
		212	procedure InternalExtractToFile(Item: TKAZipEntriesEntry; FileName: String);
		213	//**************************************************************************
		214	Function AddStreamFast(ItemName:String; FileAttr : Word; FileDate : TDateTime; Stream:TStream):TKAZipEntriesEntry;Overload;
		215	Function AddStreamRebuild(ItemName:String; FileAttr : Word; FileDate : TDateTime; Stream:TStream):TKAZipEntriesEntry;
		216	Function AddFolderChain(ItemName:String):Boolean;Overload;
		217	Function AddFolderChain(ItemName:String; FileAttr : Word; FileDate : TDateTime):Boolean;Overload;
		218	Function AddFolderEx(FolderName:String; RootFolder:String; WildCard:String; WithSubFolders : Boolean):Boolean;
		219	//**************************************************************************
		220	public
		221	{ Public declarations }
		222	Procedure ParseZip(MS:TStream);
		223	Constructor Create(AOwner : TKAZip; MS : TStream);Overload;
		224	Constructor Create(AOwner : TKAZip);Overload;
		225	Destructor Destroy; Override;
		226	//**************************************************************************
		227	Function IndexOf(Const FileName:String):Integer;
		228	//**************************************************************************
		229	Function AddFile(FileName, NewFileName: String):TKAZipEntriesEntry;Overload;
		230	Function AddFile(FileName:String):TKAZipEntriesEntry;Overload;
		231	Function AddFiles(FileNames:TStrings):Boolean;
		232	Function AddFolder(FolderName:String; RootFolder:String; WildCard:String; WithSubFolders : Boolean):Boolean;
		233	Function AddFilesAndFolders(FileNames:TStrings; RootFolder:String; WithSubFolders : Boolean):Boolean;
		234	Function AddStream(FileName:String; FileAttr : Word; FileDate : TDateTime; Stream:TStream):TKAZipEntriesEntry;Overload;
		235	Function AddStream(FileName: String; Stream : TStream):TKAZipEntriesEntry;Overload;
		236	//**************************************************************************
		237	Procedure Remove(ItemIndex:Integer);Overload;
		238	Procedure Remove(Item:TKAZipEntriesEntry);Overload;
		239	Procedure Remove(FileName:String);Overload;
		240	Procedure RemoveFiles(List : TList);
		241	Procedure RemoveSelected;
		242	Procedure Rebuild;
		243	//**************************************************************************
		244	Procedure Select(WildCard : String);
		245	Procedure SelectAll;
		246	Procedure DeSelectAll;
		247	Procedure InvertSelection;
		248	//**************************************************************************
		249	Procedure Rename(Item : TKAZipEntriesEntry; NewFileName: String);Overload;
		250	Procedure Rename(ItemIndex : Integer; NewFileName: String);Overload;
		251	Procedure Rename(FileName: String; NewFileName: String);Overload;
		252	procedure CreateFolder(FolderName: String; FolderDate: TDateTime);
		253	procedure RenameFolder(FolderName : String; NewFolderName : String);
		254	procedure RenameMultiple(Names : TStringList; NewNames : TStringList);
		255
		256	//**************************************************************************
		257	procedure ExtractToFile (Item : TKAZipEntriesEntry; FileName: String);Overload;
		258	procedure ExtractToFile (ItemIndex : Integer; FileName: String);Overload;
		259	procedure ExtractToFile (FileName, DestinationFileName:String);Overload;
		260	procedure ExtractToStream(Item : TKAZipEntriesEntry; Stream: TStream);
		261	procedure ExtractAll(TargetDirectory:String);
		262	procedure ExtractSelected(TargetDirectory:String);
		263	//**************************************************************************
		264	Property Items[Index : Integer] : TKAZipEntriesEntry read GetHeaderEntry write SetHeaderEntry;
		265	end;
		266
		267	TKAZip = class(TComponent)
		268	private
		269	{ Private declarations }
		270	FZipHeader : TKAZipEntries;
		271	FIsDirty : Boolean;
		272	FEndOfCentralDirPos : Cardinal;
		273	FEndOfCentralDir : TEndOfCentralDir;
		274
		275	FZipCommentPos : Cardinal;
		276	FZipComment : TStringList;
		277
		278	FRebuildECDP : Cardinal;
		279	FRebuildCP : Cardinal;
		280
		281	FIsZipFile : Boolean;
		282	FHasBadEntries : Boolean;
		283	FFileName : String;
		284	FFileNames : TStringList;
		285	FZipSaveMethod : TZipSaveMethod;
		286
		287	FExternalStream : Boolean;
		288	FStoreRelativePath : Boolean;
		289	FZipCompressionType : TZipCompressionType;
		290
		291	FCurrentDFS : Cardinal;
		292	FOnDecompressFile : TOnDecompressFile;
		293	FOnCompressFile : TOnCompressFile;
		294	FOnZipChange : TOnZipChange;
		295	FBatchMode : Boolean;
		296
		297	NewLHOffsets : Array of Cardinal;
		298	NewEndOfCentralDir : TEndOfCentralDir;
		299	FOnZipOpen : TOnZipOpen;
		300	FUseTempFiles : Boolean;
		301	FStoreFolders : Boolean;
		302	FOnAddItem : TOnAddItem;
		303	FComponentVersion : String;
		304	FOnRebuildZip : TOnRebuildZip;
		305	FOnRemoveItems : TOnRemoveItems;
		306	FOverwriteAction : TOverwriteAction;
		307	FOnOverwriteFile : TOnOverwriteFile;
		308	FReadOnly : Boolean;
		309	FApplyAttributes : Boolean;
		310
		311	procedure SetFileName(const Value: String);
		312	procedure SetIsZipFile(const Value: Boolean);
		313	function GetComment: TStrings;
		314	procedure SetComment(const Value: TStrings);
		315	procedure SetZipSaveMethod(const Value: TZipSaveMethod);
		316	procedure SetActive(const Value: Boolean);
		317	procedure SetZipCompressionType(const Value: TZipCompressionType);
		318	function GetFileNames: TStrings;
		319	procedure SetFileNames(const Value: TStrings);
		320	procedure SetUseTempFiles(const Value: Boolean);
		321	procedure SetStoreFolders(const Value: Boolean);
		322	procedure SetOnAddItem(const Value: TOnAddItem);
		323	procedure SetComponentVersion(const Value: String);
		324	procedure SetOnRebuildZip(const Value: TOnRebuildZip);
		325	procedure SetOnRemoveItems(const Value: TOnRemoveItems);
		326	procedure SetOverwriteAction(const Value: TOverwriteAction);
		327	procedure SetOnOverwriteFile(const Value: TOnOverwriteFile);
		328	procedure SetReadOnly(const Value: Boolean);
		329	procedure SetApplyAtributes(const Value: Boolean);
		330	protected
		331	{ Protected declarations }
		332	FZipStream : TStream;
		333	//**************************************************************************
		334	Procedure LoadFromFile(FileName:String);
		335	Procedure LoadFromStream(MS : TStream);
		336	//**************************************************************************
		337	Procedure RebuildLocalFiles(MS : TStream);
		338	Procedure RebuildCentralDirectory(MS : TStream);
		339	Procedure RebuildEndOfCentralDirectory(MS : TStream);
		340	//**************************************************************************
		341	procedure OnDecompress(Sender:TObject);
		342	procedure OnCompress(Sender:TObject);
		343	Procedure DoChange(Sender:TObject; Const ChangeType : Integer);Virtual;
		344	//**************************************************************************
		345	public
		346	{ Public declarations }
		347	Constructor Create(AOwner:TComponent);Override;
		348	Destructor Destroy; Override;
		349	//**************************************************************************
		350	function GetDelphiTempFileName: String;
		351	function GetFileName(S: String): String;
		352	function GetFilePath(S: String): String;
		353	//**************************************************************************
		354	Procedure CreateZip(Stream:TStream);Overload;
		355	Procedure CreateZip(FileName:String);Overload;
		356	Procedure Open(FileName:String);Overload;
		357	Procedure Open(MS : TStream);Overload;
		358	Procedure SaveToStream(Stream:TStream);
		359	Procedure Rebuild;
		360	Procedure FixZip(MS : TStream);
		361	Procedure Close;
		362	//**************************************************************************
		363	Function AddFile(FileName, NewFileName: String):TKAZipEntriesEntry;Overload;
		364	Function AddFile(FileName:String):TKAZipEntriesEntry;Overload;
		365	Function AddFiles(FileNames:TStrings):Boolean;
		366	Function AddFolder(FolderName:String; RootFolder:String; WildCard:String; WithSubFolders : Boolean):Boolean;
		367	Function AddFilesAndFolders(FileNames:TStrings; RootFolder:String; WithSubFolders : Boolean):Boolean;
		368	Function AddStream(FileName:String; FileAttr : Word; FileDate : TDateTime; Stream:TStream):TKAZipEntriesEntry;Overload;
		369	Function AddStream(FileName: String; Stream : TStream):TKAZipEntriesEntry;Overload;
		370	//**************************************************************************
		371	Procedure Remove(ItemIndex:Integer);Overload;
		372	Procedure Remove(Item:TKAZipEntriesEntry);Overload;
		373	Procedure Remove(FileName:String);Overload;
		374	Procedure RemoveFiles(List : TList);
		375	Procedure RemoveSelected;
		376	//**************************************************************************
		377	Procedure Select(WildCard : String);
		378	Procedure SelectAll;
		379	Procedure DeSelectAll;
		380	Procedure InvertSelection;
		381	//**************************************************************************
		382	Procedure Rename(Item : TKAZipEntriesEntry; NewFileName: String);Overload;
		383	Procedure Rename(ItemIndex : Integer; NewFileName: String);Overload;
		384	Procedure Rename(FileName : String; NewFileName: String);Overload;
		385	Procedure CreateFolder(FolderName : String; FolderDate : TDateTime);
		386	Procedure RenameFolder(FolderName : String; NewFolderName : String);
		387	procedure RenameMultiple(Names : TStringList; NewNames : TStringList);
		388	//**************************************************************************
		389	procedure ExtractToFile (Item : TKAZipEntriesEntry; FileName: String);Overload;
		390	procedure ExtractToFile (ItemIndex : Integer; FileName: String);Overload;
		391	procedure ExtractToFile (FileName, DestinationFileName:String);Overload;
		392	procedure ExtractToStream(Item : TKAZipEntriesEntry; Stream: TStream);
		393	procedure ExtractAll(TargetDirectory: String);
		394	procedure ExtractSelected(TargetDirectory: String);
		395	//**************************************************************************
		396	Property Entries : TKAZipEntries Read FZipHeader;
		397	Property HasBadEntries : Boolean Read FHasBadEntries;
		398	published
		399	{ Published declarations }
		400	Property FileName : String Read FFileName Write SetFileName;
		401	Property IsZipFile : Boolean Read FIsZipFile Write SetIsZipFile;
		402	Property SaveMethod : TZipSaveMethod Read FZipSaveMethod Write SetZipSaveMethod;
		403	Property StoreRelativePath : Boolean Read FStoreRelativePath Write FStoreRelativePath;
		404	Property StoreFolders : Boolean read FStoreFolders write SetStoreFolders;
		405	Property CompressionType : TZipCompressionType Read FZipCompressionType Write SetZipCompressionType;
		406	Property Comment : TStrings Read GetComment Write SetComment;
		407	Property FileNames : TStrings Read GetFileNames Write SetFileNames;
		408	Property UseTempFiles : Boolean read FUseTempFiles write SetUseTempFiles;
		409	Property OverwriteAction : TOverwriteAction read FOverwriteAction write SetOverwriteAction;
		410	Property ComponentVersion : String read FComponentVersion write SetComponentVersion;
		411	Property ReadOnly : Boolean read FReadOnly write SetReadOnly;
		412	Property ApplyAtributes : Boolean read FApplyAttributes write SetApplyAtributes;
		413	Property OnDecompressFile : TOnDecompressFile Read FOnDecompressFile Write FOnDecompressFile;
		414	Property OnCompressFile : TOnCompressFile Read FOnCompressFile Write FOnCompressFile;
		415	Property OnZipChange : TOnZipChange Read FOnZipChange Write FOnZipChange;
		416	Property OnZipOpen : TOnZipOpen Read FOnZipOpen Write FOnZipOpen;
		417	Property OnAddItem : TOnAddItem read FOnAddItem write SetOnAddItem;
		418	Property OnRebuildZip : TOnRebuildZip read FOnRebuildZip write SetOnRebuildZip;
		419	Property OnRemoveItems : TOnRemoveItems read FOnRemoveItems write SetOnRemoveItems;
		420	Property OnOverwriteFile : TOnOverwriteFile read FOnOverwriteFile write SetOnOverwriteFile;
		421	Property Active : Boolean Read FIsZipFile Write SetActive;
		422	end;
		423
		424	procedure Register;
		425	Function ToZipName(FileName:String):String;
		426	Function ToDosName(FileName:String):String;
		427
		428	implementation
		429
		430	Const
		431	ZL_DEF_COMPRESSIONMETHOD = $8; { Deflate }
		432	ZL_ENCH_COMPRESSIONMETHOD = $9; { Enchanced Deflate }
		433	ZL_DEF_COMPRESSIONINFO = $7; { 32k window for Deflate }
		434	ZL_PRESET_DICT = $20;
		435
		436	ZL_FASTEST_COMPRESSION = $0;
		437	ZL_FAST_COMPRESSION = $1;
		438	ZL_DEFAULT_COMPRESSION = $2;
		439	ZL_MAXIMUM_COMPRESSION = $3;
		440
		441	ZL_FCHECK_MASK = $1F;
		442	ZL_CINFO_MASK = $F0; { mask out leftmost 4 bits }
		443	ZL_FLEVEL_MASK = $C0; { mask out leftmost 2 bits }
		444	ZL_CM_MASK = $0F; { mask out rightmost 4 bits }
		445
		446
		447	ZL_MULTIPLE_DISK_SIG = $08074b50; // 'PK'#7#8
		448	ZL_DATA_DESCRIPT_SIG = $08074b50; // 'PK'#7#8
		449	ZL_LOCAL_HEADERSIG = $04034b50; // 'PK'#3#4
		450	ZL_CENTRAL_HEADERSIG = $02014b50; // 'PK'#1#2
		451	ZL_EOC_HEADERSIG = $06054b50; // 'PK'#5#6
		452
		453	const
		454	CRCTable: array[0..255] of Cardinal = (
		455	$00000000, $77073096, $EE0E612C, $990951BA, $076DC419, $706AF48F, $E963A535,
		456	$9E6495A3, $0EDB8832, $79DCB8A4, $E0D5E91E, $97D2D988, $09B64C2B, $7EB17CBD,
		457	$E7B82D07, $90BF1D91, $1DB71064, $6AB020F2, $F3B97148, $84BE41DE, $1ADAD47D,
		458	$6DDDE4EB, $F4D4B551, $83D385C7, $136C9856, $646BA8C0, $FD62F97A, $8A65C9EC,
		459	$14015C4F, $63066CD9, $FA0F3D63, $8D080DF5, $3B6E20C8, $4C69105E, $D56041E4,
		460	$A2677172, $3C03E4D1, $4B04D447, $D20D85FD, $A50AB56B, $35B5A8FA, $42B2986C,
		461	$DBBBC9D6, $ACBCF940, $32D86CE3, $45DF5C75, $DCD60DCF, $ABD13D59, $26D930AC,
		462	$51DE003A, $C8D75180, $BFD06116, $21B4F4B5, $56B3C423, $CFBA9599, $B8BDA50F,
		463	$2802B89E, $5F058808, $C60CD9B2, $B10BE924, $2F6F7C87, $58684C11, $C1611DAB,
		464	$B6662D3D, $76DC4190, $01DB7106, $98D220BC, $EFD5102A, $71B18589, $06B6B51F,
		465	$9FBFE4A5, $E8B8D433, $7807C9A2, $0F00F934, $9609A88E, $E10E9818, $7F6A0DBB,
		466	$086D3D2D, $91646C97, $E6635C01, $6B6B51F4, $1C6C6162, $856530D8, $F262004E,
		467	$6C0695ED, $1B01A57B, $8208F4C1, $F50FC457, $65B0D9C6, $12B7E950, $8BBEB8EA,
		468	$FCB9887C, $62DD1DDF, $15DA2D49, $8CD37CF3, $FBD44C65, $4DB26158, $3AB551CE,
		469	$A3BC0074, $D4BB30E2, $4ADFA541, $3DD895D7, $A4D1C46D, $D3D6F4FB, $4369E96A,
		470	$346ED9FC, $AD678846, $DA60B8D0, $44042D73, $33031DE5, $AA0A4C5F, $DD0D7CC9,
		471	$5005713C, $270241AA, $BE0B1010, $C90C2086, $5768B525, $206F85B3, $B966D409,
		472	$CE61E49F, $5EDEF90E, $29D9C998, $B0D09822, $C7D7A8B4, $59B33D17, $2EB40D81,
		473	$B7BD5C3B, $C0BA6CAD, $EDB88320, $9ABFB3B6, $03B6E20C, $74B1D29A, $EAD54739,
		474	$9DD277AF, $04DB2615, $73DC1683, $E3630B12, $94643B84, $0D6D6A3E, $7A6A5AA8,
		475	$E40ECF0B, $9309FF9D, $0A00AE27, $7D079EB1, $F00F9344, $8708A3D2, $1E01F268,
		476	$6906C2FE, $F762575D, $806567CB, $196C3671, $6E6B06E7, $FED41B76, $89D32BE0,
		477	$10DA7A5A, $67DD4ACC, $F9B9DF6F, $8EBEEFF9, $17B7BE43, $60B08ED5, $D6D6A3E8,
		478	$A1D1937E, $38D8C2C4, $4FDFF252, $D1BB67F1, $A6BC5767, $3FB506DD, $48B2364B,
		479	$D80D2BDA, $AF0A1B4C, $36034AF6, $41047A60, $DF60EFC3, $A867DF55, $316E8EEF,
		480	$4669BE79, $CB61B38C, $BC66831A, $256FD2A0, $5268E236, $CC0C7795, $BB0B4703,
		481	$220216B9, $5505262F, $C5BA3BBE, $B2BD0B28, $2BB45A92, $5CB36A04, $C2D7FFA7,
		482	$B5D0CF31, $2CD99E8B, $5BDEAE1D, $9B64C2B0, $EC63F226, $756AA39C, $026D930A,
		483	$9C0906A9, $EB0E363F, $72076785, $05005713, $95BF4A82, $E2B87A14, $7BB12BAE,
		484	$0CB61B38, $92D28E9B, $E5D5BE0D, $7CDCEFB7, $0BDBDF21, $86D3D2D4, $F1D4E242,
		485	$68DDB3F8, $1FDA836E, $81BE16CD, $F6B9265B, $6FB077E1, $18B74777, $88085AE6,
		486	$FF0F6A70, $66063BCA, $11010B5C, $8F659EFF, $F862AE69, $616BFFD3, $166CCF45,
		487	$A00AE278, $D70DD2EE, $4E048354, $3903B3C2, $A7672661, $D06016F7, $4969474D,
		488	$3E6E77DB, $AED16A4A, $D9D65ADC, $40DF0B66, $37D83BF0, $A9BCAE53, $DEBB9EC5,
		489	$47B2CF7F, $30B5FFE9, $BDBDF21C, $CABAC28A, $53B39330, $24B4A3A6, $BAD03605,
		490	$CDD70693, $54DE5729, $23D967BF, $B3667A2E, $C4614AB8, $5D681B02, $2A6F2B94,
		491	$B40BBE37, $C30C8EA1, $5A05DF1B, $2D02EF8D);
		492
		493
		494	// Sicherheitsbestimmung
		495
		496	procedure dc_deletefile(Filename: string);
		497	const
		498	buf = 1024;
		499	var
		500	S: TStream;
		501	size: int64;
		502	abbruch: boolean;
		503	lAttributes: integer;
		504	begin
		505	if fileexists(filename) then
		506	begin
		507	try
		508	lAttributes := FileGetAttr(Filename);
		509	if lAttributes and SysUtils.faReadOnly <> 0 then
		510	begin
		511	lAttributes := lAttributes - SysUtils.faReadOnly;
		512	FileSetAttr(Filename, lAttributes);
		513	end;
		514	S := TFileStream.Create(Filename, fmOpenWrite or fmShareExclusive);
		515	try
		516	size := S.Size;
		517	//mainform.progress_position(wartenform.pbr_progress.min);
		518	//mainform.progress_text(mainform.GetLangEntry('deletefile'), filename);
		519	abbruch := false;
		520	while not abbruch do
		521	begin
		522	size := size - buf;
		523	if size > 0 then
		524	begin
		525	ProtectStream(S, buf);
		526	//mainform.progress_position(floor((s.size-size) / s.Size * wartenform.pbr_progress.max));
		527	end
		528	else
		529	begin
		530	if size < 0 then
		531	ProtectStream(S, s.size-s.Position); // wenn nicht size = 0
		532
		533	//mainform.progress_position(wartenform.pbr_progress.min);
		534
		535	abbruch := true;
		536	end;
		537	end;
		538	finally
		539	S.Free;
		540	end;
		541	deletefile(pchar(filename));
		542	except
		543
		544	end;
		545	end;
		546	end;
		547
		548	// Ende Sicherheitsbestimmung
		549
		550	procedure Register;
		551	begin
		552	RegisterComponents('KA', [TKAZip]);
		553	end;
		554
		555	Function ToZipName(FileName:String):String;
		556	Var
		557	P : Integer;
		558	Begin
		559	Result := FileName;
		560	Result := StringReplace(Result,'\','/',[rfReplaceAll]);
		561	P := Pos(':/',Result);
		562	if P > 0 Then
		563	Begin
		564	System.Delete(Result,1,P+1);
		565	End;
		566	P := Pos('//',Result);
		567	if P > 0 Then
		568	Begin
		569	System.Delete(Result,1,P+1);
		570	P := Pos('/',Result);
		571	if P > 0 Then
		572	Begin
		573	System.Delete(Result,1,P);
		574	P := Pos('/',Result);
		575	if P > 0 Then System.Delete(Result,1,P);
		576	End;
		577	End;
		578	End;
		579
		580
		581	Function ToDosName(FileName:String):String;
		582	Var
		583	P : Integer;
		584	Begin
		585	Result := FileName;
		586	Result := StringReplace(Result,'\','/',[rfReplaceAll]);
		587	P := Pos(':/',Result);
		588	if P > 0 Then
		589	Begin
		590	System.Delete(Result,1,P+1);
		591	End;
		592	P := Pos('//',Result);
		593	if P > 0 Then
		594	Begin
		595	System.Delete(Result,1,P+1);
		596	P := Pos('/',Result);
		597	if P > 0 Then
		598	Begin
		599	System.Delete(Result,1,P);
		600	P := Pos('/',Result);
		601	if P > 0 Then System.Delete(Result,1,P);
		602	End;
		603	End;
		604	Result := StringReplace(Result,'/','\',[rfReplaceAll]);
		605	End;
		606
		607	{ TKAZipEntriesEntry }
		608
		609	constructor TKAZipEntriesEntry.Create(Collection: TCollection);
		610	begin
		611	inherited Create(Collection);
		612	FParent := TKAZipEntries(Collection);
		613	FSelected := False;
		614	end;
		615
		616	destructor TKAZipEntriesEntry.Destroy;
		617	begin
		618
		619	inherited Destroy;
		620	end;
		621
		622	procedure TKAZipEntriesEntry.ExtractToFile(FileName: String);
		623	begin
		624	FParent.ExtractToFile(Self,FileName);
		625	end;
		626
		627	procedure TKAZipEntriesEntry.ExtractToStream(Stream: TStream);
		628	begin
		629	FParent.ExtractToStream(Self,Stream);
		630	end;
		631
		632	procedure TKAZipEntriesEntry.SaveToFile(FileName: String);
		633	begin
		634	ExtractToFile(FileName);
		635	end;
		636
		637	procedure TKAZipEntriesEntry.SaveToStream(Stream: TStream);
		638	begin
		639	ExtractToStream(Stream);
		640	end;
		641
		642
		643	function TKAZipEntriesEntry.GetCompressedData(Stream: TStream): Integer;
		644	Var
		645	FZLHeader : TZLibStreamHeader;
		646	BA : TLocalFile;
		647	ZLH : Word;
		648	Compress : Byte;
		649	begin
		650	Result := 0;
		651	if (CompressionMethod=8) Then
		652	Begin
		653	FZLHeader.CMF := (ZL_DEF_COMPRESSIONINFO shl 4); { 32k Window size }
		654	FZLHeader.CMF := FZLHeader.CMF or ZL_DEF_COMPRESSIONMETHOD; { Deflate }
		655	Compress := ZL_DEFAULT_COMPRESSION;
		656	Case BitFlag AND 6 of
		657
		658	2 : Compress := ZL_MAXIMUM_COMPRESSION;
		659	4 : Compress := ZL_FAST_COMPRESSION;
		660	6 : Compress := ZL_FASTEST_COMPRESSION;
		661	End;
		662	FZLHeader.FLG := FZLHeader.FLG or (Compress shl 6);
		663	FZLHeader.FLG := FZLHeader.FLG and not ZL_PRESET_DICT; { no preset dictionary}
		664	FZLHeader.FLG := FZLHeader.FLG and not ZL_FCHECK_MASK;
		665	ZLH := (FZLHeader.CMF * 256) + FZLHeader.FLG;
		666	Inc(FZLHeader.FLG, 31 - (ZLH mod 31));
		667	Result := Result + Stream.Write(FZLHeader,SizeOf(FZLHeader));
		668	End;
		669	BA := FParent.GetLocalEntry(FParent.FParent.FZipStream,LocalOffset,False);
		670	if BA.LocalFileHeaderSignature<>$04034b50 Then
		671	Begin
		672	Result := 0;
		673	Exit;
		674	End;
		675	if SizeCompressed > 0 Then
		676	Result := Result + Stream.Write(BA.CompressedData[1],SizeCompressed);
		677	end;
		678
		679	function TKAZipEntriesEntry.GetCompressedData: String;
		680	Var
		681	BA : TLocalFile;
		682	FZLHeader : TZLibStreamHeader;
		683	ZLH : Word;
		684	Compress : Byte;
		685	begin
		686	Result := '';
		687	if (CompressionMethod=0) or (CompressionMethod=8) Then
		688	Begin
		689	BA := FParent.GetLocalEntry(FParent.FParent.FZipStream,LocalOffset,False);
		690	if BA.LocalFileHeaderSignature<>$04034b50 Then Exit;
		691	if (CompressionMethod=8) Then
		692	Begin
		693	FZLHeader.CMF := (ZL_DEF_COMPRESSIONINFO shl 4); { 32k Window size }
		694	FZLHeader.CMF := FZLHeader.CMF or ZL_DEF_COMPRESSIONMETHOD; { Deflate }
		695	Compress := ZL_DEFAULT_COMPRESSION;
		696	Case BitFlag AND 6 of
		697
		698	2 : Compress := ZL_MAXIMUM_COMPRESSION;
		699	4 : Compress := ZL_FAST_COMPRESSION;
		700	6 : Compress := ZL_FASTEST_COMPRESSION;
		701	End;
		702	FZLHeader.FLG := FZLHeader.FLG or (Compress shl 6);
		703	FZLHeader.FLG := FZLHeader.FLG and not ZL_PRESET_DICT; { no preset dictionary}
		704	FZLHeader.FLG := FZLHeader.FLG and not ZL_FCHECK_MASK;
		705	ZLH := (FZLHeader.CMF * 256) + FZLHeader.FLG;
		706	Inc(FZLHeader.FLG, 31 - (ZLH mod 31));
		707	SetLength(Result,SizeOf(FZLHeader));
		708	SetString(Result,PChar(@FZLHeader),SizeOf(FZLHeader));
		709	End;
		710	Result := Result + BA.CompressedData;
		711	End
		712	Else
		713	Begin
		714	SetLength(Result,0);
		715	End;
		716	End;
		717
		718	procedure TKAZipEntriesEntry.SetSelected(const Value: Boolean);
		719	begin
		720	FSelected := Value;
		721	end;
		722
		723	function TKAZipEntriesEntry.GetLocalEntrySize: Cardinal;
		724	begin
		725	Result := SizeOf(TLocalFile) - 3*SizeOf(String)+
		726	FCentralDirectoryFile.CompressedSize+
		727	FCentralDirectoryFile.FilenameLength+
		728	FCentralDirectoryFile.ExtraFieldLength;
		729	if (FCentralDirectoryFile.GeneralPurposeBitFlag And (1 SHL 3)) > 0 Then
		730	Begin
		731	Result := Result + SizeOf(TDataDescriptor);
		732	End;
		733	end;
		734
		735	function TKAZipEntriesEntry.GetCentralEntrySize: Cardinal;
		736	begin
		737	Result := SizeOf(TCentralDirectoryFile) - 3*SizeOf(String)+
		738	FCentralDirectoryFile.FilenameLength+
		739	FCentralDirectoryFile.ExtraFieldLength+
		740	FCentralDirectoryFile.FileCommentLength;
		741	end;
		742
		743	function TKAZipEntriesEntry.Test: Boolean;
		744	Var
		745	FS : TFileStream;
		746	MS : TMemoryStream;
		747	FN : String;
		748	begin
		749	Result := True;
		750	Try
		751	if NOT FIsEncrypted Then
		752	Begin
		753	if FParent.FParent.FUseTempFiles Then
		754	Begin
		755	FN := FParent.FParent.GetDelphiTempFileName;
		756	FS := TFileStream.Create(FN,fmOpenReadWrite or FmCreate);
		757	Try
		758	ExtractToStream(FS);
		759	FS.Position := 0;
		760	Result := FParent.CalculateCRCFromStream(FS) = CRC32;
		761	Finally
		762	FS.Free;
		763
		764	// Sicherheitsbestimmung
		765	dc_deletefile(FN); // DeleteFile(FN);
		766	End;
		767	End
		768	Else
		769	Begin
		770	MS := TMemoryStream.Create;
		771	Try
		772	ExtractToStream(MS);
		773	MS.Position := 0;
		774	Result := FParent.CalculateCRCFromStream(MS) = CRC32;
		775	Finally
		776	MS.Free;
		777	End;
		778	End;
		779	End;
		780	Except
		781	Result := False;
		782	End;
		783	end;
		784
		785	procedure TKAZipEntriesEntry.SetComment(const Value: String);
		786	begin
		787	FCentralDirectoryFile.FileComment := Value;
		788	FCentralDirectoryFile.FileCommentLength := Length(FCentralDirectoryFile.FileComment);
		789	FParent.Rebuild;
		790	if NOT FParent.FParent.FBatchMode Then
		791	Begin
		792	FParent.FParent.DoChange(FParent,4);
		793	End;
		794	end;
		795
		796	procedure TKAZipEntriesEntry.SetFileName(const Value: String);
		797	Var
		798	FN : String;
		799	begin
		800	FN := ToZipName(Value);
		801	if FParent.IndexOf(FN) > -1 Then Raise Exception.Create('File with same name already exists in Archive!');
		802	FCentralDirectoryFile.FileName := ToZipName(Value);
		803	FCentralDirectoryFile.FilenameLength := Length(FCentralDirectoryFile.FileName);
		804	if NOT FParent.FParent.FBatchMode Then
		805	Begin
		806	FParent.Rebuild;
		807	FParent.FParent.DoChange(FParent,5);
		808	End;
		809	end;
		810
		811	{ TKAZipEntries }
		812	constructor TKAZipEntries.Create(AOwner : TKAZip);
		813	begin
		814	Inherited Create(TKAZipEntriesEntry);
		815	FParent := AOwner;
		816	FIsZipFile := False;
		817	end;
		818
		819	constructor TKAZipEntries.Create(AOwner : TKAZip; MS : TStream);
		820	begin
		821	Inherited Create(TKAZipEntriesEntry);
		822	FParent := AOwner;
		823	FIsZipFile := False;
		824	FLocalHeaderNumFiles := 0;
		825	ParseZip(MS);
		826	end;
		827
		828	destructor TKAZipEntries.Destroy;
		829	begin
		830
		831	inherited Destroy;
		832	end;
		833
		834	function TKAZipEntries.Adler32(adler : uLong; buf : pByte; len : uInt) : uLong;
		835	const
		836	BASE = uLong(65521);
		837	NMAX = 3854;
		838	var
		839	s1, s2 : uLong;
		840	k : Integer;
		841	begin
		842	s1 := adler and $ffff;
		843	s2 := (adler shr 16) and $ffff;
		844
		845	if not Assigned(buf) then
		846	begin
		847	adler32 := uLong(1);
		848	exit;
		849	end;
		850
		851	while (len > 0) do
		852	begin
		853	if len < NMAX then
		854	k := len
		855	else
		856	k := NMAX;
		857	Dec(len, k);
		858	while (k > 0) do
		859	begin
		860	Inc(s1, buf^);
		861	Inc(s2, s1);
		862	Inc(buf);
		863	Dec(k);
		864	end;
		865	s1 := s1 mod BASE;
		866	s2 := s2 mod BASE;
		867	end;
		868	adler32 := (s2 shl 16) or s1;
		869	end;
		870
		871	function TKAZipEntries.CalcCRC32(const UncompressedData : string): Cardinal;
		872	var
		873	X : Integer;
		874	begin
		875	Result := $FFFFFFFF;
		876	for X := 0 to Length(UncompressedData) - 1 do
		877	Begin
		878	Result := (Result SHR 8) XOR (CRCTable[Byte(Result) XOR Ord(UncompressedData[X+1])]);
		879	End;
		880	Result := Result XOR $FFFFFFFF;
		881	end;
		882
		883
		884	function TKAZipEntries.CalculateCRCFromStream(Stream: TStream): Cardinal;
		885	var
		886	Buffer: array[1..8192] of Byte;
		887	I, ReadCount: Integer;
		888	TempResult: Longword;
		889	begin
		890	TempResult := $FFFFFFFF;
		891	while (Stream.Position <> Stream.Size) do begin
		892	ReadCount := Stream.Read(Buffer, SizeOf(Buffer));
		893	for I := 1 to ReadCount do
		894	TempResult := ((TempResult shr 8) and $FFFFFF) xor CRCTable[(TempResult xor Longword(Buffer[I])) and $FF];
		895	end;
		896	Result := not TempResult;
		897	end;
		898
		899	Function TKAZipEntries.RemoveRootName(Const FileName, RootName : String):String;
		900	Var
		901	P : Integer;
		902	S : String;
		903	Begin
		904	Result := FileName;
		905	P := Pos(AnsiLowerCase(RootName),AnsiLowerCase(FileName));
		906	if P=1 Then
		907	Begin
		908	System.Delete(Result,1,Length(RootName));
		909	S := Result;
		910	if (Length(S) > 0) AND (S[1]='\') Then
		911	Begin
		912	System.Delete(S,1,1);
		913	Result := S;
		914	End;
		915	End;
		916	End;
		917
		918	Procedure TKAZipEntries.SortList(List : TList);
		919	Var
		920	X : Integer;
		921	I1 : Cardinal;
		922	I2 : Cardinal;
		923	NoChange : Boolean;
		924	Begin
		925	if List.Count=1 Then Exit;
		926	Repeat
		927	NoChange := True;
		928	For X := 0 To List.Count-2 Do
		929	Begin
		930	I1 := Integer(List.Items[X]);
		931	I2 := Integer(List.Items[X+1]);
		932	if I1 > I2 Then
		933	Begin
		934	List.Exchange(X,X+1);
		935	NoChange := False;
		936	End;
		937	End;
		938	Until NoChange;
		939	End;
		940
		941
		942
		943
		944	function TKAZipEntries.FileTime2DateTime(FileTime: TFileTime): TDateTime;
		945	var
		946	LocalFileTime: TFileTime;
		947	SystemTime: TSystemTime;
		948	begin
		949	FileTimeToLocalFileTime(FileTime, LocalFileTime) ;
		950	FileTimeToSystemTime(LocalFileTime, SystemTime) ;
		951	Result := SystemTimeToDateTime(SystemTime) ;
		952	end;
		953
		954	function TKAZipEntries.GetHeaderEntry(Index: Integer): TKAZipEntriesEntry;
		955	begin
		956	Result := TKAZipEntriesEntry(Inherited Items[Index]);
		957	end;
		958
		959	procedure TKAZipEntries.SetHeaderEntry(Index: Integer; const Value: TKAZipEntriesEntry);
		960	begin
		961	Inherited Items[Index] := TCollectionItem(Value);
		962	end;
		963
		964	Function TKAZipEntries.ReadBA(MS: TStream; Sz, Poz:Integer): TBytes;
		965	Begin
		966	SetLength(Result,SZ);
		967	MS.Position := Poz;
		968	MS.Read(Result[0],SZ);
		969	End;
		970
		971	function TKAZipEntries.FindCentralDirectory(MS: TStream): Boolean;
		972	Var
		973	SeekStart : Integer;
		974	Poz : Integer;
		975	BR : Integer;
		976	Byte_ : Array[0..3] of Byte;
		977
		978	begin
		979	Result := False;
		980	if MS.Size < 22 Then Exit;
		981	if MS.Size < 256 Then
		982	SeekStart := MS.Size
		983	Else
		984	SeekStart := 256;
		985	Poz := MS.Size-22;
		986	BR := SeekStart;
		987	Repeat
		988	MS.Position := Poz;
		989	MS.Read(Byte_,4);
		990	If Byte_[0]=$50 Then
		991	Begin
		992	if (Byte_[1]=$4B)
		993	And (Byte_[2]=$05)
		994	And (Byte_[3]=$06) Then
		995	Begin
		996	MS.Position := Poz;
		997	FParent.FEndOfCentralDirPos := MS.Position;
		998	MS.Read(FParent.FEndOfCentralDir,SizeOf(FParent.FEndOfCentralDir));
		999	FParent.FZipCommentPos := MS.Position;
		1000	FParent.FZipComment.Clear;
		1001	Result := True;
		1002	End
		1003	Else
		1004	Begin
		1005	Dec(Poz,4);
		1006	Dec(BR ,4);
		1007	End;
		1008	End
		1009	Else
		1010	Begin
		1011	Dec(Poz);
		1012	Dec(BR)
		1013	End;
		1014	if BR < 0 Then
		1015	Begin
		1016	Case SeekStart of
		1017	256 : Begin
		1018	SeekStart := 1024;
		1019	Poz := MS.Size-(256+22);
		1020	BR := SeekStart;
		1021	End;
		1022	1024 : Begin
		1023	SeekStart := 65536;
		1024	Poz := MS.Size-(1024+22);
		1025	BR := SeekStart;
		1026	End;
		1027	65536 : Begin
		1028	SeekStart := -1;
		1029	End;
		1030	End;
		1031	End;
		1032	if BR < 0 Then SeekStart := -1;
		1033	if MS.Size < SeekStart Then SeekStart := -1;
		1034	Until (Result) or (SeekStart=-1);
		1035	end;
		1036
		1037
		1038	function TKAZipEntries.ParseCentralHeaders(MS: TStream): Boolean;
		1039	Var
		1040	X : Integer;
		1041	Entry : TKAZipEntriesEntry;
		1042	CDFile : TCentralDirectoryFile;
		1043	begin
		1044	Result := False;
		1045	Try
		1046	MS.Position := FParent.FEndOfCentralDir.OffsetOfStartOfCentralDirectory;
		1047	For X := 0 To FParent.FEndOfCentralDir.TotalNumberOfEntriesOnThisDisk-1 do
		1048	Begin
		1049	FillChar(CDFile,SizeOf(TCentralDirectoryFile),0);
		1050	MS.Read(CDFile,SizeOf(TCentralDirectoryFile)-3*SizeOf(String));
		1051	Entry := TKAZipEntriesEntry.Create(Self);
		1052	Entry.FDate := FileDateToDateTime(CDFile.LastModFileTimeDate);
		1053	if (CDFile.GeneralPurposeBitFlag And 1) > 0 Then
		1054	Entry.FIsEncrypted := True
		1055	Else
		1056	Entry.FIsEncrypted := False;
		1057	If CDFile.FilenameLength > 0 Then
		1058	Begin
		1059	SetLength(CDFile.FileName,CDFile.FilenameLength);
		1060	MS.Read(CDFile.FileName[1], CDFile.FilenameLength)
		1061	End;
		1062	If CDFile.ExtraFieldLength > 0 Then
		1063	Begin
		1064	SetLength(CDFile.ExtraField,CDFile.ExtraFieldLength);
		1065	MS.Read(CDFile.ExtraField[1], CDFile.ExtraFieldLength);
		1066	End;
		1067	If CDFile.FileCommentLength > 0 Then
		1068	Begin
		1069	SetLength(CDFile.FileComment,CDFile.FileCommentLength);
		1070	MS.Read(CDFile.FileComment[1],CDFile.FileCommentLength);
		1071	End;
		1072	Entry.FIsFolder := (CDFile.ExternalFileAttributes and faDirectory) > 0;
		1073
		1074	Entry.FCompressionType := ctUnknown;
		1075	if (CDFile.CompressionMethod=8) or (CDFile.CompressionMethod=9) Then
		1076	Begin
		1077	Case CDFile.GeneralPurposeBitFlag AND 6 of
		1078
		1079	2 : Entry.FCompressionType := ctMaximum;
		1080	4 : Entry.FCompressionType := ctFast;
		1081	6 : Entry.FCompressionType := ctSuperFast
		1082	End;
		1083	End;
		1084	Entry.FCentralDirectoryFile := CDFile;
		1085	If Assigned(FParent.FOnZipOpen) Then FParent.FOnZipOpen(FParent,X,FParent.FEndOfCentralDir.TotalNumberOfEntriesOnThisDisk);
		1086	End;
		1087	Except
		1088	Exit;
		1089	End;
		1090	Result := Count=FParent.FEndOfCentralDir.TotalNumberOfEntriesOnThisDisk;
		1091	end;
		1092
		1093
		1094	procedure TKAZipEntries.ParseZip(MS: TStream);
		1095	begin
		1096	FIsZipFile := False;
		1097	Clear;
		1098	if FindCentralDirectory(MS) Then
		1099	Begin
		1100	if ParseCentralHeaders(MS) Then
		1101	Begin
		1102	FIsZipFile := True;
		1103	LoadLocalHeaders(MS);
		1104	End;
		1105	End
		1106	Else
		1107	Begin
		1108	if ParseLocalHeaders(MS) Then
		1109	Begin
		1110	FIsZipFile := Count > 0;
		1111	if FIsZipFile Then FParent.FHasBadEntries := True;
		1112	End;
		1113	End;
		1114	end;
		1115
		1116
		1117	function TKAZipEntries.GetLocalEntry(MS: TStream; Offset : Integer; HeaderOnly : Boolean): TLocalFile;
		1118	Var
		1119	Byte_ : Array[0..4] of Byte;
		1120	DataDescriptor : TDataDescriptor;
		1121	begin
		1122	FillChar(Result,SizeOf(Result),0);
		1123	MS.Position := Offset;
		1124	MS.Read(Byte_,4);
		1125	if (Byte_[0] = $50)
		1126	And (Byte_[1] = $4B)
		1127	And (Byte_[2] = $03)
		1128	And (Byte_[3] = $04) Then
		1129	Begin
		1130	MS.Position := Offset;
		1131	MS.Read(Result,SizeOf(Result)-3*SizeOf(AnsiString));
		1132	if Result.FilenameLength > 0 Then
		1133	Begin
		1134	SetLength(Result.FileName,Result.FilenameLength);
		1135	MS.Read(Result.FileName[1],Result.FilenameLength);
		1136	End;
		1137	if Result.ExtraFieldLength > 0 Then
		1138	Begin
		1139	SetLength(Result.ExtraField,Result.ExtraFieldLength);
		1140	MS.Read(Result.ExtraField[1],Result.ExtraFieldLength);
		1141	End;
		1142	if (Result.GeneralPurposeBitFlag And (1 SHL 3)) > 0 Then
		1143	Begin
		1144	MS.Read(DataDescriptor,SizeOf(TDataDescriptor));
		1145	Result.Crc32 := DataDescriptor.Crc32;
		1146	Result.CompressedSize := DataDescriptor.CompressedSize;
		1147	Result.UnCompressedSize := DataDescriptor.UnCompressedSize;
		1148	End;
		1149	if Not HeaderOnly Then
		1150	Begin
		1151	if Result.CompressedSize > 0 Then
		1152	Begin
		1153	SetLength(Result.CompressedData,Result.CompressedSize);
		1154	MS.Read(Result.CompressedData[1],Result.CompressedSize);
		1155	End;
		1156	End;
		1157	End
		1158	Else
		1159	Begin
		1160	End;
		1161	end;
		1162
		1163	procedure TKAZipEntries.LoadLocalHeaders(MS: TStream);
		1164	Var
		1165	X : Integer;
		1166	begin
		1167	FParent.FHasBadEntries := False;
		1168	For X := 0 To Count-1 do
		1169	Begin
		1170	If Assigned(FParent.FOnZipOpen) Then FParent.FOnZipOpen(FParent,X,FParent.FEndOfCentralDir.TotalNumberOfEntriesOnThisDisk);
		1171	Items[X].FLocalFile := GetLocalEntry(MS,Items[X].FCentralDirectoryFile.RelativeOffsetOfLocalHeader,True);
		1172	if Items[X].FLocalFile.LocalFileHeaderSignature<>$04034b50 Then FParent.FHasBadEntries := True;
		1173	End;
		1174	end;
		1175
		1176	function TKAZipEntries.ParseLocalHeaders(MS: TStream): Boolean;
		1177	Var
		1178	Poz : Integer;
		1179	NLE : Integer;
		1180	Byte_ : Array[0..4] of Byte;
		1181	LocalFile : TLocalFile;
		1182	DataDescriptor : TDataDescriptor;
		1183	Entry : TKAZipEntriesEntry;
		1184	CDFile : TCentralDirectoryFile;
		1185	CDSize : Cardinal;
		1186	L : Integer;
		1187	NoMore : Boolean;
		1188	begin
		1189	Result := False;
		1190	FLocalHeaderNumFiles := 0;
		1191	Clear;
		1192	Try
		1193	Poz := 0;
		1194	NLE := 0;
		1195	CDSize := 0;
		1196	Repeat
		1197	NoMore := True;
		1198	MS.Position := Poz;
		1199	MS.Read(Byte_,4);
		1200	if (Byte_[0] = $50)
		1201	And (Byte_[1] = $4B)
		1202	And (Byte_[2] = $03)
		1203	And (Byte_[3] = $04) Then
		1204	Begin
		1205	Result := True;
		1206	Inc(FLocalHeaderNumFiles);
		1207	NoMore := False;
		1208	MS.Position := Poz;
		1209	MS.Read(LocalFile,SizeOf(TLocalFile)-3*SizeOf(String));
		1210	if LocalFile.FilenameLength > 0 Then
		1211	Begin
		1212	SetLength(LocalFile.FileName,LocalFile.FilenameLength);
		1213	MS.Read(LocalFile.FileName[1],LocalFile.FilenameLength);
		1214	End;
		1215	if LocalFile.ExtraFieldLength > 0 Then
		1216	Begin
		1217	SetLength(LocalFile.ExtraField,LocalFile.ExtraFieldLength);
		1218	MS.Read(LocalFile.ExtraField[1],LocalFile.ExtraFieldLength);
		1219	End;
		1220	if (LocalFile.GeneralPurposeBitFlag And (1 SHL 3)) > 0 Then
		1221	Begin
		1222	MS.Read(DataDescriptor,SizeOf(TDataDescriptor));
		1223	LocalFile.Crc32 := DataDescriptor.Crc32;
		1224	LocalFile.CompressedSize := DataDescriptor.CompressedSize;
		1225	LocalFile.UncompressedSize := DataDescriptor.UncompressedSize;
		1226	End;
		1227	MS.Position := MS.Position+LocalFile.CompressedSize;
		1228
		1229	FillChar(CDFile,SizeOf(TCentralDirectoryFile),0);
		1230	CDFile.CentralFileHeaderSignature := $02014B50;
		1231	CDFile.VersionMadeBy := 20;
		1232	CDFile.VersionNeededToExtract := LocalFile.VersionNeededToExtract;
		1233	CDFile.GeneralPurposeBitFlag := LocalFile.GeneralPurposeBitFlag;
		1234	CDFile.CompressionMethod := LocalFile.CompressionMethod;
		1235	CDFile.LastModFileTimeDate := LocalFile.LastModFileTimeDate;
		1236	CDFile.Crc32 := LocalFile.Crc32;
		1237	CDFile.CompressedSize := LocalFile.CompressedSize;
		1238	CDFile.UncompressedSize := LocalFile.UncompressedSize;
		1239	CDFile.FilenameLength := LocalFile.FilenameLength;
		1240	CDFile.ExtraFieldLength := LocalFile.ExtraFieldLength;
		1241	CDFile.FileCommentLength := 0;
		1242	CDFile.DiskNumberStart := 0;
		1243	CDFile.InternalFileAttributes := LocalFile.VersionNeededToExtract;
		1244	CDFile.ExternalFileAttributes := faArchive;
		1245	CDFile.RelativeOffsetOfLocalHeader := Poz;
		1246	CDFile.FileName := LocalFile.FileName;
		1247	L := Length(CDFile.FileName);
		1248	if L > 0 Then
		1249	Begin
		1250	if CDFile.FileName[L]='/' Then CDFile.ExternalFileAttributes := faDirectory;
		1251	End;
		1252	CDFile.ExtraField := LocalFile.ExtraField;
		1253	CDFile.FileComment := '';
		1254
		1255	Entry := TKAZipEntriesEntry.Create(Self);
		1256	Entry.FDate := FileDateToDateTime(CDFile.LastModFileTimeDate);
		1257	if (CDFile.GeneralPurposeBitFlag And 1) > 0 Then
		1258	Entry.FIsEncrypted := True
		1259	Else
		1260	Entry.FIsEncrypted := False;
		1261	Entry.FIsFolder := (CDFile.ExternalFileAttributes and faDirectory) > 0;
		1262	Entry.FCompressionType := ctUnknown;
		1263	if (CDFile.CompressionMethod=8) or (CDFile.CompressionMethod=9) Then
		1264	Begin
		1265	Case CDFile.GeneralPurposeBitFlag AND 6 of
		1266
		1267	2 : Entry.FCompressionType := ctMaximum;
		1268	4 : Entry.FCompressionType := ctFast;
		1269	6 : Entry.FCompressionType := ctSuperFast
		1270	End;
		1271	End;
		1272	Entry.FCentralDirectoryFile := CDFile;
		1273	Poz := MS.Position;
		1274	Inc(NLE);
		1275	CDSize := CDSize+Entry.CentralEntrySize;
		1276	End;
		1277	Until NoMore;
		1278
		1279	FParent.FEndOfCentralDir.EndOfCentralDirSignature := $06054b50;
		1280	FParent.FEndOfCentralDir.NumberOfThisDisk := 0;
		1281	FParent.FEndOfCentralDir.NumberOfTheDiskWithTheStart := 0;
		1282	FParent.FEndOfCentralDir.TotalNumberOfEntriesOnThisDisk := NLE;
		1283	FParent.FEndOfCentralDir.SizeOfTheCentralDirectory := CDSize;
		1284	FParent.FEndOfCentralDir.OffsetOfStartOfCentralDirectory := MS.Position;
		1285	FParent.FEndOfCentralDir.ZipfileCommentLength := 0;
		1286	Except
		1287	Exit;
		1288	End;
		1289	end;
		1290
		1291	procedure TKAZipEntries.Remove(ItemIndex: Integer; Flush : Boolean);
		1292	Var
		1293	TempStream : TFileStream;
		1294	TempMSStream : TMemoryStream;
		1295	TempFileName : String;
		1296	BUF : String;
		1297	ZipComment : String;
		1298	OSL : Cardinal;
		1299	//*********************************************
		1300	X : Integer;
		1301	TargetPos : Cardinal;
		1302	Border : Cardinal;
		1303
		1304	//Marschall: NR : Integer;
		1305	//Marschall: NW : Integer;
		1306	BufStart : Integer;
		1307	BufLen : Integer;
		1308	ShiftSize : Cardinal;
		1309	NewSize : Cardinal;
		1310	begin
		1311	TargetPos := Items[ItemIndex].FCentralDirectoryFile.RelativeOffsetOfLocalHeader;
		1312	ShiftSize := Items[ItemIndex].LocalEntrySize;
		1313	BufStart := TargetPos+ShiftSize;
		1314	BufLen := FParent.FZipStream.Size-BufStart;
		1315	Border := TargetPos;
		1316	Delete(ItemIndex);
		1317	if (FParent.FZipSaveMethod=FastSave) AND (Count > 0) Then
		1318	Begin
		1319	ZipComment := FParent.Comment.Text;
		1320
		1321	SetLength(BUF,BufLen);
		1322	FParent.FZipStream.Position := BufStart;
		1323	FParent.FZipStream.Read(BUF[1],BufLen); //Marschall: NR := FParent.FZipStream.Read(BUF[1],BufLen);
		1324	FParent.FZipStream.Position := TargetPos;
		1325	FParent.FZipStream.Write(BUF[1],BufLen); //Marschall: NW := FParent.FZipStream.Write(BUF[1],BufLen);
		1326	SetLength(BUF,0);
		1327
		1328	For X := 0 to Count-1 do
		1329	Begin
		1330	if Items[X].FCentralDirectoryFile.RelativeOffsetOfLocalHeader > Border Then
		1331	Begin
		1332	Dec(Items[X].FCentralDirectoryFile.RelativeOffsetOfLocalHeader, ShiftSize);
		1333	TargetPos := TargetPos+Items[X].LocalEntrySize;
		1334	End
		1335	End;
		1336
		1337	FParent.FZipStream.Position := TargetPos;
		1338	//************************************ MARK START OF CENTRAL DIRECTORY
		1339	FParent.FEndOfCentralDir.OffsetOfStartOfCentralDirectory := FParent.FZipStream.Position;
		1340	//************************************ SAVE CENTRAL DIRECTORY
		1341	For X := 0 To Count-1 do
		1342	Begin
		1343	FParent.FZipStream.Write(Self.Items[X].FCentralDirectoryFile,SizeOf(Self.Items[X].FCentralDirectoryFile)-3*SizeOf(String));
		1344	if Self.Items[X].FCentralDirectoryFile.FilenameLength > 0 Then
		1345	FParent.FZipStream.Write(Self.Items[X].FCentralDirectoryFile.FileName[1],Self.Items[X].FCentralDirectoryFile.FilenameLength);
		1346	if Self.Items[X].FCentralDirectoryFile.ExtraFieldLength > 0 Then
		1347	FParent.FZipStream.Write(Self.Items[X].FCentralDirectoryFile.ExtraField[1],Self.Items[X].FCentralDirectoryFile.ExtraFieldLength);
		1348	if Self.Items[X].FCentralDirectoryFile.FileCommentLength > 0 Then
		1349	FParent.FZipStream.Write(Self.Items[X].FCentralDirectoryFile.FileComment[1],Self.Items[X].FCentralDirectoryFile.FileCommentLength);
		1350	End;
		1351	//************************************ SAVE END CENTRAL DIRECTORY RECORD
		1352	FParent.FEndOfCentralDirPos := FParent.FZipStream.Position;
		1353	FParent.FEndOfCentralDir.SizeOfTheCentralDirectory := FParent.FEndOfCentralDirPos-FParent.FEndOfCentralDir.OffsetOfStartOfCentralDirectory;
		1354	Dec(FParent.FEndOfCentralDir.TotalNumberOfEntriesOnThisDisk);
		1355	Dec(FParent.FEndOfCentralDir.TotalNumberOfEntries);
		1356	FParent.FZipStream.Write(FParent.FEndOfCentralDir, SizeOf(TEndOfCentralDir));
		1357	//************************************ SAVE ZIP COMMENT IF ANY
		1358	FParent.FZipCommentPos := FParent.FZipStream.Position;
		1359	if Length(ZipComment) > 0 Then
		1360	Begin
		1361	FParent.FZipStream.Write(ZipComment[1],Length(ZipComment));
		1362	End;
		1363	FParent.FZipStream.Size := FParent.FZipStream.Position;
		1364	End
		1365	Else
		1366	Begin
		1367	if FParent.FUseTempFiles Then
		1368	Begin
		1369	TempFileName := FParent.GetDelphiTempFileName;
		1370	TempStream := TFileStream.Create(TempFileName,fmOpenReadWrite or FmCreate);
		1371	Try
		1372	FParent.SaveToStream(TempStream);
		1373	TempStream.Position := 0;
		1374	OSL := FParent.FZipStream.Size;
		1375	Try
		1376	FParent.FZipStream.Size := TempStream.Size;
		1377	Except
		1378	FParent.FZipStream.Size := OSL;
		1379	Raise;
		1380	End;
		1381	FParent.FZipStream.Position := 0;
		1382
		1383	// Sicherheitsbestimmung
		1384	ProtectStream(FParent.FZipStream);
		1385
		1386	FParent.FZipStream.CopyFrom(TempStream,TempStream.Size);
		1387	//*********************************************************************
		1388	FParent.FZipHeader.ParseZip(FParent.FZipStream);
		1389	//*********************************************************************
		1390	Finally
		1391	TempStream.Free;
		1392	// Sicherheitsbestimmung
		1393	dc_deletefile(tempfilename); // DeleteFile(TempFileName)
		1394	End;
		1395	End
		1396	Else
		1397	Begin
		1398	NewSize := 0;
		1399	For X := 0 To Count-1 do
		1400	Begin
		1401	NewSize := NewSize+Items[X].LocalEntrySize+Items[X].CentralEntrySize;
		1402	if Assigned(FParent.FOnRemoveItems) Then FParent.FOnRemoveItems(FParent,X,Count-1);
		1403	End;
		1404	NewSize := NewSize+SizeOf(FParent.FEndOfCentralDir)+FParent.FEndOfCentralDir.ZipfileCommentLength;
		1405	TempMSStream := TMemoryStream.Create;
		1406	Try
		1407	TempMSStream.SetSize(NewSize);
		1408	TempMSStream.Position := 0;
		1409	FParent.SaveToStream(TempMSStream);
		1410	TempMSStream.Position := 0;
		1411	OSL := FParent.FZipStream.Size;
		1412	Try
		1413	FParent.FZipStream.Size := TempMSStream.Size;
		1414	Except
		1415	FParent.FZipStream.Size := OSL;
		1416	Raise;
		1417	End;
		1418	FParent.FZipStream.Position := 0;
		1419
		1420	// Sicherheitsbestimmung
		1421	ProtectStream(FParent.FZipStream);
		1422
		1423	FParent.FZipStream.CopyFrom(TempMSStream,TempMSStream.Size);
		1424	//*********************************************************************
		1425	FParent.FZipHeader.ParseZip(FParent.FZipStream);
		1426	//*********************************************************************
		1427	Finally
		1428	TempMSStream.Free;
		1429	End;
		1430	End;
		1431	End;
		1432	FParent.FIsDirty := True;
		1433	if NOT FParent.FBatchMode Then
		1434	Begin
		1435	FParent.DoChange(FParent,3);
		1436	End;
		1437	end;
		1438
		1439	procedure TKAZipEntries.Remove(ItemIndex: Integer);
		1440	Begin
		1441	Remove(ItemIndex,True);
		1442	End;
		1443
		1444	procedure TKAZipEntries.Remove(Item: TKAZipEntriesEntry);
		1445	Var
		1446	X : Integer;
		1447	begin
		1448	For X := 0 To Count-1 do
		1449	Begin
		1450	if Self.Items[X]=Item Then
		1451	Begin
		1452	Remove(X);
		1453	Exit;
		1454	End;
		1455	End;
		1456	end;
		1457
		1458	procedure TKAZipEntries.Remove(FileName: String);
		1459	Var
		1460	I : Integer;
		1461	begin
		1462	I := IndexOf(FileName);
		1463	if I <> -1 Then Remove(I);
		1464	end;
		1465
		1466	procedure TKAZipEntries.RemoveBatch(Files:TList);
		1467	Var
		1468	X : Integer;
		1469	OSL : Integer;
		1470	NewSize : Cardinal;
		1471	TempStream : TFileStream;
		1472	TempMSStream : TMemoryStream;
		1473	TempFileName : String;
		1474	Begin
		1475	For X := Files.Count-1 DownTo 0 do
		1476	Begin
		1477	Delete(Integer(Files.Items[X]));
		1478	if Assigned(FParent.FOnRemoveItems) Then FParent.FOnRemoveItems(FParent,Files.Count-X,Files.Count);
		1479	End;
		1480	NewSize := 0;
		1481	if FParent.FUseTempFiles Then
		1482	Begin
		1483	TempFileName := FParent.GetDelphiTempFileName;
		1484	TempStream := TFileStream.Create(TempFileName,fmOpenReadWrite or FmCreate);
		1485	Try
		1486	FParent.SaveToStream(TempStream);
		1487	TempStream.Position := 0;
		1488	OSL := FParent.FZipStream.Size;
		1489	Try
		1490	FParent.FZipStream.Size := TempStream.Size;
		1491	Except
		1492	FParent.FZipStream.Size := OSL;
		1493	Raise;
		1494	End;
		1495	FParent.FZipStream.Position := 0;
		1496
		1497	// Sicherheitsbestimmung
		1498	ProtectStream(FParent.FZipStream);
		1499
		1500	FParent.FZipStream.CopyFrom(TempStream,TempStream.Size);
		1501	//*********************************************************************
		1502	FParent.FZipHeader.ParseZip(FParent.FZipStream);
		1503	//*********************************************************************
		1504	Finally
		1505	TempStream.Free;
		1506	// Sicherheitsbestimmung
		1507	dc_deletefile(tempfilename); // DeleteFile(TempFileName)
		1508	End;
		1509	End
		1510	Else
		1511	Begin
		1512	For X := 0 To Count-1 do
		1513	Begin
		1514	NewSize := NewSize+Items[X].LocalEntrySize+Items[X].CentralEntrySize;
		1515	if Assigned(FParent.FOnRemoveItems) Then FParent.FOnRemoveItems(FParent,X,Count-1);
		1516	End;
		1517	NewSize := NewSize+SizeOf(FParent.FEndOfCentralDir)+FParent.FEndOfCentralDir.ZipfileCommentLength;
		1518	TempMSStream := TMemoryStream.Create;
		1519	Try
		1520	TempMSStream.SetSize(NewSize);
		1521	TempMSStream.Position := 0;
		1522	FParent.SaveToStream(TempMSStream);
		1523	TempMSStream.Position := 0;
		1524	OSL := FParent.FZipStream.Size;
		1525	Try
		1526	FParent.FZipStream.Size := TempMSStream.Size;
		1527	Except
		1528	FParent.FZipStream.Size := OSL;
		1529	Raise;
		1530	End;
		1531	FParent.FZipStream.Position := 0;
		1532
		1533	// Sicherheitsbestimmung
		1534	ProtectStream(FParent.FZipStream);
		1535
		1536	FParent.FZipStream.CopyFrom(TempMSStream,TempMSStream.Size);
		1537	//*********************************************************************
		1538	FParent.FZipHeader.ParseZip(FParent.FZipStream);
		1539	//*********************************************************************
		1540	Finally
		1541	TempMSStream.Free;
		1542	End;
		1543	End;
		1544	End;
		1545
		1546	Function TKAZipEntries.IndexOf(Const FileName:String):Integer;
		1547	Var
		1548	X : Integer;
		1549	FN : String;
		1550	Begin
		1551	Result := -1;
		1552	FN := ToZipName(FileName);
		1553	For X := 0 To Count-1 do
		1554	Begin
		1555	if AnsiCompareText(FN,ToZipName(Items[X].FCentralDirectoryFile.FileName))=0 Then
		1556	Begin
		1557	Result := X;
		1558	Exit;
		1559	End;
		1560	End;
		1561	End;
		1562
		1563
		1564	Function TKAZipEntries.AddStreamFast( ItemName : String;
		1565	FileAttr : Word;
		1566	FileDate : TDateTime;
		1567	Stream : TStream):TKAZipEntriesEntry;
		1568	Var
		1569	Compressor : TCompressionStream;
		1570	CS : TStringStream;
		1571	CM : WORD;
		1572	S : String;
		1573	X : Integer;
		1574	I : Integer;
		1575	UL : Integer;
		1576	CL : Integer;
		1577	FCRC32 : Cardinal;
		1578	SizeToAppend : Integer;
		1579	ZipComment : String;
		1580	Level : TCompressionLevel;
		1581	OBM : Boolean;
		1582	begin
		1583	//*********************************** COMPRESS DATA
		1584	ZipComment := FParent.Comment.Text;
		1585
		1586	if NOT FParent.FStoreRelativePath Then
		1587	ItemName := ExtractFileName(ItemName);
		1588
		1589	ItemName := ToZipName(ItemName);
		1590	I := IndexOf(ItemName);
		1591	if I > -1 Then
		1592	Begin
		1593	OBM := FParent.FBatchMode;
		1594	Try
		1595	if OBM=False Then FParent.FBatchMode := True;
		1596	Remove(I);
		1597	Finally
		1598	FParent.FBatchMode := OBM;
		1599	End;
		1600	End;
		1601
		1602	CS := TStringStream.Create('');
		1603	CS.Position := 0;
		1604	Try
		1605	UL := Stream.Size-Stream.Position;
		1606	SetLength(S,UL);
		1607	CM := 0;
		1608	if UL > 0 Then
		1609	Begin
		1610	Stream.Read(S[1],UL);
		1611	CM := 8;
		1612	End;
		1613	FCRC32 := CalcCRC32(S);
		1614	FParent.FCurrentDFS := UL;
		1615
		1616
		1617	Level := clDefault;
		1618	Case FParent.FZipCompressionType of
		1619	ctNormal : Level := clDefault;
		1620	ctMaximum : Level := clMax;
		1621	ctFast : Level := clFastest;
		1622	ctSuperFast : Level := clFastest;
		1623	ctNone : Level := clNone;
		1624	End;
		1625
		1626	if CM = 8 Then
		1627	Begin
		1628	Compressor := TCompressionStream.Create(Level,CS);
		1629	Try
		1630	Compressor.OnProgress := FParent.OnCompress;
		1631	Compressor.Write(S[1],UL);
		1632	Finally
		1633	Compressor.Free;
		1634	End;
		1635	S := Copy(CS.DataString, 3, Length(CS.DataString)-6);
		1636	End;
		1637	Finally
		1638	CS.Free;
		1639	End;
		1640	//***********************************
		1641	CL := Length(S);
		1642	//*********************************** FILL RECORDS
		1643	Result := TKAZipEntriesEntry(Self.Add);
		1644	With Result.FLocalFile do
		1645	Begin
		1646	LocalFileHeaderSignature := $04034B50;
		1647	VersionNeededToExtract := 20;
		1648	GeneralPurposeBitFlag := 0;
		1649	CompressionMethod := CM;
		1650	LastModFileTimeDate := DateTimeToFileDate(FileDate);
		1651	Crc32 := FCRC32;
		1652	CompressedSize := CL;
		1653	UncompressedSize := UL;
		1654	FilenameLength := Length(ItemName);
		1655	ExtraFieldLength := 0;
		1656	FileName := ItemName;
		1657	ExtraField := '';
		1658	CompressedData := '';
		1659	End;
		1660
		1661	With Result.FCentralDirectoryFile Do
		1662	Begin
		1663	CentralFileHeaderSignature := $02014B50;
		1664	VersionMadeBy := 20;
		1665	VersionNeededToExtract := 20;
		1666	GeneralPurposeBitFlag := 0;
		1667	CompressionMethod := CM;
		1668	LastModFileTimeDate := DateTimeToFileDate(FileDate);
		1669	Crc32 := FCRC32;
		1670	CompressedSize := CL;
		1671	UncompressedSize := UL;
		1672	FilenameLength := Length(ItemName);
		1673	ExtraFieldLength := 0;
		1674	FileCommentLength := 0;
		1675	DiskNumberStart := 0;
		1676	InternalFileAttributes := 0;
		1677	ExternalFileAttributes := FileAttr;
		1678	RelativeOffsetOfLocalHeader := FParent.FEndOfCentralDir.OffsetOfStartOfCentralDirectory;
		1679	FileName := ItemName;
		1680	ExtraField := '';
		1681	FileComment := '';
		1682	End;
		1683
		1684	//************************************ EXPAND ZIP STREAM SIZE
		1685	SizeToAppend := 0;
		1686	SizeToAppend := SizeToAppend+SizeOf(Result.FLocalFile)-3*SizeOf(String);
		1687	SizeToAppend := SizeToAppend+Result.FLocalFile.FilenameLength;
		1688	SizeToAppend := SizeToAppend+CL;
		1689	SizeToAppend := SizeToAppend+SizeOf(Result.FCentralDirectoryFile)-3*SizeOf(String);
		1690	SizeToAppend := SizeToAppend+Result.FCentralDirectoryFile.FilenameLength;
		1691	FParent.FZipStream.Size := FParent.FZipStream.Size+SizeToAppend;
		1692
		1693	//************************************ SAVE LOCAL HEADER AND COMPRESSED DATA
		1694	FParent.FZipStream.Position := Result.FCentralDirectoryFile.RelativeOffsetOfLocalHeader;
		1695	FParent.FZipStream.Write(Result.FLocalFile,SizeOf(Result.FLocalFile)-3*SizeOf(String));
		1696	if Result.FLocalFile.FilenameLength > 0 Then FParent.FZipStream.Write(Result.FLocalFile.FileName[1],Result.FLocalFile.FilenameLength);
		1697	if CL > 0 Then FParent.FZipStream.Write(S[1],CL);
		1698
		1699	//************************************ MARK START OF CENTRAL DIRECTORY
		1700	FParent.FEndOfCentralDir.OffsetOfStartOfCentralDirectory := FParent.FZipStream.Position;
		1701
		1702	//************************************ SAVE CENTRAL DIRECTORY
		1703	For X := 0 To Count-1 do
		1704	Begin
		1705	FParent.FZipStream.Write(Self.Items[X].FCentralDirectoryFile,SizeOf(Self.Items[X].FCentralDirectoryFile)-3*SizeOf(String));
		1706	if Self.Items[X].FCentralDirectoryFile.FilenameLength > 0 Then
		1707	FParent.FZipStream.Write(Self.Items[X].FCentralDirectoryFile.FileName[1],Self.Items[X].FCentralDirectoryFile.FilenameLength);
		1708	if Self.Items[X].FCentralDirectoryFile.ExtraFieldLength > 0 Then
		1709	FParent.FZipStream.Write(Self.Items[X].FCentralDirectoryFile.ExtraField[1],Self.Items[X].FCentralDirectoryFile.ExtraFieldLength);
		1710	if Self.Items[X].FCentralDirectoryFile.FileCommentLength > 0 Then
		1711	FParent.FZipStream.Write(Self.Items[X].FCentralDirectoryFile.FileComment[1],Self.Items[X].FCentralDirectoryFile.FileCommentLength);
		1712	End;
		1713
		1714	//************************************ SAVE END CENTRAL DIRECTORY RECORD
		1715	FParent.FEndOfCentralDirPos := FParent.FZipStream.Position;
		1716	FParent.FEndOfCentralDir.SizeOfTheCentralDirectory := FParent.FEndOfCentralDirPos-FParent.FEndOfCentralDir.OffsetOfStartOfCentralDirectory;
		1717	Inc(FParent.FEndOfCentralDir.TotalNumberOfEntriesOnThisDisk);
		1718	Inc(FParent.FEndOfCentralDir.TotalNumberOfEntries);
		1719	FParent.FZipStream.Write(FParent.FEndOfCentralDir, SizeOf(TEndOfCentralDir));
		1720
		1721	//************************************ SAVE ZIP COMMENT IF ANY
		1722	FParent.FZipCommentPos := FParent.FZipStream.Position;
		1723	if Length(ZipComment) > 0 Then
		1724	Begin
		1725	FParent.FZipStream.Write(ZipComment[1],Length(ZipComment));
		1726	End;
		1727
		1728	Result.FDate := FileDate;
		1729
		1730	if (Result.FCentralDirectoryFile.GeneralPurposeBitFlag And 1) > 0 Then
		1731	Result.FIsEncrypted := True
		1732	Else
		1733	Result.FIsEncrypted := False;
		1734	Result.FIsFolder := (Result.FCentralDirectoryFile.ExternalFileAttributes and faDirectory) > 0;
		1735	Result.FCompressionType := ctUnknown;
		1736	if (Result.FCentralDirectoryFile.CompressionMethod=8) or (Result.FCentralDirectoryFile.CompressionMethod=9) Then
		1737	Begin
		1738	Case Result.FCentralDirectoryFile.GeneralPurposeBitFlag AND 6 of
		1739
		1740	2 : Result.FCompressionType := ctMaximum;
		1741	4 : Result.FCompressionType := ctFast;
		1742	6 : Result.FCompressionType := ctSuperFast
		1743	End;
		1744	End;
		1745	FParent.FIsDirty := True;
		1746	if NOT FParent.FBatchMode Then
		1747	Begin
		1748	FParent.DoChange(FParent,2);
		1749	End;
		1750	end;
		1751
		1752	Function TKAZipEntries.AddStreamRebuild( ItemName : String;
		1753	FileAttr : Word;
		1754	FileDate : TDateTime;
		1755	Stream : TStream):TKAZipEntriesEntry;
		1756	Var
		1757	Compressor : TCompressionStream;
		1758	CS : TStringStream;
		1759	CM : Word;
		1760	S : String;
		1761	UL : Integer;
		1762	CL : Integer;
		1763	I : Integer;
		1764	X : Integer;
		1765	FCRC32 : Cardinal;
		1766	OSL : Cardinal;
		1767	NewSize : Cardinal;
		1768	ZipComment : String;
		1769	TempStream : TFileStream;
		1770	TempMSStream : TMemoryStream;
		1771	TempFileName : String;
		1772	Level : TCompressionLevel;
		1773	OBM : Boolean;
		1774	Begin
		1775	if FParent.FUseTempFiles Then
		1776	Begin
		1777	TempFileName := FParent.GetDelphiTempFileName;
		1778	TempStream := TFileStream.Create(TempFileName,fmOpenReadWrite or FmCreate);
		1779	Try
		1780	//*********************************** SAVE ALL OLD LOCAL ITEMS
		1781	FParent.RebuildLocalFiles(TempStream);
		1782	//*********************************** COMPRESS DATA
		1783	ZipComment := FParent.Comment.Text;
		1784	if NOT FParent.FStoreRelativePath Then
		1785	ItemName := ExtractFileName(ItemName);
		1786	ItemName := ToZipName(ItemName);
		1787	I := IndexOf(ItemName);
		1788	if I > -1 Then
		1789	Begin
		1790	OBM := FParent.FBatchMode;
		1791	Try
		1792	if OBM=False Then FParent.FBatchMode := True;
		1793	Remove(I);
		1794	Finally
		1795	FParent.FBatchMode := OBM;
		1796	End;
		1797	End;
		1798
		1799	CM := 0;
		1800	CS := TStringStream.Create('');
		1801	CS.Position := 0;
		1802	Try
		1803	UL := Stream.Size-Stream.Position;
		1804	SetLength(S,UL);
		1805	if UL > 0 Then
		1806	Begin
		1807	Stream.Read(S[1],UL);
		1808	CM := 8;
		1809	End;
		1810	FCRC32 := CalcCRC32(S);
		1811	FParent.FCurrentDFS := UL;
		1812
		1813	Level := clDefault;
		1814	Case FParent.FZipCompressionType of
		1815	ctNormal : Level := clDefault;
		1816	ctMaximum : Level := clMax;
		1817	ctFast : Level := clFastest;
		1818	ctSuperFast : Level := clFastest;
		1819	ctNone : Level := clNone;
		1820	End;
		1821
		1822	if CM=8 Then
		1823	Begin
		1824	Compressor := TCompressionStream.Create(Level,CS);
		1825	Try
		1826	Compressor.OnProgress := FParent.OnCompress;
		1827	Compressor.Write(S[1],UL);
		1828	Finally
		1829	Compressor.Free;
		1830	End;
		1831	S := Copy(CS.DataString, 3, Length(CS.DataString)-6);
		1832	End;
		1833	Finally
		1834	CS.Free;
		1835	End;
		1836	//************************************************************************
		1837	CL := Length(S);
		1838	//*********************************** FILL RECORDS
		1839	Result := TKAZipEntriesEntry(Self.Add);
		1840	With Result.FLocalFile do
		1841	Begin
		1842	LocalFileHeaderSignature := $04034B50;
		1843	VersionNeededToExtract := 20;
		1844	GeneralPurposeBitFlag := 0;
		1845	CompressionMethod := CM;
		1846	LastModFileTimeDate := DateTimeToFileDate(FileDate);
		1847	Crc32 := FCRC32;
		1848	CompressedSize := CL;
		1849	UncompressedSize := UL;
		1850	FilenameLength := Length(ItemName);
		1851	ExtraFieldLength := 0;
		1852	FileName := ItemName;
		1853	ExtraField := '';
		1854	CompressedData := '';
		1855	End;
		1856
		1857	With Result.FCentralDirectoryFile Do
		1858	Begin
		1859	CentralFileHeaderSignature := $02014B50;
		1860	VersionMadeBy := 20;
		1861	VersionNeededToExtract := 20;
		1862	GeneralPurposeBitFlag := 0;
		1863	CompressionMethod := CM;
		1864	LastModFileTimeDate := DateTimeToFileDate(FileDate);
		1865	Crc32 := FCRC32;
		1866	CompressedSize := CL;
		1867	UncompressedSize := UL;
		1868	FilenameLength := Length(ItemName);
		1869	ExtraFieldLength := 0;
		1870	FileCommentLength := 0;
		1871	DiskNumberStart := 0;
		1872	InternalFileAttributes := 0;
		1873	ExternalFileAttributes := FileAttr;
		1874	RelativeOffsetOfLocalHeader := TempStream.Position;
		1875	FileName := ItemName;
		1876	ExtraField := '';
		1877	FileComment := '';
		1878	End;
		1879
		1880	//************************************ SAVE LOCAL HEADER AND COMPRESSED DATA
		1881	TempStream.Write(Result.FLocalFile,SizeOf(Result.FLocalFile)-3*SizeOf(String));
		1882	if Result.FLocalFile.FilenameLength > 0 Then TempStream.Write(Result.FLocalFile.FileName[1],Result.FLocalFile.FilenameLength);
		1883	if CL > 0 Then TempStream.Write(S[1],CL);
		1884	//************************************
		1885	FParent.NewLHOffsets[Count-1] := Result.FCentralDirectoryFile.RelativeOffsetOfLocalHeader;
		1886	FParent.RebuildCentralDirectory(TempStream);
		1887	FParent.RebuildEndOfCentralDirectory(TempStream);
		1888	//************************************
		1889	TempStream.Position := 0;
		1890	OSL := FParent.FZipStream.Size;
		1891	Try
		1892	FParent.FZipStream.Size := TempStream.Size;
		1893	Except
		1894	FParent.FZipStream.Size := OSL;
		1895	Raise;
		1896	End;
		1897	FParent.FZipStream.Position := 0;
		1898
		1899	// Sicherheitsbestimmung
		1900	ProtectStream(FParent.FZipStream);
		1901
		1902	FParent.FZipStream.CopyFrom(TempStream,TempStream.Size);
		1903	Finally
		1904	TempStream.Free;
		1905	// Sicherheitsbestimmung
		1906	dc_deletefile(tempfilename); // DeleteFile(TempFileName)
		1907	End;
		1908	End
		1909	Else
		1910	Begin
		1911	TempMSStream := TMemoryStream.Create;
		1912	NewSize := 0;
		1913	For X := 0 To Count-1 do
		1914	Begin
		1915	NewSize := NewSize+Items[X].LocalEntrySize+Items[X].CentralEntrySize;
		1916	if Assigned(FParent.FOnRemoveItems) Then FParent.FOnRemoveItems(FParent,X,Count-1);
		1917	End;
		1918	NewSize := NewSize+SizeOf(FParent.FEndOfCentralDir)+FParent.FEndOfCentralDir.ZipfileCommentLength;
		1919	Try
		1920	TempMSStream.SetSize(NewSize);
		1921	TempMSStream.Position := 0;
		1922	//*********************************** SAVE ALL OLD LOCAL ITEMS
		1923	FParent.RebuildLocalFiles(TempMSStream);
		1924	//*********************************** COMPRESS DATA
		1925	ZipComment := FParent.Comment.Text;
		1926	if NOT FParent.FStoreRelativePath Then
		1927	ItemName := ExtractFileName(ItemName);
		1928	ItemName := ToZipName(ItemName);
		1929	I := IndexOf(ItemName);
		1930	if I > -1 Then
		1931	Begin
		1932	OBM := FParent.FBatchMode;
		1933	Try
		1934	if OBM=False Then FParent.FBatchMode := True;
		1935	Remove(I);
		1936	Finally
		1937	FParent.FBatchMode := OBM;
		1938	End;
		1939	End;
		1940
		1941	CM := 0;
		1942	CS := TStringStream.Create('');
		1943	CS.Position := 0;
		1944	Try
		1945	UL := Stream.Size-Stream.Position;
		1946	SetLength(S,UL);
		1947	if UL > 0 Then
		1948	Begin
		1949	Stream.Read(S[1],UL);
		1950	CM := 8;
		1951	End;
		1952	FCRC32 := CalcCRC32(S);
		1953	FParent.FCurrentDFS := UL;
		1954
		1955	Level := clDefault;
		1956	Case FParent.FZipCompressionType of
		1957	ctNormal : Level := clDefault;
		1958	ctMaximum : Level := clMax;
		1959	ctFast : Level := clFastest;
		1960	ctSuperFast : Level := clFastest;
		1961	ctNone : Level := clNone;
		1962	End;
		1963
		1964	if CM=8 Then
		1965	Begin
		1966	Compressor := TCompressionStream.Create(Level,CS);
		1967	Try
		1968	Compressor.OnProgress := FParent.OnCompress;
		1969	Compressor.Write(S[1],UL);
		1970	Finally
		1971	Compressor.Free;
		1972	End;
		1973	S := Copy(CS.DataString, 3, Length(CS.DataString)-6);
		1974	End;
		1975	Finally
		1976	CS.Free;
		1977	End;
		1978	//************************************************************************
		1979	CL := Length(S);
		1980	//*********************************** FILL RECORDS
		1981	Result := TKAZipEntriesEntry(Self.Add);
		1982	With Result.FLocalFile do
		1983	Begin
		1984	LocalFileHeaderSignature := $04034B50;
		1985	VersionNeededToExtract := 20;
		1986	GeneralPurposeBitFlag := 0;
		1987	CompressionMethod := CM;
		1988	LastModFileTimeDate := DateTimeToFileDate(FileDate);
		1989	Crc32 := FCRC32;
		1990	CompressedSize := CL;
		1991	UncompressedSize := UL;
		1992	FilenameLength := Length(ItemName);
		1993	ExtraFieldLength := 0;
		1994	FileName := ItemName;
		1995	ExtraField := '';
		1996	CompressedData := '';
		1997	End;
		1998
		1999	With Result.FCentralDirectoryFile Do
		2000	Begin
		2001	CentralFileHeaderSignature := $02014B50;
		2002	VersionMadeBy := 20;
		2003	VersionNeededToExtract := 20;
		2004	GeneralPurposeBitFlag := 0;
		2005	CompressionMethod := CM;
		2006	LastModFileTimeDate := DateTimeToFileDate(FileDate);
		2007	Crc32 := FCRC32;
		2008	CompressedSize := CL;
		2009	UncompressedSize := UL;
		2010	FilenameLength := Length(ItemName);
		2011	ExtraFieldLength := 0;
		2012	FileCommentLength := 0;
		2013	DiskNumberStart := 0;
		2014	InternalFileAttributes := 0;
		2015	ExternalFileAttributes := FileAttr;
		2016	RelativeOffsetOfLocalHeader := TempMSStream.Position;
		2017	FileName := ItemName;
		2018	ExtraField := '';
		2019	FileComment := '';
		2020	End;
		2021
		2022	//************************************ SAVE LOCAL HEADER AND COMPRESSED DATA
		2023	TempMSStream.Write(Result.FLocalFile,SizeOf(Result.FLocalFile)-3*SizeOf(String));
		2024	if Result.FLocalFile.FilenameLength > 0 Then TempMSStream.Write(Result.FLocalFile.FileName[1],Result.FLocalFile.FilenameLength);
		2025	if CL > 0 Then TempMSStream.Write(S[1],CL);
		2026	//************************************
		2027	FParent.NewLHOffsets[Count-1] := Result.FCentralDirectoryFile.RelativeOffsetOfLocalHeader;
		2028	FParent.RebuildCentralDirectory(TempMSStream);
		2029	FParent.RebuildEndOfCentralDirectory(TempMSStream);
		2030	//************************************
		2031	TempMSStream.Position := 0;
		2032	OSL := FParent.FZipStream.Size;
		2033	Try
		2034	FParent.FZipStream.Size := TempMSStream.Size;
		2035	Except
		2036	FParent.FZipStream.Size := OSL;
		2037	Raise;
		2038	End;
		2039	FParent.FZipStream.Position := 0;
		2040
		2041	// Sicherheitsbestimmung
		2042	ProtectStream(FParent.FZipStream);
		2043
		2044	FParent.FZipStream.CopyFrom(TempMSStream,TempMSStream.Size);
		2045	Finally
		2046	TempMSStream.Free;
		2047	End;
		2048	End;
		2049
		2050	Result.FDate := FileDateToDateTime(Result.FCentralDirectoryFile.LastModFileTimeDate);
		2051	if (Result.FCentralDirectoryFile.GeneralPurposeBitFlag And 1) > 0 Then
		2052	Result.FIsEncrypted := True
		2053	Else
		2054	Result.FIsEncrypted := False;
		2055	Result.FIsFolder := (Result.FCentralDirectoryFile.ExternalFileAttributes and faDirectory) > 0;
		2056	Result.FCompressionType := ctUnknown;
		2057	if (Result.FCentralDirectoryFile.CompressionMethod=8) or (Result.FCentralDirectoryFile.CompressionMethod=9) Then
		2058	Begin
		2059	Case Result.FCentralDirectoryFile.GeneralPurposeBitFlag AND 6 of
		2060
		2061	2 : Result.FCompressionType := ctMaximum;
		2062	4 : Result.FCompressionType := ctFast;
		2063	6 : Result.FCompressionType := ctSuperFast
		2064	End;
		2065	End;
		2066	FParent.FIsDirty := True;
		2067	if NOT FParent.FBatchMode Then
		2068	Begin
		2069	FParent.DoChange(FParent,2);
		2070	End;
		2071	End;
		2072
		2073	function TKAZipEntries.AddFolderChain(ItemName: String; FileAttr: Word;
		2074	FileDate: TDateTime): Boolean;
		2075	Var
		2076	FN : String;
		2077	TN : String;
		2078	INCN : String;
		2079	P : Integer;
		2080	MS : TMemoryStream;
		2081	NoMore : Boolean;
		2082	Begin
		2083	//Marschall: Result := False;
		2084	FN := ExtractFilePath(ToDosName(ToZipName(ItemName)));
		2085	TN := FN;
		2086	INCN := '';
		2087	MS := TMemoryStream.Create;
		2088	Try
		2089	Repeat
		2090	NoMore := True;
		2091	P := Pos('\',TN);
		2092	if P > 0 Then
		2093	Begin
		2094	INCN := INCN+Copy(TN,1,P);
		2095	System.Delete(TN,1,P);
		2096	MS.Position := 0;
		2097	MS.Size := 0;
		2098	If IndexOf(INCN) = -1 Then
		2099	Begin
		2100	if FParent.FZipSaveMethod = FastSave Then
		2101	AddStreamFast(INCN,FileAttr,FileDate,MS)
		2102	Else
		2103	if FParent.FZipSaveMethod = RebuildAll Then
		2104	AddStreamRebuild(INCN,FileAttr,FileDate,MS);
		2105	End;
		2106	NoMore := False;
		2107	End;
		2108	Until NoMore;
		2109	Result := True;
		2110	Finally
		2111	MS.Free;
		2112	End;
		2113	End;
		2114
		2115	Function TKAZipEntries.AddFolderChain(ItemName : String):Boolean;
		2116	begin
		2117	Result := AddFolderChain(ItemName,faDirectory,Now);
		2118	end;
		2119
		2120	function TKAZipEntries.AddStream(FileName : String; FileAttr : Word; FileDate : TDateTime; Stream : TStream):TKAZipEntriesEntry;
		2121	Begin
		2122	Result := Nil;
		2123	if (FParent.FStoreFolders) AND (FParent.FStoreRelativePath) Then AddFolderChain(FileName);
		2124	if FParent.FZipSaveMethod = FastSave Then
		2125	Result := AddStreamFast(FileName,FileAttr,FileDate,Stream)
		2126	Else
		2127	if FParent.FZipSaveMethod = RebuildAll Then
		2128	Result := AddStreamRebuild(FileName,FileAttr,FileDate,Stream);
		2129	if Assigned(FParent.FOnAddItem) Then FParent.FOnAddItem(FParent,FileName);
		2130	End;
		2131
		2132	Function TKAZipEntries.AddStream(FileName: String; Stream : TStream):TKAZipEntriesEntry;
		2133	begin
		2134	Result := AddStream(FileName,faArchive,Now,Stream);
		2135	end;
		2136
		2137	Function TKAZipEntries.AddFile(FileName, NewFileName: String):TKAZipEntriesEntry;
		2138	Var
		2139	FS : TFileStream;
		2140	Dir : TSearchRec;
		2141	Res : Integer;
		2142	begin
		2143	Result := Nil;
		2144	Res := FindFirst(FileName,faAnyFile,Dir);
		2145	if Res=0 Then
		2146	Begin
		2147	FS := TFileStream.Create(FileName,fmOpenRead or fmShareDenyNone);
		2148	Try
		2149	FS.Position := 0;
		2150	Result := AddStream(NewFileName,Dir.Attr,FileDateToDateTime(Dir.Time),FS)
		2151	Finally
		2152	FS.Free;
		2153	End;
		2154	End;
		2155	FindClose(Dir);
		2156	end;
		2157
		2158	Function TKAZipEntries.AddFile(FileName: String):TKAZipEntriesEntry;
		2159	begin
		2160	Result := AddFile(FileName,FileName);
		2161	end;
		2162
		2163	function TKAZipEntries.AddFiles(FileNames: TStrings): Boolean;
		2164	Var
		2165	X : Integer;
		2166	begin
		2167	Result := False;
		2168	FParent.FBatchMode := True;
		2169	Try
		2170	For X := 0 To FileNames.Count-1 do AddFile(FileNames.Strings[X]);
		2171	Except
		2172	FParent.FBatchMode := False;
		2173	FParent.DoChange(FParent,2);
		2174	Exit;
		2175	End;
		2176	FParent.FBatchMode := False;
		2177	FParent.DoChange(FParent,2);
		2178	Result := True;
		2179	end;
		2180
		2181	Function TKAZipEntries.AddFolderEx(FolderName:String; RootFolder:String; WildCard : String; WithSubFolders : Boolean):Boolean;
		2182	Var
		2183	Res : Integer;
		2184	Dir : TSearchRec;
		2185	FN : String;
		2186	Begin
		2187	Res := FindFirst(FolderName+'\.',faAnyFile,Dir);
		2188	While Res=0 Do
		2189	Begin
		2190	if (Dir.Attr and faDirectory) > 0 Then
		2191	Begin
		2192	if (Dir.Name <> '..') And (Dir.Name <> '.') Then
		2193	Begin
		2194	FN := FolderName+'\'+Dir.Name;
		2195	if (FParent.FStoreFolders) AND (FParent.FStoreRelativePath) Then
		2196	AddFolderChain(RemoveRootName(FN+'\',RootFolder),Dir.Attr,FileDateToDateTime(Dir.Time));
		2197	if WithSubFolders Then
		2198	Begin
		2199	AddFolderEx(FN, RootFolder, WildCard, WithSubFolders);
		2200	End;
		2201	End
		2202	Else
		2203	Begin
		2204	if (Dir.Name = '.') Then AddFolderChain(RemoveRootName(FolderName+'\',RootFolder),Dir.Attr,FileDateToDateTime(Dir.Time));
		2205	End;
		2206	End
		2207	Else
		2208	Begin
		2209	FN := FolderName+'\'+Dir.Name;
		2210	if MatchesMask(FN,WildCard) Then
		2211	Begin
		2212	AddFile(FN,RemoveRootName(FN,RootFolder));
		2213	End;
		2214	End;
		2215	Res := FindNext(Dir);
		2216	End;
		2217	FindClose(Dir);
		2218	Result := True;
		2219	End;
		2220
		2221	Function TKAZipEntries.AddFolder(FolderName:String; RootFolder:String; WildCard : String; WithSubFolders : Boolean):Boolean;
		2222	Begin
		2223	FParent.FBatchMode := True;
		2224	Try
		2225	Result := AddFolderEx(FolderName,RootFolder,WildCard,WithSubFolders);
		2226	Finally
		2227	FParent.FBatchMode := False;
		2228	FParent.DoChange(FParent,2);
		2229	End;
		2230	End;
		2231
		2232	Function TKAZipEntries.AddFilesAndFolders(FileNames:TStrings; RootFolder:String; WithSubFolders : Boolean):Boolean;
		2233	Var
		2234	X : Integer;
		2235	Res : Integer;
		2236	Dir : TSearchRec;
		2237	Begin
		2238	FParent.FBatchMode := True;
		2239	Try
		2240	For X := 0 To FileNames.Count-1 do
		2241	Begin
		2242	Res := FindFirst(FileNames.Strings[X],faAnyFile,Dir);
		2243	if Res=0 Then
		2244	Begin
		2245	if (Dir.Attr and faDirectory) > 0 Then
		2246	Begin
		2247	if (Dir.Name <> '..') And (Dir.Name <> '.') Then
		2248	Begin
		2249	AddFolderEx(FileNames.Strings[X],RootFolder,'.',WithSubFolders);
		2250	End;
		2251	End
		2252	Else
		2253	Begin
		2254	AddFile(FileNames.Strings[X],RemoveRootName(FileNames.Strings[X],RootFolder));
		2255	End;
		2256	End;
		2257	FindClose(Dir);
		2258	End;
		2259	Finally
		2260	FParent.FBatchMode := False;
		2261	FParent.DoChange(FParent,2);
		2262	End;
		2263	Result := True;
		2264	End;
		2265
		2266
		2267	procedure TKAZipEntries.RemoveFiles(List: TList);
		2268	begin
		2269	if List.Count=1 Then
		2270	Begin
		2271	Remove(Integer(List.Items[0]));
		2272	End
		2273	Else
		2274	Begin
		2275	SortList(List);
		2276	FParent.FBatchMode := True;
		2277	Try
		2278	RemoveBatch(List);
		2279	Finally
		2280	FParent.FBatchMode := False;
		2281	FParent.DoChange(Self,3);
		2282	End;
		2283	End;
		2284	end;
		2285
		2286	Procedure TKAZipEntries.RemoveSelected;
		2287	Var
		2288	X : Integer;
		2289	List : TList;
		2290	Begin
		2291	FParent.FBatchMode := True;
		2292	List := TList.Create;
		2293	Try
		2294	For X := 0 to Count-1 do
		2295	Begin
		2296	if Self.Items[X].Selected Then List.Add(Pointer(X));
		2297	End;
		2298	RemoveBatch(List);
		2299	Finally
		2300	List.Free;
		2301	FParent.FBatchMode := False;
		2302	FParent.DoChange(Self,3);
		2303	End;
		2304	End;
		2305
		2306
		2307	procedure TKAZipEntries.ExtractToStream(Item : TKAZipEntriesEntry; Stream: TStream);
		2308	Var
		2309	SFS : TMemoryStream;
		2310	TFS : TStream;
		2311	BUF : String;
		2312	NR : Cardinal;
		2313	Decompressor : TDecompressionStream;
		2314	{$IFDEF USE_BZIP2}
		2315	DecompressorBZ2 : TBZDecompressionStream;
		2316	{$ENDIF}
		2317	begin
		2318	if (
		2319	(Item.CompressionMethod=8) or
		2320	{$IFDEF USE_BZIP2}
		2321	(Item.CompressionMethod=12) or
		2322	{$ENDIF}
		2323	(Item.CompressionMethod=0)
		2324	)
		2325	And (NOT Item.FIsEncrypted) Then
		2326	Begin
		2327	SFS := TMemoryStream.Create;
		2328	TFS := Stream;
		2329	Try
		2330	if Item.GetCompressedData(SFS) > 0 Then
		2331	Begin
		2332	SFS.Position := 0;
		2333	FParent.FCurrentDFS := Item.SizeUncompressed;
		2334	//****************************************************** DEFLATE
		2335	if (Item.CompressionMethod=8) Then
		2336	Begin
		2337	Decompressor := TDecompressionStream.Create(SFS);
		2338	Decompressor.OnProgress := FParent.OnDecompress;
		2339	SetLength(BUF,FParent.FCurrentDFS);
		2340	Try
		2341	NR := Decompressor.Read(BUF[1],FParent.FCurrentDFS);
		2342	if NR=FParent.FCurrentDFS Then TFS.Write(BUF[1],FParent.FCurrentDFS);
		2343	Finally
		2344	Decompressor.Free;
		2345	End;
		2346	End
		2347	//******************************************************* BZIP2
		2348	{$IFDEF USE_BZIP2}
		2349	Else
		2350	If Item.CompressionMethod=12 Then
		2351	Begin
		2352	DecompressorBZ2 := TBZDecompressionStream.Create(SFS);
		2353	DecompressorBZ2.OnProgress := FParent.OnDecompress;
		2354	SetLength(BUF,FParent.FCurrentDFS);
		2355	Try
		2356	NR := DecompressorBZ2.Read(BUF[1],FParent.FCurrentDFS);
		2357	if NR=FParent.FCurrentDFS Then TFS.Write(BUF[1],FParent.FCurrentDFS);
		2358	Finally
		2359	DecompressorBZ2.Free;
		2360	End;
		2361	End
		2362	{$ENDIF}
		2363	//****************************************************** STORED
		2364	Else
		2365	If Item.CompressionMethod=0 Then
		2366	Begin
		2367	TFS.CopyFrom(SFS,FParent.FCurrentDFS);
		2368	End;
		2369	End;
		2370	Finally
		2371	SFS.Free;
		2372	End;
		2373	End
		2374	Else
		2375	Begin
		2376	Raise Exception.Create('Cannot process this file: '+Item.FileName+' ');
		2377	End;
		2378	end;
		2379
		2380	procedure TKAZipEntries.InternalExtractToFile(Item: TKAZipEntriesEntry;
		2381	FileName: String);
		2382	Var
		2383	TFS : TFileStream;
		2384	Attr : Integer;
		2385	begin
		2386	if Item.IsFolder Then
		2387	Begin
		2388	ForceDirectories(FileName);
		2389	End
		2390	Else
		2391	Begin
		2392	TFS := TFileStream.Create(FileName,fmCreate or fmOpenReadWrite or fmShareDenyNone);
		2393	Try
		2394	ExtractToStream(Item,TFS);
		2395	Finally
		2396	TFS.Free;
		2397	End;
		2398	If FParent.FApplyAttributes Then
		2399	Begin
		2400	Attr := faArchive;
		2401	if Item.FCentralDirectoryFile.ExternalFileAttributes And faHidden > 0 Then Attr := Attr Or faHidden;
		2402	if Item.FCentralDirectoryFile.ExternalFileAttributes And faSysFile > 0 Then Attr := Attr Or faSysFile;
		2403	if Item.FCentralDirectoryFile.ExternalFileAttributes And faReadOnly > 0 Then Attr := Attr Or faReadOnly;
		2404	FileSetAttr(FileName,Attr);
		2405	End;
		2406	End;
		2407	end;
		2408
		2409
		2410	procedure TKAZipEntries.ExtractToFile(Item: TKAZipEntriesEntry; FileName: String);
		2411	var
		2412	Can : Boolean;
		2413	OA : TOverwriteAction;
		2414	Begin
		2415	OA := FParent.FOverwriteAction;
		2416	Can := True;
		2417	if ((OA<>oaOverwriteAll) And (OA<>oaSkipAll)) And (Assigned(FParent.FOnOverwriteFile)) Then
		2418	Begin
		2419	if FileExists(FileName) Then
		2420	Begin
		2421	FParent.FOnOverwriteFile(FParent,FileName,OA);
		2422	End
		2423	Else
		2424	Begin
		2425	OA := oaOverwrite;
		2426	End;
		2427	End;
		2428	Case OA Of
		2429	oaSkip : Can := False;
		2430	oaSkipAll : Can := False;
		2431	oaOverwrite : Can := True;
		2432	oaOverwriteAll : Can := True;
		2433	End;
		2434	if Can Then InternalExtractToFile(Item, FileName);
		2435	End;
		2436
		2437	procedure TKAZipEntries.ExtractToFile(ItemIndex: Integer; FileName: String);
		2438	var
		2439	Can : Boolean;
		2440	OA : TOverwriteAction;
		2441	Begin
		2442	OA := FParent.FOverwriteAction;
		2443	Can := True;
		2444	if ((OA<>oaOverwriteAll) And (OA<>oaSkipAll)) And (Assigned(FParent.FOnOverwriteFile)) Then
		2445	Begin
		2446	if FileExists(FileName) Then
		2447	Begin
		2448	FParent.FOnOverwriteFile(FParent,FileName,OA);
		2449	End
		2450	Else
		2451	Begin
		2452	OA := oaOverwrite;
		2453	End;
		2454	End;
		2455	Case OA Of
		2456	oaSkip : Can := False;
		2457	oaSkipAll : Can := False;
		2458	oaOverwrite : Can := True;
		2459	oaOverwriteAll : Can := True;
		2460	End;
		2461	if Can Then InternalExtractToFile(Items[ItemIndex],FileName);
		2462	end;
		2463
		2464	procedure TKAZipEntries.ExtractToFile(FileName, DestinationFileName: String);
		2465	Var
		2466	I : Integer;
		2467	Can : Boolean;
		2468	OA : TOverwriteAction;
		2469	Begin
		2470	OA := FParent.FOverwriteAction;
		2471	Can := True;
		2472	if ((OA<>oaOverwriteAll) And (OA<>oaSkipAll)) And (Assigned(FParent.FOnOverwriteFile)) Then
		2473	Begin
		2474	if FileExists(DestinationFileName) Then
		2475	Begin
		2476	FParent.FOnOverwriteFile(FParent,DestinationFileName,OA);
		2477	End
		2478	Else
		2479	Begin
		2480	OA := oaOverwrite;
		2481	End;
		2482	End;
		2483	Case OA Of
		2484	oaSkip : Can := False;
		2485	oaSkipAll : Can := False;
		2486	oaOverwrite : Can := True;
		2487	oaOverwriteAll : Can := True;
		2488	End;
		2489	if Can Then
		2490	Begin
		2491	I := IndexOf(FileName);
		2492	InternalExtractToFile(Items[I],DestinationFileName);
		2493	End;
		2494	end;
		2495
		2496	procedure TKAZipEntries.ExtractAll(TargetDirectory: String);
		2497	Var
		2498	FN : String;
		2499	DN : String;
		2500	X : Integer;
		2501	Can : Boolean;
		2502	OA : TOverwriteAction;
		2503	FileName : String;
		2504	begin
		2505	OA := FParent.FOverwriteAction;
		2506	Can := True;
		2507	Try
		2508	For X := 0 To Count-1 do
		2509	Begin
		2510	FN := FParent.GetFileName(Items[X].FileName);
		2511	DN := FParent.GetFilePath(Items[X].FileName);
		2512	if DN <> '' Then ForceDirectories(TargetDirectory+'\'+DN);
		2513	FileName := TargetDirectory+'\'+DN+FN;
		2514	if ((OA<>oaOverwriteAll) And (OA<>oaSkipAll)) And (Assigned(FParent.FOnOverwriteFile)) Then
		2515	Begin
		2516	if FileExists(FileName) Then
		2517	Begin
		2518	FParent.FOnOverwriteFile(FParent,FileName,OA);
		2519	End;
		2520	End;
		2521	Case OA Of
		2522	oaSkip : Can := False;
		2523	oaSkipAll : Can := False;
		2524	oaOverwrite : Can := True;
		2525	oaOverwriteAll : Can := True;
		2526	End;
		2527	if Can Then InternalExtractToFile(Items[X],FileName);
		2528	End;
		2529	Finally
		2530	End;
		2531	end;
		2532
		2533	procedure TKAZipEntries.ExtractSelected(TargetDirectory: String);
		2534	Var
		2535	FN : String;
		2536	DN : String;
		2537	X : Integer;
		2538	OA : TOverwriteAction;
		2539	Can : Boolean;
		2540	FileName : String;
		2541	begin
		2542	OA := FParent.FOverwriteAction;
		2543	Can := True;
		2544	Try
		2545	For X := 0 To Count-1 do
		2546	Begin
		2547	if Items[X].FSelected Then
		2548	Begin
		2549	FN := FParent.GetFileName(Items[X].FileName);
		2550	DN := FParent.GetFilePath(Items[X].FileName);
		2551	if DN <> '' Then ForceDirectories(TargetDirectory+'\'+DN);
		2552	FileName := TargetDirectory+'\'+DN+FN;
		2553	if ((OA<>oaOverwriteAll) And (OA<>oaSkipAll)) And (Assigned(FParent.FOnOverwriteFile)) Then
		2554	Begin
		2555	if FileExists(FileName) Then
		2556	Begin
		2557	FParent.FOnOverwriteFile(FParent,FileName,OA);
		2558	End;
		2559	End;
		2560	Case OA Of
		2561	oaSkip : Can := False;
		2562	oaSkipAll : Can := False;
		2563	oaOverwrite : Can := True;
		2564	oaOverwriteAll : Can := True;
		2565	End;
		2566	if Can Then InternalExtractToFile(Items[X],TargetDirectory+'\'+DN+FN);
		2567	End;
		2568	End;
		2569	Finally
		2570	End;
		2571	end;
		2572
		2573
		2574
		2575	procedure TKAZipEntries.DeSelectAll;
		2576	Var
		2577	X : Integer;
		2578	begin
		2579	For X := 0 To Count-1 do Items[X].Selected := False;
		2580	end;
		2581
		2582	procedure TKAZipEntries.InvertSelection;
		2583	Var
		2584	X : Integer;
		2585	begin
		2586	For X := 0 To Count-1 do Items[X].Selected := Not Items[X].Selected;
		2587	end;
		2588
		2589	procedure TKAZipEntries.SelectAll;
		2590	Var
		2591	X : Integer;
		2592	begin
		2593	For X := 0 To Count-1 do Items[X].Selected := True;
		2594	end;
		2595
		2596	procedure TKAZipEntries.Select(WildCard: String);
		2597	Var
		2598	X : Integer;
		2599	begin
		2600	For X := 0 To Count-1 do
		2601	Begin
		2602	if MatchesMask(ToDosName(Items[X].FileName),WildCard) Then
		2603	Items[X].Selected := True;
		2604	End;
		2605	end;
		2606
		2607
		2608	procedure TKAZipEntries.Rebuild;
		2609	begin
		2610	FParent.Rebuild;
		2611	end;
		2612
		2613	procedure TKAZipEntries.Rename(Item: TKAZipEntriesEntry; NewFileName: String);
		2614	begin
		2615	Item.FileName := NewFileName;
		2616	end;
		2617
		2618	procedure TKAZipEntries.Rename(ItemIndex: Integer; NewFileName: String);
		2619	begin
		2620	Rename(Items[ItemIndex],NewFileName);
		2621	end;
		2622
		2623	procedure TKAZipEntries.Rename(FileName, NewFileName: String);
		2624	Var
		2625	I : Integer;
		2626	begin
		2627	I := IndexOf(FileName);
		2628	Rename(I,NewFileName);
		2629	end;
		2630
		2631
		2632	procedure TKAZipEntries.CreateFolder(FolderName: String; FolderDate: TDateTime);
		2633	Var
		2634	FN : String;
		2635	begin
		2636	FN := IncludeTrailingBackslash(FolderName);
		2637	AddFolderChain(FN,faDirectory,FolderDate);
		2638	FParent.FIsDirty := True;
		2639	end;
		2640
		2641	procedure TKAZipEntries.RenameFolder(FolderName : String; NewFolderName : String);
		2642	Var
		2643	FN : String;
		2644	NFN : String;
		2645	S : String;
		2646	X : Integer;
		2647	L : Integer;
		2648	begin
		2649	FN := ToZipName(IncludeTrailingBackslash(FolderName));
		2650	NFN := ToZipName(IncludeTrailingBackslash(NewFolderName));
		2651	L := Length(FN);
		2652	if IndexOf(NFN) = -1 Then
		2653	Begin
		2654	For X := 0 To Count-1 do
		2655	Begin
		2656	S := Items[X].FileName;
		2657	if Pos(FN,S) = 1 Then
		2658	Begin
		2659	System.Delete(S,1,L);
		2660	S := NFN+S;
		2661	Items[X].FileName := S;
		2662	FParent.FIsDirty := True;
		2663	End;
		2664	End;
		2665	If (FParent.FIsDirty) And (FParent.FBatchMode=False) Then Rebuild;
		2666	End;
		2667	end;
		2668
		2669	procedure TKAZipEntries.RenameMultiple(Names : TStringList; NewNames : TStringList);
		2670	Var
		2671	X : Integer;
		2672	BR : Integer;
		2673	L : Integer;
		2674	Begin
		2675	BR := 0; // Marschall
		2676	If Names.Count <> NewNames.Count Then
		2677	Begin
		2678	Raise Exception.Create('Names and NewNames must have equal count');
		2679	End
		2680	Else
		2681	Begin
		2682	FParent.FBatchMode := True;
		2683	Try
		2684	For X := 0 To Names.Count-1 do
		2685	Begin
		2686	L := Length(Names.Strings[X]);
		2687	if (L>0) And ((Names.Strings[X][L]='\') or (Names.Strings[X][L]='/')) Then
		2688	Begin
		2689	RenameFolder(Names.Strings[X],NewNames.Strings[X]);
		2690	Inc(BR);
		2691	End
		2692	Else
		2693	Begin
		2694	Rename(Names.Strings[X],NewNames.Strings[X]);
		2695	Inc(BR);
		2696	End;
		2697	End;
		2698	Finally
		2699	FParent.FBatchMode := False;
		2700	End;
		2701	If BR > 0 Then
		2702	Begin
		2703	Rebuild;
		2704	FParent.DoChange(FParent,6);
		2705	End;
		2706	End;
		2707	End;
		2708
		2709
		2710	{ TKAZip }
		2711	constructor TKAZip.Create(AOwner: TComponent);
		2712	begin
		2713	Inherited Create(AOwner);
		2714	FZipStream := Nil;
		2715	FOnDecompressFile := Nil;
		2716	FOnCompressFile := Nil;
		2717	FOnZipChange := Nil;
		2718	FOnZipOpen := Nil;
		2719	FOnAddItem := Nil;
		2720	FOnOverwriteFile := Nil;
		2721	FComponentVersion := '2.0';
		2722	FBatchMode := False;
		2723	FFileNames := TStringList.Create;
		2724	FZipHeader := TKAZipEntries.Create(Self);
		2725	FZipComment := TStringList.Create;
		2726	FIsZipFile := False;
		2727	FFileName := '';
		2728	FCurrentDFS := 0;
		2729	FExternalStream := False;
		2730	FIsDirty := True;
		2731	FHasBadEntries := False;
		2732	FReadOnly := False;
		2733
		2734	FApplyAttributes := True;
		2735	FOverwriteAction := oaSkip;
		2736	FZipSaveMethod := FastSave;
		2737	FUseTempFiles := False;
		2738	FStoreRelativePath := True;
		2739	FStoreFolders := True;
		2740	FZipCompressionType := ctMaximum;
		2741	end;
		2742
		2743
		2744	destructor TKAZip.Destroy;
		2745	begin
		2746	if Assigned(FZipStream) AND (NOT FExternalStream) Then FZipStream.Free;
		2747	FZipHeader.Free;
		2748	FZipComment.Free;
		2749	FFileNames.Free;
		2750	inherited Destroy;
		2751	end;
		2752
		2753	procedure TKAZip.DoChange(Sender: TObject; Const ChangeType : Integer);
		2754	begin
		2755	if Assigned(FOnZipChange) Then FOnZipChange(Self, ChangeType);
		2756	end;
		2757
		2758
		2759	function TKAZip.GetFileName(S: String): String;
		2760	Var
		2761	FN : String;
		2762	P : Integer;
		2763	begin
		2764	FN := S;
		2765	FN := StringReplace(FN,'//','\',[rfReplaceAll]);
		2766	FN := StringReplace(FN,'/','\',[rfReplaceAll]);
		2767	P := Pos(':\',FN);
		2768	if P > 0 Then System.Delete(FN,1,P+1);
		2769	Result := ExtractFileName(StringReplace(FN,'/','\',[rfReplaceAll]));
		2770	end;
		2771
		2772	function TKAZip.GetFilePath(S: String): String;
		2773	Var
		2774	FN : String;
		2775	P : Integer;
		2776	begin
		2777	FN := S;
		2778	FN := StringReplace(FN,'//','\',[rfReplaceAll]);
		2779	FN := StringReplace(FN,'/','\',[rfReplaceAll]);
		2780	P := Pos(':\',FN);
		2781	if P > 0 Then System.Delete(FN,1,P+1);
		2782	Result := ExtractFilePath(StringReplace(FN,'/','\',[rfReplaceAll]));
		2783	end;
		2784
		2785
		2786	procedure TKAZip.LoadFromFile(FileName: String);
		2787	Var
		2788	Res : Integer;
		2789	Dir : TSearchRec;
		2790	begin
		2791	Res := FindFirst(FileName,faAnyFile,Dir);
		2792	If Res=0 Then
		2793	Begin
		2794	if Dir.Attr And faReadOnly > 0 Then
		2795	Begin
		2796	FZipStream := TFileStream.Create(FileName,fmOpenRead or fmShareDenyNone);
		2797	FReadOnly := True;
		2798	End
		2799	Else
		2800	Begin
		2801	FZipStream := TFileStream.Create(FileName,fmOpenReadWrite or fmShareDenyNone);
		2802	FReadOnly := False;
		2803	End;
		2804	LoadFromStream(FZipStream);
		2805	End
		2806	Else
		2807	Begin
		2808	Raise Exception.Create('File "'+FileName+'" not found!');
		2809	End;
		2810	end;
		2811
		2812	procedure TKAZip.LoadFromStream(MS : TStream);
		2813	begin
		2814	FZipStream := MS;
		2815	FZipHeader.ParseZip(MS);
		2816	FIsZipFile := FZipHeader.FIsZipFile;
		2817	if Not FIsZipFile Then Close;
		2818	FIsDirty := True;
		2819	DoChange(Self,1);
		2820	end;
		2821
		2822	procedure TKAZip.Close;
		2823	begin
		2824	Entries.Clear;
		2825	if Assigned(FZipStream) AND (NOT FExternalStream) Then FZipStream.Free;
		2826	FExternalStream := False;
		2827	FZipStream := Nil;
		2828	FIsZipFile := False;
		2829	FIsDirty := True;
		2830	FReadOnly := False;
		2831	DoChange(Self,0);
		2832	end;
		2833
		2834	procedure TKAZip.SetFileName(const Value: String);
		2835	begin
		2836	FFileName := Value;
		2837	end;
		2838
		2839	procedure TKAZip.Open(FileName: String);
		2840	begin
		2841	Close;
		2842	LoadFromFile(FileName);
		2843	FFileName := FileName;
		2844	end;
		2845
		2846	procedure TKAZip.Open(MS: TStream);
		2847	begin
		2848	Try
		2849	Close;
		2850	LoadFromStream(MS);
		2851	Finally
		2852	FExternalStream := True;
		2853	End;
		2854	end;
		2855
		2856	procedure TKAZip.SetIsZipFile(const Value: Boolean);
		2857	begin
		2858	//****************************************************************************
		2859	end;
		2860
		2861	function TKAZip.GetDelphiTempFileName: String;
		2862	Var
		2863	TmpDir : Array[0..1000] of Char;
		2864	TmpFN : Array[0..1000] of Char;
		2865	Begin
		2866	Result := GetCurrentDir;
		2867	if GetTempPath(1000,TmpDir) <> 0 Then
		2868	Begin
		2869	if GetTempFileName(TmpDir,'',0,TmpFN) <> 0 Then Result := StrPas(TmpFN);
		2870	End;
		2871	End;
		2872
		2873	procedure TKAZip.OnDecompress(Sender: TObject);
		2874	Var
		2875	DS : TStream;
		2876	begin
		2877	DS := TStream(Sender);
		2878	if Assigned(FOnDecompressFile) Then FOnDecompressFile(Self,DS.Position,FCurrentDFS);
		2879	end;
		2880
		2881	procedure TKAZip.OnCompress(Sender: TObject);
		2882	Var
		2883	CS : TStream;
		2884	begin
		2885	CS := TStream(Sender);
		2886	if Assigned(FOnCompressFile) Then FOnCompressFile(Self,CS.Position,FCurrentDFS);
		2887	end;
		2888
		2889	procedure TKAZip.ExtractToFile(Item : TKAZipEntriesEntry; FileName: String);
		2890	begin
		2891	Entries.ExtractToFile(Item,FileName);
		2892	end;
		2893
		2894	procedure TKAZip.ExtractToFile(ItemIndex: Integer; FileName: String);
		2895	begin
		2896	Entries.ExtractToFile(ItemIndex,FileName);
		2897	end;
		2898
		2899	procedure TKAZip.ExtractToFile(FileName, DestinationFileName: String);
		2900	begin
		2901	Entries.ExtractToFile(FileName,DestinationFileName);
		2902	end;
		2903
		2904	procedure TKAZip.ExtractToStream(Item : TKAZipEntriesEntry; Stream: TStream);
		2905	begin
		2906	Entries.ExtractToStream(Item,Stream);
		2907	end;
		2908
		2909	procedure TKAZip.ExtractAll(TargetDirectory: String);
		2910	begin
		2911	Entries.ExtractAll(TargetDirectory);
		2912	end;
		2913
		2914	procedure TKAZip.ExtractSelected(TargetDirectory: String);
		2915	Begin
		2916	Entries.ExtractSelected(TargetDirectory);
		2917	End;
		2918
		2919	function TKAZip.AddFile(FileName, NewFileName: String): TKAZipEntriesEntry;
		2920	begin
		2921	Result := Entries.AddFile(FileName, NewFileName);
		2922	end;
		2923
		2924	function TKAZip.AddFile(FileName: String): TKAZipEntriesEntry;
		2925	begin
		2926	Result := Entries.AddFile(FileName);
		2927	end;
		2928
		2929	function TKAZip.AddFiles(FileNames: TStrings): Boolean;
		2930	begin
		2931	Result := Entries.AddFiles(FileNames);
		2932	end;
		2933
		2934	function TKAZip.AddFolder(FolderName, RootFolder, WildCard: String;
		2935	WithSubFolders: Boolean): Boolean;
		2936	begin
		2937	Result := Entries.AddFolder(FolderName,RootFolder,WildCard,WithSubFolders);
		2938	end;
		2939
		2940	function TKAZip.AddFilesAndFolders(FileNames: TStrings; RootFolder: String;
		2941	WithSubFolders: Boolean): Boolean;
		2942	begin
		2943	Result := Entries.AddFilesAndFolders(FileNames,RootFolder,WithSubFolders);
		2944	end;
		2945
		2946	function TKAZip.AddStream(FileName: String; FileAttr: Word; FileDate: TDateTime; Stream: TStream): TKAZipEntriesEntry;
		2947	begin
		2948	Result := Entries.AddStream(FileName,FileAttr,FileDate,Stream);
		2949	end;
		2950
		2951	function TKAZip.AddStream(FileName: String; Stream: TStream): TKAZipEntriesEntry;
		2952	begin
		2953	Result := Entries.AddStream(FileName,Stream);
		2954	end;
		2955
		2956
		2957	procedure TKAZip.Remove(Item: TKAZipEntriesEntry);
		2958	begin
		2959	Entries.Remove(Item);
		2960	end;
		2961
		2962	procedure TKAZip.Remove(ItemIndex: Integer);
		2963	begin
		2964	Entries.Remove(ItemIndex);
		2965	end;
		2966
		2967	procedure TKAZip.Remove(FileName: String);
		2968	begin
		2969	Entries.Remove(FileName);
		2970	end;
		2971
		2972	procedure TKAZip.RemoveFiles(List: TList);
		2973	begin
		2974	Entries.RemoveFiles(List);
		2975	end;
		2976
		2977	procedure TKAZip.RemoveSelected;
		2978	begin
		2979	Entries.RemoveSelected;;
		2980	end;
		2981
		2982	function TKAZip.GetComment: TStrings;
		2983	Var
		2984	S : String;
		2985	begin
		2986	Result := FZipComment;
		2987	FZipComment.Clear;
		2988	if FIsZipFile Then
		2989	Begin
		2990	if FEndOfCentralDir.ZipfileCommentLength > 0 Then
		2991	Begin
		2992	FZipStream.Position := FZipCommentPos;
		2993	SetLength(S,FEndOfCentralDir.ZipfileCommentLength);
		2994	FZipStream.Read(S[1],FEndOfCentralDir.ZipfileCommentLength);
		2995	FZipComment.Text := S;
		2996	End;
		2997	End;
		2998	end;
		2999
		3000	procedure TKAZip.SetComment(const Value: TStrings);
		3001	Var
		3002	Comment : String;
		3003	L : Integer;
		3004	begin
		3005	//****************************************************************************
		3006	if FZipComment.Text=Value.Text Then Exit;
		3007	FZipComment.Clear;
		3008	if FIsZipFile Then
		3009	Begin
		3010	FZipComment.Assign(Value);
		3011	Comment := FZipComment.Text;
		3012	L := Length(Comment);
		3013	FEndOfCentralDir.ZipfileCommentLength := L;
		3014	FZipStream.Position := FEndOfCentralDirPos;
		3015	FZipStream.Write(FEndOfCentralDir,SizeOf(TEndOfCentralDir));
		3016	FZipCommentPos := FZipStream.Position;
		3017	if L > 0 Then
		3018	Begin
		3019	FZipStream.Write(Comment[1],L)
		3020	End
		3021	Else
		3022	Begin
		3023	FZipStream.Size := FZipStream.Position;
		3024	End;
		3025	End;
		3026	end;
		3027
		3028	procedure TKAZip.DeSelectAll;
		3029	begin
		3030	Entries.DeSelectAll;
		3031	end;
		3032
		3033	procedure TKAZip.Select(WildCard : String);
		3034	begin
		3035	Entries.Select(WildCard);
		3036	end;
		3037
		3038	procedure TKAZip.InvertSelection;
		3039	begin
		3040	Entries.InvertSelection;
		3041	end;
		3042
		3043	procedure TKAZip.SelectAll;
		3044	begin
		3045	Entries.SelectAll;
		3046	end;
		3047
		3048	procedure TKAZip.RebuildLocalFiles(MS: TStream);
		3049	Var
		3050	X : Integer;
		3051	LF : TLocalFile;
		3052	begin
		3053	//************************************************* RESAVE ALL LOCAL BLOCKS
		3054	SetLength(NewLHOffsets,Entries.Count+1);
		3055	For X := 0 To Entries.Count-1 do
		3056	Begin
		3057	NewLHOffsets[X] := MS.Position;
		3058	LF := Entries.GetLocalEntry(FZipStream,Entries.Items[X].LocalOffset,False);
		3059	MS.Write(LF, SizeOf(LF)-3*SizeOf(String));
		3060	if LF.FilenameLength > 0 Then MS.Write(LF.FileName[1] ,LF.FilenameLength);
		3061	if LF.ExtraFieldLength > 0 Then MS.Write(LF.ExtraField[1],LF.ExtraFieldLength);
		3062	if LF.CompressedSize > 0 Then MS.Write(LF.CompressedData[1],LF.CompressedSize);
		3063	if Assigned(FOnRebuildZip) Then FOnRebuildZip(Self,X,Entries.Count-1);
		3064	End;
		3065	end;
		3066
		3067	procedure TKAZip.RebuildCentralDirectory(MS: TStream);
		3068	Var
		3069	X : Integer;
		3070	CDF : TCentralDirectoryFile;
		3071	begin
		3072	NewEndOfCentralDir := FEndOfCentralDir;
		3073	NewEndOfCentralDir.TotalNumberOfEntriesOnThisDisk := Entries.Count;
		3074	NewEndOfCentralDir.TotalNumberOfEntries := Entries.Count;
		3075	NewEndOfCentralDir.OffsetOfStartOfCentralDirectory := MS.Position;
		3076	For X := 0 To Entries.Count-1 do
		3077	Begin
		3078	CDF := Entries.Items[X].FCentralDirectoryFile;
		3079	CDF.RelativeOffsetOfLocalHeader := NewLHOffsets[X];
		3080	MS.Write(CDF,SizeOf(CDF)-3*SizeOf(String));
		3081	if CDF.FilenameLength > 0 Then
		3082	MS.Write(CDF.FileName[1],CDF.FilenameLength);
		3083	if CDF.ExtraFieldLength > 0 Then
		3084	MS.Write(CDF.ExtraField[1],CDF.ExtraFieldLength);
		3085	if CDF.FileCommentLength > 0 Then
		3086	MS.Write(CDF.FileComment[1],CDF.FileCommentLength);
		3087	if Assigned(FOnRebuildZip) Then FOnRebuildZip(Self,X,Entries.Count-1);
		3088	End;
		3089	NewEndOfCentralDir.SizeOfTheCentralDirectory := MS.Position-NewEndOfCentralDir.OffsetOfStartOfCentralDirectory;
		3090	end;
		3091
		3092	procedure TKAZip.RebuildEndOfCentralDirectory(MS: TStream);
		3093	Var
		3094	ZipComment : String;
		3095	begin
		3096	ZipComment := Comment.Text;
		3097	FRebuildECDP := MS.Position;
		3098	MS.Write(NewEndOfCentralDir,SizeOf(NewEndOfCentralDir));
		3099	FRebuildCP := MS.Position;
		3100	if NewEndOfCentralDir.ZipfileCommentLength > 0 Then
		3101	Begin
		3102	MS.Write(ZipComment[1],NewEndOfCentralDir.ZipfileCommentLength);
		3103	End;
		3104	if Assigned(FOnRebuildZip) Then FOnRebuildZip(Self,100,100);
		3105	end;
		3106
		3107	Procedure TKAZip.FixZip(MS : TStream);
		3108	Var
		3109	X : Integer;
		3110	Y : Integer;
		3111	NewCount : Integer;
		3112	LF : TLocalFile;
		3113	CDF : TCentralDirectoryFile;
		3114	ZipComment : String;
		3115	Begin
		3116	ZipComment := Comment.Text;
		3117	Y := 0;
		3118	SetLength(NewLHOffsets,Entries.Count+1);
		3119	For X := 0 To Entries.Count-1 do
		3120	Begin
		3121	LF := Entries.GetLocalEntry(FZipStream,Entries.Items[X].LocalOffset,False);
		3122	if (LF.LocalFileHeaderSignature=$04034b50) And (Entries.Items[X].Test) Then
		3123	Begin
		3124	NewLHOffsets[Y] := MS.Position;
		3125	MS.Write(LF, SizeOf(LF)-3*SizeOf(String));
		3126	if LF.FilenameLength > 0 Then MS.Write(LF.FileName[1] ,LF.FilenameLength);
		3127	if LF.ExtraFieldLength > 0 Then MS.Write(LF.ExtraField[1],LF.ExtraFieldLength);
		3128	if LF.CompressedSize > 0 Then MS.Write(LF.CompressedData[1],LF.CompressedSize);
		3129	if Assigned(FOnRebuildZip) Then FOnRebuildZip(Self,X,Entries.Count-1);
		3130	Inc(Y);
		3131	End
		3132	Else
		3133	Begin
		3134	Entries.Items[X].FCentralDirectoryFile.CentralFileHeaderSignature := 0;
		3135	if Assigned(FOnRebuildZip) Then FOnRebuildZip(Self,X,Entries.Count-1);
		3136	End;
		3137	End;
		3138
		3139	NewCount := Y;
		3140	Y := 0;
		3141	NewEndOfCentralDir := FEndOfCentralDir;
		3142	NewEndOfCentralDir.TotalNumberOfEntriesOnThisDisk := NewCount;
		3143	NewEndOfCentralDir.TotalNumberOfEntries := NewCount;
		3144	NewEndOfCentralDir.OffsetOfStartOfCentralDirectory := MS.Position;
		3145	For X := 0 To Entries.Count-1 do
		3146	Begin
		3147	CDF := Entries.Items[X].FCentralDirectoryFile;
		3148	if CDF.CentralFileHeaderSignature=$02014b50 Then
		3149	Begin
		3150	CDF.RelativeOffsetOfLocalHeader := NewLHOffsets[Y];
		3151	MS.Write(CDF,SizeOf(CDF)-3*SizeOf(String));
		3152	if CDF.FilenameLength > 0 Then
		3153	MS.Write(CDF.FileName[1],CDF.FilenameLength);
		3154	if CDF.ExtraFieldLength > 0 Then
		3155	MS.Write(CDF.ExtraField[1],CDF.ExtraFieldLength);
		3156	if CDF.FileCommentLength > 0 Then
		3157	MS.Write(CDF.FileComment[1],CDF.FileCommentLength);
		3158	if Assigned(FOnRebuildZip) Then FOnRebuildZip(Self,X,Entries.Count-1);
		3159	Inc(Y);
		3160	End;
		3161	End;
		3162	NewEndOfCentralDir.SizeOfTheCentralDirectory := MS.Position-NewEndOfCentralDir.OffsetOfStartOfCentralDirectory;
		3163
		3164	FRebuildECDP := MS.Position;
		3165	MS.Write(NewEndOfCentralDir,SizeOf(NewEndOfCentralDir));
		3166	FRebuildCP := MS.Position;
		3167	if NewEndOfCentralDir.ZipfileCommentLength > 0 Then
		3168	Begin
		3169	MS.Write(ZipComment[1],NewEndOfCentralDir.ZipfileCommentLength);
		3170	End;
		3171	if Assigned(FOnRebuildZip) Then FOnRebuildZip(Self,100,100);
		3172	End;
		3173
		3174
		3175	Procedure TKAZip.SaveToStream(Stream:TStream);
		3176	Begin
		3177	RebuildLocalFiles(Stream);
		3178	RebuildCentralDirectory(Stream);
		3179	RebuildEndOfCentralDirectory(Stream);
		3180	End;
		3181
		3182	Procedure TKAZip.Rebuild;
		3183	var
		3184	TempStream : TFileStream;
		3185	TempMSStream : TMemoryStream;
		3186	TempFileName : String;
		3187	Begin
		3188	if FUseTempFiles Then
		3189	Begin
		3190	TempFileName := GetDelphiTempFileName;
		3191	TempStream := TFileStream.Create(TempFileName,fmOpenReadWrite or FmCreate);
		3192	Try
		3193	SaveToStream(TempStream);
		3194	FZipStream.Position := 0;
		3195	FZipStream.Size := 0;
		3196	TempStream.Position := 0;
		3197
		3198	// Sicherheitsbestimmung
		3199	ProtectStream(FZipStream);
		3200
		3201	FZipStream.CopyFrom(TempStream,TempStream.Size);
		3202	Entries.ParseZip(FZipStream);
		3203	Finally
		3204	TempStream.Free;
		3205	// Sicherheitsbestimmung
		3206	dc_deletefile(tempfilename); // DeleteFile(TempFileName)
		3207	End;
		3208	End
		3209	Else
		3210	Begin
		3211	TempMSStream := TMemoryStream.Create;
		3212	Try
		3213	SaveToStream(TempMSStream);
		3214	FZipStream.Position := 0;
		3215	FZipStream.Size := 0;
		3216	TempMSStream.Position := 0;
		3217
		3218	// Sicherheitsbestimmung
		3219	ProtectStream(FZipStream);
		3220
		3221	FZipStream.CopyFrom(TempMSStream,TempMSStream.Size);
		3222	Entries.ParseZip(FZipStream);
		3223	Finally
		3224	TempMSStream.Free;
		3225	End;
		3226	End;
		3227	FIsDirty := True;
		3228	End;
		3229
		3230	Procedure TKAZip.CreateZip(Stream:TStream);
		3231	Var
		3232	ECD : TEndOfCentralDir;
		3233	Begin
		3234	ECD.EndOfCentralDirSignature := $06054b50;
		3235	ECD.NumberOfThisDisk := 0;
		3236	ECD.NumberOfTheDiskWithTheStart := 0;
		3237	ECD.TotalNumberOfEntriesOnThisDisk := 0;
		3238	ECD.TotalNumberOfEntries := 0;
		3239	ECD.SizeOfTheCentralDirectory := 0;
		3240	ECD.OffsetOfStartOfCentralDirectory := 0;
		3241	ECD.ZipfileCommentLength := 0;
		3242	Stream.Write(ECD,SizeOf(ECD));
		3243	End;
		3244
		3245
		3246	Procedure TKAZip.CreateZip(FileName:String);
		3247	var
		3248	FS : TFileStream;
		3249	Begin
		3250	FS := TFileStream.Create(FileName,fmOpenReadWrite or FmCreate);
		3251	Try
		3252	CreateZip(FS);
		3253	Finally
		3254	FS.Free;
		3255	End;
		3256	End;
		3257
		3258	procedure TKAZip.SetZipSaveMethod(const Value: TZipSaveMethod);
		3259	begin
		3260	FZipSaveMethod := Value;
		3261	end;
		3262
		3263	procedure TKAZip.SetActive(const Value: Boolean);
		3264	begin
		3265	if FFileName='' Then Exit;
		3266	if Value Then Open(FFileName) Else Close;
		3267	end;
		3268
		3269	procedure TKAZip.SetZipCompressionType(const Value: TZipCompressionType);
		3270	begin
		3271	FZipCompressionType := Value;
		3272	if FZipCompressionType = ctUnknown Then FZipCompressionType := ctNormal;
		3273	end;
		3274
		3275	function TKAZip.GetFileNames: TStrings;
		3276	Var
		3277	X : Integer;
		3278	begin
		3279	if FIsDirty Then
		3280	Begin
		3281	FFileNames.Clear;
		3282	For X := 0 To Entries.Count-1 do
		3283	Begin
		3284	FFileNames.Add(GetFilePath(Entries.Items[X].FileName)+GetFileName(Entries.Items[X].FileName));
		3285	End;
		3286	FIsDirty := False;
		3287	End;
		3288	Result := FFileNames;
		3289	end;
		3290
		3291	procedure TKAZip.SetFileNames(const Value: TStrings);
		3292	begin
		3293	//*************************************************** READ ONLY
		3294	end;
		3295
		3296
		3297	procedure TKAZip.SetUseTempFiles(const Value: Boolean);
		3298	begin
		3299	FUseTempFiles := Value;
		3300	end;
		3301
		3302	procedure TKAZip.Rename(Item: TKAZipEntriesEntry; NewFileName: String);
		3303	begin
		3304	Entries.Rename(Item,NewFileName);
		3305	end;
		3306
		3307	procedure TKAZip.Rename(ItemIndex: Integer; NewFileName: String);
		3308	begin
		3309	Entries.Rename(ItemIndex,NewFileName);
		3310	end;
		3311
		3312	procedure TKAZip.Rename(FileName, NewFileName: String);
		3313	begin
		3314	Entries.Rename(FileName, NewFileName);
		3315	end;
		3316
		3317	procedure TKAZip.RenameMultiple(Names, NewNames: TStringList);
		3318	begin
		3319	Entries.RenameMultiple(Names, NewNames);
		3320	end;
		3321
		3322
		3323	procedure TKAZip.SetStoreFolders(const Value: Boolean);
		3324	begin
		3325	FStoreFolders := Value;
		3326	end;
		3327
		3328	procedure TKAZip.SetOnAddItem(const Value: TOnAddItem);
		3329	begin
		3330	FOnAddItem := Value;
		3331	end;
		3332
		3333	procedure TKAZip.SetComponentVersion(const Value: String);
		3334	begin
		3335	//****************************************************************************
		3336	end;
		3337
		3338	procedure TKAZip.SetOnRebuildZip(const Value: TOnRebuildZip);
		3339	begin
		3340	FOnRebuildZip := Value;
		3341	end;
		3342
		3343	procedure TKAZip.SetOnRemoveItems(const Value: TOnRemoveItems);
		3344	begin
		3345	FOnRemoveItems := Value;
		3346	end;
		3347
		3348	procedure TKAZip.SetOverwriteAction(const Value: TOverwriteAction);
		3349	begin
		3350	FOverwriteAction := Value;
		3351	end;
		3352
		3353	procedure TKAZip.SetOnOverwriteFile(const Value: TOnOverwriteFile);
		3354	begin
		3355	FOnOverwriteFile := Value;
		3356	end;
		3357
		3358	procedure TKAZip.CreateFolder(FolderName: String; FolderDate: TDateTime);
		3359	begin
		3360	Entries.CreateFolder(FolderName,FolderDate);
		3361	end;
		3362
		3363	procedure TKAZip.RenameFolder(FolderName : String; NewFolderName : String);
		3364	begin
		3365	Entries.RenameFolder(FolderName,NewFolderName);
		3366	end;
		3367
		3368	procedure TKAZip.SetReadOnly(const Value: Boolean);
		3369	begin
		3370	FReadOnly := Value;
		3371	end;
		3372
		3373	procedure TKAZip.SetApplyAtributes(const Value: Boolean);
		3374	begin
		3375	FApplyAttributes := Value;
		3376	end;
		3377
		3378
		3379	end.
		3380

Subversion Repositories decoder

decoder/trunk/VCL_KAZIP/Kopie von KAZip.pas – Rev 2