WebSVN – autosfx – Blame – /zmstr1900102/ZMIRec19.pas

Rev	Author	Line No.	Line
1	daniel-mar	1	unit ZMIRec19;
		2
		3	(*
		4	ZMIRec19.pas - Represents the 'Directory entry' of a Zip file
		5	Copyright (C) 2009, 2010 by Russell J. Peters, Roger Aelbrecht,
		6	Eric W. Engler and Chris Vleghert.
		7
		8	This file is part of TZipMaster Version 1.9.
		9
		10	TZipMaster is free software: you can redistribute it and/or modify
		11	it under the terms of the GNU Lesser General Public License as published by
		12	the Free Software Foundation, either version 3 of the License, or
		13	(at your option) any later version.
		14
		15	TZipMaster is distributed in the hope that it will be useful,
		16	but WITHOUT ANY WARRANTY; without even the implied warranty of
		17	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
		18	GNU Lesser General Public License for more details.
		19
		20	You should have received a copy of the GNU Lesser General Public License
		21	along with TZipMaster. If not, see <http://www.gnu.org/licenses/>.
		22
		23	contact: problems@delphizip.org (include ZipMaster in the subject).
		24	updates: http://www.delphizip.org
		25	DelphiZip maillist subscribe at http://www.freelists.org/list/delphizip
		26
		27	modified 2010-05-12
		28	---------------------------------------------------------------------------*)
		29	interface
		30
		31	uses
		32	Classes, Windows, ZipMstr19, ZMWorkFile19, ZMStructs19, ZMCompat19;
		33
		34	type
		35	TZMRecStrings = (zrsName, zrsComment, zrsIName);
		36	TZipSelects = (zzsClear, zzsSet, zzsToggle);
		37	TZMStrEncOpts = (zseDOS, zseXName, zseXComment);
		38	TZMStrEncodes = set of TZMStrEncOpts;
		39
		40	// ZipDirEntry status bit constants
		41	const
		42	zsbHashed = $100; // hash calculated
		43	zsbLocalDone = $200; // local data prepared
		44	zsbLocal64 = $400; // local header required zip64
		45
		46	zsbEncMask = $70000; // mask for bits holding how entry is encoded
		47
		48	type
		49	TZSExtOpts = (zsxUnkown, zsxName, zsxComment, zsxName8, zsxComment8);
		50	TZStrExts = set of TZSExtOpts;
		51
		52	type
		53	THowToEnc = (hteOEM, hteAnsi, hteUTF8);
		54
		55
		56	type
		57	TZMIRec = class(TZMDirRec)
		58	private
		59	fComprMethod: Word; //compression method(2)
		60	fComprSize: Int64; //compressed file size (8)
		61	fCRC32: Longword; //Cyclic redundancy check (4)
		62	fDiskStart: Cardinal; //starts on disk number xx(4)
		63	fExtFileAtt: Longword; //external file attributes(4)
		64	FExtraField: TZMRawBytes;//RawByteString;
		65	fFileName: TZMString; // cache for external filename
		66	fFileComLen: Word; //(2)
		67	fFileNameLen: Word; //(2)
		68	fFlag: Word; //generalPurpose bitflag(2)
		69	FHash: Cardinal;
		70	fHeaderComment: TZMRawBytes;//RawByteString; // internal comment
		71	fHeaderName: TZMRawBytes;//RawByteString;
		72	fIntFileAtt: Word; //internal file attributes(2)
		73	FLocalData: TZMRawBytes;//RawByteString;
		74	fModifDateTime: Longword; // dos date/time (4)
		75	fOrigHeaderName: TZMRawBytes;//RawByteString;
		76	fOwner: TZMWorkFile;
		77	fRelOffLocal: Int64;
		78	FSelectArgs: string;
		79	fStatusBits: Cardinal;
		80	fUnComprSize: Int64; //uncompressed file size (8)
		81	FVersionMadeBy: word;
		82	fVersionNeeded: Word; // version needed to extract(2)
		83	function GetEncodeAs: TZMEncodingOpts;
		84	function GetEncoding: TZMEncodingOpts;
		85	function GetHash: Cardinal;
		86	function GetHeaderComment: TZMRawBytes;
		87	function GetIsEncoded: TZMEncodingOpts;
		88	function GetSelected: Boolean;
		89	function GetStatusBit(Mask: Cardinal): Cardinal;
		90	procedure SetIsEncoded(const Value: TZMEncodingOpts);
		91	procedure SetSelected(const Value: Boolean);
		92	protected
		93	procedure Diag(const msg: TZMString);
		94	function FindDataTag(tag: Word; var idx, siz: Integer): Boolean;
		95	// function FindDuplicate(const Name: String): TZMIRec;
		96	function FixStrings(const NewName, NewComment: TZMString): Integer;
		97	function FixXData64: Integer;
		98	function GetCompressedSize: Int64; override;
		99	function GetCompressionMethod: Word; override;
		100	function GetCRC32: Cardinal; override;
		101	function GetDataString(Cmnt: Boolean): UTF8String;
		102	function GetDateTime: Cardinal; override;
		103	function GetDirty: Boolean;
		104	function GetEncoded: TZMEncodingOpts; override;
		105	function GetEncrypted: Boolean; override;
		106	function GetExtFileAttrib: Longword; override;
		107	function GetExtraData(Tag: Word): TZMRawBytes; override;
		108	function GetExtraField: TZMRawBytes; override;
		109	function GetExtraFieldLength: Word; override;
		110	function GetFileComment: TZMString; override;
		111	function GetFileCommentLen: Word; override;
		112	function GetFileName: TZMString; override;
		113	function GetFileNameLength: Word; override;
		114	function GetFlag: Word; override;
		115	function GetHeaderName: TZMRawBytes; override;
		116	function GetIntFileAttrib: Word; override;
		117	function GetRelOffLocalHdr: Int64; override;
		118	function GetStartOnDisk: Word; override;
		119	function GetStatusBits: Cardinal; override;
		120	function GetUncompressedSize: Int64; override;
		121	function GetVersionMadeBy: Word; override;
		122	function GetVersionNeeded: Word; override;
		123	function IsZip64: Boolean;
		124	procedure MarkDirty;
		125	//1 Set Minimum VersionMadeBy and VersionNeeded
		126	procedure FixMinimumVers(z64: boolean);
		127	//1 convert internal Filename/Comment from utf
		128	function Int2UTF(Field: TZMRecStrings; NoUD: Boolean = False): TZMString;
		129	//1 return true if Zip64 fields used
		130	procedure PrepareLocalData;
		131	procedure SetDateStamp(Value: TDateTime);
		132	procedure SetEncrypted(const Value: Boolean);
		133	procedure SetExtraData(Tag: Word; const data: TZMRawBytes);
		134	function StrToSafe(const aString: TZMString; ToOem: boolean): AnsiString;
		135	function StripDrive(const FName: TZMString; NoPath: Boolean): TZMString;
		136	function StrToHeader(const aString: TZMString; how: THowToEnc): TZMRawBytes;
		137	function StrToUTF8Header(const aString: TZMString): TZMRawBytes;
		138	function StrTo_UTF8(const aString: TZMString): UTF8String;
		139	function ToIntForm(const nname: TZMString; var iname: TZMString): Integer;
		140	function WriteAsLocal: Integer;
		141	function WriteAsLocal1(Stamp, crc: Cardinal): Integer;
		142	function WriteDataDesc(OutZip: TZMWorkFile): Integer;
		143	property LocalData: TZMRawBytes read FLocalData write FLocalData;
		144	//1 Header name before rename - needed to verify local header
		145	property OrigHeaderName: TZMRawBytes read fOrigHeaderName;
		146	public
		147	constructor Create(theOwner: TZMWorkFile);
		148	procedure AfterConstruction; override;
		149	procedure AssignFrom(const zr: TZMIRec);
		150	procedure BeforeDestruction; override;
		151	function CentralSize: Cardinal;
		152	function ChangeAttrs(nAttr: Cardinal): Integer; override;
		153	function ChangeComment(const ncomment: TZMString): Integer; override;
		154	function ChangeData(ndata: TZMRawBytes): Integer; override;
		155	function ChangeDate(ndosdate: Cardinal): Integer; override;
		156	function ChangeEncoding: Integer; override;
		157	function ChangeName(const nname: TZMString): Integer; override;
		158	procedure ClearCachedName;
		159	function ClearStatusBit(const values: Cardinal): Cardinal;
		160	function HasChanges: Boolean;
		161	function LocalSize: Cardinal;
		162	function Process: Int64; virtual;
		163	function ProcessSize: Int64; virtual;
		164	function Read(wf: TZMWorkFile): Integer;
		165	function SafeHeaderName(const IntName: TZMString): TZMString;
		166	function SeekLocalData: Integer;
		167	function Select(How: TZipSelects): Boolean;
		168	function SetStatusBit(const Value: Cardinal): Cardinal;
		169	function TestStatusBit(const mask: Cardinal): Boolean;
		170	function Write: Integer;
		171	property CompressedSize: Int64 Read fComprSize Write fComprSize;
		172	property ComprMethod: Word Read fComprMethod Write fComprMethod;
		173	property CRC32: Longword Read fCRC32 Write fCRC32;
		174	property DiskStart: Cardinal Read fDiskStart Write fDiskStart;
		175	property EncodeAs: TZMEncodingOpts Read GetEncodeAs;
		176	property Encoded: TZMEncodingOpts Read GetEncoded;
		177	property Encoding: TZMEncodingOpts Read GetEncoding;
		178	property Encrypted: Boolean Read GetEncrypted Write SetEncrypted;
		179	property ExtFileAttrib: Longword Read fExtFileAtt Write fExtFileAtt;
		180	property ExtraData[Tag: Word]: TZMRawBytes read GetExtraData write
		181	SetExtraData;
		182	property ExtraField: TZMRawBytes read FExtraField write FExtraField;
		183	property ExtraFieldLength: Word read GetExtraFieldLength;
		184	property FileComLen: Word Read fFileComLen Write fFileComLen;
		185	property FileComment: TZMString Read GetFileComment;
		186	property FileCommentLen: Word Read fFileComLen Write fFileComLen;
		187	property FileName: TZMString Read GetFileName;
		188	property FileNameLen: Word Read fFileNameLen Write fFileNameLen;
		189	property FileNameLength: Word Read fFileNameLen Write fFileNameLen;
		190	property Flag: Word Read fFlag Write fFlag;
		191	property Hash: Cardinal read GetHash;
		192	property HeaderComment: TZMRawBytes read GetHeaderComment;
		193	property HeaderName: TZMRawBytes read GetHeaderName write fHeaderName;
		194	property IntFileAttrib: Word Read fIntFileAtt Write fIntFileAtt;
		195	//1 the cached value in the status
		196	property IsEncoded: TZMEncodingOpts read GetIsEncoded write SetIsEncoded;
		197	property ModifDateTime: Longword Read fModifDateTime Write fModifDateTime;
		198	property Owner: TZMWorkFile Read fOwner;
		199	property RelOffLocal: Int64 Read fRelOffLocal Write fRelOffLocal;
		200	property SelectArgs: string read FSelectArgs write FSelectArgs;
		201	property Selected: Boolean Read GetSelected Write SetSelected;
		202	property StatusBit[Mask: Cardinal]: Cardinal read GetStatusBit;
		203	property StatusBits: Cardinal Read GetStatusBits Write fStatusBits;
		204	property UncompressedSize: Int64 read fUnComprSize write fUnComprSize;
		205	property VersionMadeBy: word read FVersionMadeBy write FVersionMadeBy;
		206	property VersionNeeded: Word Read fVersionNeeded Write fVersionNeeded;
		207	end;
		208
		209	function XData(const x: TZMRawBytes; Tag: Word; var idx, size: Integer):
		210	Boolean;
		211	function XDataAppend(var x: TZMRawBytes; const src1; siz1: Integer; const src2;
		212	siz2: Integer): Integer;
		213	function XDataKeep(const x: TZMRawBytes; const tags: array of Integer):
		214	TZMRawBytes;
		215	function XDataRemove(const x: TZMRawBytes; const tags: array of Integer):
		216	TZMRawBytes;
		217
		218	function HashFunc(const str: String): Cardinal;
		219	function IsInvalidIntName(const FName: TZMString): Boolean;
		220
		221	implementation
		222
		223	uses
		224	SysUtils, ZMZipFile19, ZMMsg19, ZMXcpt19, ZMMsgStr19, ZMUtils19,
		225	ZMUTF819, ZMMatch19, ZMCore19, ZMDelZip19;
		226
		227	{$INCLUDE '.\ZipVers19.inc'}
		228	{$IFDEF VER180}
		229	{$WARN SYMBOL_PLATFORM OFF}
		230	{$ENDIF}
		231
		232	const
		233	MAX_BYTE = 255;
		234
		235	type
		236	Txdat64 = packed record
		237	tag: Word;
		238	siz: Word;
		239	vals: array [0..4] of Int64; // last only cardinal
		240	end;
		241
		242	const
		243	ZipCenRecFields: array [0..17] of Integer =
		244	(4, 1, 1, 2, 2, 2, 2, 2, 4, 4, 4, 2, 2, 2, 2, 2, 4, 4);
		245
		246
		247	// P. J. Weinberger Hash function
		248	function HashFunc(const str : String) : Cardinal;
		249	var
		250	i : Cardinal;
		251	x : Cardinal;
		252	begin
		253	Result := 0;
		254	for i := 1 to Length(str) do
		255	begin
		256	Result := (Result shl 4) + Ord(str[i]);
		257	x := Result and $F0000000;
		258	if (x <> 0) then
		259	Result := (Result xor (x shr 24)) and $0FFFFFFF;
		260	end;
		261	end;
		262
		263	// make safe version of external comment
		264	function SafeComment(const xcomment: String): string;
		265	var
		266	c: Char;
		267	i: integer;
		268	Begin
		269	if StrHasExt(xcomment) then
		270	Result := StrToOEM(xcomment)
		271	else
		272	Result := xcomment;
		273	for i := 1 to Length(Result) do
		274	begin
		275	c := Result[i];
		276	if (c < ' ') or (c > #126) then
		277	Result[i] := '_';
		278	end;
		279	End;
		280
		281	{ TZMIRec }
		282	constructor TZMIRec.Create(theOwner: TZMWorkFile);
		283	begin
		284	inherited Create;
		285	fOwner := theOwner;
		286	end;
		287
		288	procedure TZMIRec.AssignFrom(const zr: TZMIRec);
		289	begin
		290	inherited;
		291	if (zr <> self) and (zr is TZMIRec) then
		292	begin
		293	VersionMadeBy := zr.VersionMadeBy;
		294	VersionNeeded := zr.VersionNeeded;
		295	Flag := zr.Flag;
		296	ComprMethod := zr.ComprMethod;
		297	ModifDateTime := zr.ModifDateTime;
		298	CRC32 := zr.CRC32;
		299	CompressedSize := zr.CompressedSize;
		300	UncompressedSize := zr.UncompressedSize;
		301	FileNameLength := zr.FileNameLength;
		302	FileCommentLen := zr.FileCommentLen;
		303	DiskStart := zr.DiskStart;
		304	IntFileAttrib := zr.IntFileAttrib;
		305	ExtFileAttrib := zr.ExtFileAttrib;
		306	RelOffLocal := zr.RelOffLocal;
		307	fOrigHeaderName := zr.OrigHeaderName;
		308	fHeaderName := zr.HeaderName;
		309	fHeaderComment := zr.HeaderComment;
		310	fExtraField := zr.fExtraField;
		311	StatusBits := zr.StatusBits;
		312	fHash := zr.FHash;
		313	end;
		314	end;
		315
		316	function TZMIRec.CentralSize: Cardinal;
		317	begin
		318	Result := SizeOf(TZipCentralHeader);
		319	Inc(Result, FileNameLength + ExtraFieldLength + FileCommentLen);
		320	end;
		321
		322	function TZMIRec.ChangeAttrs(nAttr: Cardinal): Integer;
		323	begin
		324	Result := 0; // always allowed
		325	if nAttr <> GetExtFileAttrib then
		326	begin
		327	ExtFileAttrib := nAttr;
		328	MarkDirty;
		329	end;
		330	end;
		331
		332	function TZMIRec.ChangeComment(const ncomment: TZMString): Integer;
		333	begin
		334	Result := 0; // always allowed
		335	if ncomment <> GetFileComment then
		336	Result := FixStrings(FileName, ncomment);
		337	end;
		338
		339	function TZMIRec.ChangeData(ndata: TZMRawBytes): Integer;
		340	var
		341	NewData: TZMRawBytes;
		342	OldData: TZMRawBytes;
		343	begin
		344	Result := 0; // always allowed
		345	if ndata <> GetExtraField then
		346	begin
		347	// preserve required tags
		348	OldData := XDataKeep(ExtraField, [Zip64_data_tag, UPath_Data_Tag, UCmnt_Data_Tag]);
		349	// do not allow changing fields
		350	NewData := XDataRemove(ndata, [Zip64_data_tag, UPath_Data_Tag, UCmnt_Data_Tag]);
		351	// will it fit?
		352	if (Length(OldData) + Length(NewData) + Length(GetFileComment) +
		353	Length(GetFileName)) < MAX_WORD then
		354	begin
		355	fExtraField := OldData + NewData;
		356	MarkDirty;
		357	end
		358	else
		359	Result := -CD_CEHDataSize;
		360	end;
		361	end;
		362
		363	function TZMIRec.ChangeDate(ndosdate: Cardinal): Integer;
		364	begin
		365	Result := -CD_NoProtected;
		366	if Encrypted then
		367	exit;
		368	try
		369	// test if valid date/time will throw error if not
		370	FileDateToDateTime(ndosdate);
		371	except
		372	Result := -RN_InvalidDateTime;
		373	if Owner.Boss.Verbosity >= zvVerbose then
		374	Diag('Invalid date ' + GetFileName);
		375	exit;
		376	end;
		377	Result := 0;
		378	if ndosdate <> GetDateTime then
		379	begin
		380	ModifDateTime := ndosdate;
		381	MarkDirty;
		382	end;
		383	end;
		384
		385	function TZMIRec.ChangeEncoding: Integer;
		386	begin
		387	Result := FixStrings(FileName, FileComment);
		388	end;
		389
		390	function TZMIRec.ChangeName(const nname: TZMString): Integer;
		391	var
		392	iname: TZMString;
		393	begin
		394	Result := ToIntForm(nname, iname);
		395	if Result = 0 then
		396	begin
		397	Result := -CD_NoChangeDir;
		398	if IsFolder(iname) <> IsFolder(HeaderName) then
		399	exit; // dirOnly status must be same
		400	if iname <> FileName then
		401	Result := FixStrings(iname, FileComment);
		402	end;
		403	end;
		404
		405	function TZMIRec.ClearStatusBit(const values: Cardinal): Cardinal;
		406	begin
		407	StatusBits := StatusBits and not values;
		408	Result := StatusBits;
		409	end;
		410
		411
		412	procedure TZMIRec.Diag(const msg: TZMString);
		413	begin
		414	if Owner.Boss.Verbosity >= zvVerbose then
		415	Owner.Boss.ShowMsg('Trace: ' + msg, 0, False);
		416	end;
		417
		418	procedure TZMIRec.ClearCachedName;
		419	begin
		420	fFileName := ''; // force reconvert - settings have changed
		421	ClearStatusBit(zsbHashed);
		422	IsEncoded := zeoAuto; // force re-evaluate
		423	end;
		424
		425	function TZMIRec.FindDataTag(tag: Word; var idx, siz: Integer): Boolean;
		426	begin
		427	Result := False;
		428	if XData(ExtraField, tag, idx, siz) then
		429	Result := True;
		430	end;
		431
		432	//function TZMIRec.FindDuplicate(const Name: String): TZMIRec;
		433	//var
		434	// ix: Integer;
		435	//begin
		436	// ix := -1; // from start
		437	// repeat
		438	// Result := (Owner as TZMZipFile).FindName(Name, ix);
		439	// until Result <> self;
		440	//end;
		441
		442	function IsOnlyDOS(const hstr: TZMRawBytes): Boolean;
		443	var
		444	i: Integer;
		445	begin
		446	Result := True;
		447	for i := 1 to Length(hstr) do
		448	if (hstr[i] > #126) or (hstr[i] < #32) then
		449	begin
		450	Result := False;
		451	Break;
		452	end;
		453	end;
		454
		455	function TZMIRec.FixStrings(const NewName, NewComment: TZMString): Integer;
		456	var
		457	dup: TZMIRec;
		458	enc: TZMEncodingOpts;
		459	HasXComment: Boolean;
		460	HasXName: Boolean;
		461	hcomment: TZMRawBytes;
		462	IX: Integer;
		463	need64: Boolean;
		464	NeedU8Bit: Boolean;
		465	newdata: Boolean;
		466	NewHeaderName: TZMRawBytes;
		467	NewIntName: string;
		468	NewMadeFS: Word;
		469	UComment: UTF8String;
		470	UData: TZMRawBytes;
		471	uheader: TUString_Data_Header;
		472	UName: UTF8String;
		473	xlen: Integer;
		474	begin
		475	enc := EncodeAs;
		476	NewMadeFS := (FS_FAT * 256) or OUR_VEM;
		477	UName := '';
		478	UComment := '';
		479	NeedU8Bit := False;
		480	Result := -CD_DuplFileName;
		481	ix := -1; // from start
		482	dup := (Owner as TZMZipFile).FindName(NewName, ix, self);
		483	if dup <> nil then
		484	exit; // duplicate external name
		485	NewIntName := SafeHeaderName(NewName);
		486	// default convert new name and comment to OEM
		487	NewHeaderName := StrToHeader(NewIntName, hteOEM);
		488	hcomment := StrToHeader(NewComment, hteOEM);
		489	// make entry name
		490	HasXName := StrHasExt(NewName);
		491	HasXComment := StrHasExt(NewComment);
		492	// form required strings
		493	if HasXName or HasXComment then
		494	begin
		495	if enc = zeoAuto then
		496	begin
		497	enc := zeoUPATH; // unless both extended
		498	if HasXName and HasXComment then
		499	enc := zeoUTF8;
		500	end;
		501	// convert strings
		502	if enc = zeoUTF8 then
		503	begin
		504	NewHeaderName := StrToHeader(NewIntName, hteUTF8);
		505	hcomment := StrToHeader(NewComment, hteUTF8);
		506	NeedU8Bit := True;
		507	end
		508	else
		509	begin
		510	if enc = zeoUPath then
		511	begin
		512	// we want UPATH or/and UCOMMENT
		513	if HasXName then
		514	UName := StrTo_UTF8(NewIntName);
		515	if HasXComment then
		516	UComment := StrTo_UTF8(NewComment);
		517	end
		518	else
		519	if enc = zeoNone then
		520	begin
		521	// we want Ansi name and comment - NTFS
		522	NewHeaderName := StrToHeader(NewIntName, hteAnsi);
		523	hcomment := StrToHeader(NewComment, hteAnsi);
		524	if StrHasExt(NewHeaderName) or StrHasExt(hcomment) then
		525	NewMadeFS := (FS_NTFS * 256) or OUR_VEM; // wasn't made safe FAT
		526	end;
		527	end;
		528	end;
		529	// we now have the required strings
		530	// remove old extra strings
		531	UData := XDataRemove(GetExtraField, [UPath_Data_Tag, UCmnt_Data_Tag]);
		532	newdata := Length(UData) <> ExtraFieldLength;
		533	if UName <> '' then
		534	begin
		535	uheader.tag := UPath_Data_Tag;
		536	uheader.totsiz := sizeof(TUString_Data_Header) + Length(UName) - (2 * sizeof(Word));
		537	uheader.version := 1;
		538	uheader.origcrc := CalcCRC32(NewHeaderName[1], length(NewHeaderName), 0);
		539	XDataAppend(UData, uheader, sizeof(uheader), UName[1], length(UName));
		540	newdata := True;
		541	end;
		542
		543	if UComment <> '' then
		544	begin
		545	// append UComment
		546	uheader.tag := UCmnt_Data_Tag;
		547	uheader.totsiz := sizeof(TUString_Data_Header) + Length(UComment) -
		548	(2 * sizeof(Word));
		549	uheader.version := 1;
		550	uheader.origcrc := CalcCRC32(hcomment[1], length(hcomment), 0);
		551	XDataAppend(UData, uheader, sizeof(uheader), UComment[1], length(UComment));
		552	newdata := True;
		553	end;
		554	// will it fit?
		555	Result := -CD_CEHDataSize;
		556	xlen := Length(HeaderComment) + Length(NewHeaderName) + Length(UData);
		557	if xlen < MAX_WORD then
		558	begin
		559	// ok - make change
		560	fHeaderName := NewHeaderName;
		561	fFileNameLen := Length(NewHeaderName);
		562	fHeaderComment := hcomment;
		563	fFileComLen := Length(hcomment);
		564
		565	if newdata then
		566	ExtraField := UData;
		567
		568	if NeedU8Bit then
		569	fFlag := fFlag or FLAG_UTF8_BIT
		570	else
		571	fFlag := fFlag and (not FLAG_UTF8_BIT);
		572	ClearCachedName;
		573	IsEncoded := zeoAuto; // unknown
		574	need64 := (UncompressedSize >= MAX_UNSIGNED) or (CompressedSize >= MAX_UNSIGNED);
		575	// set versions to minimum required
		576	FVersionMadeBy := NewMadeFS;
		577	FixMinimumVers(need64);
		578	MarkDirty;
		579	Result := 0;
		580	end;
		581	end;
		582
		583	// 'fixes' the special Zip64 fields from extra data
		584	// return <0 error, 0 none, 1 Zip64
		585	function TZMIRec.FixXData64: Integer;
		586	var
		587	idx: Integer;
		588	p: PAnsiChar;
		589	wsz: Integer;
		590	begin
		591	Result := 0;
		592	if (VersionNeeded and VerMask) < ZIP64_VER then
		593	exit;
		594	if not XData(FExtraField, Zip64_data_tag, idx, wsz) then
		595	Exit;
		596	p := @fExtraField[idx];
		597	Result := -DS_Zip64FieldError; // new msg
		598	Inc(p, 4); // past header
		599	Dec(wsz, 4); // discount header
		600	if UncompressedSize = MAX_UNSIGNED then
		601	begin
		602	if wsz < 8 then
		603	exit; // error
		604	UncompressedSize := pInt64(p)^;
		605	Inc(p, sizeof(Int64));
		606	Dec(wsz, sizeof(Int64));
		607	end;
		608	if CompressedSize = MAX_UNSIGNED then
		609	begin
		610	if wsz < 8 then
		611	exit; // error
		612	CompressedSize := pInt64(p)^;
		613	Inc(p, sizeof(Int64));
		614	Dec(wsz, sizeof(Int64));
		615	end;
		616	if RelOffLocal = MAX_UNSIGNED then
		617	begin
		618	if wsz < 8 then
		619	exit; // error
		620	RelOffLocal := pInt64(p)^;
		621	Inc(p, sizeof(Int64));
		622	Dec(wsz, sizeof(Int64));
		623	end;
		624	if DiskStart = MAX_WORD then
		625	begin
		626	if wsz < 4 then
		627	exit; // error
		628	DiskStart := pCardinal(p)^;
		629	end;
		630	Result := 1;
		631	end;
		632
		633	function TZMIRec.GetCompressedSize: Int64;
		634	begin
		635	Result := fComprSize;
		636	end;
		637
		638	function TZMIRec.GetCompressionMethod: Word;
		639	begin
		640	Result := fComprMethod;
		641	end;
		642
		643	function TZMIRec.GetCRC32: Cardinal;
		644	begin
		645	Result := fCRC32;
		646	end;
		647
		648	// will return empty if not exists or invalid
		649	function TZMIRec.GetDataString(Cmnt: Boolean): UTF8String;
		650	var
		651	crc: Cardinal;
		652	field: TZMRawBytes;
		653	idx: Integer;
		654	pH: PUString_Data_Header;
		655	pS: PAnsiChar;
		656	siz: Integer;
		657	tag: Word;
		658	begin
		659	Result := '';
		660	if Cmnt then
		661	begin
		662	tag := UCmnt_Data_Tag;
		663	Field := HeaderComment;
		664	if field = '' then
		665	Exit; // no point checking
		666	end
		667	else
		668	begin
		669	tag := UPath_Data_Tag;
		670	field := HeaderName;
		671	end;
		672	if FindDataTag(tag, idx, siz) then
		673	begin
		674	pS := @ExtraField[idx];
		675	pH := PUString_Data_Header(pS);
		676	if pH^.version = 1 then
		677	begin
		678	crc := CalcCRC32(field[1], Length(field), 0);
		679	if pH^.origcrc = crc then
		680	begin
		681	siz := siz - sizeof(TUString_Data_Header);
		682	Inc(pS, sizeof(TUString_Data_Header));
		683	if (siz > 0) and (ValidUTF8(pS, siz) >= 0) then
		684	begin
		685	SetLength(Result, siz);
		686	move(pS^, Result[1], siz);
		687	end;
		688	end;
		689	end;
		690	end;
		691	end;
		692
		693	function TZMIRec.GetDateTime: Cardinal;
		694	begin
		695	Result := fModifDateTime;
		696	end;
		697
		698	function TZMIRec.GetDirty: Boolean;
		699	begin
		700	Result := TestStatusBit(zsbDirty);
		701	end;
		702
		703	function TZMIRec.GetEncodeAs: TZMEncodingOpts;
		704	begin
		705	Result := (Owner as TZMZipFile).EncodeAs;
		706	end;
		707
		708	{
		709	Encoded as OEM for
		710	DOS (default) FS_FAT
		711	OS/2 FS_HPFS
		712	Win95/NT with Nico Mak's WinZip FS_NTFS && host = 5.0
		713	UTF8 is flag is set
		714	except (someone always has to be different)
		715	PKZIP (Win) 2.5, 2.6, 4.0 - mark as FS_FAT but local is Windows ANSI (1252)
		716	PKZIP (Unix) 2.51 - mark as FS_FAT but are current code page
		717	}
		718	function TZMIRec.GetEncoded: TZMEncodingOpts;
		719	const
		720	WZIP = $0B32;//(FS_NTFS * 256) + 50;
		721	OS_HPFS = FS_HPFS * 256;
		722	OS_FAT = FS_FAT * 256;
		723	begin
		724	Result := zeoNone;
		725
		726	if (Flag and FLAG_UTF8_BIT) <> 0 then
		727	Result := zeoUTF8
		728	else
		729	if (GetDataString(false) <> '') or (GetDataString(True) <> '') then
		730	Result := zeoUPath
		731	else
		732	if ((VersionMadeBy and OSMask) = OS_FAT) or
		733	((VersionMadeBy and OSMask) = OS_HPFS) or
		734	(VersionMadeBy = WZIP) then
		735	Result := zeoOEM;
		736	end;
		737
		738
		739	function TZMIRec.GetEncoding: TZMEncodingOpts;
		740	begin
		741	Result := (Owner as TZMZipFile).Encoding;
		742	end;
		743
		744	function TZMIRec.GetEncrypted: Boolean;
		745	begin
		746	Result := (fFlag and 1) <> 0;
		747	end;
		748
		749	function TZMIRec.GetExtFileAttrib: Longword;
		750	begin
		751	Result := fExtFileAtt;
		752	end;
		753
		754	// returns the 'data' without the tag
		755	function TZMIRec.GetExtraData(Tag: Word): TZMRawBytes;
		756	var
		757	i: Integer;
		758	sz: Integer;
		759	x: TZMRawBytes;
		760	begin
		761	Result := '';
		762	x := GetExtraField;
		763	if XData(x, Tag, i, sz) then
		764	Result := Copy(x, i + 4, sz - 4);
		765	end;
		766
		767	function TZMIRec.GetExtraField: TZMRawBytes;
		768	begin
		769	Result := fExtraField;
		770	end;
		771
		772	function TZMIRec.GetExtraFieldLength: Word;
		773	begin
		774	Result := Length(fExtraField);
		775	end;
		776
		777	function TZMIRec.GetFileComment: TZMString;
		778	begin
		779	Result := Int2UTF(zrsComment, False);
		780	end;
		781
		782	function TZMIRec.GetFileCommentLen: Word;
		783	begin
		784	Result := Length(HeaderComment);
		785	end;
		786
		787	// returns the external filename interpretting the internal name by Encoding
		788	// still in internal form
		789	function TZMIRec.GetFileName: TZMString;
		790	begin
		791	if fFileName = '' then
		792	fFileName := Int2UTF(zrsName, False);
		793	Result := fFileName;
		794	end;
		795
		796	function TZMIRec.GetFileNameLength: Word;
		797	begin
		798	Result := Length(HeaderName);
		799	end;
		800
		801	function TZMIRec.GetFlag: Word;
		802	begin
		803	Result := fFlag;
		804	end;
		805
		806	function TZMIRec.GetHash: Cardinal;
		807	begin
		808	if not TestStatusBit(zsbHashed) then
		809	begin
		810	fHash := HashFunc(FileName);
		811	SetStatusBit(zsbHashed);
		812	end;
		813	Result := fHash;
		814	end;
		815
		816	function TZMIRec.GetHeaderComment: TZMRawBytes;
		817	begin
		818	Result := fHeaderComment;
		819	end;
		820
		821	function TZMIRec.GetHeaderName: TZMRawBytes;
		822	begin
		823	Result := fHeaderName;
		824	end;
		825
		826	function TZMIRec.GetIntFileAttrib: Word;
		827	begin
		828	Result := fIntFileAtt;
		829	end;
		830
		831	function TZMIRec.GetIsEncoded: TZMEncodingOpts;
		832	var
		833	n: Integer;
		834	begin
		835	n := StatusBit[zsbEncMask] shr 16;
		836	if n > ord(zeoUPath) then
		837	n := 0;
		838	if n = 0 then
		839	begin
		840	// unknown - work it out and cache result
		841	Result := Encoded;
		842	SetIsEncoded(Result);
		843	end
		844	else
		845	Result := TZMEncodingOpts(n);
		846	end;
		847
		848	function TZMIRec.GetRelOffLocalHdr: Int64;
		849	begin
		850	Result := fRelOffLocal;
		851	end;
		852
		853	function TZMIRec.GetSelected: Boolean;
		854	begin
		855	Result := TestStatusBit(zsbSelected);
		856	end;
		857
		858	function TZMIRec.GetStartOnDisk: Word;
		859	begin
		860	Result := fDiskStart;
		861	end;
		862
		863	function TZMIRec.GetStatusBit(Mask: Cardinal): Cardinal;
		864	begin
		865	Result := StatusBits and mask;
		866	end;
		867
		868	function TZMIRec.GetStatusBits: Cardinal;
		869	begin
		870	Result := fStatusBits;
		871	end;
		872
		873	function TZMIRec.GetUncompressedSize: Int64;
		874	begin
		875	Result := fUnComprSize;
		876	end;
		877
		878	function TZMIRec.GetVersionMadeBy: Word;
		879	begin
		880	Result := FVersionMadeBy;
		881	end;
		882
		883	function TZMIRec.GetVersionNeeded: Word;
		884	begin
		885	Result := fVersionNeeded;
		886	end;
		887
		888	function TZMIRec.HasChanges: Boolean;
		889	begin
		890	Result := (StatusBits and zsbDirty) <> 0;
		891	end;
		892
		893	function TZMIRec.Int2UTF(Field: TZMRecStrings; NoUD: Boolean = False):
		894	TZMString;
		895	var
		896	Enc: TZMEncodingOpts;
		897	fld: TZMRawBytes;
		898	begin
		899	if Field = zrsComment then
		900	fld := HeaderComment
		901	else
		902	fld := HeaderName;
		903	Result := '';
		904	Enc := Encoding;
		905	if Enc = zeoAuto then
		906	begin
		907	Enc := IsEncoded; // cached Encoded; // how entry is encoded
		908	if NoUD and (Enc = zeoUPath) then
		909	Enc := zeoOEM; // use header Field
		910	end;
		911	if (Enc = zeoUPath) or StrHasExt(fld) then
		912	begin
		913	{$IFDEF UNICODE}
		914	case Enc of
		915	// use UTF8 extra data string if available
		916	zeoUPath: Result := UTF8ToWide(GetDataString(Field = zrsComment));
		917	zeoNone: // treat as Ansi (from somewhere)
		918	Result := StrToUTFEx(fld, TZMZipFile(Owner).Encoding_CP, -1);
		919	zeoUTF8: // treat Field as being UTF8
		920	Result := PUTF8ToWideStr(PAnsiChar(fld), Length(fld));
		921	zeoOEM: // convert to OEM
		922	Result := StrToUTFEx(fld, CP_OEMCP, -1);
		923	end;
		924	{$ELSE}
		925	if Owner.Worker.UseUtf8 then
		926	begin
		927	case Enc of
		928	// use UTF8 extra data string if available
		929	zeoUPath: Result := GetDataString(Field = zrsComment);
		930	zeoNone: // treat as Ansi (from somewhere)
		931	Result := StrToUTFEx(fld, TZMZipFile(Owner).Encoding_CP, -1);
		932	zeoUTF8: // treat Field as being UTF8
		933	Result := fld;
		934	zeoOEM: // convert to OEM
		935	Result := StrToUTFEx(fld, CP_OEMCP, -1);
		936	end;
		937	end
		938	else
		939	begin
		940	case Enc of
		941	// use UTF8 extra data string if available
		942	zeoUPath: Result := UTF8ToSafe(GetDataString(Field = zrsComment), false);
		943	zeoNone: // treat as Ansi (from somewhere)
		944	Result := StrToWideEx(fld, TZMZipFile(Owner).Encoding_CP, -1); // will be converted
		945	zeoUTF8: // treat Field as being UTF8
		946	Result := UTF8ToSafe(fld, false);
		947	zeoOEM: // convert to OEM
		948	Result := StrToWideEx(fld, CP_OEMCP, -1); // will be converted
		949	end;
		950	end;
		951	{$ENDIF}
		952	end;
		953	if length(Result) = 0 then
		954	Result := String(fld); // better than nothing
		955	if Field = zrsName then
		956	Result := SetSlash(Result, psdExternal);
		957	end;
		958
		959	// test for invalid characters
		960	function IsInvalidIntName(const FName: TZMString): Boolean;
		961	var
		962	c: Char;
		963	clen: Integer;
		964	i: Integer;
		965	len: Integer;
		966	n: Char;
		967	p: Char;
		968	begin
		969	Result := True;
		970	len := Length(FName);
		971	if (len < 1) or (len >= MAX_PATH) then
		972	exit; // empty or too long
		973	c := FName[1];
		974	if (c = PathDelim) or (c = '.') or (c = ' ') then
		975	exit; // invalid from root or below
		976	i := 1;
		977	clen := 0;
		978	p := #0;
		979	while i <= len do
		980	begin
		981	Inc(clen);
		982	if clen > 255 then
		983	exit; // component too long
		984	c := FName[i];
		985	if i < len then
		986	n := FName[i + 1]
		987	else
		988	n := #0;
		989	case c of
		990	WILD_MULTI, DriveDelim, WILD_CHAR, '<', '>', '\|', #0:
		991	exit;
		992	#1..#31:
		993	exit; // invalid
		994	PathDelimAlt:
		995	begin
		996	if p = ' ' then
		997	exit; // bad - component has Trailing space
		998	if (n = c) or (n = '.') or (n = ' ') then
		999	exit; // \\ . leading space invalid
		1000	clen := 0;
		1001	end;
		1002	'.':
		1003	begin
		1004	n := FName[succ(i)];
		1005	if (n = PathDelim) or (n < ' ') then
		1006	exit;
		1007	end;
		1008	' ':
		1009	if i = len then
		1010	exit; // invalid
		1011	end;
		1012	p := c;
		1013	Inc(i);
		1014	end;
		1015	Result := False;
		1016	end;
		1017
		1018	procedure TZMIRec.AfterConstruction;
		1019	begin
		1020	inherited;
		1021	fStatusBits := 0;
		1022	end;
		1023
		1024	procedure TZMIRec.BeforeDestruction;
		1025	begin
		1026	fExtraField := '';
		1027	fHeaderName := '';
		1028	fHeaderComment := '';
		1029	inherited;
		1030	end;
		1031
		1032	function TZMIRec.IsZip64: Boolean;
		1033	begin
		1034	Result := (UncompressedSize >= MAX_UNSIGNED) or
		1035	(CompressedSize >= MAX_UNSIGNED) or
		1036	(RelOffLocal >= MAX_UNSIGNED) or (DiskStart >= MAX_WORD);
		1037	end;
		1038
		1039	// also calculate required version and create extra data
		1040	function TZMIRec.LocalSize: Cardinal;
		1041	begin
		1042	Result := SizeOf(TZipLocalHeader);
		1043	PrepareLocalData; // form local extra data
		1044	Inc(Result, FileNameLength + Length(LocalData));
		1045	end;
		1046
		1047	procedure TZMIRec.MarkDirty;
		1048	begin
		1049	SetStatusBit(zsbDirty);
		1050	end;
		1051
		1052	procedure TZMIRec.FixMinimumVers(z64: boolean);
		1053	const
		1054	OS_FAT: Word = (FS_FAT * 256);
		1055	WZIP = (FS_NTFS * 256) + 50;
		1056	var
		1057	NewNeed: Word;
		1058	begin
		1059	if ((VersionMadeBy and VerMask) <= ZIP64_VER) and
		1060	((VersionNeeded and VerMask) <= ZIP64_VER) then
		1061	begin
		1062	// Enc := IsEncoded;
		1063	if z64 then
		1064	VersionMadeBy := (VersionMadeBy and OSMask) or ZIP64_VER
		1065	else
		1066	if (VersionMadeBy and VerMask) = ZIP64_VER then
		1067	begin
		1068	// zip64 no longer needed
		1069	VersionMadeBy := (VersionMadeBy and OSMask) or OUR_VEM;
		1070	end;
		1071	// correct bad encodings - marked ntfs should be fat
		1072	if VersionMadeBy = WZIP then
		1073	VersionMadeBy := OS_FAT or OUR_VEM;
		1074
		1075	case ComprMethod of
		1076	0: NewNeed := 10; // stored
		1077	1..8: NewNeed := 20;
		1078	9: NewNeed := 21; // enhanced deflate
		1079	10: NewNeed := 25; // DCL
		1080	12: NewNeed := 46; // BZip2
		1081	else
		1082	NewNeed := ZIP64_VER;
		1083	end;
		1084	if ((Flag and 32) <> 0) and (NewNeed < 27) then
		1085	NewNeed := 27;
		1086	if z64 and (NewNeed < ZIP64_VER) then
		1087	NewNeed := ZIP64_VER;
		1088	// keep needed os
		1089	VersionNeeded := (VersionNeeded and OSMask) + NewNeed;
		1090	end;
		1091	end;
		1092
		1093	// process the record (base type does nothing)
		1094	// returns bytes written, <0 _ error
		1095	function TZMIRec.Process: Int64;
		1096	begin
		1097	Result := 0; // default, nothing done
		1098	end;
		1099
		1100	// size of data to process - excludes central directory (virtual)
		1101	function TZMIRec.ProcessSize: Int64;
		1102	begin
		1103	Result := 0;// default nothing to process
		1104	end;
		1105
		1106	(*? TZMIRec.Read
		1107	Reads directory entry
		1108	returns
		1109	>=0 = ok (1 = Zip64)
		1110	<0 = -error
		1111	*)
		1112	function TZMIRec.Read(wf: TZMWorkFile): Integer;
		1113	var
		1114	CH: TZipCentralHeader;
		1115	ExtraLen: Word;
		1116	n: TZMRawBytes;
		1117	r: Integer;
		1118	v: Integer;
		1119	begin
		1120	StatusBits := zsbInvalid;
		1121	// Diag('read central' );
		1122	r := wf.Reads(CH, ZipCenRecFields);
		1123	if r <> SizeOf(TZipCentralHeader) then
		1124	begin
		1125	Result := -DS_CEHBadRead;
		1126	exit;
		1127	end;
		1128	if CH.HeaderSig <> CentralFileHeaderSig then
		1129	begin
		1130	Result := -DS_CEHWrongSig;
		1131	exit;
		1132	end;
		1133	VersionMadeBy := CH.VersionMadeBy;
		1134	VersionNeeded := CH.VersionNeeded;
		1135	Flag := CH.Flag;
		1136	ComprMethod := CH.ComprMethod;
		1137	ModifDateTime := CH.ModifDateTime;
		1138	CRC32 := CH.CRC32;
		1139	FileNameLength := CH.FileNameLen;
		1140	ExtraLen := CH.ExtraLen;
		1141	FileCommentLen := CH.FileComLen;
		1142	DiskStart := CH.DiskStart;
		1143	IntFileAttrib := CH.IntFileAtt;
		1144	ExtFileAttrib := CH.ExtFileAtt;
		1145	RelOffLocal := CH.RelOffLocal;
		1146	CompressedSize := CH.ComprSize;
		1147	UncompressedSize := CH.UncomprSize;
		1148	// read variable length fields
		1149	v := FileNameLen + ExtraLen + FileComLen;
		1150	SetLength(n, v);
		1151	r := wf.Reads(n[1], [FileNameLen, ExtraLen, FileComLen]);
		1152	if r <> v then
		1153	begin
		1154	Result := -DS_CECommentLen;
		1155	if r < FileNameLen then
		1156	Result := -DS_CENameLen
		1157	else
		1158	if r < (FileNameLen + ExtraLen) then
		1159	Result := -LI_ReadZipError;
		1160	exit;
		1161	end;
		1162	if FileComLen > 0 then
		1163	fHeaderComment := copy(n, FileNameLen + ExtraLen + 1, FileComLen);
		1164	if ExtraLen > 0 then
		1165	fExtraField := copy(n, FileNameLen + 1, ExtraLen);
		1166	SetLength(n, FileNameLen);
		1167	fHeaderName := n;
		1168	fOrigHeaderName := n;
		1169	ClearStatusBit(zsbInvalid); // record is valid
		1170	if n[Length(n)] = PathDelimAlt then
		1171	SetStatusBit(zsbDirOnly); // dir only entry
		1172	Result := FixXData64;
		1173	end;
		1174
		1175	procedure TZMIRec.PrepareLocalData;
		1176	var
		1177	xd: Txdat64;
		1178	Need64: Boolean;
		1179	begin
		1180	LocalData := ''; // empty
		1181	ClearStatusBit(zsbLocal64);
		1182	// check for Zip64
		1183	Need64 := (UncompressedSize >= MAX_UNSIGNED) or (CompressedSize >= MAX_UNSIGNED);
		1184	FixMinimumVers(Need64);
		1185	if Need64 then
		1186	begin
		1187	SetStatusBit(zsbLocal64);
		1188	xd.tag := Zip64_data_tag;
		1189	xd.siz := 16;
		1190	xd.vals[0] := UncompressedSize;
		1191	xd.vals[1] := CompressedSize;
		1192	SetLength(fLocalData, 20);
		1193	Move(xd.tag, PAnsiChar(LocalData)^, 20);
		1194	end;
		1195	// remove unwanted 'old' tags
		1196	if ExtraFieldLength > 0 then
		1197	LocalData := LocalData + XDataRemove(ExtraField,
		1198	[Zip64_data_tag, Ntfs_data_tag, UCmnt_Data_Tag]);
		1199	SetStatusBit(zsbLocalDone);
		1200	end;
		1201
		1202	function TZMIRec.SafeHeaderName(const IntName: TZMString): TZMString;
		1203	const
		1204	BadChars : TSysCharSet = [#0..#31, ':', '<', '>', '\|', '*', '?', #39, '\'];
		1205	var
		1206	c: Char;
		1207	i: integer;
		1208	Begin
		1209	Result := '';
		1210	for i := 1 to Length(IntName) do
		1211	begin
		1212	c := IntName[i];
		1213	if (c <= #255) and (AnsiChar(c) in BadChars) then
		1214	begin
		1215	if c = '\' then
		1216	Result := Result + PathDelimAlt
		1217	else
		1218	Result := Result + '#$' + IntToHex(Ord(c),2);
		1219	end
		1220	else
		1221	Result := Result + c;
		1222	end;
		1223	end;
		1224
		1225	function TZMIRec.SeekLocalData: Integer;
		1226	const
		1227	// no signature
		1228	LOHFlds: array [0..9] of Integer = (2, 2, 2, 2, 2, 4, 4, 4, 2, 2);
		1229	var
		1230	did: Int64;
		1231	i: Integer;
		1232	InWorkFile: TZMWorkFile;
		1233	LOH: TZipLocalHeader;
		1234	t: Integer;
		1235	v: TZMRawBytes;
		1236	begin
		1237	ASSERT(assigned(Owner), 'no owner');
		1238	InWorkFile := Owner;
		1239	// Diag('Seeking local');
		1240	Result := -DS_FileOpen;
		1241	if not InWorkFile.IsOpen then
		1242	exit;
		1243	Result := -DS_LOHBadRead;
		1244	try
		1245	InWorkFile.SeekDisk(DiskStart);
		1246	InWorkFile.Position := RelOffLocal;
		1247	did := InWorkFile.Read(LOH, 4);
		1248	if (did = 4) and (LOH.HeaderSig = LocalFileHeaderSig) then
		1249	begin // was local header
		1250	did := InWorkFile.Reads(LOH.VersionNeeded, LOHFlds);
		1251	if did = (sizeof(TZipLocalHeader) - 4) then
		1252	begin
		1253	if LOH.FileNameLen = Length(OrigHeaderName) then
		1254	begin
		1255	t := LOH.FileNameLen + LOH.ExtraLen;
		1256	SetLength(v, t);
		1257	did := InWorkFile.Reads(v[1], [LOH.FileNameLen, LOH.ExtraLen]);
		1258	if (did = t) then
		1259	begin
		1260	Result := 0;
		1261	for i := 1 to LOH.FileNameLen do
		1262	begin
		1263	if v[i] <> OrigHeaderName[i] then
		1264	begin
		1265	Result := -DS_LOHWrongName;
		1266	break;
		1267	end;
		1268	end;
		1269	end;
		1270	end;
		1271	v := '';
		1272	end;
		1273	end;
		1274	if Result = -DS_LOHBadRead then
		1275	Diag('could not read local header: ' + FileName);
		1276	except
		1277	on E: EZipMaster do
		1278	begin
		1279	Result := -E.ResId;
		1280	exit;
		1281	end;
		1282	on E: Exception do
		1283	begin
		1284	Result := -DS_UnknownError;
		1285	exit;
		1286	end;
		1287	end;
		1288	end;
		1289
		1290	// returns the new value
		1291	function TZMIRec.Select(How: TZipSelects): Boolean;
		1292	begin
		1293	case How of
		1294	zzsClear:
		1295	Result := False;
		1296	zzsSet:
		1297	Result := True;
		1298	// zzsToggle:
		1299	else
		1300	Result := not TestStatusBit(zsbSelected);
		1301	end;
		1302	SetSelected(Result);
		1303	end;
		1304
		1305	procedure TZMIRec.SetDateStamp(Value: TDateTime);
		1306	begin
		1307	DateTimeToFileDate(Value);
		1308	end;
		1309
		1310	procedure TZMIRec.SetEncrypted(const Value: Boolean);
		1311	begin
		1312	if Value then
		1313	Flag := Flag or 1
		1314	else
		1315	Flag := Flag and $FFFE;
		1316	end;
		1317
		1318	// assumes data contains the data with no header
		1319	procedure TZMIRec.SetExtraData(Tag: Word; const data: TZMRawBytes);
		1320	var
		1321	after: Integer;
		1322	afterLen: integer;
		1323	nidx: Integer;
		1324	ix: Integer;
		1325	newXData: TZMRawBytes;
		1326	dataSize: Word;
		1327	sz: Integer;
		1328	v: Integer;
		1329	x: TZMRawBytes;
		1330	begin
		1331	x := GetExtraField;
		1332	XData(x, Tag, ix, sz); // find existing Tag
		1333	v := Length(x) - sz; // size after old tag removed
		1334	if Length(data) > 0 then
		1335	v := v + Length(data) + 4;
		1336	if v > MAX_WORD then // new length too big?
		1337	exit; // maybe give error
		1338	dataSize := Length(data);
		1339	SetLength(newXData, v);
		1340	nidx := 1; // next index into newXData
		1341	if (dataSize > 0) then
		1342	begin
		1343	// prefix required tag
		1344	newXData[1] := AnsiChar(Tag and MAX_BYTE);
		1345	newXData[2] := AnsiChar(Tag shr 8);
		1346	newXData[3] := AnsiChar(dataSize and MAX_BYTE);
		1347	newXData[4] := AnsiChar(dataSize shr 8);
		1348	// add the data
		1349	Move(data[1], newXData[5], dataSize);
		1350	Inc(nidx, dataSize + 4);
		1351	end;
		1352	if ix >= 1 then
		1353	begin
		1354	// had existing data
		1355	if ix > 1 then
		1356	begin
		1357	// append data from before existing tag
		1358	Move(x[1], newXData[nidx], ix - 1);
		1359	Inc(nidx, ix);
		1360	end;
		1361	after := ix + sz; // index after replaced tag
		1362	if after < Length(x) then
		1363	begin
		1364	// append data from after existing
		1365	afterLen := Length(x) + 1 - after;
		1366	Move(x[after], newXData[nidx], afterLen);
		1367	end;
		1368	end
		1369	else
		1370	begin
		1371	// did not exist
		1372	if Length(x) > 0 then
		1373	Move(x[1], newXData[nidx], Length(x)); // append old extra data
		1374	end;
		1375	ExtraField := newXData;
		1376	end;
		1377
		1378	procedure TZMIRec.SetIsEncoded(const Value: TZMEncodingOpts);
		1379	var
		1380	n: Integer;
		1381	begin
		1382	n := Ord(Value) shl 16;
		1383	ClearStatusBit(zsbEncMask); // clear all
		1384	SetStatusBit(n); // set new value
		1385	end;
		1386
		1387	procedure TZMIRec.SetSelected(const Value: Boolean);
		1388	begin
		1389	if Selected <> Value then
		1390	begin
		1391	if Value then
		1392	SetStatusBit(zsbSelected)
		1393	else
		1394	begin
		1395	ClearStatusBit(zsbSelected);
		1396	SelectArgs := '';
		1397	end;
		1398	end;
		1399	end;
		1400
		1401	function TZMIRec.SetStatusBit(const Value: Cardinal): Cardinal;
		1402	begin
		1403	StatusBits := StatusBits or Value;
		1404	Result := StatusBits;
		1405	end;
		1406
		1407	function TZMIRec.StrToSafe(const aString: TZMString; ToOem: boolean):
		1408	AnsiString;
		1409	begin
		1410	{$IFDEF UNICODE}
		1411	Result := WideToSafe(aString, ToOem);
		1412	{$ELSE}
		1413	if Owner.Worker.UseUTF8 then
		1414	Result := UTF8ToSafe(aString, ToOem)
		1415	else
		1416	Result := WideToSafe(aString, ToOem);
		1417	{$ENDIF}
		1418	end;
		1419
		1420	// converts to internal delimiter
		1421	function TZMIRec.StripDrive(const FName: TZMString; NoPath: Boolean): TZMString;
		1422	var
		1423	nam: Integer;
		1424	posn: Integer;
		1425	begin
		1426	Result := SetSlash(FName, psdExternal);
		1427	// Remove drive: or //host/share
		1428	posn := 0;
		1429	if length(Result) > 1 then
		1430	begin
		1431	if Result[1] = ':' then
		1432	begin
		1433	posn := 2;
		1434	if (Length(Result) > 2) and (Result[3] = PathDelim{Alt}) then
		1435	posn := 3;
		1436	end
		1437	else
		1438	if (Result[1] = PathDelimAlt) and (Result[2] = PathDelim{Alt}) then
		1439	begin
		1440	posn := 3;
		1441	while (posn < Length(Result)) and (Result[posn] <> PathDelim{Alt}) do
		1442	Inc(posn);
		1443	Inc(posn);
		1444	while (posn < Length(Result)) and (Result[posn] <> PathDelimAlt) do
		1445	Inc(posn);
		1446	if posn >= Length(Result) then
		1447	begin
		1448	// error - invalid host/share
		1449	Diag('Invalid filespec: ' + Result);
		1450	Result := '';
		1451	exit;// { TODO : handle error }
		1452	end;
		1453	end;
		1454	end;
		1455	Inc(posn);
		1456	// remove leading ./
		1457	if ((posn + 1) < Length(Result)) and (Result[posn] = '.') and
		1458	(Result[posn + 1] = PathDelim) then
		1459	posn := posn + 2;
		1460	// remove path if not wanted
		1461	if NoPath then
		1462	begin
		1463	nam := LastPos(Result, PathDelim);
		1464	if nam > posn then
		1465	posn := nam + 1;
		1466	end;
		1467	Result := Copy(Result, posn, MAX_PATH);
		1468	end;
		1469
		1470	function TZMIRec.StrToHeader(const aString: TZMString; how: THowToEnc):
		1471	TZMRawBytes;
		1472	begin
		1473	{$IFDEF UNICODE}
		1474	if how = hteUTF8 then
		1475	Result := TZMRawBytes(WideToUTF8(aString, -1))
		1476	else
		1477	Result := TZMRawBytes(WideToSafe(aString, how = hteOEM));
		1478	{$ELSE}
		1479	if Owner.Worker.UseUTF8 then
		1480	begin
		1481	if how = hteUTF8 then
		1482	Result := TZMRawBytes(aString)
		1483	else
		1484	Result := TZMRawBytes(WideToSafe(UTF8ToWide(aString), how = hteOEM));
		1485	end
		1486	else
		1487	begin
		1488	case how of
		1489	hteOEM: Result := TZMRawBytes(StrToOEM(aString));
		1490	hteAnsi: Result := TZMRawBytes(aString);
		1491	hteUTF8: Result := TZMRawBytes(StrToUTF8(aString));
		1492	end;
		1493	end;
		1494	{$ENDIF}
		1495	end;
		1496
		1497	function TZMIRec.StrToUTF8Header(const aString: TZMString): TZMRawBytes;
		1498	begin
		1499	{$IFDEF UNICODE}
		1500	Result := UTF8String(aString);
		1501	{$ELSE}
		1502	if Owner.Worker.UseUtf8 then
		1503	Result := AsUTF8Str(aString) // make sure UTF8
		1504	else
		1505	Result := StrToUTF8(aString);
		1506	{$ENDIF}
		1507	end;
		1508
		1509	function TZMIRec.StrTo_UTF8(const aString: TZMString): UTF8String;
		1510	begin
		1511	{$IFDEF UNICODE}
		1512	Result := UTF8String(aString);
		1513	{$ELSE}
		1514	if Owner.Worker.UseUtf8 then
		1515	Result := AsUTF8Str(aString) // make sure UTF8
		1516	else
		1517	Result := StrToUTF8(aString);
		1518	{$ENDIF}
		1519	end;
		1520
		1521	function TZMIRec.TestStatusBit(const mask: Cardinal): Boolean;
		1522	begin
		1523	Result := (StatusBits and mask) <> 0;
		1524	end;
		1525
		1526	function TZMIRec.ToIntForm(const nname: TZMString; var iname: TZMString):
		1527	Integer;
		1528	var
		1529	temp: TZMString;
		1530	begin
		1531	Result := 0;
		1532	iname := StripDrive(nname, not (AddDirNames in Owner.Worker.AddOptions));
		1533	// truncate if too long
		1534	if Length(iname) > MAX_PATH then
		1535	begin
		1536	temp := iname;
		1537	SetLength(iname, MAX_PATH);
		1538	Diag('Truncated ' + temp + ' to ' + iname);
		1539	end;
		1540	if IsInvalidIntName(iname) then
		1541	Result := -AD_BadFileName;
		1542	end;
		1543
		1544	// write the central entry on it's owner
		1545	// return bytes written (< 0 = -Error)
		1546	function TZMIRec.Write: Integer;
		1547	var
		1548	CH: PZipCentralHeader;
		1549	l: Integer;
		1550	Need64: Boolean;
		1551	ni: TZMRawBytes;
		1552	p: pByte;
		1553	pb: pByte;
		1554	r: Integer;
		1555	siz: Word;
		1556	vals: array [0..4] of Int64;
		1557	wf: TZMWorkFile;
		1558	x: TZMRawBytes;
		1559	begin
		1560	wf := Owner;
		1561	ASSERT(assigned(wf), 'no WorkFile');
		1562	// Diag('Write central');
		1563	Result := -1;
		1564	if not wf.IsOpen then
		1565	exit;
		1566	fOrigHeaderName := HeaderName; // might have changed
		1567	pb := wf.WBuffer(sizeof(TZipCentralHeader));
		1568	CH := PZipCentralHeader(pb);
		1569	ni := HeaderName;
		1570	CH^.HeaderSig := CentralFileHeaderSig;
		1571	CH^.VersionMadeBy := VersionMadeBy;
		1572	CH^.VersionNeeded := VersionNeeded; // assumes local was written - may be updated
		1573	CH^.Flag := Flag;
		1574	CH^.ComprMethod := ComprMethod;
		1575	CH^.ModifDateTime := ModifDateTime;
		1576	CH^.CRC32 := CRC32;
		1577	CH^.FileNameLen := length(ni);
		1578	CH^.FileComLen := Length(HeaderComment);
		1579	CH^.IntFileAtt := IntFileAttrib;
		1580	CH^.ExtFileAtt := ExtFileAttrib;
		1581
		1582	siz := 0;
		1583	if (UncompressedSize >= MAX_UNSIGNED) then
		1584	begin
		1585	vals[0] := UncompressedSize;
		1586	siz := 8;
		1587	CH^.UncomprSize := MAX_UNSIGNED;
		1588	end
		1589	else
		1590	CH^.UncomprSize := Cardinal(UncompressedSize);
		1591
		1592	if (CompressedSize >= MAX_UNSIGNED) then
		1593	begin
		1594	vals[siz div 8] := CompressedSize;
		1595	Inc(siz, 8);
		1596	CH^.ComprSize := MAX_UNSIGNED;
		1597	end
		1598	else
		1599	CH^.ComprSize := Cardinal(CompressedSize);
		1600
		1601	if (RelOffLocal >= MAX_UNSIGNED) then
		1602	begin
		1603	vals[siz div 8] := RelOffLocal;
		1604	Inc(siz, 8);
		1605	CH^.RelOffLocal := MAX_UNSIGNED;
		1606	end
		1607	else
		1608	CH^.RelOffLocal := Cardinal(RelOffLocal);
		1609
		1610	if (DiskStart >= MAX_WORD) then
		1611	begin
		1612	vals[siz div 8] := DiskStart;
		1613	Inc(siz, 4);
		1614	CH^.DiskStart := MAX_WORD;
		1615	end
		1616	else
		1617	CH^.DiskStart := Word(DiskStart);
		1618	Need64 := False;
		1619	if siz > 0 then
		1620	begin
		1621	SetLength(x, siz);
		1622	move(vals[0], x[1], siz);
		1623	Need64 := True;
		1624	if (VersionNeeded and MAX_BYTE) < ZIP64_VER then
		1625	begin
		1626	FixMinimumVers(True);
		1627	CH^.VersionNeeded := VersionNeeded;
		1628	CH^.VersionMadeBy := VersionMadeBy;
		1629	end;
		1630	ExtraData[Zip64_data_tag] := x;
		1631	end
		1632	else
		1633	ExtraData[Zip64_data_tag] := ''; // remove old 64 data
		1634	if (StatusBit[zsbLocalDone] = 0) or (Need64) then
		1635	FixMinimumVers(Need64);
		1636	CH^.VersionMadeBy := VersionMadeBy;
		1637	CH^.VersionNeeded := VersionNeeded;
		1638	x := '';
		1639	CH^.ExtraLen := ExtraFieldLength;
		1640	Result := -DS_CEHBadWrite;
		1641	l := sizeof(TZipCentralHeader) + CH^.FileNameLen + CH^.ExtraLen +
		1642	CH^.FileComLen;
		1643	pb := wf.WBuffer(l);
		1644	p := pb;
		1645	Inc(p, sizeof(TZipCentralHeader));
		1646	move(ni[1], p^, CH^.FileNameLen);
		1647	Inc(p, CH^.FileNameLen);
		1648	if CH^.ExtraLen > 0 then
		1649	begin
		1650	move(ExtraField[1], p^, CH^.ExtraLen);
		1651	Inc(p, CH^.ExtraLen);
		1652	end;
		1653	if CH^.FileComLen > 0 then
		1654	move(HeaderComment[1], p^, CH^.FileComLen);
		1655	r := wf.Write(pb^, -l);
		1656	if r = l then
		1657	begin
		1658	// Diag(' Write central ok');
		1659	Result := r;
		1660	ClearStatusBit(zsbDirty);
		1661	end//;
		1662	else
		1663	if r < 0 then
		1664	Result := r;
		1665	end;
		1666
		1667	function TZMIRec.WriteAsLocal: Integer;
		1668	begin
		1669	Result := WriteAsLocal1(ModifDateTime, CRC32);
		1670	end;
		1671
		1672	// write local header using specified stamp and crc
		1673	// return bytes written (< 0 = -Error)
		1674	function TZMIRec.WriteAsLocal1(Stamp, crc: Cardinal): Integer;
		1675	var
		1676	cd: TZMRawBytes;
		1677	fnlen: Integer;
		1678	i: Integer;
		1679	LOH: PZipLocalHeader;
		1680	need64: Boolean;
		1681	ni: TZMRawBytes;
		1682	p: pByte;
		1683	pb: pByte;
		1684	t: Integer;
		1685	wf: TZMWorkFile;
		1686	begin
		1687	wf := Owner;
		1688	ASSERT(assigned(wf), 'no WorkFile');
		1689	if StatusBit[zsbLocalDone] = 0 then
		1690	PrepareLocalData;
		1691	LOH := PZipLocalHeader(wf.WBuffer(sizeof(TZipLocalHeader)));
		1692	if ((Flag and 9) = 8) then
		1693	Flag := Flag and $FFF7; // remove extended local data if not encrypted
		1694	ni := HeaderName;
		1695	fnlen := length(ni);
		1696	LOH^.HeaderSig := LocalFileHeaderSig;
		1697	LOH^.VersionNeeded := VersionNeeded; // may be updated
		1698	LOH^.Flag := Flag;
		1699	LOH^.ComprMethod := ComprMethod;
		1700	LOH^.ModifDateTime := Stamp;
		1701	LOH^.CRC32 := crc;
		1702	LOH^.FileNameLen := fnlen;
		1703	cd := LocalData;
		1704	LOH^.ExtraLen := Length(cd); // created by LocalSize
		1705	need64 := (LOH^.ExtraLen > 0) and (StatusBit[zsbLocal64] <> 0);
		1706	if need64 then
		1707	begin
		1708	LOH^.UnComprSize := MAX_UNSIGNED;
		1709	LOH^.ComprSize := MAX_UNSIGNED;
		1710	end
		1711	else
		1712	begin
		1713	if (Flag and 8) <> 0 then
		1714	begin
		1715	LOH^.UnComprSize := 0;
		1716	LOH^.ComprSize := 0;
		1717	if (VersionNeeded and MAX_BYTE) < ZIP64_VER then
		1718	begin
		1719	FixMinimumVers(True);
		1720	LOH^.VersionNeeded := VersionNeeded;
		1721	end;
		1722	end
		1723	else
		1724	begin
		1725	LOH^.UnComprSize := Cardinal(UncompressedSize);
		1726	LOH^.ComprSize := Cardinal(CompressedSize);
		1727	end;
		1728	end;
		1729	t := fnlen + Length(cd);
		1730	pb := wf.WBuffer(sizeof(TZipLocalHeader) + t);
		1731	p := pb;
		1732	Inc(p, sizeof(TZipLocalHeader));
		1733	i := Sizeof(TZipLocalHeader); // i = destination index
		1734	Move(ni[1], p^, fnlen);
		1735	i := i + fnlen;
		1736	Inc(p, fnlen);
		1737	// copy any extra data
		1738	if Length(cd) > 0 then
		1739	begin
		1740	Move(cd[1], p^, Length(cd));
		1741	Inc(i, Length(cd));
		1742	end;
		1743	Result := wf.Write(pb^, -i); // must fit
		1744	if Result = i then
		1745	ClearStatusBit(zsbDirty)
		1746	else
		1747	Result := -DS_LOHBadWrite;
		1748	end;
		1749
		1750	// return bytes written (< 0 = -Error)
		1751	function TZMIRec.WriteDataDesc(OutZip: TZMWorkFile): Integer;
		1752	var
		1753	d: TZipDataDescriptor;
		1754	d64: TZipDataDescriptor64;
		1755	r: Integer;
		1756	begin
		1757	ASSERT(assigned(OutZip), 'no WorkFile');
		1758	if (Flag and 8) <> 0 then
		1759	begin
		1760	Result := 0;
		1761	exit;
		1762	end;
		1763	Result := -DS_DataDesc;
		1764	if (VersionNeeded and MAX_BYTE) < ZIP64_VER then
		1765	begin
		1766	d.DataDescSig := ExtLocalSig;
		1767	d.CRC32 := CRC32;
		1768	d.ComprSize := Cardinal(CompressedSize);
		1769	d.UnComprSize := Cardinal(UncompressedSize);
		1770	r := OutZip.Write(d, -sizeof(TZipDataDescriptor));
		1771	if r = sizeof(TZipDataDescriptor) then
		1772	Result := r;
		1773	end
		1774	else
		1775	begin
		1776	d64.DataDescSig := ExtLocalSig;
		1777	d64.CRC32 := CRC32;
		1778	d64.ComprSize := CompressedSize;
		1779	d64.UnComprSize := UncompressedSize;
		1780	r := OutZip.Write(d64, -sizeof(TZipDataDescriptor64));
		1781	if r = sizeof(TZipDataDescriptor64) then
		1782	Result := r;
		1783	end;
		1784	end;
		1785
		1786	// Return true if found
		1787	// if found return idx --> tag, size = tag + data
		1788	function XData(const x: TZMRawBytes; Tag: Word; var idx, size: Integer):
		1789	Boolean;
		1790	var
		1791	i: Integer;
		1792	l: Integer;
		1793	wsz: Word;
		1794	wtg: Word;
		1795	begin
		1796	Result := False;
		1797	idx := 0;
		1798	size := 0;
		1799	i := 1;
		1800	l := Length(x);
		1801	while i < l - 4 do
		1802	begin
		1803	wtg := pWord(@x[i])^;
		1804	wsz := pWord(@x[i + 2])^;
		1805	if wtg = Tag then
		1806	begin
		1807	Result := (i + wsz + 4) <= l + 1;
		1808	if Result then
		1809	begin
		1810	idx := i;
		1811	size := wsz + 4;
		1812	end;
		1813	break;
		1814	end;
		1815	i := i + wsz + 4;
		1816	end;
		1817	end;
		1818
		1819	function XData_HasTag(tag: Integer; const tags: array of Integer): Boolean;
		1820	var
		1821	ii: Integer;
		1822	begin
		1823	Result := False;
		1824	for ii := 0 to HIGH(tags) do
		1825	if tags[ii] = tag then
		1826	begin
		1827	Result := True;
		1828	break;
		1829	end;
		1830	end;
		1831
		1832	function XDataAppend(var x: TZMRawBytes; const src1; siz1: Integer; const src2;
		1833	siz2: Integer): Integer;
		1834	var
		1835	newlen: Integer;
		1836	begin
		1837	Result := Length(x);
		1838	if (siz1 < 0) or (siz2 < 0) then
		1839	exit;
		1840	newlen := Result + siz1 + siz2;
		1841	SetLength(x, newlen);
		1842	Move(src1, x[Result + 1], siz1);
		1843	Result := Result + siz1;
		1844	if siz2 > 0 then
		1845	begin
		1846	Move(src2, x[Result + 1], siz2);
		1847	Result := Result + siz2;
		1848	end;
		1849	end;
		1850
		1851	function XDataKeep(const x: TZMRawBytes; const tags: array of Integer):
		1852	TZMRawBytes;
		1853	var
		1854	di: Integer;
		1855	i: Integer;
		1856	l: Integer;
		1857	siz: Integer;
		1858	wsz: Word;
		1859	wtg: Word;
		1860	begin
		1861	Result := '';
		1862	siz := 0;
		1863	l := Length(x);
		1864	if l < 4 then
		1865	exit; // invalid
		1866	i := 1;
		1867	while i <= l - 4 do
		1868	begin
		1869	wtg := pWord(@x[i])^;
		1870	wsz := pWord(@x[i + 2])^;
		1871	if (XData_HasTag(wtg, tags)) and ((i + wsz + 4) <= l + 1) then
		1872	begin
		1873	Inc(siz, wsz + 4);
		1874	end;
		1875	i := i + wsz + 4;
		1876	end;
		1877	SetLength(Result, siz);
		1878	di := 1;
		1879	i := 1;
		1880	while i <= l - 4 do
		1881	begin
		1882	wtg := pWord(@x[i])^;
		1883	wsz := pWord(@x[i + 2])^;
		1884	if (XData_HasTag(wtg, tags)) and ((i + wsz + 4) <= l + 1) then
		1885	begin
		1886	wsz := wsz + 4;
		1887	while wsz > 0 do
		1888	begin
		1889	Result[di] := x[i];
		1890	Inc(di);
		1891	Inc(i);
		1892	Dec(wsz);
		1893	end;
		1894	end
		1895	else
		1896	i := i + wsz + 4;
		1897	end;
		1898	end;
		1899
		1900
		1901	function XDataRemove(const x: TZMRawBytes; const tags: array of Integer):
		1902	TZMRawBytes;
		1903	var
		1904	di: Integer;
		1905	i: Integer;
		1906	l: Integer;
		1907	siz: Integer;
		1908	wsz: Word;
		1909	wtg: Word;
		1910	begin
		1911	Result := '';
		1912	siz := 0;
		1913	l := Length(x);
		1914	if l < 4 then
		1915	exit; // invalid
		1916	i := 1;
		1917	while i <= l - 4 do
		1918	begin
		1919	wtg := pWord(@x[i])^;
		1920	wsz := pWord(@x[i + 2])^;
		1921	if (not XData_HasTag(wtg, tags)) and ((i + wsz + 4) <= l + 1) then
		1922	begin
		1923	Inc(siz, wsz + 4);
		1924	end;
		1925	i := i + wsz + 4;
		1926	end;
		1927	SetLength(Result, siz);
		1928	di := 1;
		1929	i := 1;
		1930	while i <= l - 4 do
		1931	begin
		1932	wtg := pWord(@x[i])^;
		1933	wsz := pWord(@x[i + 2])^;
		1934	if (not XData_HasTag(wtg, tags)) and ((i + wsz + 4) <= l + 1) then
		1935	begin
		1936	wsz := wsz + 4;
		1937	while wsz > 0 do
		1938	begin
		1939	Result[di] := x[i];
		1940	Inc(di);
		1941	Inc(i);
		1942	Dec(wsz);
		1943	end;
		1944	end
		1945	else
		1946	i := i + wsz + 4;
		1947	end;
		1948	end;
		1949
		1950	end.

Subversion Repositories autosfx

autosfx/zmstr1900102/ZMIRec19.pas @ 7 – Rev 1