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

Rev	Author	Line No.	Line
1	daniel-mar	1	unit ZMZipFile19;
		2
		3	(*
		4	ZMZipFile19.pas - Represents the 'Directory' 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-06-20
		28	---------------------------------------------------------------------------*)
		29	interface
		30
		31	uses
		32	Classes, Windows, ZipMstr19, ZMCore19, ZMIRec19, ZMHash19, ZMWorkFile19, ZMCompat19, ZMEOC19;
		33
		34	type
		35	TZCChanges = (zccNone, zccBegin, zccCount, zccAdd, zccEdit, zccDelete,
		36	zccEnd, zccCheckNo);
		37	TZCChangeEvent = procedure(Sender: TObject; idx: Integer;
		38	change: TZCChanges) of object;
		39
		40	type
		41	TVariableData = array of Byte;
		42
		43	type
		44	TZMCXFields = (zcxUncomp, zcxComp, zcxOffs, zcxStart);
		45
		46
		47
		48	type
		49	TZMZipFile = class(TZMEOC)
		50	private
		51	FAddOptions: TZMAddOpts;
		52	fCheckNo: Cardinal;
		53	FEncodeAs: TZMEncodingOpts;
		54	fEncoding: TZMEncodingOpts;
		55	fEncoding_CP: Cardinal;
		56	fEntries: TList;
		57	fEOCFileTime: TFileTime;
		58	FFirst: Integer;
		59	FIgnoreDirOnly: boolean;
		60	fOnChange: TZCChangeEvent;
		61	fOpenRet: Integer;
		62	FSelCount: integer;
		63	fSFXOfs: Cardinal;
		64	fShowAll: Boolean;
		65	fStub: TMemoryStream;
		66	fUseSFX: Boolean;
		67	FWriteOptions: TZMWriteOpts;
		68	function GetCount: Integer;
		69	function GetItems(Idx: Integer): TZMIRec;
		70	function SelectEntry(t: TZMIRec; How: TZipSelects): Boolean;
		71	procedure SetCount(const Value: Integer);
		72	procedure SetEncoding(const Value: TZMEncodingOpts);
		73	procedure SetEncoding_CP(const Value: Cardinal);
		74	procedure SetItems(Idx: Integer; const Value: TZMIRec);
		75	procedure SetShowAll(const Value: Boolean);
		76	procedure SetStub(const Value: TMemoryStream);
		77	protected
		78	fHashList: TZMDirHashList;
		79	function BeforeCommit: Integer; virtual;
		80	function CalcSizes(var NoEntries: Integer; var ToProcess: Int64;
		81	var CenSize: Cardinal): Integer;
		82	procedure ClearCachedNames;
		83	procedure ClearEntries;
		84	function EOCSize(Is64: Boolean): Cardinal;
		85	procedure InferNumbering;
		86	function Load: Integer;
		87	procedure MarkDirty;
		88	function Open1(EOConly: Boolean): Integer;
		89	function WriteCentral: Integer;
		90	property Entries: TList Read fEntries;
		91	public
		92	constructor Create(Wrkr: TZMCore); override;
		93	function Add(rec: TZMIRec): Integer;
		94	procedure AssignFrom(Src: TZMWorkFile); override;
		95	procedure AssignStub(from: TZMZipFile);
		96	procedure BeforeDestruction; override;
		97	procedure ClearSelection;
		98	function Commit(MarkLatest: Boolean): Integer;
		99	function CommitAppend(Last: Integer; MarkLatest: Boolean): Integer;
		100	procedure Replicate(Src: TZMZipFile; LastEntry: Integer);
		101	function Entry(Chk: Cardinal; Idx: Integer): TZMIRec;
		102	function FindName(const pattern: TZMString; var idx: Integer): TZMIRec;
		103	overload;
		104	function FindName(const pattern: TZMString; var idx: Integer; const myself:
		105	TZMIRec): TZMIRec; overload;
		106	function FindNameEx(const pattern: TZMString; var idx: Integer; IsWild:
		107	boolean): TZMIRec;
		108	function HasDupName(const rec: TZMIRec): Integer;
		109	//1 Returns the number of duplicates
		110	function HashContents(var HList: TZMDirHashList; what: integer): Integer;
		111	//1 Mark as Contents Invalid
		112	procedure Invalidate;
		113	function Next(Current: Integer): integer;
		114	function NextSelected(Current: Integer): integer;
		115	function Open(EOConly, NoLoad: Boolean): Integer;
		116	function PrepareWrite(typ: TZipWrites): Boolean;
		117	function Reopen(Mode: Cardinal): integer;
		118	function Select(const Pattern: TZMString; How: TZipSelects): Integer;
		119	function Select1(const Pattern, reject: TZMString; How: TZipSelects): Integer;
		120	function SelectFiles(const want, reject: TStrings; skipped: TStrings): Integer;
		121	function VerifyOpen: Integer;
		122	property AddOptions: TZMAddOpts read FAddOptions write FAddOptions;
		123	property CheckNo: Cardinal Read fCheckNo;
		124	property Count: Integer Read GetCount Write SetCount;
		125	// how new/modified entries will be encoded
		126	property EncodeAs: TZMEncodingOpts read FEncodeAs write FEncodeAs;
		127	// how to interpret entry strings
		128	property Encoding: TZMEncodingOpts read fEncoding write SetEncoding;
		129	property Encoding_CP: Cardinal Read fEncoding_CP Write SetEncoding_CP;
		130	property EOCFileTime: TFileTime Read fEOCFileTime;
		131	property First: Integer read FFirst;
		132	property IgnoreDirOnly: boolean read FIgnoreDirOnly write FIgnoreDirOnly;
		133	property Items[Idx: Integer]: TZMIRec Read GetItems Write SetItems; default;
		134	property OpenRet: Integer Read fOpenRet Write fOpenRet;
		135	property SelCount: integer read FSelCount;
		136	property SFXOfs: Cardinal Read fSFXOfs Write fSFXOfs;
		137	property ShowAll: Boolean Read fShowAll Write SetShowAll;
		138	property Stub: TMemoryStream Read fStub Write SetStub;
		139	property UseSFX: Boolean Read fUseSFX Write fUseSFX;
		140	property WriteOptions: TZMWriteOpts read FWriteOptions write FWriteOptions;
		141	property OnChange: TZCChangeEvent Read fOnChange Write fOnChange;
		142	end;
		143
		144	type
		145	TZMCopyRec = class(TZMIRec)
		146	private
		147	fLink: TZMIRec;
		148	procedure SetLink(const Value: TZMIRec);
		149	public
		150	constructor Create(theOwner: TZMWorkFile);
		151	procedure AfterConstruction; override;
		152	function Process: Int64; override;
		153	function ProcessSize: Int64; override;
		154	property Link: TZMIRec Read fLink Write SetLink;
		155	end;
		156
		157	type
		158	TZMZipCopy = class(TZMZipFile)
		159	protected
		160	function AffixZippedFile(rec: TZMIRec): Integer;
		161	public
		162	constructor Create(Wrkr: TZMCore); override;
		163	function AffixZippedFiles(Src: TZMZipFile; All: Boolean): Integer;
		164	function WriteFile(InZip: TZMZipFile; All: Boolean): Int64;
		165	end;
		166
		167	const
		168	BadIndex = -HIGH(Integer);
		169
		170	const
		171	zfi_Loaded: cardinal = $1000; // central loaded
		172	zfi_DidLoad: cardinal = $2000; // central loaded
		173	zfi_Invalid: Cardinal = $8000; // needs reload
		174
		175	implementation
		176
		177	uses
		178	SysUtils, ZMMsg19, ZMXcpt19, ZMMsgStr19, ZMStructs19, ZMDelZip19,
		179	ZMUtils19, ZMMatch19, ZMUTF819;
		180
		181	{$INCLUDE '.\ZipVers19.inc'}
		182
		183	const
		184	AllSpec: String = '.';
		185	AnySpec: String = '*';
		186
		187	constructor TZMZipFile.Create(Wrkr: TZMCore);
		188	begin
		189	inherited;
		190	fEntries := TList.Create;
		191	fHashList := TZMDirHashList.Create;
		192	{$IFNDEF UNICODE}
		193	fHashList.Worker := Worker;
		194	{$ENDIF}
		195	fEncoding := Wrkr.Encoding;
		196	fAddOptions := wrkr.AddOptions;
		197	fEncodeAs := wrkr.EncodeAs;
		198	fEncoding_CP := wrkr.Encoding_CP;
		199	fIgnoreDirOnly := Wrkr.IgnoreDirOnly;
		200	FWriteOptions := Wrkr.WriteOptions;
		201	end;
		202
		203	function TZMZipFile.Add(rec: TZMIRec): Integer;
		204	begin
		205	Result := fEntries.Add(rec);
		206	if fHashList.Empty then
		207	fHashList.Add(rec);
		208	end;
		209
		210	procedure TZMZipFile.AssignFrom(Src: TZMWorkFile);
		211	begin
		212	inherited;
		213	if (Src is TZMZipFile) and (Src <> Self) then
		214	begin
		215	Replicate(TZMZipFile(Src), -1); // copy all entries
		216	end;
		217	end;
		218
		219	procedure TZMZipFile.AssignStub(from: TZMZipFile);
		220	begin
		221	FreeAndNil(fStub);
		222	fStub := from.Stub;
		223	from.fStub := nil;
		224	end;
		225
		226	function TZMZipFile.BeforeCommit: Integer;
		227	begin
		228	Result := 0;
		229	end;
		230
		231	procedure TZMZipFile.BeforeDestruction;
		232	begin
		233	ClearEntries;
		234	FreeAndNil(fEntries);
		235	FreeAndNil(fStub);
		236	FreeAndNil(fHashList);
		237	inherited;
		238	end;
		239
		240	function TZMZipFile.CalcSizes(var NoEntries: Integer; var ToProcess: Int64;
		241	var CenSize: Cardinal): Integer;
		242	var
		243	i: Integer;
		244	rec: TZMIRec;
		245	begin
		246	Result := 0;
		247	for i := 0 to Count - 1 do
		248	begin
		249	rec := Items[i];
		250	ToProcess := ToProcess + rec.ProcessSize;
		251	CenSize := CenSize + rec.CentralSize;
		252	Inc(NoEntries);
		253	end;
		254	end;
		255
		256	procedure TZMZipFile.ClearCachedNames;
		257	var
		258	i: Integer;
		259	tmp: TObject;
		260	begin
		261	for i := 0 to Count - 1 do
		262	begin
		263	tmp := fEntries[i];
		264	if tmp is TZMIRec then
		265	TZMIRec(tmp).ClearCachedName;
		266	end;
		267	fHashList.Clear;
		268	end;
		269
		270	procedure TZMZipFile.ClearEntries;
		271	var
		272	i: Integer;
		273	tmp: TObject;
		274	begin
		275	for i := 0 to pred(fEntries.Count) do
		276	begin
		277	tmp := fEntries.Items[i];
		278	if tmp <> nil then
		279	begin
		280	fEntries.Items[i] := nil;
		281	tmp.Free;
		282	end;
		283	end;
		284	fEntries.Clear;
		285	fHashList.Clear;
		286	FFirst := -1;
		287	fSelCount := 0;
		288	end;
		289
		290	procedure TZMZipFile.ClearSelection;
		291	var
		292	i: Integer;
		293	t: TZMIRec;
		294	begin
		295	FSelCount := 0;
		296	for i := 0 to fEntries.Count - 1 do
		297	begin
		298	t := fEntries[i];
		299	t.Selected := False;
		300	end;
		301	end;
		302
		303	function TZMZipFile.Commit(MarkLatest: Boolean): Integer;
		304	var
		305	i: Integer;
		306	latest: Cardinal;
		307	NoEntries: Integer;
		308	ToDo: Int64;
		309	r: Integer;
		310	rec: TZMIRec;
		311	s: Cardinal;
		312	ToProcess: Int64;
		313	TotalProcess: Int64;
		314	w64: Int64;
		315	wrote: Int64;
		316	begin
		317	Diag('Commit file');
		318	latest := 0;
		319	wrote := 0;
		320	Result := BeforeCommit;
		321	if Result < 0 then
		322	exit;
		323	// calculate sizes
		324	NoEntries := 0;
		325	ToProcess := 0;
		326	for i := 0 to Count - 1 do
		327	begin
		328	Boss.CheckCancel;
		329	rec := TZMIRec(Items[i]);
		330	Assert(assigned(rec), ' no rec');
		331	ToProcess := ToProcess + rec.ProcessSize;
		332	Inc(NoEntries);
		333	if MarkLatest and (rec.ModifDateTime > Latest) then
		334	Latest := rec.ModifDateTime;
		335	end;
		336	// mostly right ToProcess = total compressed sizes
		337	TotalProcess := ToProcess;
		338	if UseSFX and assigned(Stub) and (Stub.size > 0) then
		339	TotalProcess := TotalProcess + Stub.Size;
		340	ProgReport(zacCount, PR_Writing, '', NoEntries + 1);
		341	ProgReport(zacSize, PR_Writing, '', TotalProcess);
		342	Diag(' to process ' + IntToStr(NoEntries) + ' entries');
		343	Diag(' size = ' + IntToStr(TotalProcess));
		344	Result := 0;
		345	if MarkLatest then
		346	begin
		347	// Diag(' latest date = ' + DateTimeToStr(FileDateToLocalDateTime(latest)));
		348	StampDate := latest;
		349	end;
		350	try
		351	// if out is going to split should write proper signal
		352	if IsMultiPart then
		353	begin
		354	s := ExtLocalSig;
		355	Result := Write(s, -4);
		356	if (Result <> 4) and (Result > 0) then
		357	Result := -DS_NoWrite;
		358	Sig := zfsMulti;
		359	end
		360	else // write stub if required
		361	if UseSFX and assigned(Stub) and (Stub.size > 0) then
		362	begin
		363	// write the sfx stub
		364	ProgReport(zacItem, PR_SFX, '', Stub.Size);
		365	Stub.Position := 0;
		366	Result := WriteFrom(Stub, Stub.Size);
		367	if Result > 0 then
		368	begin
		369	wrote := Stub.Size;
		370	ProgReport(zacProgress, PR_SFX, '', Stub.Size);
		371	if ShowProgress = zspFull then
		372	Boss.ProgDetail.Written(wrote);
		373	Sig := zfsDOS; // assume correct
		374	end;
		375	end
		376	else
		377	Sig := zfsLocal;
		378	if (Result >= 0) and (ToProcess > 0) then
		379	begin
		380	for i := 0 to Count - 1 do
		381	begin
		382	Boss.CheckCancel;
		383	rec := TZMIRec(Items[i]);
		384	ToDo := rec.ProcessSize;
		385	if ToDo > 0 then
		386	begin
		387	w64 := rec.Process;
		388	if w64 < 0 then
		389	begin
		390	Result := w64;
		391	Break;
		392	end;
		393	wrote := wrote + w64;
		394	if ShowProgress = zspFull then
		395	Boss.TotalWritten := wrote;
		396	end;
		397	end;
		398	end;
		399	// finished locals and data
		400	if Result >= 0 then
		401	begin
		402	// write central
		403	Boss.ReportMsg(GE_Copying, [Boss.ZipLoadStr(DS_CopyCentral)]);
		404	r := WriteCentral; // uses XProgress
		405	if r >= 0 then
		406	wrote := wrote + r;
		407	Diag(' wrote = ' + IntToStr(wrote));
		408	if r > 0 then
		409	begin
		410	Result := FinishWrite;
		411	if r >= 0 then
		412	begin
		413	Result := 0;
		414	File_Size := wrote;
		415	Diag(' finished ok');
		416	end;
		417	end;
		418	end;
		419	finally
		420	ProgReport(zacEndOfBatch, 7, '', 0);
		421	end;
		422	end;
		423
		424	function TZMZipFile.CommitAppend(Last: Integer; MarkLatest: Boolean): Integer;
		425	var
		426	i: Integer;
		427	latest: Cardinal;
		428	NoEntries: Integer;
		429	ToDo: Int64;
		430	r: Integer;
		431	rec: TZMIRec;
		432	ToProcess: Int64;
		433	TotalProcess: Int64;
		434	w64: Int64;
		435	wrote: Int64;
		436	begin
		437	Diag('CommitAppend file');
		438	latest := 0;
		439	wrote := 0;
		440	// calculate sizes
		441	NoEntries := 0;
		442	ToProcess := 0;
		443	for i := 0 to Count - 1 do
		444	begin
		445	Boss.CheckCancel;
		446	rec := TZMIRec(Items[i]);
		447	Assert(assigned(rec), ' no rec');
		448	if i >= Last then
		449	begin
		450	ToProcess := ToProcess + rec.ProcessSize;
		451	Inc(NoEntries);
		452	end;
		453	if MarkLatest and (rec.ModifDateTime > latest) then
		454	latest := rec.ModifDateTime;
		455	end;
		456	// mostly right ToProcess = total compressed sizes
		457	TotalProcess := ToProcess;
		458	if UseSFX and assigned(Stub) and (Stub.size > 0) and (First < 0) then
		459	TotalProcess := TotalProcess + Stub.size;
		460	ProgReport(zacCount, PR_Writing, '', NoEntries + 1);
		461	ProgReport(zacSize, PR_Writing, '', TotalProcess);
		462	Diag(' to process ' + IntToStr(NoEntries) + ' entries');
		463	Diag(' size = ' + IntToStr(TotalProcess));
		464	Result := 0;
		465	if MarkLatest then
		466	begin
		467	// Diag(' latest date = ' + DateTimeToStr(FileDateToLocalDateTime(latest)));
		468	StampDate := latest;
		469	end;
		470	try
		471	// write stub if required
		472	if UseSFX and assigned(Stub) and (Stub.size > 0) and (First < 0) then
		473	begin
		474	// write the sfx stub
		475	ProgReport(zacItem, PR_SFX, '', Stub.size);
		476	Stub.Position := 0;
		477	Result := WriteFrom(Stub, Stub.size);
		478	if Result > 0 then
		479	begin
		480	wrote := Stub.size;
		481	ProgReport(zacProgress, PR_SFX, '', Stub.size);
		482	if ShowProgress = zspFull then
		483	Boss.ProgDetail.Written(wrote);
		484	Sig := zfsDOS; // assume correct
		485	end;
		486	end
		487	else
		488	Sig := zfsLocal;
		489	if (Result >= 0) and (ToProcess > 0) then
		490	begin
		491	for i := Last to Count - 1 do
		492	begin
		493	Boss.CheckCancel;
		494	rec := TZMIRec(Items[i]);
		495	ToDo := rec.ProcessSize;
		496	if ToDo > 0 then
		497	begin
		498	w64 := rec.Process;
		499	if w64 < 0 then
		500	begin
		501	Result := w64;
		502	Break;
		503	end;
		504	wrote := wrote + w64;
		505	if ShowProgress = zspFull then
		506	Boss.TotalWritten := wrote;
		507	end;
		508	end;
		509	end;
		510	// finished locals and data
		511	if Result >= 0 then
		512	begin
		513	// write central
		514	Boss.ReportMsg(GE_Copying, [Boss.ZipLoadStr(DS_CopyCentral)]);
		515	r := WriteCentral; // uses XProgress
		516	if r >= 0 then
		517	wrote := wrote + r;
		518	Diag(' wrote = ' + IntToStr(wrote));
		519	if r > 0 then
		520	begin
		521	Result := 0;
		522	File_Size := wrote;
		523	Diag(' finished ok');
		524	end;
		525	end;
		526	finally
		527	ProgReport(zacEndOfBatch, 7, '', 0);
		528	end;
		529	end;
		530
		531	function TZMZipFile.Entry(Chk: Cardinal; Idx: Integer): TZMIRec;
		532	begin
		533	Result := nil;
		534	if (Chk = CheckNo) and (Idx >= 0) and (Idx < Count) then
		535	Result := Items[Idx];
		536	end;
		537
		538	// Zip64 size aproximate only
		539	function TZMZipFile.EOCSize(Is64: Boolean): Cardinal;
		540	begin
		541	Result := Cardinal(sizeof(TZipEndOfCentral) + Length(ZipComment));
		542	if Is64 then
		543	Result := Result + sizeof(TZip64EOCLocator) + sizeof(TZipEOC64) +
		544	(3 * sizeof(Int64));
		545	end;
		546
		547	function TZMZipFile.FindName(const pattern: TZMString; var idx: Integer):
		548	TZMIRec;
		549	begin
		550	Result := FindNameEx(pattern, idx, CanHash(pattern));
		551	end;
		552
		553	function TZMZipFile.FindName(const pattern: TZMString; var idx: Integer; const
		554	myself: TZMIRec): TZMIRec;
		555	begin
		556	if myself = nil then
		557	Result := FindNameEx(pattern, idx, CanHash(pattern))
		558	else
		559	begin
		560	myself.SetStatusBit(zsbIgnore); // prevent 'finding' myself
		561	Result := FindNameEx(pattern, idx, CanHash(pattern));
		562	myself.ClearStatusBit(zsbIgnore);
		563	end;
		564	end;
		565
		566	function TZMZipFile.FindNameEx(const pattern: TZMString; var idx: Integer;
		567	IsWild: boolean): TZMIRec;
		568	var
		569	found: Boolean;
		570	hash: Cardinal;
		571	begin
		572	found := False;
		573	Result := nil; // keep compiler happy
		574	hash := 0; // keep compiler happy
		575	if (pattern <> '') then
		576	begin
		577	// if it wild or multiple we must try to match - else only if same hash
		578	if (not IsWild) and (idx < 0) and (fHashList.Size > 0) then
		579	Result := fHashList.Find(pattern) // do it quick
		580	else
		581	Begin
		582	if not IsWild then
		583	hash := HashFunc(pattern);
		584	repeat
		585	idx := Next(idx);
		586	if idx < 0 then
		587	break;
		588	Result := Entries[idx];
		589	if IsWild or (Result.Hash = hash) then
		590	begin
		591	found := Worker.FNMatch(pattern, Result.Filename);
		592	if Result.StatusBit[zsbIgnore] <> 0 then
		593	found := false;
		594	end;
		595	until (found);
		596	if not found then
		597	Result := nil;
		598	End;
		599	end;
		600	if Result = nil then
		601	idx := BadIndex;
		602	end;
		603
		604	function TZMZipFile.GetCount: Integer;
		605	begin
		606	Result := fEntries.Count;
		607	end;
		608
		609	function TZMZipFile.GetItems(Idx: Integer): TZMIRec;
		610	begin
		611	if Idx >= Count then
		612	Result := nil
		613	else
		614	Result := Entries[Idx];
		615	end;
		616
		617	// searches for record with same name
		618	function TZMZipFile.HasDupName(const rec: TZMIRec): Integer;
		619	var
		620	nrec: TZMIRec;
		621	begin
		622	Result := -1;
		623	if fHashList.Size = 0 then
		624	HashContents(fHashList, 0);
		625	nrec := fHashList.Add(rec);
		626	if nrec <> nil then// exists
		627	begin
		628	Diag('Duplicate FileName: ' + rec.FileName);
		629	for Result := 0 to Count - 1 do
		630	begin
		631	if nrec = TZMIRec(Items[Result]) then
		632	break;
		633	end;
		634	end;
		635	end;
		636
		637	// zsbDirty = $1;
		638	// zsbSelected = $2;
		639	// zsbSkipped = $4;
		640	// zsbIgnore = $8;
		641	// zsbDirOnly = $10;
		642	// zsbInvalid = $20;
		643	// what = -1 _ all
		644	// else ignore rubbish
		645	// what = 0 _ any non rubbish
		646	function TZMZipFile.HashContents(var HList: TZMDirHashList; what: integer):
		647	Integer;
		648	const
		649	Skip = zsbInvalid or zsbIgnore or zsbSkipped;
		650	var
		651	I: Integer;
		652	rec: TZMIRec;
		653	use: boolean;
		654	begin
		655	Result := 0;
		656	HList.AutoSize(Count); // make required size
		657	for I := 0 to Count - 1 do
		658	begin
		659	rec := Entries[i];
		660	if rec = nil then
		661	continue;
		662	use := what = -1;
		663	if (not use) then
		664	begin
		665	if (rec.StatusBit[Skip] <> 0) then
		666	continue;
		667	use := (what = 0) or (rec.StatusBit[what] <> 0);
		668	end;
		669	if use then
		670	begin
		671	if HList.Add(Entries[I]) <> nil then
		672	Inc(Result); // count duplicates
		673	end;
		674	end;
		675	end;
		676
		677	// Use after EOC found and FileName is last part
		678	// if removable has proper numbered volume name we assume it is numbered volume
		679	procedure TZMZipFile.InferNumbering;
		680	var
		681	fname: string;
		682	num: Integer;
		683	numStr: string;
		684	begin
		685	// only if unknown
		686	if (Numbering = znsNone) and (TotalDisks > 1) then
		687	begin
		688	if WorkDrive.DriveIsFloppy and AnsiSameText(WorkDrive.DiskName, VolName(DiskNr)) then
		689	Numbering := znsVolume
		690	else
		691	begin
		692	numStr := '';
		693	fname := ExtractNameOfFile(FileName);
		694	Numbering := znsExt;
		695	if Length(fname) > 3 then
		696	begin
		697	numStr := Copy(fname, length(fname) - 2, 3);
		698	num := StrToIntDef(numStr, -1);
		699	if num = (DiskNr + 1) then
		700	begin
		701	// ambiguous conflict
		702	if WorkDrive.DriveIsFixed then
		703	begin
		704	if HasSpanSig(ChangeNumberedName(FileName, 1, True)) then
		705	Numbering := znsName; // unless there is an orphan
		706	end;
		707	end;
		708	end;
		709	end;
		710	end;
		711	end;
		712
		713	procedure TZMZipFile.Invalidate;
		714	begin
		715	info := info or zfi_Invalid;
		716	end;
		717
		718	function TZMZipFile.Load: Integer;
		719	var
		720	i: Integer;
		721	LiE: Integer;
		722	OffsetDiff: Int64;
		723	r: Integer;
		724	rec: TZMIRec;
		725	sgn: Cardinal;
		726	SOCOfs: Int64;
		727	begin
		728	if not IsOpen then
		729	begin
		730	Result := DS_FileOpen;
		731	exit;
		732	end;
		733	Result := -LI_ErrorUnknown;
		734	if (info and zfi_EOC) = 0 then
		735	exit; // should not get here if eoc has not been read
		736	LiE := 1;
		737	OffsetDiff := 0;
		738	ClearEntries;
		739	fCheckNo := TZMCore(Worker).NextCheckNo;
		740	if Assigned(OnChange) then
		741	OnChange(Self, CheckNo, zccBegin);
		742	SOCOfs := CentralOffset;
		743	try
		744	OffsetDiff := CentralOffset;
		745	// Do we have to request for a previous disk first?
		746	if DiskNr <> CentralDiskNo then
		747	begin
		748	SeekDisk(CentralDiskNo);
		749	File_Size := Seek(0, 2);
		750	end
		751	else
		752	if not Z64 then
		753	begin
		754	// Due to the fact that v1.3 and v1.4x programs do not change the archives
		755	// EOC and CEH records in case of a SFX conversion (and back) we have to
		756	// make this extra check.
		757	OffsetDiff := File_Size - (Integer(CentralSize) +
		758	SizeOf(TZipEndOfCentral) + ZipCommentLen);
		759	end;
		760	SOCOfs := OffsetDiff;
		761	// save the location of the Start Of Central dir
		762	SFXOfs := Cardinal(OffsetDiff);
		763	if SFXOfs <> SOCOfs then
		764	SFXOfs := 0;
		765	// initialize this - we will reduce it later
		766	if File_Size = 22 then
		767	SFXOfs := 0;
		768
		769	if CentralOffset <> OffsetDiff then
		770	begin
		771	// We need this in the ConvertXxx functions.
		772	Boss.ShowZipMessage(LI_WrongZipStruct, '');
		773	CheckSeek(CentralOffset, 0, LI_ReadZipError);
		774	CheckRead(sgn, 4, DS_CEHBadRead);
		775	if sgn = CentralFileHeaderSig then
		776	begin
		777	SOCOfs := CentralOffset;
		778	// TODO warn - central size error
		779	end;
		780	end;
		781
		782	// Now we can go to the start of the Central directory.
		783	CheckSeek(SOCOfs, 0, LI_ReadZipError);
		784	ProgReport(zacItem, PR_Loading, '', TotalEntries);
		785	// Read every entry: The central header and save the information.
		786	{$IFDEF DEBUG}
		787	if Boss.Verbosity >= zvTrace then
		788	Diag(Format('List - expecting %d files', [TotalEntries]));
		789	{$ENDIF}
		790	fEntries.Capacity := TotalEntries;
		791	rec := nil;
		792	if Assigned(OnChange) then
		793	OnChange(Self, TotalEntries, zccCount);
		794	fHashList.AutoSize(TotalEntries);
		795	for i := 0 to (TotalEntries - 1) do
		796	begin
		797	FreeAndNil(rec);
		798	rec := TZMIRec.Create(Self);
		799	r := rec.Read(Self);
		800	if r < 0 then
		801	begin
		802	FreeAndNil(rec);
		803	raise EZipMaster.CreateResDisp(r, True);
		804	end;
		805	if r > 0 then
		806	Z64 := True;
		807	{$IFDEF DEBUG}
		808	if Boss.Verbosity >= zvTrace then //Trace then
		809	Diag(Format('List - [%d] "%s"', [i, rec.FileName]));
		810	{$ENDIF}
		811	fEntries.Add(rec);
		812	fHashList.Add(rec);
		813	// Notify user, when needed, of the NextSelected entry in the ZipDir.
		814	if Assigned(OnChange) then
		815	OnChange(Self, i, zccAdd); // change event to give TZipDirEntry
		816
		817	// Calculate the earliest Local Header start
		818	if SFXOfs > rec.RelOffLocal then
		819	SFXOfs := rec.RelOffLocal;
		820	rec := nil; // used
		821	ProgReport(zacProgress, PR_Loading, '', 1);
		822	Boss.CheckCancel;
		823	end; // for
		824	LiE := 0; // finished ok
		825	Result := 0;
		826	info := (info and not (zfi_MakeMask)) or zfi_Loaded;
		827	finally
		828	ProgReport(zacEndOfBatch, PR_Loading, '', 0);
		829	if LiE = 1 then
		830	begin
		831	FileName := '';
		832	SFXOfs := 0;
		833	File_Close;
		834	end
		835	else
		836	begin
		837	CentralOffset := SOCOfs; // corrected
		838	// Correct the offset for v1.3 and 1.4x
		839	SFXOfs := SFXOfs + Cardinal(OffsetDiff - CentralOffset);
		840	end;
		841
		842	// Let the user's program know we just refreshed the zip dir contents.
		843	if Assigned(OnChange) then
		844	OnChange(Self, Count, zccEnd);
		845	end;
		846	end;
		847
		848	procedure TZMZipFile.MarkDirty;
		849	begin
		850	info := info or zfi_Dirty;
		851	end;
		852
		853	// allow current = -1 to get first
		854	// get next index, if IgnoreDirOnly = True skip DirOnly entries
		855	function TZMZipFile.Next(Current: Integer): Integer;
		856	var
		857	cnt: Integer;
		858	begin
		859	Result := BadIndex;
		860	if Current >= -1 then
		861	begin
		862	cnt := Entries.Count;
		863	if IgnoreDirOnly then
		864	begin
		865	repeat
		866	Inc(Current);
		867	until (Current >= cnt) or ((TZMIRec(Entries[Current]).StatusBits and zsbDirOnly) = 0);
		868	end
		869	else
		870	Inc(Current);
		871	if Current < cnt then
		872	Result := Current;
		873	end;
		874	end;
		875
		876	// return BadIndex when no more
		877	function TZMZipFile.NextSelected(Current: Integer): integer;
		878	var
		879	k: Cardinal;
		880	mask: cardinal;
		881	rec: TZMIRec;
		882	begin
		883	Result := BadIndex;
		884	mask := zsbSkipped or zsbSelected;
		885	if IgnoreDirOnly then
		886	mask := mask or zsbDirOnly;
		887	if Current >= -1 then
		888	begin
		889	while Current < Entries.Count -1 do
		890	begin
		891	inc(Current);
		892	rec := TZMIRec(Entries[Current]);
		893	if rec <> nil then
		894	begin
		895	k := rec.StatusBit[mask];
		896	if k = zsbSelected then
		897	begin
		898	Result := Current;
		899	break;
		900	end;
		901	end;
		902	end;
		903	end;
		904	end;
		905
		906	function TZMZipFile.Open(EOConly, NoLoad: Boolean): Integer;
		907	var
		908	r: Integer;
		909	begin
		910	// verify disk loaded
		911	ClearFileInformation;
		912	info := (info and zfi_MakeMask) or zfi_Loading;
		913	if WorkDrive.DriveIsFixed or WorkDrive.HasMedia(False) then
		914	begin
		915	Result := Open1(EOConly);
		916	if (Result >= 0) then
		917	begin
		918	LastWriteTime(fEOCFileTime);
		919	InferNumbering;
		920	if not (EOConly or NoLoad) then
		921	begin
		922	info := info or zfi_EOC;
		923	if (Result and EOCBadComment) <> 0 then
		924	Boss.ShowZipMessage(DS_CECommentLen, '');
		925	if (Result and EOCBadStruct) <> 0 then
		926	Boss.ShowZipMessage(LI_WrongZipStruct, '');
		927	r := Load;
		928	if r <> 0 then
		929	Result := r
		930	else
		931	begin
		932	info := info or zfi_Loaded or zfi_DidLoad;
		933	SaveFileInformation; // get details
		934	end;
		935	end;
		936	end;
		937	end
		938	else
		939	Result := -DS_NoInFile;
		940	OpenRet := Result;
		941	if Boss.Verbosity >= zvTrace then
		942	begin
		943	if Result < 0 then
		944	Diag('Open = ' + Boss.ZipLoadStr(-Result))
		945	else
		946	Diag('Open = ' + IntToStr(Result));
		947	end;
		948	end;
		949
		950	function TZMZipFile.Open1(EOConly: Boolean): Integer;
		951	var
		952	fn: string;
		953	SfxType: Integer;
		954	size: Integer;
		955	begin
		956	SfxType := 0; // keep compiler happy
		957	ReqFileName := FileName;
		958	fn := FileName;
		959	Result := OpenEOC(EOConly);
		960	if (Result >= 0) and (Sig = zfsDOS) then
		961	begin
		962	stub := nil;
		963	SfxType := CheckSFXType(handle, fn, size);
		964	if SfxType >= cstSFX17 then
		965	begin
		966	if Seek(0, 0) <> 0 then
		967	exit;
		968	stub := TMemoryStream.Create;
		969	try
		970	if ReadTo(stub, size) <> size then
		971	begin
		972	stub := nil;
		973	end;
		974	except
		975	stub := nil;
		976	end;
		977	end;
		978	end;
		979	if not (spExactName in SpanOptions) then
		980	begin
		981	if (Result >= 0) and (SfxType >= cstDetached) then
		982	begin // it is last part of detached sfx
		983	File_Close;
		984	// Get proper path and name
		985	FileName := IncludeTrailingBackslash(ExtractFilePath(ReqFileName)) + fn;
		986	// find last part
		987	Result := -DS_NoInFile;
		988	end;
		989	if Result < 0 then
		990	Result := OpenLast(EOConly, Result);
		991	end;
		992	end;
		993
		994	function TZMZipFile.PrepareWrite(typ: TZipWrites): Boolean;
		995	begin
		996	case typ of
		997	zwSingle:
		998	Result := false;
		999	zwMultiple:
		1000	Result := True;
		1001	else
		1002	Result := zwoDiskSpan in WriteOptions;
		1003	end;
		1004	IsMultiPart := Result;
		1005	if Result then
		1006	begin
		1007	DiskNr := 0;
		1008	File_Close;
		1009	end
		1010	else
		1011	begin
		1012	DiskNr := -1;
		1013	end;
		1014	end;
		1015
		1016	function TZMZipFile.Reopen(Mode: Cardinal): integer;
		1017	begin
		1018	Result := 0;
		1019	if (not IsOpen) or (OpenMode <> Mode) then
		1020	begin
		1021	File_Close;
		1022	if Boss.Verbosity >= zvTrace then
		1023	Diag('Trace: Reopening ' + RealFileName);
		1024	if not File_Open(Mode) then
		1025	begin
		1026	Diag('Could not reopen: ' + RealFileName);
		1027	Result := -DS_FileOpen;
		1028	end;
		1029	end;
		1030	if (Result = 0) and ((info and zfi_Loaded) <> 0) and
		1031	not VerifyFileInformation then
		1032	begin
		1033	Worker.Diag('File has changed! ' + RealFileName);
		1034	// close it?
		1035	Result := GE_FileChanged; // just complain at moment
		1036	end;
		1037	end;
		1038
		1039	procedure TZMZipFile.Replicate(Src: TZMZipFile; LastEntry: Integer);
		1040	var
		1041	I: Integer;
		1042	rec: TZMIRec;
		1043	begin
		1044	if (Src <> nil) and (Src <> Self) then
		1045	begin
		1046	inherited AssignFrom(Src);
		1047	fCheckNo := Worker.NextCheckNo;
		1048	// FAddOptions := Src.FAddOptions;
		1049	// FEncodeAs := Src.FEncodeAs;
		1050	// fEncoding := Src.fEncoding;
		1051	// fEncoding_CP := Src.fEncoding_CP;
		1052	// FIgnoreDirOnly := Src.FIgnoreDirOnly;
		1053	fEOCFileTime := Src.fEOCFileTime;
		1054	FFirst := Src.FFirst;
		1055	fOnChange := Src.fOnChange;
		1056	fOpenRet := Src.fOpenRet;
		1057	FSelCount := Src.FSelCount;
		1058	fSFXOfs := Src.fSFXOfs;
		1059	fShowAll := Src.fShowAll;
		1060	fStub := nil;
		1061	fUseSFX := False;
		1062	if Src.UseSFX and Assigned(Src.fStub) then
		1063	begin
		1064	fStub := TMemoryStream.Create;
		1065	Src.fStub.Position := 0;
		1066	if fStub.CopyFrom(Src.fStub, Src.fStub.Size) = Src.fStub.Size then
		1067	fUseSFX := True
		1068	else
		1069	FreeAndNil(fStub);
		1070	end;
		1071	// add records from Src
		1072	if (LastEntry < 0) or (LastEntry > Src.Count) then
		1073	LastEntry := Src.Count - 1;
		1074	for I := 0 to LastEntry do
		1075	begin
		1076	rec := TZMIRec.Create(self);
		1077	rec.AssignFrom(Src[I]);
		1078	Add(rec);
		1079	end;
		1080	end;
		1081	end;
		1082
		1083	// select entries matching external pattern - return number of selected entries
		1084	function TZMZipFile.Select(const Pattern: TZMString; How: TZipSelects): Integer;
		1085	var
		1086	i: Integer;
		1087	srch: Integer;
		1088	t: TZMIRec;
		1089	wild: Boolean;
		1090	begin
		1091	Result := 0;
		1092	// if it wild or multiple we must try to match - else only if same hash
		1093	wild := not CanHash(pattern);
		1094	if (Pattern = '') or (wild and ((Pattern = AllSpec) or (Pattern = AnySpec))) then
		1095	begin
		1096	// do all
		1097	for i := 0 to fEntries.Count - 1 do
		1098	begin
		1099	t := fEntries[i];
		1100	if SelectEntry(t, How) then
		1101	Inc(Result);
		1102	end;
		1103	end
		1104	else
		1105	begin
		1106	// select specific pattern
		1107	i := -1;
		1108	srch := 1;
		1109	while srch <> 0 do
		1110	begin
		1111	t := FindNameEx(Pattern, i, wild);
		1112	if t = nil then
		1113	break;
		1114	if SelectEntry(t, How) then
		1115	Inc(Result);
		1116	if srch > 0 then
		1117	begin
		1118	if wild then
		1119	srch := -1 // search all
		1120	else
		1121	srch := 0; // done
		1122	end;
		1123	end;
		1124	end;
		1125	end;
		1126
		1127	// Select1 entries matching external pattern
		1128	function TZMZipFile.Select1(const Pattern, reject: TZMString;
		1129	How: TZipSelects): Integer;
		1130	var
		1131	args: string;
		1132	i: Integer;
		1133	exc: string;
		1134	ptn: string;
		1135	aRec: TZMIRec;
		1136	wild: Boolean;
		1137	begin
		1138	Result := 0;
		1139	args := ''; // default args - empty
		1140	exc := reject; // default excludes
		1141	ptn := Pattern; // need to remove switches
		1142	// split Pattern into pattern and switches
		1143	// if it wild or multiple we must try to match - else only if same hash
		1144	wild := not CanHash(ptn);
		1145	if (ptn = '') or (wild and ((ptn = AllSpec) or (ptn = AnySpec))) then
		1146	begin
		1147	// do all
		1148	for i := 0 to fEntries.Count - 1 do
		1149	begin
		1150	aRec := fEntries[i];
		1151	if (exc <> '') and (Worker.FNMatch(exc, aRec.Filename)) then
		1152	Continue;
		1153	if SelectEntry(aRec, How) then
		1154	begin
		1155	// set SelectArgs
		1156	aRec.SelectArgs := args;
		1157	end;
		1158	Inc(Result);
		1159	end;
		1160	end
		1161	else
		1162	begin
		1163	// Select1 specific pattern
		1164	i := -1;
		1165	while True do
		1166	begin
		1167	aRec := FindNameEx(ptn, i, wild);
		1168	if aRec = nil then
		1169	break; // no matches
		1170	if (exc = '') or not (Worker.FNMatch(exc, aRec.Filename)) then
		1171	begin
		1172	if SelectEntry(aRec, How) then
		1173	begin
		1174	// set SelectArgs
		1175	aRec.SelectArgs := args;
		1176	end;
		1177	Inc(Result);
		1178	end;
		1179	if not wild then
		1180	Break; // old find first
		1181	end;
		1182	end;
		1183	end;
		1184
		1185	function TZMZipFile.SelectEntry(t: TZMIRec; How: TZipSelects): Boolean;
		1186	begin
		1187	Result := t.Select(How);
		1188	if Result then
		1189	inc(FSelCount)
		1190	else
		1191	dec(FSelCount);
		1192	end;
		1193
		1194	function TZMZipFile.SelectFiles(const want, reject: TStrings; skipped:
		1195	TStrings): Integer;
		1196	var
		1197	a: Integer;
		1198	SelectsCount: Integer;
		1199	exc: string;
		1200	I: Integer;
		1201	NoSelected: Integer;
		1202	spec: String;
		1203	begin
		1204	Result := 0;
		1205	ClearSelection; // clear all
		1206	SelectsCount := want.Count;
		1207	if (SelectsCount < 1) or (Count < 1) then
		1208	exit;
		1209	exc := '';
		1210	// combine rejects into a string
		1211	if (reject <> nil) and (reject.Count > 0) then
		1212	begin
		1213	exc := reject[0];
		1214	for I := 1 to reject.Count - 1 do
		1215	exc := exc + ZSwitchFollows + reject[I];
		1216	end;
		1217	// attempt to select each wanted spec
		1218	for a := 0 to SelectsCount - 1 do
		1219	begin
		1220	spec := want[a];
		1221	NoSelected := Select1(spec, exc, zzsSet);
		1222	if NoSelected < 1 then
		1223	begin
		1224	// none found
		1225	if Boss.Verbosity >= zvVerbose then
		1226	Diag('Skipped filespec ' + spec);
		1227	if assigned(skipped) then
		1228	skipped.Add(spec);
		1229	end;
		1230	if NoSelected > 0 then
		1231	Result := Result + NoSelected;
		1232	if NoSelected >= Count then
		1233	break; // all have been done
		1234	end;
		1235	end;
		1236
		1237	procedure TZMZipFile.SetCount(const Value: Integer);
		1238	begin
		1239	// not allowed
		1240	end;
		1241
		1242	procedure TZMZipFile.SetEncoding(const Value: TZMEncodingOpts);
		1243	begin
		1244	if fEncoding <> Value then
		1245	begin
		1246	ClearCachedNames;
		1247	fEncoding := Value;
		1248	end;
		1249	end;
		1250
		1251	procedure TZMZipFile.SetEncoding_CP(const Value: Cardinal);
		1252	begin
		1253	if fEncoding_CP <> Value then
		1254	begin
		1255	ClearCachedNames;
		1256	fEncoding_CP := Value;
		1257	end;
		1258	end;
		1259
		1260	procedure TZMZipFile.SetItems(Idx: Integer; const Value: TZMIRec);
		1261	var
		1262	tmp: TObject;
		1263	begin
		1264	tmp := fEntries[Idx];
		1265	if tmp <> Value then
		1266	begin
		1267	fEntries[Idx] := Value;
		1268	tmp.Free;
		1269	end;
		1270	end;
		1271
		1272	procedure TZMZipFile.SetShowAll(const Value: Boolean);
		1273	begin
		1274	fShowAll := Value;
		1275	end;
		1276
		1277	procedure TZMZipFile.SetStub(const Value: TMemoryStream);
		1278	begin
		1279	if fStub <> Value then
		1280	begin
		1281	if assigned(fStub) then
		1282	fStub.Free;
		1283	fStub := Value;
		1284	end;
		1285	end;
		1286
		1287	function TZMZipFile.VerifyOpen: Integer;
		1288	var
		1289	ft: TFileTime;
		1290	begin
		1291	Result := DS_FileOpen;
		1292	if not IsOpen and not File_Open(fmOpenRead or fmShareDenyWrite) then
		1293	exit;
		1294	if LastWriteTime(ft) then
		1295	begin
		1296	Result := 0;
		1297
		1298	LastWriteTime(fEOCFileTime);
		1299	if CompareFileTime(EOCFileTime, ft) <> 0 then
		1300	Result := -DS_FileChanged;
		1301	end;
		1302	end;
		1303
		1304	// returns bytes written or <0 _ error
		1305	function TZMZipFile.WriteCentral: Integer;
		1306	var
		1307	i: Integer;
		1308	rec: TZMIRec;
		1309	wrote: Integer;
		1310	begin
		1311	Result := 0;
		1312	wrote := 0;
		1313	CentralOffset := Position;
		1314	CentralDiskNo := DiskNr;
		1315	TotalEntries := 0;
		1316	CentralEntries := 0;
		1317	CentralSize := 0;
		1318	ProgReport(zacXItem, PR_CentrlDir, '', Count);
		1319	for i := 0 to Count - 1 do
		1320	begin
		1321	rec := TZMIRec(Items[i]);
		1322	if rec.StatusBit[zsbError] = 0 then
		1323	begin
		1324	// no processing error
		1325	if Boss.Verbosity >= zvTrace then
		1326	Diag('Writing central [' + IntToStr(i) + '] ' + rec.FileName);
		1327	// check for deleted?
		1328	Result := rec.Write;
		1329	if Result < 0 then
		1330	break; // error
		1331	if Position <= Result then // started new part
		1332	CentralEntries := 0;
		1333	wrote := wrote + Result;
		1334	CentralSize := CentralSize + Cardinal(Result);
		1335	TotalEntries := TotalEntries + 1;
		1336	CentralEntries := CentralEntries + 1;
		1337	ProgReport(zacXProgress, PR_CentrlDir, '', 1);
		1338	end
		1339	else
		1340	Diag('skipped Writing central ['+ IntToStr(i) + '] ' + rec.FileName);
		1341	end;
		1342	// finished Central
		1343	if Result >= 0 then
		1344	begin
		1345	Result := WriteEOC;
		1346	if Result >= 0 then
		1347	begin
		1348	ProgReport(zacXProgress, PR_CentrlDir, '', 1);
		1349	Result := wrote + Result;
		1350	if Result > 0 then
		1351	begin
		1352	Diag(' finished ok');
		1353	end;
		1354	end;
		1355	end;
		1356	end;
		1357
		1358	constructor TZMCopyRec.Create(theOwner: TZMWorkFile);
		1359	begin
		1360	inherited Create(theOwner);
		1361	end;
		1362
		1363	procedure TZMCopyRec.AfterConstruction;
		1364	begin
		1365	inherited;
		1366	fLink := nil;
		1367	end;
		1368
		1369	// process record, return bytes written; <0 = -error
		1370	function TZMCopyRec.Process: Int64;
		1371	var
		1372	did: Int64;
		1373	InRec: TZMIRec;
		1374	InWorkFile: TZMWorkFile;
		1375	stNr: Integer;
		1376	stt: Int64;
		1377	ToWrite: Int64;
		1378	wrt: Int64;
		1379	begin
		1380	// ASSERT(assigned(Owner), 'no owner');
		1381	if Owner.Boss.Verbosity >= zvVerbose then
		1382	Owner.Boss.ReportMsg(GE_Copying, [FileName]);
		1383	InRec := Link;
		1384	InWorkFile := InRec.Owner;
		1385	if Owner.Boss.Verbosity >= zvVerbose then
		1386	Diag('Copying local');
		1387	Result := InRec.SeekLocalData;
		1388	if Result < 0 then
		1389	exit; // error
		1390	stNr := Owner.DiskNr;
		1391	stt := Owner.Position;
		1392	Result := WriteAsLocal1(ModifDateTime, CRC32);
		1393	if Result < 0 then
		1394	exit; // error
		1395	wrt := Result;
		1396	Owner.ProgReport(zacProgress, PR_Copying, '', wrt);
		1397	// Diag(' finished copy local');
		1398	// ok so update positions
		1399	RelOffLocal := stt;
		1400	DiskStart := stNr;
		1401	ToWrite := CompressedSize;
		1402	// Diag('copying zipped data');
		1403	Owner.ProgReport(zacItem, zprCompressed, FileName, ToWrite);
		1404	did := Owner.CopyFrom(InWorkFile, ToWrite);
		1405	if did <> ToWrite then
		1406	begin
		1407	if did < 0 then
		1408	Result := did // write error
		1409	else
		1410	Result := -DS_DataCopy;
		1411	exit;
		1412	end;
		1413	wrt := wrt + did;
		1414	if (Flag and 8) <> 0 then
		1415	begin
		1416	did := WriteDataDesc(Owner);
		1417	if did < 0 then
		1418	begin
		1419	Result := did; // error
		1420	exit;
		1421	end;
		1422	wrt := wrt + did;
		1423	Owner.ProgReport(zacProgress, PR_Copying, '', did);
		1424	end;
		1425	Result := wrt;
		1426	end;
		1427
		1428	// return bytes to be processed
		1429	function TZMCopyRec.ProcessSize: Int64;
		1430	begin
		1431	Result := CompressedSize + LocalSize;
		1432	if (Flag and 8) <> 0 then
		1433	Result := Result + sizeof(TZipDataDescriptor);
		1434	end;
		1435
		1436	procedure TZMCopyRec.SetLink(const Value: TZMIRec);
		1437	begin
		1438	if fLink <> Value then
		1439	begin
		1440	fLink := Value;
		1441	end;
		1442	end;
		1443
		1444	constructor TZMZipCopy.Create(Wrkr: TZMCore);
		1445	begin
		1446	inherited Create(Wrkr);
		1447	end;
		1448
		1449	// Add a copy of source record if name is unique
		1450	function TZMZipCopy.AffixZippedFile(rec: TZMIRec): Integer;
		1451	var
		1452	nrec: TZMCopyRec;
		1453	begin
		1454	Result := -1;
		1455	if HasDupName(rec) < 0 then
		1456	begin
		1457	// accept it
		1458	nrec := TZMCopyRec.Create(self); // make a copy
		1459	nrec.AssignFrom(rec);
		1460	// clear unknowns ?
		1461	nrec.Link := rec; // link to original
		1462	Result := Add(nrec);
		1463	end;
		1464	end;
		1465
		1466	// return >=0 number added <0 error
		1467	function TZMZipCopy.AffixZippedFiles(Src: TZMZipFile; All: Boolean): Integer;
		1468	var
		1469	i: Integer;
		1470	r: Integer;
		1471	rec: TZMIRec;
		1472	begin
		1473	Result := 0;
		1474	for i := 0 to Src.Count - 1 do
		1475	begin
		1476	rec := Src[i];
		1477	if not assigned(rec) then
		1478	continue;
		1479	if All or rec.TestStatusBit(zsbSelected) then
		1480	begin
		1481	Diag('including: ' + rec.FileName);
		1482	r := AffixZippedFile(rec);
		1483	if (r >= 0) then
		1484	Inc(Result) // added
		1485	else
		1486	begin
		1487	// error
		1488	if r < 0 then
		1489	Result := r;
		1490	end;
		1491	end
		1492	else
		1493	Diag('ignoring: ' + rec.FileName);
		1494	end;
		1495	end;
		1496
		1497
		1498	// copies selected files from InZip
		1499	function TZMZipCopy.WriteFile(InZip: TZMZipFile; All: Boolean): Int64;
		1500	begin
		1501	ASSERT(assigned(InZip), 'no input');
		1502	Diag('Write file');
		1503	Result := InZip.VerifyOpen; // verify unchanged and open
		1504	if Result < 0 then
		1505	exit;
		1506	ZipComment := InZip.ZipComment;
		1507	Result := AffixZippedFiles(InZip, All);
		1508	if Result >= 0 then
		1509	Result := Commit(zwoZipTime in {Worker.}WriteOptions);
		1510	end;
		1511
		1512
		1513	end.

Subversion Repositories autosfx

autosfx/zmstr1900102/ZMZipFile19.pas – Rev 1