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

Rev	Author	Line No.	Line
1	daniel-mar	1	unit ZMWrkr19;
		2
		3	(*
		4	ZMWrkr19.pas - Does most of the work
		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
		30	{$I '.\ZipVers19.inc'}
		31	{$IFDEF VER180}
		32	{$WARN SYMBOL_DEPRECATED OFF}
		33	{$ENDIF}
		34
		35	interface
		36
		37	uses
		38	SysUtils, Windows, Classes, Graphics,
		39	ZipMstr19, ZMCompat19, ZMCore19, ZMWAUX19, ZMZipFile19;
		40
		41	//------------------------------------------------------------------------
		42
		43	type
		44	TSFXOps = (sfoNew, sfoZip, sfoExe);
		45
		46	type
		47	TZMWorker = class(TZMWAux)
		48	private
		49	function AddZippedFilesWrite(DstZip: TZMZipFile; DstCnt: Integer; SrcZip:
		50	TZMZipFile; SrcCnt: Integer): integer;
		51	function Prepare(MustExist: Boolean; SafePart: boolean = false): TZMZipFile;
		52	protected
		53	function Delete1: integer;
		54	function IsDetachedSFX(const fn: String): Boolean;
		55	//1 Rewrite via an intermediate
		56	function Remake(CurZip: TZMZipFile; ReqCnt: Integer; All: boolean): Integer;
		57	procedure ResolveMerge(Merge: TZMMergeOpts; SrcZip, DstZip: TZMZipFile; var
		58	SrcCnt, DstCnt: Integer);
		59	procedure VerifySource(SrcZip: TZMZipFile);
		60	public
		61	procedure AddZippedFiles(SrcWorker: TZMWorker; Merge: TZMMergeOpts);
		62	function AddZippedFilesAppend(DstZip, SrcZip: TZMZipFile; Last: Integer):
		63	integer;
		64	procedure AfterConstruction; override;
		65	procedure BeforeDestruction; override;
		66	function ChangeFileDetails(func: TZMChangeFunction; var data): Integer;
		67	procedure Clear; override;
		68	procedure CopyZippedFiles(DestWorker: TZMWorker; DeleteFromSource: boolean;
		69	OverwriteDest: TZMMergeOpts); overload;
		70	procedure Delete;
		71	function ForEach(func: TZMForEachFunction; var data): Integer;
		72	function IsDestWritable(const fname: String; AllowEmpty: Boolean): Boolean;
		73	procedure List;
		74	procedure Rename(RenameList: TList; NewDateTime: Integer; How: TZMRenameOpts =
		75	htrDefault);
		76	procedure Set_ZipComment(const zComment: AnsiString);
		77	procedure StartUp; override;
		78	property TotalSizeToProcess: Int64 read GetTotalSizeToProcess;
		79	end;
		80
		81	implementation
		82
		83	uses
		84	Dialogs, ZMStructs19, ZMDelZip19, ZMXcpt19, ZMUtils19, ZMDlg19, ZMCtx19,
		85	ZMMsgStr19, ZMMsg19, ZMWorkFile19, ZMDrv19, ZMMatch19, ZMIRec19, ZMEOC19;
		86
		87	const
		88	BufSize = 10240;
		89	//8192; // Keep under 12K to avoid Winsock problems on Win95.
		90	// If chunks are too large, the Winsock stack can
		91	// lose bytes being sent or received.
		92
		93	type
		94	pRenData = ^TRenData;
		95
		96	TRenData = record
		97	Owner: TZMCore;
		98	RenList: TList;
		99	DTime: Integer;
		100	How: TZMRenameOpts;
		101	cnt: Integer;
		102	end;
		103
		104	// 'ForEach' function to rename files
		105	function RenFunc(rec: TZMDirRec; var data): Integer;
		106	var
		107	ChangeName: boolean;
		108	FileName: String;
		109	How: TZMRenameOpts;
		110	i: Integer;
		111	k: Integer;
		112	ncomment: String;
		113	newname: String;
		114	newStamp: integer;
		115	pData: pRenData;
		116	pRenRec: PZMRenameRec;
		117	RenSource: TZMString;
		118	begin
		119	filename := rec.FileName;
		120	pData := @data;
		121	How := pData.How;
		122	Result := 0;
		123	for i := 0 to pData^.RenList.Count - 1 do
		124	begin
		125	pRenRec := PZMRenameRec(pData^.RenList[i]);
		126	RenSource := pRenRec.Source;
		127	newname := pRenRec.Dest;
		128	ncomment := pRenRec.Comment;
		129	newStamp := pRenRec.DateTime;
		130	ChangeName := (newname <> '\|') and (CompareStr(filename, newname) <> 0);
		131	if How = htrFull then
		132	begin
		133	if pData^.Owner.FNMatch(pRenRec.Source, FileName) then
		134	k := -1
		135	else
		136	k := 0;
		137	end
		138	else
		139	begin
		140	k := Pos(UpperCase(RenSource), UpperCase(FileName));
		141	end;
		142	if k <> 0 then
		143	begin
		144	inc(pData^.cnt); // I am selected
		145	if not ChangeName then
		146	Result := 0
		147	else
		148	begin
		149	if k > 0 then
		150	begin
		151	newname := FileName;
		152	System.Delete(newname, k, Length(RenSource));
		153	Insert(pRenRec.Dest, newname, k);
		154	end;
		155	Result := rec.ChangeName(newname);
		156	if Result = 0 then
		157	filename := rec.FileName;
		158	end;
		159	if Result = 0 then
		160	begin
		161	if ncomment <> '' then
		162	begin
		163	if ncomment[1] = #0 then
		164	ncomment := '';
		165	Result := rec.ChangeComment(ncomment);
		166	end;
		167	end;
		168	if Result = 0 then
		169	begin
		170	if newStamp = 0 then
		171	newStamp := pData^.DTime;
		172	if newStamp <> 0 then
		173	Result := rec.ChangeDate(newStamp);
		174	end;
		175	if How <> htrDefault then
		176	break;
		177	end;
		178	end;
		179	end;
		180
		181	(* TZMWorker.AddZippedFiles
		182	Add zipped files from source ZipMaster selected from source FSpecArgs
		183	When finished
		184	FSpecArgs will contain source files copied
		185	FSpecArgsExcl will contain source files skipped
		186	*)
		187	procedure TZMWorker.AddZippedFiles(SrcWorker: TZMWorker; Merge: TZMMergeOpts);
		188	var
		189	BadSkip: Boolean;
		190	DstCnt: Integer;
		191	DstZip: TZMZipFile;
		192	idx: Integer;
		193	res: Integer;
		194	SrcCnt: Integer;
		195	SrcZip: TZMZipFile;
		196	begin
		197	ShowProgress := zspNone;
		198	ClearErr;
		199	// Are source and destination different?
		200	SrcZip := SrcWorker.CentralDir.Current;
		201	VerifySource(SrcZip); // make sure we have some valid
		202	DstZip := Prepare(false, true);
		203	if (SrcWorker = Self) or IsSameFile(ZipFileName, SrcWorker.ZipFileName) then
		204	raise EZipMaster.CreateResDisp(CF_SourceIsDest, true);
		205
		206	if (SrcZip.WorkDrive.DriveLetter = DstZip.WorkDrive.DriveLetter) and
		207	(not DstZip.WorkDrive.DriveIsFixed) and
		208	(DstZip.MultiDisk or SrcZip.MultiDisk or (zwoDiskSpan in WriteOptions))
		209	then
		210	raise EZipMaster.CreateResDisp(AZ_SameAsSource, true);
		211
		212	BadSkip := false;
		213	FSpecArgs.Clear;
		214	SrcCnt := SrcZip.SelectFiles(SrcWorker.FSpecArgs, SrcWorker.FSpecArgsExcl,
		215	FSpecArgs);
		216	FSpecArgsExcl.Clear; // will contain source files not copied
		217	if SrcCnt > 0 then
		218	begin
		219	// copy the list of not found specs adding the correct error
		220	for idx := 0 to FSpecArgs.Count - 1 do
		221	begin
		222	FSpecArgsExcl.AddObject(FSpecArgs[idx], pointer(stNotFound));
		223	if ReportSkipping(FSpecArgs[idx], 0, stNotFound) then
		224	BadSkip := true;
		225	end;
		226	end;
		227	FSpecArgs.Clear; // will contain files copied from source
		228	if BadSkip then
		229	raise EZipMaster.CreateResDisp(GE_NoSkipping, true);
		230	if SrcCnt < 1 then
		231	raise EZipMaster.CreateResDisp(AZ_NothingToDo, true);
		232
		233	DstCnt := DstZip.Select('*', zzsSet); // initial want all
		234	if DstCnt > 0 then
		235	begin
		236	// Resolve merge conflicts
		237	// Src files to be copied are appended to FSpecArgs
		238	// Dst files to be copied instead of Src files appended to FSpecArgsExcl
		239	ResolveMerge(Merge, SrcZip, DstZip, SrcCnt, DstCnt);
		240	end;
		241	if SrcCnt < 1 then
		242	raise EZipMaster.CreateResDisp(AZ_NothingToDo, true);
		243	// write the results
		244	res := AddZippedFilesWrite(DstZip, DstCnt, SrcZip, SrcCnt);
		245	CentralDir.Current := nil; // must reload
		246	if res < 0 then
		247	raise EZipMaster.CreateResDisp(-res, res <> -GE_Abort);
		248	// Update the Zip Directory by calling List method
		249	// for spanned exe avoid swapping to last disk
		250	if not IsDetachedSFX(ZipFileName) then
		251	List;
		252	end;
		253
		254	function TZMWorker.AddZippedFilesAppend(DstZip, SrcZip: TZMZipFile; Last:
		255	Integer): integer;
		256	var
		257	r: Integer;
		258	Zip: TZMZipCopy;
		259	TruncPosn: Int64;
		260	begin
		261	DstZip.File_Close;
		262	Zip := TZMZipCopy.Create(Self);
		263	try
		264	Zip.Replicate(DstZip, Last);
		265	Zip.DiskNr := 0;
		266	Zip.ShowProgress := zspFull;
		267	Result := 0;
		268	r := Zip.Count;
		269	// add copied entries
		270	r := r + Zip.AffixZippedFiles(SrcZip, false);
		271	if r > 0 then
		272	begin
		273	Result := SrcZip.Reopen(fmOpenRead);
		274	if (Result >= 0) then
		275	begin
		276	if Last >= 0 then
		277	begin
		278	// we must append
		279	Result := Zip.Reopen(fmOpenReadWrite);
		280	if Result >= 0 then
		281	begin
		282	// get truncate position
		283	if (Last + 1) >= DstZip.Count then
		284	TruncPosn := DstZip.CentralOffset // at SOC
		285	else
		286	TruncPosn := DstZip[Last + 1].RelOffLocal; // at start of next local
		287	if Zip.Seek(TruncPosn, 0) <> TruncPosn then
		288	Result := -DS_SeekError
		289	else
		290	if not Zip.SetEndOfFile then
		291	Result := -DS_SeekError;
		292	end;
		293	if Result >= 0 then
		294	begin
		295	Diag('Append to zip');
		296	Result := Zip.CommitAppend(Last, zwoZipTime in WriteOptions);
		297	end;
		298	end
		299	else
		300	begin
		301	// new zip
		302	Diag('Write new zip');
		303	if not Zip.File_Create(Zip.FileName) then
		304	Result := -DS_FileError
		305	else
		306	Result := Zip.Commit(zwoZipTime in WriteOptions);
		307	end;
		308	end;
		309	end;
		310	SrcZip.File_Close;
		311	Zip.File_Close;
		312	if Result >= 0 then
		313	begin
		314	if Zip.Count <> r then
		315	Result := AZ_InternalError;
		316	SuccessCnt := Zip.Count; // number of remaining files
		317	end;
		318	finally
		319	FreeAndNil(Zip);
		320	end;
		321	end;
		322
		323	function TZMWorker.AddZippedFilesWrite(DstZip: TZMZipFile; DstCnt: Integer;
		324	SrcZip: TZMZipFile; SrcCnt: Integer): integer;
		325	var
		326	CanAppend: boolean;
		327	existed: boolean;
		328	FirstReplaced: Integer;
		329	Intermed: TZMZipCopy;
		330	LastKept: Integer;
		331	r: Integer;
		332	WillSpilt: boolean;
		333	I: Integer;
		334	begin
		335	existed := (zfi_Loaded and DstZip.info) <> 0;
		336	WillSpilt := DstZip.MultiDisk or ((not existed) and (zwoDiskSpan in DstZip.WriteOptions));
		337
		338	if (not WillSpilt) and not (existed and (AddSafe in DstZip.AddOptions)) then
		339	begin
		340	// check can append
		341	LastKept := -1;
		342	FirstReplaced := -1;
		343	for I := 0 to DstZip.Count - 1 do
		344	begin
		345	if DstZip[I].Selected then
		346	begin
		347	LastKept := I;
		348	if FirstReplaced >= 0 then
		349	Break; // cannot append
		350	end
		351	else
		352	if FirstReplaced < 0 then
		353	FirstReplaced := I;
		354	end;
		355	CanAppend :=(FirstReplaced < 0) or (LastKept < FirstReplaced);
		356	if (Verbosity >= zvVerbose) and CanAppend then
		357	Diag('Should be able to append starting after index: '+ IntToStr(LastKept));
		358	if CanAppend then
		359	begin
		360	Result := AddZippedFilesAppend(DstZip, SrcZip, LastKept);
		361	Exit;
		362	end;
		363	end;
		364	// write to intermediate
		365	Intermed := TZMZipCopy.Create(self);
		366	try
		367	if WillSpilt then
		368	Intermed.File_CreateTemp(PRE_INTER, '')
		369	else
		370	Intermed.File_CreateTemp(PRE_INTER, DstZip.FileName); // initial temporary destination
		371	if not WillSpilt then
		372	begin
		373	if assigned(DstZip.stub) and DstZip.UseSFX then
		374	begin
		375	Intermed.AssignStub(DstZip);
		376	Intermed.UseSFX := true;
		377	end;
		378	Intermed.DiskNr := 0;
		379	Intermed.ZipComment := DstZip.ZipComment; // keep orig
		380	end;
		381	Intermed.ShowProgress := zspFull;
		382	Result := 0;
		383	r := 0;
		384	if DstCnt > 0 then
		385	r := Intermed.AffixZippedFiles(DstZip, false);
		386	r := r + Intermed.AffixZippedFiles(SrcZip, false);
		387	if r > 0 then
		388	begin
		389	Result := SrcZip.Reopen(fmOpenRead);
		390	if (Result >= 0) and (DstCnt > 0) then
		391	Result := DstZip.Reopen(fmOpenRead);
		392	if Result >= 0 then
		393	Result := Intermed.Commit(zwoZipTime in DstZip.WriteOptions);
		394	end;
		395	SrcZip.File_Close;
		396	DstZip.File_Close;
		397	Intermed.File_Close;
		398	if Result >= 0 then
		399	begin
		400	if Intermed.Count <> r then
		401	Result := -AZ_InternalError
		402	else
		403	begin
		404	SuccessCnt := Intermed.Count; // number of remaining files
		405	// all correct so Recreate source
		406	Result := Recreate(Intermed, DstZip);
		407	end;
		408	end;
		409	finally
		410	FreeAndNil(Intermed);
		411	end;
		412	end;
		413
		414	procedure TZMWorker.AfterConstruction;
		415	begin
		416	inherited;
		417	fIsDestructing := False;
		418	end;
		419
		420	(*? TZMWorker.BeforeDestruction
		421	1.73 3 July 2003 RP stop callbacks
		422	*)
		423	procedure TZMWorker.BeforeDestruction;
		424	begin
		425	fIsDestructing := True; // stop callbacks
		426	inherited;
		427	end;
		428
		429	(* TZMWorker.ChangeFileDetails
		430	Add zipped files from source ZipMaster selected from source FSpecArgs
		431	When finished
		432	FSpecArgs will contain source files copied
		433	FSpecArgsExcl will contain source files skipped (data = error code)
		434	*)
		435	function TZMWorker.ChangeFileDetails(func: TZMChangeFunction; var data):
		436	Integer;
		437	var
		438	Changes: Integer;
		439	CurZip: TZMZipFile;
		440	idx: Integer;
		441	rec: TZMIRec;
		442	SelCnt: Integer;
		443	SkipCnt: Integer;
		444	SkippedFiles: TStringList;
		445	begin
		446	ClearErr;
		447	Result := 0;
		448	SuccessCnt := 0;
		449	SkippedFiles := TStringList.Create;
		450	try
		451	if Verbosity >= zvVerbose then
		452	Diag('StartUp ChangeFileDetails');
		453	CurZip := Prepare(true); // prepare the current zip
		454	SelCnt := CurZip.SelectFiles(FSpecArgs, FSpecArgsExcl, SkippedFiles);
		455	FSpecArgs.Clear; // will contain files processed
		456	FSpecArgsExcl.Clear; // will contain source files skipped
		457	SkipCnt := SkippedFiles.Count;
		458	for idx := 0 to SkippedFiles.Count - 1 do
		459	begin
		460	FSpecArgsExcl.AddObject(SkippedFiles[idx], pointer(stNotFound));
		461	if ReportSkipping(SkippedFiles[idx], 0, stNotFound) then
		462	Result := -GE_NoSkipping
		463	else
		464	Dec(SkipCnt); // user chose to ignore
		465	end;
		466	if (Result = 0) and ((SelCnt <= 0) or (SkipCnt <> 0)) then
		467	begin
		468	if Verbosity >= zvVerbose then
		469	Diag('nothing selected');
		470	ShowZipMessage(AZ_NothingToDo, '');
		471	Result := -AZ_NothingToDo;
		472	end;
		473	finally
		474	SkippedFiles.Free;
		475	end;
		476	// process selected files
		477	Changes := 0;
		478	idx := -1; // from beginning
		479	try
		480	while Result = 0 do
		481	begin
		482	idx := CurZip.NextSelected(idx);
		483	if idx < 0 then
		484	break; // no more - finished
		485	rec := CurZip[idx];
		486	if Verbosity >= zvVerbose then
		487	Diag('Changing: ' + rec.FileName);
		488	Result := func(rec, data);
		489	if Result <> 0 then
		490	begin
		491	if Verbosity >= zvVerbose then
		492	Diag(Format('error [%d] for: %s',[Result, rec.FileName]));
		493
		494	FSpecArgsExcl.AddObject(rec.FileName, pointer(Result));
		495	if ReportSkipping(rec.FileName, Result, stCannotDo) then
		496	Result := -GE_NoSkipping
		497	else
		498	Result := 0; // ignore error
		499	end;
		500	if Result = 0 then
		501	begin
		502	FSpecArgs.Add(rec.FileName);
		503	if rec.HasChanges then
		504	begin
		505	if Verbosity >= zvVerbose then
		506	Diag('Changed: ' + rec.FileName);
		507	inc(Changes);
		508	end;
		509	CheckCancel;
		510	end;
		511	end;
		512	except
		513	on E: EZipMaster do
		514	begin
		515	Result := -E.ResId;
		516	end;
		517	on E: Exception do
		518	Result := -GE_ExceptErr;
		519	end;
		520	if (Result = 0) and (Changes > 0) then
		521	begin
		522	if Verbosity >= zvVerbose then
		523	Diag('saving changes');
		524	Remake(CurZip, -1, True);
		525	SuccessCnt := Changes;
		526	CentralDir.Current := nil;
		527	// Update the Zip Directory by calling List method
		528	// for spanned exe avoid swapping to last disk
		529	if not IsDetachedSFX(ZipFileName) then
		530	List;
		531	end;
		532	if Verbosity >= zvVerbose then
		533	Diag('finished ChangeFileDetails');
		534	end;
		535
		536	(*? TZMWorker.Clear
		537	Clears lists and strings
		538	*)
		539	procedure TZMWorker.Clear;
		540	begin
		541	Cancel := -1;
		542	SuccessCnt := 0;
		543	inherited;
		544	end;
		545
		546	(*
		547	Enter FSpecArgs and FSpecArgsExcl specify files to be copied
		548	Exit FSpecArgs = files copied
		549	FSpecArgsExcl = files skipped
		550	*)
		551	procedure TZMWorker.CopyZippedFiles(DestWorker: TZMWorker; DeleteFromSource:
		552	boolean; OverwriteDest: TZMMergeOpts);
		553	var
		554	DestName: string;
		555	DstZip: TZMZipFile;
		556	DstCnt: Integer;
		557	I: Integer;
		558	idx: Integer;
		559	SavedDone: TStringList;
		560	res: integer;
		561	Skipped: TStringList;
		562	SrcCnt: Integer;
		563	SrcZip: TZMZipFile;
		564	begin
		565	ShowProgress := zspNone;
		566	ClearErr;
		567	res := 0;
		568	SrcZip := CurrentZip(True, False);
		569	// validate dest
		570	DestName := DestWorker.ZipFileName;
		571	if DestName = '' then
		572	raise EZipMaster.CreateResDisp(GE_NoZipSpecified, true);
		573	// Are source and destination different?
		574	if IsSameFile(ZipFileName, DestName) then
		575	raise EZipMaster.CreateResDisp(CF_SourceIsDest, true);
		576	DstZip := DestWorker.CentralDir.Current;
		577	if DstZip.FileName = '' then
		578	begin
		579	// creating new file
		580	DstZip.FileName := DestName;
		581	DstZip.ReqFileName := DestName;
		582	end;
		583	if (zfi_Cancelled and DstZip.info) <> 0 then
		584	begin
		585	if DstZip.AskAnotherDisk(DestName) = idCancel then
		586	raise EZipMaster.CreateResDisp(GE_Abort, false);
		587	DstZip.info := 0; // clear error
		588	end;
		589
		590	VerifySource(SrcZip); // make sure we have some valid
		591	Skipped := TStringList.Create;
		592	try
		593	SrcCnt := SrcZip.SelectFiles(FSpecArgs, FSpecArgsExcl, Skipped);
		594	FSpecArgsExcl.Clear; // will contain source files not copied
		595	if SrcCnt > 0 then
		596	begin
		597	// copy the list of not found specs adding the correct error
		598	for idx := 0 to Skipped.Count - 1 do
		599	begin
		600	FSpecArgsExcl.AddObject(Skipped[idx], pointer(stNotFound));
		601	if ReportSkipping(FSpecArgs[idx], 0, stNotFound) then
		602	res := -GE_NoSkipping;
		603	end;
		604	end;
		605	finally
		606	Skipped.Free;
		607	end;
		608	FSpecArgs.Clear; // will contain files copied from source
		609	if (res = 0) and (SrcCnt < 1) then
		610	res := -AZ_NothingToDo;
		611	// we now know what files are selected to be merged
		612	if res = 0 then
		613	begin
		614	DstZip.Boss := Self;
		615	if res >= 0 then
		616	begin
		617	DstCnt := DstZip.Select('*', zzsSet); // initial want all
		618	if DstCnt > 0 then
		619	begin
		620	// Resolve merge conflicts
		621	// Src files to be copied are appended to FSpecArgs
		622	// Dst files to be copied instead of Src files appended to FSpecArgsExcl
		623	ResolveMerge(OverwriteDest, SrcZip, DstZip, SrcCnt, DstCnt);
		624	end;
		625	// Write the resulting zip
		626	if SrcCnt < 1 then
		627	res := -AZ_NothingToDo
		628	else
		629	res := AddZippedFilesWrite(DstZip, DstCnt, SrcZip, SrcCnt);
		630	// did it work?
		631	if res = 0 then
		632	begin
		633	if not IsDetachedSFX(DestName) then
		634	begin
		635	// try to load the destination
		636	DstZip.FileName := DestName;
		637	res := DstZip.Open(False, False);
		638	end;
		639	end;
		640	end;
		641	end;
		642	if (res = 0) and DeleteFromSource then
		643	begin
		644	// delete the copied files
		645	Skipped := nil;
		646	SavedDone := TStringList.Create;
		647	try
		648	// save done and skipped files
		649	SavedDone.AddStrings(FSpecArgs);
		650	Skipped := TStringList.Create;
		651	for I := 0 to FSpecArgsExcl.Count - 1 do
		652	Skipped.AddObject(FSpecArgsExcl.Strings[I], FSpecArgsExcl.Objects[i]);
		653	FSpecArgsExcl.Clear;
		654	res := Delete1; // delete from current zip
		655	FSpecArgs.Assign(SavedDone); // restore done files
		656	for I := 0 to Skipped.Count - 1 do
		657	FSpecArgsExcl.AddObject(Skipped.Strings[I], Skipped.Objects[i]);
		658	finally
		659	SavedDone.Free;
		660	if Skipped <> nil then
		661	Skipped.Free;
		662	end;
		663	CentralDir.Current := nil; // must reload
		664	// Update the Zip Directory by calling List method
		665	// for spanned exe avoid swapping to last disk
		666	if not IsDetachedSFX(ZipFileName) then
		667	List;
		668	end;
		669	if res < 0 then
		670	raise EZipMaster.CreateResDisp(-res, res <> -GE_Abort);
		671	SuccessCnt := FSpecArgs.Count;
		672	end;
		673
		674	(*? TZMWorker.Delete
		675	Deletes files specified in FSpecArgs from current Zip
		676	exit: FSpecArgs = files deleted,
		677	FSpecArgsExcl = files skipped
		678	SuccessCnt = number of files deleted
		679	*)
		680	procedure TZMWorker.Delete;
		681	var
		682	res: integer;
		683	begin
		684	ClearErr;
		685	if {(not assigned(CentralDir.Current)) or} (CentralDir.Current.Count < 1) or
		686	(FSpecArgs.Count = 0) then
		687	res := -DL_NothingToDel
		688	else
		689	res := Delete1;
		690	if res < 0 then
		691	ShowZipMessage(-res, '')
		692	else
		693	SuccessCnt := res;
		694	// Update the Zip Directory by calling List method
		695	// for spanned exe avoid swapping to last disk
		696	if (res <> -DL_NothingToDel) and not IsDetachedSFX(ZipFileName) then
		697	List;
		698	end;
		699
		700	(*? TZMWorker.Delete1
		701	Deletes files specified in FSpecArgs from current Zip
		702	exit: FSpecArgs = files deleted,
		703	FSpecArgsExcl = files skipped
		704	Result = >=0 number of files deleted, <0 error
		705	*)
		706	function TZMWorker.Delete1: integer;
		707	var
		708	BeforeCnt: Integer;
		709	CurZip: TZMZipFile;
		710	DelCnt: Integer;
		711	idx: Integer;
		712	SkippedFiles: TStringList;
		713	begin
		714	CurZip := Prepare(true); // prepare the Current zip
		715	Result := 0;
		716	SkippedFiles := TStringList.Create;
		717	try
		718	DelCnt := CurZip.SelectFiles(FSpecArgs, FSpecArgsExcl, SkippedFiles);
		719	FSpecArgs.Clear; // will contain files deleted
		720	FSpecArgsExcl.Clear; // will contain files skipped
		721	for idx := 0 to SkippedFiles.Count - 1 do
		722	begin
		723	FSpecArgsExcl.AddObject(SkippedFiles[idx], pointer(stNotFound));
		724	if ReportSkipping(SkippedFiles[idx], 0, stNotFound) then
		725	Result := - GE_NoSkipping;
		726	end;
		727	finally
		728	SkippedFiles.Free;
		729	end;
		730	if (Result = 0) and (DelCnt <= 0) then
		731	Result := -DL_NothingToDel;
		732	if Result = 0 then
		733	begin
		734	ASSERT(DelCnt = CurZip.SelCount, 'selcount wrong 1');
		735	DelCnt := CurZip.Count - DelCnt;
		736	if DelCnt < 1 then
		737	begin
		738	// no files left
		739	CurZip.File_Close;
		740	SysUtils.DeleteFile(CurZip.FileName);
		741	Result := DelCnt; // number of files deleted
		742	end
		743	else
		744	begin
		745	idx := -1; // from beginning
		746	while true do
		747	begin
		748	idx := CurZip.NextSelected(idx);
		749	if idx < 0 then
		750	break; // no more - finished
		751	FSpecArgs.Add(CurZip[idx].FileName);
		752	end;
		753	BeforeCnt := CurZip.Count;
		754	CurZip.Select('*', zzsToggle); // select entries to keep
		755	ASSERT(DelCnt = CurZip.SelCount, 'selcount wrong 2');
		756	// write the result
		757	Result := Remake(CurZip, DelCnt, False);
		758	if Result >= 0 then
		759	Result := BeforeCnt - Result; // if no error
		760	end;
		761	end;
		762	CurZip.Invalidate;
		763	CentralDir.Current := nil; // force reload
		764	end;
		765
		766	function TZMWorker.ForEach(func: TZMForEachFunction; var data): Integer;
		767	var
		768	BadSkip: Boolean;
		769	CurZip: TZMZipFile;
		770	good: Integer;
		771	i: Integer;
		772	idx: Integer;
		773	rec: TZMDirEntry;
		774	SelCnt: Integer;
		775	SkippedFiles: TStringList;
		776	begin
		777	ClearErr;
		778	Result := 0;
		779	SuccessCnt := 0;
		780	good := 0;
		781	SkippedFiles := TStringList.Create;
		782	try
		783	if Verbosity >= zvVerbose then
		784	Diag('StartUp ForEach');
		785	CurZip := CurrentZip(True);
		786	SelCnt := CurZip.SelectFiles(FSpecArgs, FSpecArgsExcl, SkippedFiles);
		787	if SelCnt <= 0 then
		788	begin
		789	if Verbosity >= zvVerbose then
		790	Diag('nothing selected');
		791	ShowZipMessage(AZ_NothingToDo, '');
		792	Exit;
		793	end;
		794	FSpecArgs.Clear; // will contain files processed
		795	FSpecArgsExcl.Clear; // will contain files skipped
		796	BadSkip := False;
		797	for idx := 0 to SkippedFiles.Count - 1 do
		798	begin
		799	FSpecArgsExcl.AddObject(SkippedFiles[idx], pointer(stNotFound));
		800	if ReportSkipping(SkippedFiles[idx], 0, stNotFound) then
		801	BadSkip := True;
		802	end;
		803	finally
		804	SkippedFiles.Free;
		805	end;
		806	if BadSkip then
		807	begin
		808	ShowZipMessage(GE_NoSkipping, '');
		809	Exit;
		810	end;
		811	i := -1;
		812	while True do
		813	begin
		814	i := CurZip.NextSelected(i);
		815	if i < 0 then
		816	break;
		817	rec := CurZip[i];
		818	if Verbosity >= zvVerbose then
		819	Diag('Processing: ' + rec.FileName);
		820	Result := func(rec, data);
		821	if Result <> 0 then
		822	begin
		823	FSpecArgsExcl.Add(rec.FileName);
		824	break;
		825	end;
		826	inc(good);
		827	FSpecArgs.Add(rec.FileName);
		828	CheckCancel;
		829	end;
		830	SuccessCnt := good;
		831	if Verbosity >= zvVerbose then
		832	Diag('finished ForEach');
		833	end;
		834
		835	(*? TZMWorker.IsDestWritable
		836	1.79 2005 Jul 9
		837	*)
		838	function TZMWorker.IsDestWritable(const fname: String; AllowEmpty: Boolean):
		839	Boolean;
		840	var
		841	hFile: Integer;
		842	sr: TSearchRec;
		843	wd: TZMWorkDrive;
		844	xname: String;
		845	begin
		846	Result := False;
		847	wd := TZMWorkDrive.Create;
		848	try
		849	xname := ExpandUNCFileName(fname);
		850	// test if destination can be written
		851	wd.DriveStr := xname;
		852	if not wd.HasMedia(false) then
		853	begin
		854	Result := AllowEmpty and (wd.DriveType = DRIVE_REMOVABLE);
		855	// assume can put in writable disk
		856	exit;
		857	end;
		858	if WinXP or (wd.DriveType <> DRIVE_CDROM) then
		859	begin
		860	if sysUtils.FindFirst(xname, faAnyFile, sr) = 0 then
		861	begin
		862	Result := (sr.Attr and faReadOnly) = 0;
		863	sysUtils.FindClose(sr);
		864	if Result then
		865	begin
		866	// exists and is not read-only - test locked
		867	hFile := SysUtils.FileOpen(xname, fmOpenWrite);
		868	Result := hFile > -1;
		869	if Result then
		870	SysUtils.FileClose(hFile);
		871	end;
		872	exit;
		873	end;
		874	// file did not exist - try to create it
		875	hFile := FileCreate(xname);
		876	if hFile > -1 then
		877	begin
		878	Result := True;
		879	FileClose(hFile);
		880	SysUtils.DeleteFile(xname);
		881	end;
		882	end;
		883	finally
		884	wd.Free;
		885	end;
		886	end;
		887
		888	function TZMWorker.IsDetachedSFX(const fn: String): Boolean;
		889	var
		890	ext: String;
		891	wz: TZMZipFile;
		892	begin
		893	Result := False;
		894	ext := ExtractFileExt(fn);
		895	if AnsiSameText(ext, '.exe') then
		896	begin
		897	wz := TZMZipFile.Create(self);
		898	try
		899	wz.FileName := fn;
		900	if (wz.OpenEOC(true) >= 0) and IsDetachSFX(wz) then
		901	Result := true;
		902	finally
		903	wz.Free;
		904	end;
		905	end;
		906	end;
		907
		908	procedure TZMWorker.List;
		909	begin
		910	LoadZip(ZipFileName, false);
		911	end;
		912
		913	(* TZMWorker.Prepare
		914	Prepare destination and get SFX stub as needed
		915	*)
		916	function TZMWorker.Prepare(MustExist: Boolean; SafePart: boolean = false):
		917	TZMZipFile;
		918	begin
		919	Result := CurrentZip(MustExist, SafePart);
		920	if Unattended and not Result.WorkDrive.DriveIsFixed then
		921	raise EZipMaster.CreateResDisp(DS_NoUnattSpan, true);
		922	if (Uppercase(ExtractFileExt(Result.ReqFileName)) = EXT_EXE) then
		923	begin
		924	Result.UseSFX := true;
		925	Result.Stub := NewSFXStub;
		926	Result.UseSFX := true;
		927	end;
		928	end;
		929
		930	// write to intermediate then recreate as original
		931	function TZMWorker.Remake(CurZip: TZMZipFile; ReqCnt: Integer; All: boolean):
		932	Integer;
		933	var
		934	Intermed: TZMZipCopy;
		935	Res: Integer;
		936	begin
		937	Result := 0;
		938	Intermed := TZMZipCopy.Create(self);
		939	try
		940	if not Intermed.File_CreateTemp(PRE_INTER, '') then
		941	raise EZipMaster.CreateResDisp(DS_NoOutFile, True);
		942	Intermed.ShowProgress := zspFull;
		943	Intermed.ZipComment := CurZip.ZipComment;
		944	CurZip.Reopen(fmOpenRead);
		945	Res := Intermed.WriteFile(CurZip, All);
		946	CurZip.File_Close;
		947	Intermed.File_Close;
		948	if Res < 0 then
		949	raise EZipMaster.CreateResDisp(-Res, true);
		950	Result := Intermed.Count; // number of remaining files
		951	if (ReqCnt >= 0) and (Result <> ReqCnt) then
		952	raise EZipMaster.CreateResDisp(AZ_InternalError, true);
		953	// Recreate like orig
		954	Res := Recreate(Intermed, CurZip);
		955	if Res < 0 then
		956	raise EZipMaster.CreateResDisp(-Res, true);
		957	finally
		958	Intermed.Free; // also delete temp file
		959	end;
		960	end;
		961
		962	(*? TZMWorker.Rename
		963	Function to read a Zip archive and change one or more file specifications.
		964	Source and Destination should be of the same type. (path or file)
		965	If NewDateTime is 0 then no change is made in the date/time fields.
		966	*)
		967	procedure TZMWorker.Rename(RenameList: TList; NewDateTime: Integer; How:
		968	TZMRenameOpts = htrDefault);
		969	var
		970	i: Integer;
		971	RenDat: TRenData;
		972	RenRec: PZMRenameRec;
		973	res: Integer;
		974	begin
		975	for i := 0 to RenameList.Count - 1 do
		976	begin
		977	RenRec := RenameList.Items[i];
		978	if IsWild(RenRec.Source) then
		979	raise EZipMaster.CreateResDisp(AD_InvalidName, true);
		980	RenRec^.Source := SetSlash(RenRec^.Source, psdExternal);
		981	RenRec^.Dest := SetSlash(RenRec^.Dest, psdExternal);
		982	end;
		983	RenDat.Owner := Self;
		984	RenDat.RenList := RenameList;
		985	RenDat.DTime := NewDateTime;
		986	RenDat.How := How;
		987	RenDat.cnt := 0;
		988	if FSpecArgs.Count < 1 then
		989	FSpecArgs.Add('.');
		990	res := ChangeFileDetails(@RenFunc, RenDat);
		991	if res < 0 then
		992	raise EZipMaster.CreateResDisp(-res, true);
		993	SuccessCnt := RenDat.cnt;
		994	end;
		995
		996	(*
		997	Resolve merge conflicts
		998	Src files to be copied are appended to FSpecArgs
		999	Dst files to be copied instead of Src files appended to FSpecArgsExcl
		1000	*)
		1001	procedure TZMWorker.ResolveMerge(Merge: TZMMergeOpts; SrcZip, DstZip:
		1002	TZMZipFile; var SrcCnt, DstCnt: Integer);
		1003	var
		1004	DstRec: TZMIRec;
		1005	i: Integer;
		1006	idx: Integer;
		1007	k: Cardinal;
		1008	SrcRec: TZMIRec;
		1009	tmpCopyZippedOverwrite: TZMCopyZippedOverwriteEvent;
		1010	WantSrc: Boolean;
		1011	begin
		1012	i := -1; // from beginning
		1013	k := 0;
		1014	while true do
		1015	begin
		1016	i := SrcZip.NextSelected(i);
		1017	if i < 0 then
		1018	break;
		1019	Inc(k);
		1020	if (k and 127) = 0 then
		1021	CheckCancel;
		1022	SrcRec := SrcZip[i];
		1023	// check conflicts
		1024	idx := -1;
		1025	DstRec := nil; // keep compiler happy
		1026	if DstCnt > 0 then
		1027	DstRec := DstZip.FindName(SrcRec.FileName, idx);
		1028	if idx < 0 then
		1029	begin
		1030	FSpecArgs.Add(SrcRec.FileName); // ext name
		1031	continue;
		1032	end;
		1033	if Verbosity >= zvVerbose then
		1034	Diag('file conflict: ' + SrcRec.FileName);
		1035	// file exists in both
		1036	WantSrc := false;
		1037	case Merge of
		1038	zmoConfirm:
		1039	begin
		1040	// Do we have a event assigned for this then don't ask.
		1041	tmpCopyZippedOverwrite := Master.OnCopyZippedOverwrite;
		1042	if Assigned(tmpCopyZippedOverwrite) then
		1043	tmpCopyZippedOverwrite(Master, SrcRec, DstRec, WantSrc)
		1044	else if ZipMessageDlgEx('', Format(ZipLoadStr(CF_OverwriteYN),
		1045	[SrcZip.FileName, DstZip.FileName]),
		1046	zmtConfirmation + DHC_CpyZipOvr, [mbYes, mbNo]) = idYes then
		1047	WantSrc := true;
		1048	end;
		1049	zmoAlways:
		1050	WantSrc := true;
		1051	zmoNewer:
		1052	WantSrc := SrcRec.ModifDateTime > DstRec.ModifDateTime;
		1053	zmoOlder:
		1054	WantSrc := SrcRec.ModifDateTime < DstRec.ModifDateTime;
		1055	zmoNever:
		1056	WantSrc := false;
		1057	end;
		1058	if WantSrc then
		1059	begin
		1060	if Verbosity >= zvVerbose then
		1061	Diag('to copy source');
		1062	DstRec.ClearStatusBit(zsbSelected);
		1063	dec(DstCnt);
		1064	FSpecArgs.Add(SrcRec.FileName);
		1065	end
		1066	else
		1067	begin
		1068	if Verbosity >= zvVerbose then
		1069	Diag('to copy destination');
		1070	SrcRec.ClearStatusBit(zsbSelected);
		1071	dec(SrcCnt);
		1072	FSpecArgsExcl.Add(SrcRec.FileName);
		1073	end;
		1074	end;
		1075	end;
		1076
		1077	procedure TZMWorker.Set_ZipComment(const zComment: AnsiString);
		1078	var
		1079	EOC: TZipEndOfCentral;
		1080	len: Integer;
		1081	wz: TZMZipFile;
		1082	zcom: AnsiString;
		1083	begin
		1084	wz := TZMZipFile.Create(self);
		1085	try
		1086	try
		1087	if Length(ZipFileName) <> 0 then
		1088	begin
		1089	wz.SpanOptions := wz.SpanOptions - [spExactName];
		1090	wz.FileName := ZipFileName;
		1091	wz.Open(true, true);// ignore errors
		1092	end
		1093	else
		1094	raise EZipMaster.CreateResDisp(GE_NoZipSpecified, true);
		1095	ZipComment := zComment;
		1096	// opened by OpenEOC() only for Read
		1097	if wz.IsOpen then // file exists
		1098	begin
		1099	wz.File_Close;
		1100	if wz.ZipComment <> zComment then
		1101	begin // change it
		1102	// must reopen for read/write
		1103	zcom := zComment;
		1104	len := Length(zCom);
		1105	wz.File_Open(fmShareDenyWrite or fmOpenReadWrite);
		1106	if not wz.IsOpen then
		1107	raise EZipMaster.CreateResDisp(DS_FileOpen, True);
		1108	if wz.MultiDisk and (wz.StampDate = 0) then
		1109	wz.StampDate := wz.LastWritten; // keep date of set
		1110	wz.CheckSeek(wz.EOCOffset, 0, DS_FailedSeek);
		1111	wz.CheckRead(EOC, SizeOf(EOC), DS_EOCBadRead);
		1112	if (EOC.HeaderSig <> EndCentralDirSig) then
		1113	raise EZipMaster.CreateResDisp(DS_EOCBadRead, True);
		1114	EOC.ZipCommentLen := len;
		1115	wz.CheckSeek(-Sizeof(EOC), 1, DS_FailedSeek);
		1116	wz.CheckWrite(EOC, sizeof(EOC), DS_EOCBadWrite);
		1117	if len > 0 then
		1118	wz.CheckWrite(zCom[1], len, DS_EOCBadWrite);
		1119	// if SetEOF fails we get garbage at the end of the file, not nice but
		1120	// also not important.
		1121	wz.SetEndOfFile;
		1122	end;
		1123	end;
		1124	except
		1125	on ews: EZipMaster do
		1126	begin
		1127	ShowExceptionError(ews);
		1128	ZipComment := '';
		1129	end;
		1130	on EOutOfMemory do
		1131	begin
		1132	ShowZipMessage(GE_NoMem, '');
		1133	ZipComment := '';
		1134	end;
		1135	end;
		1136	finally
		1137	wz.Free;
		1138	end;
		1139	// Update the Zip Directory by calling List method
		1140	// for spanned exe avoid swapping to last disk
		1141	if not IsDetachedSFX(ZipFileName) then
		1142	List
		1143	end;
		1144
		1145	(*? TZMWorker.StartUp
		1146	*)
		1147	procedure TZMWorker.StartUp;
		1148	var
		1149	CurZip: TZMZipFile;
		1150	begin
		1151	SuccessCnt := 0;
		1152	CentralDir.IgnoreDirOnly := not Master.UseDirOnlyEntries;
		1153	inherited;
		1154	// update values that may have changed since CurZip was made
		1155	CurZip := CentralDir.Current;
		1156	CurZip.AddOptions := AddOptions;
		1157	CurZip.SpanOptions := SpanOptions;
		1158	CurZip.WriteOptions := WriteOptions;
		1159	CurZip.IgnoreDirOnly := IgnoreDirOnly;
		1160	CurZip.Encoding := Encoding;
		1161	CurZip.EncodeAs := EncodeAs;
		1162	CurZip.Encoding_CP := Encoding_CP;
		1163	end;
		1164
		1165	procedure TZMWorker.VerifySource(SrcZip: TZMZipFile);
		1166	begin
		1167	if not assigned(SrcZip) then
		1168	raise EZipMaster.CreateResDisp(AZ_NothingToDo, true);
		1169	if (SrcZip.info and zfi_Cancelled) <> 0 then
		1170	raise EZipMaster.CreateResDisp(DS_Canceled, true);
		1171	if (SrcZip.info and zfi_loaded) = 0 then
		1172	raise EZipMaster.CreateResDisp(AD_InvalidZip, true);
		1173	end;
		1174
		1175	end.

Subversion Repositories autosfx

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