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

Rev	Author	Line No.	Line
1	daniel-mar	1	unit ZMWAUX19;
		2
		3	(*
		4	ZMWAUX19.pas - SFX and Span support
		5	Derived from
		6	* SFX for DelZip v1.7
		7	* Copyright 2002-2005
		8	* written by Markus Stephany
		9	Copyright (C) 2009, 2010 by Russell J. Peters, Roger Aelbrecht,
		10	Eric W. Engler and Chris Vleghert.
		11
		12	This file is part of TZipMaster Version 1.9.
		13
		14	TZipMaster is free software: you can redistribute it and/or modify
		15	it under the terms of the GNU Lesser General Public License as published by
		16	the Free Software Foundation, either version 3 of the License, or
		17	(at your option) any later version.
		18
		19	TZipMaster is distributed in the hope that it will be useful,
		20	but WITHOUT ANY WARRANTY; without even the implied warranty of
		21	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
		22	GNU Lesser General Public License for more details.
		23
		24	You should have received a copy of the GNU Lesser General Public License
		25	along with TZipMaster. If not, see <http://www.gnu.org/licenses/>.
		26
		27	contact: problems@delphizip.org (include ZipMaster in the subject).
		28	updates: http://www.delphizip.org
		29	DelphiZip maillist subscribe at http://www.freelists.org/list/delphizip
		30
		31	modified 2010-06-19
		32	--------------------------------------------------------------------------- *)
		33	{$I '.\ZipVers19.inc'}
		34
		35	interface
		36
		37	uses
		38	Windows, SysUtils, Classes, Graphics, ZipMstr19, ZMSFXInt19,
		39	ZMStructs19, ZMCompat19, ZMZipFile19, ZMCore19, ZMCendir19;
		40
		41	type
		42	TZMWAux = class(TZMCore)
		43	private
		44	Detached: Boolean;
		45	FAuxChanged: Boolean;
		46	fCentralDir: TZMCenDir;
		47	FNoReadAux: Boolean;
		48	fRegFailPath: String;
		49	fSFXCaption: String;
		50	fSFXCommandLine: String;
		51	fSFXDefaultDir: String;
		52	fSFXIcon: TIcon;
		53	fSFXMessage: String;
		54	fSFXMessageFlags: Word;
		55	fSFXOptions: TZMSFXOpts;
		56	fSFXOverwriteMode: TZMOvrOpts;
		57	fSFXPath: String;
		58	fSuccessCnt: Integer;
		59	fUseDelphiBin: Boolean;
		60	FZipComment: AnsiString;
		61	fZipFileName: String;
		62	OutSize: Integer;
		63	function MapSFXSettings17(pheder: PByte; stub: TMemoryStream): Integer;
		64	function MapSFXSettings19(pheder: PByte; stub: TMemoryStream): Integer;
		65	function RecreateSingle(Intermed, theZip: TZMZipFile): Integer;
		66	procedure SetSFXCommandLine(const Value: String);
		67	protected
		68	fSFXBinStream: TMemoryStream;
		69	function BrowseResDir(ResStart, Dir: PIRD; Depth: Integer): PIRDatE;
		70	function CreateStubStream: Boolean;
		71	procedure EncodingChanged(New_Enc: TZMEncodingOpts); override;
		72	procedure Encoding_CPChanged(New_CP: Cardinal); override;
		73	function LoadFromBinFile(var stub: TStream; var Specified: Boolean)
		74	: Integer;
		75	function LoadFromResource(var stub: TStream; const sfxtyp: String): Integer;
		76	function LoadSFXStr(ptbl: pByte; ident: Byte): String;
		77	function MapOptionsFromStub(opts: Word): TZMSFXOpts;
		78	function MapOptionsFrom17(opts: Word): TZMSFXOpts;
		79	function MapOptionsToStub(opts: TZMSFXOpts): Word;
		80	function MapOverwriteModeFromStub(ovr: Word): TZMOvrOpts;
		81	function MapOverwriteModeToStub(mode: TZMOvrOpts): Word;
		82	function PrepareStub: Integer;
		83	function RecreateMVArchive(const TmpZipName: String; Recreate: Boolean):
		84	Boolean;
		85	function ReleaseSFXBin: TMemoryStream;
		86	function SearchResDirEntry(ResStart: PIRD; entry: PIRDirE; Depth: Integer)
		87	: PIRDatE;
		88	procedure StartUp; override;
		89	// 1 return true if it was there
		90	function TrimDetached(stub: TMemoryStream): Boolean;
		91	// 1 return true if it was there
		92	function MapSFXSettings(stub: TMemoryStream): Integer;
		93	function WriteEOC(Current: TZMZipFile; OutFile: Integer): Integer;
		94	public
		95	constructor Create(AMaster: TCustomZipMaster19);
		96	procedure AfterConstruction; override;
		97	procedure BeforeDestruction; override;
		98	procedure Clear; override;
		99	function ConvertToSFX(const OutName: string; theZip: TZMZipFile): Integer;
		100	function ConvertToSpanSFX(const OutFileName: String; theZip: TZMZipFile):
		101	Integer;
		102	function ConvertToZIP: Integer;
		103	function CopyBuffer(InFile, OutFile: Integer; ReadLen: Int64): Integer;
		104	function Copy_File(const InFileName, OutFileName: String): Integer;
		105	function CurrentZip(MustExist: Boolean; SafePart: Boolean = false)
		106	: TZMZipFile;
		107	procedure Deflate(OutStream, InStream: TStream; Length: Int64; var Method:
		108	TZMDeflates; var crc: Cardinal); virtual; abstract;
		109	function DetachedSize(zf: TZMZipFile): Integer;
		110	procedure Done(Good: Boolean = true); override;
		111	function GetAuxProperties: Boolean;
		112	function IsDetachSFX(zfile: TZMZipFile): Boolean;
		113	function IsZipSFX(const SFXExeName: String): Integer;
		114	procedure LoadZip(const ZipName: String; NoEvent: Boolean);
		115	function NewSFXFile(const ExeName: String): Integer;
		116	function NewSFXStub: TMemoryStream;
		117	function ReadSpan(const InFileName: String; var OutFilePath: String;
		118	UseXProgress: Boolean): Integer;
		119	//1 Remake Intermed using parameters of theZip
		120	function Recreate(Intermed, theZip: TZMZipFile): Integer;
		121	function RejoinMVArchive(var TmpZipName: String): Integer;
		122	function RemakeTemp(temp: TZMZipFile; Recreate, detach: Boolean): Integer;
		123	procedure Set_ZipFileName(const zname: String; Load: TZLoadOpts);
		124	procedure Undeflate(OutStream, InStream: TStream; Length: Int64; var Method:
		125	TZMDeflates; var crc: Cardinal); virtual; abstract;
		126	function WriteDetached(zf: TZMZipFile): Integer;
		127	function WriteMulti(Src: TZMZipFile; Dest: TZMZipCopy;
		128	UseXProgress: Boolean): Integer;
		129	function WriteSpan(const InFileName, OutFileName: String;
		130	UseXProgress: Boolean): Integer;
		131	property AuxChanged: Boolean read FAuxChanged write FAuxChanged;
		132	property CentralDir: TZMCenDir Read fCentralDir;
		133	property NoReadAux: Boolean read FNoReadAux write FNoReadAux;
		134	property RegFailPath: String read fRegFailPath write fRegFailPath;
		135	property SFXCaption: String read fSFXCaption write fSFXCaption;
		136	property SFXCommandLine
		137	: String Read fSFXCommandLine Write SetSFXCommandLine;
		138	property SFXDefaultDir: String read fSFXDefaultDir write fSFXDefaultDir;
		139	property SFXIcon: TIcon Read fSFXIcon;
		140	property SFXMessage: String read fSFXMessage write fSFXMessage;
		141	property SFXOptions: TZMSFXOpts Read fSFXOptions Write fSFXOptions;
		142	(* This value controls the behaviour of the SFX when a file to be extracted
		143	would overwrite an existing file on disk:<br><br>
		144	- <u>somOverwrite</u>:<br> Always overwrite existing files<br><br>
		145	- <u>somSkip</u>:<br> Never overwrite existing files<br><br>
		146	- <u>somAsk</u>:<br> Let the user confirm overwriting.<br><br><br><br>
		147	*)
		148	property SFXOverwriteMode
		149	: TZMOvrOpts Read fSFXOverwriteMode Write fSFXOverwriteMode default
		150	ovrConfirm;
		151	property SFXPath: String read fSFXPath write fSFXPath;
		152	property SuccessCnt: Integer Read fSuccessCnt Write fSuccessCnt;
		153	property ZipComment: AnsiString read FZipComment write FZipComment;
		154	property ZipFileName: String Read fZipFileName;
		155	end;
		156
		157	implementation
		158
		159	uses
		160	Dialogs, ZMMsg19, ZMDrv19, ZMDelZip19,
		161	ZMUtils19, ZMXcpt19, ZMMsgStr19, ZMEOC19, ZMWorkFile19,
		162	ZMIRec19, ZMUTF819, ZMMatch19, ShellAPI;
		163
		164	const
		165	SPKBACK001 = 'PKBACK#001';
		166	{ File Extensions }
		167	ExtZip = 'zip';
		168	DotExtZip = '.' + ExtZip;
		169	ExtExe = 'exe';
		170	DotExtExe = '.' + ExtExe;
		171	ExtBin = 'bin';
		172	ExtZSX = 'zsx';
		173	{ Identifiers }
		174	DzSfxID = 'DZSFX';
		175
		176	const
		177	MinStubSize = 12000;
		178	MaxStubSize = 80000;
		179	BufSize = 10240;
		180	// 8192; // Keep under 12K to avoid Winsock problems on Win95.
		181	// If chunks are too large, the Winsock stack can
		182	// lose bytes being sent or received.
		183
		184	function WriteCommand(Dest: TMemoryStream; const cmd: string; ident: Integer)
		185	: Integer; Forward;
		186
		187	type
		188	TZMLoader = class(TZMZipFile)
		189	private
		190	fForZip: TZMZipFile;
		191	fname: String;
		192	fSFXWorker: TZMWAux;
		193	procedure SetForZip(const Value: TZMZipFile);
		194	protected
		195	function AddStripped(const rec: TZMIRec): Integer;
		196	function BeforeCommit: Integer; override;
		197	function PrepareDetached: Integer;
		198	function StripEntries: Integer;
		199	public
		200	constructor Create(Wrkr: TZMCore); override;
		201	procedure AfterConstruction; override;
		202	property ForZip: TZMZipFile Read fForZip Write SetForZip;
		203	property SFXWorker: TZMWAux Read fSFXWorker;
		204	end;
		205
		206	type
		207	TFileNameIs = (fiExe, fiZip, fiOther, fiEmpty);
		208
		209	const
		210	SFXBinDefault: string = 'ZMSFX19.bin';
		211	SFXBufSize: Word = $2000;
		212
		213	const
		214	SE_CreateError = -1; // Error in open or creation of OutFile.
		215	SE_CopyError = -2; // Write error or no memory during copy.
		216	SE_OpenReadError = -3; // Error in open or Seek of InFile.
		217	SE_SetDateError = -4; // Error setting date/time of OutFile.
		218	SE_GeneralError = -9;
		219
		220	function WriteIconToStream(Stream: Classes.TStream; Icon: HICON;
		221	Width, Height, Depth: Integer): Integer; forward;
		222
		223	// get the kind of filename
		224	function GetFileNameKind(const sFile: TFileName): TFileNameIs;
		225	var
		226	sExt: String;
		227	begin
		228	if sFile = '' then
		229	Result := fiEmpty
		230	else
		231	begin
		232	sExt := LowerCase(ExtractFileExt(sFile));
		233	if sExt = DotExtZip then
		234	Result := fiZip
		235	else if sExt = DotExtExe then
		236	Result := fiExe
		237	else
		238	Result := fiOther;
		239	end;
		240	end;
		241
		242	function FindFirstIcon(var rec: TImageResourceDataEntry; const iLevel: Integer;
		243	const PointerToRawData: Cardinal; str: TStream): Boolean;
		244	var
		245	i: Integer;
		246	iPos: Integer;
		247	RecDir: TImageResourceDirectory;
		248	RecEnt: TImageResourceDirectoryEntry;
		249	begin
		250	// position must be correct
		251	Result := false;
		252	if (str.Read(RecDir, sizeof(RecDir)) <> sizeof(RecDir)) then
		253	raise EZipMaster.CreateResDisp(CZ_BrowseError, true);
		254
		255	for i := 0 to Pred(RecDir.NumberOfNamedEntries + RecDir.NumberOfIdEntries) do
		256	begin
		257	if (str.Read(RecEnt, sizeof(RecEnt)) <> sizeof(RecEnt)) then
		258	raise EZipMaster.CreateResDisp(CZ_BrowseError, true);
		259
		260	// check if a directory or a resource
		261	iPos := str.Position;
		262	try
		263	if (RecEnt.un2.DataIsDirectory and IMAGE_RESOURCE_DATA_IS_DIRECTORY)
		264	= IMAGE_RESOURCE_DATA_IS_DIRECTORY then
		265	begin
		266	if ((iLevel = 0) and (MakeIntResource(RecEnt.un1.Name) <> RT_ICON)) or
		267	((iLevel = 1) and (RecEnt.un1.Id <> 1)) then
		268	Continue; // not an icon of id 1
		269
		270	str.Seek(RecEnt.un2.OffsetToDirectory and
		271	(not IMAGE_RESOURCE_DATA_IS_DIRECTORY) + PointerToRawData,
		272	soFromBeginning);
		273	Result := FindFirstIcon(rec, iLevel + 1, PointerToRawData, str);
		274	if Result then
		275	Break;
		276	end
		277	else
		278	begin
		279	// is resource bin data
		280	str.Seek(RecEnt.un2.OffsetToData + PointerToRawData, soFromBeginning);
		281	if str.Read(rec, sizeof(rec)) <> sizeof(rec) then
		282	raise EZipMaster.CreateResDisp(CZ_BrowseError, true);
		283	Result := true;
		284	Break;
		285	end;
		286	finally
		287	str.Position := iPos;
		288	end;
		289	end;
		290	end;
		291
		292	procedure LocateFirstIconHeader(str: TStream;
		293	var hdrSection: TImageSectionHeader; var recIcon: TImageResourceDataEntry);
		294	var
		295	bFound: Boolean;
		296	cAddress: Cardinal;
		297	hdrDos: TImageDosHeader;
		298	hdrNT: TImageNTHeaders;
		299	i: Integer;
		300	begin
		301	bFound := false;
		302	// check if we have an executable
		303	str.Seek(0, soFromBeginning);
		304	if (str.Read(hdrDos, sizeof(hdrDos)) <> sizeof(hdrDos)) or
		305	(hdrDos.e_magic <> IMAGE_DOS_SIGNATURE) then
		306	raise EZipMaster.CreateResDisp(CZ_InputNotExe, true);
		307
		308	str.Seek(hdrDos._lfanew, soFromBeginning);
		309	if (str.Read(hdrNT, sizeof(hdrNT)) <> sizeof(hdrNT)) or
		310	(hdrNT.Signature <> IMAGE_NT_SIGNATURE) then
		311	raise EZipMaster.CreateResDisp(CZ_InputNotExe, true);
		312
		313	// check if we have a resource section
		314	with hdrNT.OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_RESOURCE] do
		315	if (VirtualAddress = 0) or (Size = 0) then
		316	raise EZipMaster.CreateResDisp(CZ_NoExeResource, true)
		317	else
		318	cAddress := VirtualAddress; // store address
		319
		320	// iterate over sections
		321	for i := 0 to Pred(hdrNT.FileHeader.NumberOfSections) do
		322	begin
		323	if (str.Read(hdrSection, sizeof(hdrSection)) <> sizeof(hdrSection)) then
		324	raise EZipMaster.CreateResDisp(CZ_ExeSections, true);
		325
		326	// with hdrSection do
		327	if hdrSection.VirtualAddress = cAddress then
		328	begin
		329	bFound := true;
		330	Break;
		331	end;
		332	end;
		333
		334	if not bFound then
		335	raise EZipMaster.CreateResDisp(CZ_NoExeResource, true);
		336
		337	// go to resource data
		338	str.Seek(hdrSection.PointerToRawData, soFromBeginning);
		339
		340	// recourse through the resource dirs to find an icon
		341	if not FindFirstIcon(recIcon, 0, hdrSection.PointerToRawData, str) then
		342	raise EZipMaster.CreateResDisp(CZ_NoExeIcon, true);
		343	end;
		344
		345	// replaces an icon in an executable file (stream)
		346	function GetFirstIcon(str: TMemoryStream): TIcon;
		347	var
		348	bad: Boolean;
		349	delta: Cardinal;
		350	handle: HIcon;
		351	hdrSection: TImageSectionHeader;
		352	icoData: PByte;
		353	icoSize: Cardinal;
		354	recIcon: TImageResourceDataEntry;
		355	begin
		356	bad := true;
		357	Result := nil;
		358	LocateFirstIconHeader(str, hdrSection, recIcon);
		359	delta := Integer(hdrSection.PointerToRawData) - Integer
		360	(hdrSection.VirtualAddress) + Integer(recIcon.OffsetToData);
		361	icoData := PByte(str.Memory);
		362	Inc(icoData, delta);
		363	icoSize := hdrSection.SizeOfRawData;
		364	handle := CreateIconFromResource(icoData, icoSize, true, $30000);
		365	if handle <> 0 then
		366	begin
		367	Result := TIcon.Create;
		368	Result.handle := handle;
		369	bad := false;
		370	end;
		371	if bad then
		372	// no icon copied, so none of matching size found
		373	raise EZipMaster.CreateResDisp(CZ_NoIconFound, true);
		374	end;
		375
		376	// returns size or 0 on error or wrong dimensions
		377	function WriteIconToStream(Stream: Classes.TStream; Icon: HIcon;
		378	Width, Height, Depth: Integer): Integer;
		379	type
		380	PIconRec = ^TIconRec;
		381
		382	TIconRec = packed record
		383	IDir: TIconDir;
		384	IEntry: TIconDirEntry;
		385	end;
		386	const
		387	RC3_ICON = 1;
		388	var
		389	BI: PBITMAPINFO;
		390	BIsize: Integer;
		391	CBits: PByte;
		392	cbm: Bitmap;
		393	cofs: Integer;
		394	colors: Integer;
		395	dc: HDC;
		396	Ico: TIconRec;
		397	IconInfo: TIconInfo;
		398	MBI: BitMapInfo;
		399	MBits: PByte;
		400	mofs: Integer;
		401	begin
		402	Result := 0;
		403
		404	if (Depth <= 4) then
		405	Depth := 4
		406	else if (Depth <= 8) then
		407	Depth := 8
		408	else if (Depth <= 16) then
		409	Depth := 16
		410	else if (Depth <= 24) then
		411	Depth := 24
		412	else
		413	exit;
		414	colors := 1 shl Depth;
		415
		416	BI := nil;
		417	dc := 0;
		418	if GetIconInfo(Icon, IconInfo) then
		419	begin
		420	try
		421	ZeroMemory(@Ico, sizeof(TIconRec));
		422	if GetObject(IconInfo.hbmColor, sizeof(Bitmap), @cbm) = 0 then
		423	exit;
		424	if (Width <> cbm.bmWidth) or (Height <> cbm.bmHeight) then
		425	exit;
		426
		427	// ok should be acceptable
		428	BIsize := sizeof(BitmapInfoHeader);
		429	if (Depth <> 24) then
		430	Inc(BIsize, colors * sizeof(RGBQUAD)); // pallet
		431
		432	cofs := BIsize; // offset to colorbits
		433	Inc(BIsize, (Width * Height * Depth) div 8); // bits
		434	mofs := BIsize; // offset to maskbits
		435	Inc(BIsize, (Width * Height) div 8);
		436
		437	// allocate memory for it
		438	GetMem(BI, BIsize);
		439
		440	ZeroMemory(BI, BIsize);
		441	// set required attributes for colour bitmap
		442	BI^.bmiHeader.BIsize := sizeof(BitmapInfoHeader);
		443	BI^.bmiHeader.biWidth := Width;
		444	BI^.bmiHeader.biHeight := Height;
		445	BI^.bmiHeader.biPlanes := 1;
		446	BI^.bmiHeader.biBitCount := Depth;
		447	BI^.bmiHeader.biCompression := BI_RGB;
		448
		449	CBits := PByte(BI);
		450	Inc(CBits, cofs);
		451
		452	// prepare for mono mask bits
		453	ZeroMemory(@MBI, sizeof(BitMapInfo));
		454	MBI.bmiHeader.BIsize := sizeof(BitmapInfoHeader);
		455	MBI.bmiHeader.biWidth := Width;
		456	MBI.bmiHeader.biHeight := Height;
		457	MBI.bmiHeader.biPlanes := 1;
		458	MBI.bmiHeader.biBitCount := 1;
		459
		460	MBits := PByte(BI);
		461	Inc(MBits, mofs);
		462
		463	dc := CreateCompatibleDC(0);
		464	if dc <> 0 then
		465	begin
		466	if GetDIBits(dc, IconInfo.hbmColor, 0, Height, CBits, BI^,
		467	DIB_RGB_COLORS) > 0 then
		468	begin
		469	// ok get mask bits
		470	if GetDIBits(dc, IconInfo.hbmMask, 0, Height, MBits, MBI,
		471	DIB_RGB_COLORS) > 0 then
		472	begin
		473	// good we have both
		474	DeleteDC(dc); // release it quick before anything can go wrong
		475	dc := 0;
		476	Ico.IDir.ResType := RC3_ICON;
		477	Ico.IDir.ResCount := 1;
		478	Ico.IEntry.bWidth := Width;
		479	Ico.IEntry.bHeight := Height;
		480	Ico.IEntry.bColorCount := Depth;
		481	Ico.IEntry.dwBytesInRes := BIsize;
		482	Ico.IEntry.dwImageOffset := sizeof(TIconRec);
		483	BI^.bmiHeader.biHeight := Height * 2;
		484	// color height includes mask bits
		485	Inc(BI^.bmiHeader.biSizeImage, MBI.bmiHeader.biSizeImage);
		486	if (Stream <> nil) then
		487	begin
		488	Stream.Write(Ico, sizeof(TIconRec));
		489	Stream.Write(BI^, BIsize);
		490	end;
		491	Result := BIsize + sizeof(TIconRec);
		492	end;
		493	end;
		494	end;
		495	finally
		496	if dc <> 0 then
		497	DeleteDC(dc);
		498	DeleteObject(IconInfo.hbmColor);
		499	DeleteObject(IconInfo.hbmMask);
		500	if BI <> nil then
		501	FreeMem(BI);
		502	end;
		503	end
		504	else
		505	RaiseLastOSError;
		506	end;
		507
		508	// replaces an icon in an executable file (stream)
		509	procedure ReplaceIcon(str: TMemoryStream; oIcon: TIcon);
		510	var
		511	bad: Boolean;
		512	hdrSection: TImageSectionHeader;
		513	i: Integer;
		514	oriInfo: BitmapInfoHeader;
		515	pIDE: PIconDirEntry;
		516	recIcon: TImageResourceDataEntry;
		517	strIco: TMemoryStream;
		518	begin
		519	bad := true;
		520	LocateFirstIconHeader(str, hdrSection, recIcon);
		521	str.Seek(Integer(hdrSection.PointerToRawData) - Integer
		522	(hdrSection.VirtualAddress) + Integer(recIcon.OffsetToData),
		523	soFromBeginning);
		524	if (str.Read(oriInfo, sizeof(BitmapInfoHeader)) <> sizeof(BitmapInfoHeader)) then
		525	raise EZipMaster.CreateResDisp(CZ_NoCopyIcon, true);
		526
		527	// now check the icon
		528	strIco := TMemoryStream.Create;
		529	try
		530	if WriteIconToStream(strIco, oIcon.handle, oriInfo.biWidth,
		531	oriInfo.biHeight div 2, oriInfo.biBitCount) <= 0 then
		532	raise EZipMaster.CreateResDisp(CZ_NoIcon, true);
		533
		534	// now search for matching icon
		535	with PIconDir(strIco.Memory)^ do
		536	begin
		537	if (ResType <> RES_ICON) or (ResCount < 1) or (Reserved <> 0) then
		538	raise EZipMaster.CreateResDisp(CZ_NoIcon, true);
		539
		540	for i := 0 to Pred(ResCount) do
		541	begin
		542	pIDE := PIconDirEntry(PAnsiChar(strIco.Memory) + sizeof(TIconDir) +
		543	(i * sizeof(TIconDirEntry)));
		544	if (pIDE^.dwBytesInRes = recIcon.Size) and (pIDE^.bReserved = 0) then
		545	begin
		546	// matching icon found, replace
		547	strIco.Seek(pIDE^.dwImageOffset, soFromBeginning);
		548	str.Seek(Integer(hdrSection.PointerToRawData) - Integer
		549	(hdrSection.VirtualAddress) + Integer(recIcon.OffsetToData),
		550	soFromBeginning);
		551	if str.CopyFrom(strIco, recIcon.Size) <> Integer(recIcon.Size) then
		552	raise EZipMaster.CreateResDisp(CZ_NoCopyIcon, true);
		553
		554	// ok and out
		555	bad := false;
		556	end;
		557	end;
		558	end;
		559	finally
		560	strIco.Free;
		561	end;
		562	if bad then
		563	// no icon copied, so none of matching size found
		564	raise EZipMaster.CreateResDisp(CZ_NoIconFound, true);
		565	end;
		566
		567	{ TZMWAux }
		568
		569	constructor TZMWAux.Create(AMaster: TCustomZipMaster19);
		570	begin
		571	inherited Create(AMaster);
		572	end;
		573
		574	function TZMWAux.BrowseResDir(ResStart, Dir: PIRD; Depth: Integer): PIRDatE;
		575	var
		576	i: Integer;
		577	SingleRes: PIRDirE;
		578	x: PByte;
		579	begin
		580	Result := nil;
		581	x := PByte(Dir);
		582	Inc(x, sizeof(IMAGE_RESOURCE_DIRECTORY));
		583	SingleRes := PIRDirE(x);
		584
		585	for i := 1 to Dir.NumberOfNamedEntries + Dir.NumberOfIdEntries do
		586	begin
		587	Result := SearchResDirEntry(ResStart, SingleRes, Depth);
		588	if Result <> nil then
		589	Break; // Found the one w're looking for.
		590	end;
		591	end;
		592
		593	procedure TZMWAux.Clear;
		594	begin
		595	fZipFileName := '';
		596	fSuccessCnt := 0;
		597	FZipComment := '';
		598	CentralDir.Clear;
		599	Detached := false;
		600	SFXOverwriteMode := ovrConfirm;
		601	fSFXCaption := 'Self-extracting Archive';
		602	fSFXDefaultDir := '';
		603	fSFXCommandLine := '';
		604	inherited;
		605	end;
		606
		607	function TZMWAux.ConvertToSFX(const OutName: string; theZip: TZMZipFile):
		608	Integer;
		609	var
		610	nn: String;
		611	oz: TZMZipCopy;
		612	useTemp: Boolean;
		613	begin
		614	Diag('ConvertToSFX');
		615	if theZip = nil then
		616	theZip := CurrentZip(True); // use Current
		617	Detached := false;
		618	Result := PrepareStub;
		619	if (Result < 0) or not assigned(fSFXBinStream) then
		620	begin
		621	// result:= some error;
		622	exit;
		623	end;
		624	if OutName = '' then
		625	nn := ChangeFileExt(theZip.FileName, DotExtExe)
		626	else
		627	nn := OutName;
		628	useTemp := FileExists(nn);
		629	oz := TZMZipCopy.Create(self);
		630	try
		631	if useTemp then
		632	oz.File_CreateTemp(ExtZSX, '')
		633	else
		634	oz.File_Create(nn);
		635	oz.stub := fSFXBinStream;
		636	fSFXBinStream := nil;
		637	oz.UseSFX := true;
		638	Result := oz.WriteFile(theZip, true);
		639	theZip.File_Close;
		640	if (Result >= 0) then
		641	begin
		642	if useTemp and not oz.File_Rename(nn, HowToDelete <> htdFinal) then
		643	raise EZipMaster.CreateRes2Str(CF_CopyFailed, oz.FileName, nn);
		644	Result := 0;
		645	Set_ZipFileName(nn, zloFull);
		646	end;
		647	finally
		648	oz.Free;
		649	end;
		650	end;
		651
		652	function TZMWAux.ConvertToSpanSFX(const OutFileName: String; theZip:
		653	TZMZipFile): Integer;
		654	var
		655	DiskFile: String;
		656	DiskSerial: Cardinal;
		657	Dummy1: Cardinal;
		658	Dummy2: Cardinal;
		659	FileListSize: Cardinal;
		660	FreeOnDisk1: Cardinal;
		661	KeepFree: Cardinal;
		662	LDiskFree: Cardinal;
		663	MsgStr: String;
		664	OrgKeepFree: Cardinal;
		665	OutDrv: TZMWorkDrive;
		666	PartFileName: String;
		667	RightDiskInserted: Boolean;
		668	SFXName: String;
		669	SplitZip: TZMZipCopy;
		670	VolName: array [0 .. MAX_PATH - 1] of Char;
		671	begin
		672	Detached := true;
		673	// prepare stub
		674	Result := PrepareStub;
		675	if (Result >= 0) and assigned(fSFXBinStream) then
		676	begin
		677	SplitZip := nil;
		678	if theZip = nil then
		679	theZip := CentralDir.Current; // use Current
		680	PartFileName := ChangeFileExt(OutFileName, DotExtZip);
		681	// delete the existing sfx stub
		682	if FileExists(OutFileName) then
		683	DeleteFile(OutFileName);
		684	SFXName := ExtractFileName(ChangeFileExt(OutFileName, DotExtZip));
		685	FileListSize := DetachedSize(theZip);//Current);
		686	OrgKeepFree := KeepFreeOnDisk1;
		687	OutDrv := TZMWorkDrive.Create;
		688	try
		689	// get output parameters
		690	OutDrv.DriveStr := OutFileName;
		691	OutDrv.HasMedia(true); // set media details
		692
		693	// calulate the size of the sfx stub
		694	Result := 0; // is good (at least until it goes bad)
		695
		696	if (not OutDrv.DriveIsFixed) and (MaxVolumeSize = 0) then
		697	begin
		698	MaxVolumeSize := OutDrv.VolumeSize;
		699	end;
		700	// first test if multiple parts are really needed
		701	if (MaxVolumeSize <= 0) or ((theZip.File_Size + fSFXBinStream.Size)
		702	< MaxVolumeSize) then
		703	begin
		704	Diag('Too small for span sfx');
		705	Detached := false;
		706	Result := ConvertToSFX(OutFileName, theZip);
		707	end
		708	else
		709	begin
		710	FileListSize := FileListSize + sizeof(Integer) + sizeof
		711	(TZipEndOfCentral);
		712	if KeepFreeOnDisk1 <= 0 then
		713	KeepFree := 0
		714	else
		715	KeepFree := KeepFreeOnDisk1;
		716	KeepFree := KeepFree + FileListSize;
		717	if OutDrv.VolumeSize > MAXINT then
		718	LDiskFree := MAXINT
		719	else
		720	LDiskFree := Cardinal(OutDrv.VolumeSize);
		721	{ only one set of ' span' params }
		722	if (MaxVolumeSize > 0) and (MaxVolumeSize < LDiskFree) then
		723	LDiskFree := MaxVolumeSize;
		724	if (FileListSize > LDiskFree) then
		725	Result := -SF_DetachedHeaderTooBig;
		726
		727	if Result = 0 then // << moved
		728	begin
		729	if (KeepFree mod OutDrv.VolumeSecSize) <> 0 then
		730	FreeOnDisk1 := ((KeepFree div OutDrv.VolumeSecSize) + 1)
		731	* OutDrv.VolumeSecSize
		732	else
		733	FreeOnDisk1 := KeepFree;
		734
		735	// let the spanslave of the Worker do the spanning <<< bad comment - remove
		736	KeepFreeOnDisk1 := FreeOnDisk1;
		737	SplitZip := TZMZipCopy.Create(self);
		738	SplitZip.FileName := PartFileName;
		739	Result := WriteMulti(theZip, SplitZip, true);
		740	// if all went well - rewrite the loader correctly
		741	if (Result = 0) and not OutDrv.DriveIsFixed then
		742	begin
		743	// for removable disk we need to insert the first again
		744	RightDiskInserted := false;
		745	while not RightDiskInserted do
		746	begin // ask to insert the first disk
		747	MsgStr := ZipFmtLoadStr(DS_InsertAVolume, [1]) + ZipFmtLoadStr
		748	(DS_InDrive, [OutDrv.DriveStr]);
		749
		750	MessageDlg(MsgStr, mtInformation, [mbOK], 0);
		751	// check if right disk is inserted
		752	if SplitZip.Numbering = znsVolume then
		753	begin
		754	GetVolumeInformation(@OutDrv.DriveStr, VolName, MAX_PATH,
		755	@DiskSerial, Dummy1, Dummy2, nil, 0);
		756	if (StrComp(VolName, SPKBACK001) = 0) then
		757	RightDiskInserted := true;
		758	end
		759	else
		760	begin
		761	DiskFile := Copy(PartFileName, 1, Length(PartFileName)
		762	- Length(ExtractFileExt(PartFileName))) + '001.zip';
		763	if FileExists(DiskFile) then
		764	RightDiskInserted := true;
		765	end;
		766	end;
		767	end;
		768	// write the loader
		769	if Result = 0 then
		770	Result := WriteDetached(SplitZip);
		771	end;
		772	end;
		773	finally
		774	FreeAndNil(SplitZip);
		775	FreeAndNil(OutDrv);
		776	// restore original value
		777	KeepFreeOnDisk1 := OrgKeepFree;
		778	end;
		779	end;
		780	if Result < 0 then
		781	CleanupFiles(true);
		782	end;
		783
		784	function TZMWAux.ConvertToZIP: Integer;
		785	var
		786	cz: TZMZipFile;
		787	nn: String;
		788	oz: TZMZipCopy;
		789	useTemp: Boolean;
		790	begin
		791	Diag('ConvertToZip');
		792	cz := CurrentZip(true);
		793	nn := ChangeFileExt(cz.FileName, DotExtZip);
		794	useTemp := FileExists(nn);
		795	oz := TZMZipCopy.Create(self);
		796	try
		797	if useTemp then
		798	oz.File_CreateTemp(ExtZSX, '')
		799	else
		800	oz.File_Create(nn);
		801	Result := oz.WriteFile(cz, true);
		802	cz.File_Close;
		803	if (Result >= 0) then
		804	begin
		805	if useTemp and not oz.File_Rename(nn, HowToDelete <> htdFinal) then
		806	raise EZipMaster.CreateRes2Str(CF_CopyFailed, oz.FileName, nn);
		807	Result := 0;
		808	Set_ZipFileName(nn, zloFull);
		809	end;
		810	finally
		811	oz.Free;
		812	end;
		813	end;
		814
		815	function TZMWAux.CopyBuffer(InFile, OutFile: Integer; ReadLen: Int64)
		816	: Integer;
		817	var
		818	Buffer: array of Byte;
		819	SizeR: Integer;
		820	ToRead: Cardinal;
		821	begin
		822	// both files are already open
		823	Result := 0;
		824	if ReadLen = 0 then
		825	exit;
		826	ToRead := BufSize;
		827	try
		828	SetLength(Buffer, BufSize);
		829	repeat
		830	if ReadLen >= 0 then
		831	begin
		832	ToRead := BufSize;
		833	if ReadLen < ToRead then
		834	ToRead := ReadLen;
		835	end;
		836	SizeR := FileRead(InFile, Buffer[0], ToRead);
		837	if (SizeR < 0) or (FileWrite(OutFile, Buffer[0], SizeR) <> SizeR) then
		838	begin
		839	Result := SE_CopyError;
		840	Break;
		841	end;
		842	if (ReadLen > 0) then
		843	ReadLen := ReadLen - Cardinal(SizeR);
		844	case ShowProgress of
		845	zspFull:
		846	ReportProgress(zacProgress, 0, '', SizeR);
		847	zspExtra:
		848	ReportProgress(zacXProgress, 0, '', SizeR);
		849	else
		850	KeepAlive; // Mostly for winsock.
		851	end;
		852	until ((ReadLen = 0) or (SizeR <> Integer(ToRead)));
		853	except
		854	Result := SE_CopyError;
		855	end;
		856	// leave both files open
		857	end;
		858
		859	function TZMWAux.Copy_File(const InFileName, OutFileName: String): Integer;
		860	var
		861	InFile: Integer;
		862	In_Size: Int64;
		863	OutFile: Integer;
		864	Out_Size: Int64;
		865	begin
		866	In_Size := -1;
		867	Out_Size := -1;
		868	Result := SE_OpenReadError;
		869	ShowProgress := zspNone;
		870
		871	if not FileExists(InFileName) then
		872	exit;
		873	InFile := FileOpen(InFileName, fmOpenRead or fmShareDenyWrite);
		874	if InFile <> -1 then
		875	begin
		876	if FileExists(OutFileName) then
		877	begin
		878	OutFile := FileOpen(OutFileName, fmOpenWrite or fmShareExclusive);
		879	if OutFile = -1 then
		880	begin
		881	Result := SE_CreateError; // might be read-only or source
		882	File_Close(InFile);
		883	exit;
		884	end;
		885	File_Close(OutFile);
		886	EraseFile(OutFileName, HowToDelete = htdFinal);
		887	end;
		888	OutFile := FileCreate(OutFileName);
		889	if OutFile <> -1 then
		890	begin
		891	Result := CopyBuffer(InFile, OutFile, -1);
		892	if (Result = 0) and (FileSetDate(OutFile, FileGetDate(InFile)) <> 0)
		893	then
		894	Result := SE_SetDateError;
		895	Out_Size := FileSeek64(OutFile, Int64(0), soFromEnd);
		896	File_Close(OutFile);
		897	end
		898	else
		899	Result := SE_CreateError;
		900	In_Size := FileSeek64(InFile, Int64(0), soFromEnd);
		901	File_Close(InFile);
		902	end;
		903	// An extra check if the filesizes are the same.
		904	if (Result = 0) and ((In_Size = -1) or (Out_Size = -1) or (In_Size <> Out_Size)
		905	) then
		906	Result := SE_GeneralError;
		907	// Don't leave a corrupted outfile lying around. (SetDateError is not fatal!)
		908	if (Result <> 0) and (Result <> SE_SetDateError) then
		909	SysUtils.DeleteFile(OutFileName);
		910	end;
		911
		912	function TZMWAux.CreateStubStream: Boolean;
		913	const
		914	MinVers = 1900000;
		915	var
		916	binname: string;
		917	BinStub: TStream;
		918	BinVers: Integer;
		919	err: Boolean;
		920	ResStub: TStream;
		921	ResVers: Integer;
		922	stub: TStream;
		923	stubname: string;
		924	UseBin: Boolean;
		925	begin
		926	// what type of bin will be used
		927	stub := nil;
		928	ResStub := nil;
		929	BinStub := nil;
		930	BinVers := -1;
		931	FreeAndNil(fSFXBinStream); // dispose of existing (if any)
		932	try
		933	// load it either from resource (if bcsfx##.res has been linked to the executable)
		934	// or by loading from file in SFXPath and check both versions if available
		935	// ResVersion := '';
		936	stubname := DZRES_SFX;
		937	binname := SFXBinDefault;
		938	err := false; // resource stub not found
		939	if (Length(SFXPath) > 1) and (SFXPath[1] = '>') and
		940	(SFXPath[Length(SFXPath)] = '<') then
		941	begin
		942	// must use from resource
		943	stubname := Copy(SFXPath, 2, Length(SFXPath) - 2);
		944	if stubname = '' then
		945	stubname := DZRES_SFX;
		946	ResVers := LoadFromResource(ResStub, stubname);
		947	if ResVers < MinVers then
		948	err := true;
		949	end
		950	else
		951	begin
		952	// get from resource if it exists
		953	ResVers := LoadFromResource(ResStub, DZRES_SFX);
		954	// load if exists from file
		955	BinVers := LoadFromBinFile(BinStub, UseBin);
		956	if UseBin then
		957	ResVers := 0;
		958	end;
		959	if not err then
		960	begin
		961	// decide which will be used
		962	if (BinVers >= MinVers) and (BinVers >= ResVers) then
		963	stub := BinStub
		964	else
		965	begin
		966	if ResVers >= MinVers then
		967	stub := ResStub
		968	else
		969	err := true;
		970	end;
		971	end;
		972	if stub <> nil then
		973	begin
		974	fSFXBinStream := TMemoryStream.Create();
		975	try
		976	if fSFXBinStream.CopyFrom(stub, stub.Size - sizeof(Integer)) <>
		977	(stub.Size - sizeof(Integer)) then
		978	raise EZipMaster.CreateResDisp(DS_CopyError, true);
		979	fSFXBinStream.Position := 0;
		980	if assigned(SFXIcon) then
		981	ReplaceIcon(fSFXBinStream, SFXIcon);
		982	fSFXBinStream.Position := 0;
		983	except
		984	FreeAndNil(fSFXBinStream);
		985	end;
		986	end;
		987	finally
		988	FreeAndNil(ResStub);
		989	FreeAndNil(BinStub);
		990	end;
		991	if err then
		992	raise EZipMaster.CreateResStr(SF_NoZipSFXBin, stubname);
		993	Result := fSFXBinStream <> nil;
		994	end;
		995
		996	function TZMWAux.CurrentZip(MustExist: Boolean; SafePart: Boolean = false)
		997	: TZMZipFile;
		998	begin
		999	if ZipFileName = '' then
		1000	raise EZipMaster.CreateResDisp(GE_NoZipSpecified, true);
		1001	Result := CentralDir.Current;
		1002	if MustExist and ((zfi_Loaded and Result.info) = 0) then
		1003	raise EZipMaster.CreateResDisp(DS_NoValidZip, true);
		1004	if SafePart and ((zfi_Cancelled and Result.info) <> 0) then
		1005	begin
		1006	if Result.AskAnotherDisk(ZipFileName) = idCancel then
		1007	raise EZipMaster.CreateResDisp(GE_Abort, false);
		1008	Result.info := 0; // clear error
		1009	end;
		1010
		1011	if Result.FileName = '' then
		1012	begin
		1013	// creating new file
		1014	Result.FileName := ZipFileName;
		1015	Result.ReqFileName := ZipFileName;
		1016	end;
		1017	end;
		1018
		1019	function TZMWAux.DetachedSize(zf: TZMZipFile): Integer;
		1020	var
		1021	Data: TZMRawBytes;
		1022	Has64: Boolean;
		1023	i: Integer;
		1024	ix: Integer;
		1025	rec: TZMIRec;
		1026	sz: Integer;
		1027	begin
		1028	Result := -1;
		1029	ASSERT(assigned(zf), 'no input');
		1030	// Diag('Write file');
		1031	if not assigned(zf) then
		1032	exit;
		1033	if fSFXBinStream = nil then
		1034	begin
		1035	Result := PrepareStub;
		1036	if Result < 0 then
		1037	exit;
		1038	end;
		1039	Result := fSFXBinStream.Size;
		1040
		1041	Has64 := false;
		1042	// add approximate central directory size
		1043	for i := 0 to zf.Count - 1 do
		1044	begin
		1045	rec := zf[i];
		1046	Result := Result + sizeof(TZipCentralHeader) + rec.FileNameLength;
		1047	if rec.ExtraFieldLength > 4 then
		1048	begin
		1049	ix := 0;
		1050	sz := 0;
		1051	Data := rec.ExtraField;
		1052	if XData(Data, Zip64_data_tag, ix, sz) then
		1053	begin
		1054	Result := Result + sz;
		1055	Has64 := true;
		1056	end;
		1057	if XData(Data, UPath_Data_Tag, ix, sz) then
		1058	Result := Result + sz;
		1059	if XData(Data, NTFS_data_tag, ix, sz) and (sz >= 36) then
		1060	Result := Result + sz;
		1061	end;
		1062	end;
		1063	Result := Result + sizeof(TZipEndOfCentral);
		1064	if Has64 then
		1065	begin
		1066	// also has EOC64
		1067	Inc(Result, sizeof(TZip64EOCLocator));
		1068	Inc(Result, zf.Z64VSize);
		1069	end;
		1070	end;
		1071
		1072	procedure TZMWAux.Done(Good: Boolean = true);
		1073	var
		1074	czip: TZMZipFile;
		1075	begin
		1076	if not Good then
		1077	begin
		1078	czip := CentralDir.Current;
		1079	if czip.info <> 0 then
		1080	begin
		1081	czip.info := (czip.info and zfi_Cancelled) or zfi_Error;
		1082	end;
		1083	end;
		1084	inherited;
		1085	end;
		1086
		1087	procedure TZMWAux.EncodingChanged(New_Enc: TZMEncodingOpts);
		1088	var
		1089	cz: TZMZipFile;
		1090	begin
		1091	cz := CentralDir.Current;
		1092	cz.Encoding := New_Enc;
		1093	end;
		1094
		1095	procedure TZMWAux.Encoding_CPChanged(New_CP: Cardinal);
		1096	var
		1097	cz: TZMZipFile;
		1098	begin
		1099	cz := CentralDir.Current;
		1100	cz.Encoding_CP := New_CP;
		1101	end;
		1102
		1103	function TZMWAux.GetAuxProperties: Boolean;
		1104	var
		1105	r: Integer;
		1106	czip: TZMZipFile;
		1107	begin
		1108	Result := False; // don't clear
		1109	czip := CentralDir.Current;
		1110	if (czip.info and zfi_DidLoad) <> 0 then
		1111	begin
		1112	if czip.stub <> nil then
		1113	begin
		1114	// read Aux Settings from stub into component
		1115	r := MapSFXSettings(czip.stub);
		1116	if r <> 0 then
		1117	exit; // not easy to show warning
		1118	end;
		1119	if czip.MultiDisk then
		1120	begin
		1121	Master.SpanOptions := czip.MapNumbering(Master.SpanOptions);
		1122	// set multi-disk
		1123	Master.WriteOptions := Master.WriteOptions + [zwoDiskSpan];
		1124	end
		1125	else
		1126	Master.WriteOptions := Master.WriteOptions - [zwoDiskSpan];
		1127	Result := True; // clear AuxChanged
		1128	czip.info := czip.info and (not zfi_DidLoad); // don't clear again
		1129	end;
		1130	end;
		1131
		1132	// if is detached sfx - set stub excluding the detached header
		1133	function TZMWAux.IsDetachSFX(zfile: TZMZipFile): Boolean;
		1134	var
		1135	cstt: Integer;
		1136	ms: TMemoryStream;
		1137	begin
		1138	Result := false;
		1139	try
		1140	zfile.stub := nil; // remove old
		1141	ms := nil;
		1142	if (zfile.IsOpen) and (zfile.DiskNr = 0) and (zfile.Sig = zfsDOS) then
		1143	begin
		1144	// check invalid values
		1145	if (zfile.EOCOffset <= zfile.CentralSize) or
		1146	(zfile.CentralSize < sizeof(TZipCentralHeader)) then
		1147	exit;
		1148	cstt := zfile.EOCOffset - zfile.CentralSize;
		1149	// must have SFX stub but we only check for biggest practical header
		1150	if (cstt < MinStubSize) or (cstt > MaxStubSize) then
		1151	exit;
		1152	if zfile.Seek(0, 0) <> 0 then
		1153	exit;
		1154	ms := TMemoryStream.Create;
		1155	try
		1156	if zfile.ReadTo(ms, cstt + 4) = (cstt + 4) then
		1157	begin
		1158	Result := TrimDetached(ms);
		1159	end;
		1160	finally
		1161	ms.Free;
		1162	end;
		1163	end;
		1164	except
		1165	Result := false;
		1166	FreeAndNil(ms);
		1167	end;
		1168	end;
		1169
		1170	(* ? TZMWAux.IsZipSFX
		1171	Return value:
		1172
		1173	>0 = It is one
		1174	-7 = Open, read or seek error
		1175	-8 = memory error
		1176	-9 = exception error
		1177	-10 = all other exceptions
		1178	*)
		1179	function TZMWAux.IsZipSFX(const SFXExeName: String): Integer;
		1180	const
		1181	SFXsig = zqbStartEXE or zqbHasCentral or zqbHasEOC;
		1182	var
		1183	n: string;
		1184	r: Integer;
		1185	sz: Integer;
		1186	begin
		1187	r := QueryZip(SFXExeName);
		1188	// SFX = 1 + 128 + 64
		1189	Result := 0;
		1190	if (r and SFXsig) = SFXsig then
		1191	Result := CheckSFXType(SFXExeName, n, sz);
		1192	end;
		1193
		1194	function TZMWAux.LoadFromBinFile(var stub: TStream; var Specified: Boolean)
		1195	: Integer;
		1196	var
		1197	BinExists: Boolean;
		1198	binpath: String;
		1199	path: string;
		1200	begin
		1201	Result := -1;
		1202	Specified := false;
		1203	path := SFXPath;
		1204	// if no name specified use default
		1205	if ExtractFileName(SFXPath) = '' then
		1206	path := path + SFXBinDefault;
		1207	binpath := path;
		1208	if (Length(SFXPath) > 1) and
		1209	((SFXPath[1] = '.') or (ExtractFilePath(SFXPath) <> '')) then
		1210	begin
		1211	// use specified
		1212	Specified := true;
		1213	if SFXPath[1] = '.' then // relative to program
		1214	binpath := PathConcat(ExtractFilePath(ParamStr(0)), path);
		1215	BinExists := FileExists(binpath);
		1216	end
		1217	else
		1218	begin
		1219	// Try the application directory.
		1220	binpath := DelimitPath(ExtractFilePath(ParamStr(0)), true) + path;
		1221	BinExists := FileExists(binpath);
		1222	if not BinExists then
		1223	begin
		1224	// Try the current directory.
		1225	binpath := path;
		1226	BinExists := FileExists(binpath);
		1227	end;
		1228	end;
		1229	if BinExists then
		1230	begin
		1231	try
		1232	stub := TFileStream.Create(binpath, fmOpenRead);
		1233	if (stub.Size > MinStubSize) and (stub.Size < MaxStubSize) then
		1234	begin
		1235	stub.ReadBuffer(Result, sizeof(Integer));
		1236	end;
		1237	Diag('found stub: ' + SFXPath + ' ' + VersStr(Result));
		1238	except
		1239	Result := -5;
		1240	end;
		1241	end;
		1242	end;
		1243
		1244	function TZMWAux.LoadFromResource(var stub: TStream; const sfxtyp: String)
		1245	: Integer;
		1246	var
		1247	rname: String;
		1248	begin
		1249	Result := -2;
		1250	rname := sfxtyp;
		1251	stub := OpenResStream(rname, RT_RCDATA);
		1252	if (stub <> nil) and (stub.Size > MinStubSize) and
		1253	(stub.Size < MaxStubSize) then
		1254	begin
		1255	stub.ReadBuffer(Result, sizeof(Integer));
		1256	Diag('resource stub: ' + VersStr(Result));
		1257	end;
		1258	end;
		1259
		1260	procedure TZMWAux.LoadZip(const ZipName: String; NoEvent: Boolean);
		1261	{ all work is local - no DLL calls }
		1262	var
		1263	r: Integer;
		1264	tmpDirUpdate: TNotifyEvent;
		1265	begin
		1266	ClearErr;
		1267	CentralDir.Current := nil; // close and remove any old file
		1268	if ZipName <> '' then
		1269	begin
		1270	CentralDir.Current.FileName := ZipName;
		1271	r := CentralDir.Current.Open(false, false);
		1272	if r >= 0 then
		1273	begin
		1274	CentralDir.Current.File_Close;
		1275	FZipComment := CentralDir.ZipComment;
		1276	end
		1277	else
		1278	begin
		1279	if r = -DS_NoInFile then
		1280	begin
		1281	// just report no file - may be intentional
		1282	ErrCode := DS_NoInFile;
		1283	ErrMessage := ZipLoadStr(DS_NoInFile);
		1284	end
		1285	else
		1286	ShowZipMsg(-r, true);
		1287	end;
		1288	end;
		1289	if not NoEvent then
		1290	begin
		1291	tmpDirUpdate := Master.OnDirUpdate;
		1292	if assigned(tmpDirUpdate) then
		1293	tmpDirUpdate(Master);
		1294	end;
		1295	end;
		1296
		1297	function TZMWAux.MapOptionsFromStub(opts: Word): TZMSFXOpts;
		1298	begin
		1299	Result := [];
		1300	if (so_AskCmdLine and opts) <> 0 then
		1301	Result := Result + [soAskCmdLine];
		1302	if (so_AskFiles and opts) <> 0 then
		1303	Result := Result + [soAskFiles];
		1304	if (so_HideOverWriteBox and opts) <> 0 then
		1305	Result := Result + [soHideOverWriteBox];
		1306	if (so_AutoRun and opts) <> 0 then
		1307	Result := Result + [soAutoRun];
		1308	if (so_NoSuccessMsg and opts) <> 0 then
		1309	Result := Result + [soNoSuccessMsg];
		1310	if (so_ExpandVariables and opts) <> 0 then
		1311	Result := Result + [soExpandVariables];
		1312	if (so_InitiallyHideFiles and opts) <> 0 then
		1313	Result := Result + [soInitiallyHideFiles];
		1314	if (so_ForceHideFiles and opts) <> 0 then
		1315	Result := Result + [soForceHideFiles];
		1316	if (so_CheckAutoRunFileName and opts) <> 0 then
		1317	Result := Result + [soCheckAutoRunFileName];
		1318	if (so_CanBeCancelled and opts) <> 0 then
		1319	Result := Result + [soCanBeCancelled];
		1320	if (so_CreateEmptyDirs and opts) <> 0 then
		1321	Result := Result + [soCreateEmptyDirs];
		1322	if (so_SuccessAlways and opts) <> 0 then
		1323	Result := Result + [soSuccessAlways];
		1324	end;
		1325
		1326	function TZMWAux.MapOptionsToStub(opts: TZMSFXOpts): Word;
		1327	begin
		1328	Result := 0;
		1329	if soAskCmdLine in opts then
		1330	Result := Result or so_AskCmdLine;
		1331	if soAskFiles in opts then
		1332	Result := Result or so_AskFiles;
		1333	if soHideOverWriteBox in opts then
		1334	Result := Result or so_HideOverWriteBox;
		1335	if soAutoRun in opts then
		1336	Result := Result or so_AutoRun;
		1337	if soNoSuccessMsg in opts then
		1338	Result := Result or so_NoSuccessMsg;
		1339	if soExpandVariables in opts then
		1340	Result := Result or so_ExpandVariables;
		1341	if soInitiallyHideFiles in opts then
		1342	Result := Result or so_InitiallyHideFiles;
		1343	if soForceHideFiles in opts then
		1344	Result := Result or so_ForceHideFiles;
		1345	if soCheckAutoRunFileName in opts then
		1346	Result := Result or so_CheckAutoRunFileName;
		1347	if soCanBeCancelled in opts then
		1348	Result := Result or so_CanBeCancelled;
		1349	if soCreateEmptyDirs in opts then
		1350	Result := Result or so_CreateEmptyDirs;
		1351	if soSuccessAlways in opts then
		1352	Result := Result or so_SuccessAlways;
		1353	end;
		1354
		1355	function TZMWAux.MapOverwriteModeFromStub(ovr: Word): TZMOvrOpts;
		1356	begin
		1357	case ovr of
		1358	som_Overwrite:
		1359	Result := ovrAlways;
		1360	som_Skip:
		1361	Result := ovrNever;
		1362	else
		1363	Result := ovrConfirm;
		1364	end;
		1365	end;
		1366
		1367	function TZMWAux.MapOverwriteModeToStub(mode: TZMOvrOpts): Word;
		1368	begin
		1369	case mode of
		1370	ovrAlways:
		1371	Result := som_Overwrite;
		1372	ovrNever:
		1373	Result := som_Skip;
		1374	else
		1375	Result := som_Ask;
		1376	end;
		1377	end;
		1378
		1379	function TZMWAux.NewSFXFile(const ExeName: String): Integer;
		1380	var
		1381	eoc: TZipEndOfCentral;
		1382	fs: TFileStream;
		1383	begin
		1384	Diag('Write empty SFX');
		1385	fs := nil;
		1386	Result := PrepareStub;
		1387	if Result <> 0 then
		1388	exit;
		1389	try
		1390	Result := -DS_FileError;
		1391	eoc.HeaderSig := EndCentralDirSig;
		1392	eoc.ThisDiskNo := 0;
		1393	eoc.CentralDiskNo := 0;
		1394	eoc.CentralEntries := 0;
		1395	eoc.TotalEntries := 0;
		1396	eoc.CentralSize := 0;
		1397	eoc.CentralOffset := 0;
		1398	eoc.ZipCommentLen := 0;
		1399	fSFXBinStream.WriteBuffer(eoc, sizeof(eoc));
		1400	Result := 0;
		1401	fSFXBinStream.Position := 0;
		1402	fs := TFileStream.Create(ExeName, fmCreate);
		1403	Result := fs.CopyFrom(fSFXBinStream, fSFXBinStream.Size);
		1404	if Result <> fSFXBinStream.Size then
		1405	Result := -DS_WriteError
		1406	else
		1407	Result := 0;
		1408	Diag('finished write empty SFX');
		1409	finally
		1410	FreeAndNil(fs);
		1411	FreeAndNil(fSFXBinStream);
		1412	end;
		1413	end;
		1414
		1415	function TZMWAux.NewSFXStub: TMemoryStream;
		1416	begin
		1417	Result := nil;
		1418	if PrepareStub = 0 then
		1419	Result := ReleaseSFXBin;
		1420	end;
		1421
		1422	function TZMWAux.PrepareStub: Integer;
		1423	var
		1424	cdata: TSFXStringsData;
		1425	dflt: TZMDeflates;
		1426	ds: TMemoryStream;
		1427	i: Integer;
		1428	l: Integer;
		1429	ms: TMemoryStream;
		1430	SFXBlkSize: Integer;
		1431	SFXHead: TSFXFileHeader;
		1432	begin
		1433	Result := -GE_Unknown;
		1434	if not CreateStubStream then
		1435	exit;
		1436	try
		1437	// create header
		1438	SFXHead.Signature := SFX_HEADER_SIG;
		1439	SFXHead.Options := MapOptionsToStub(SFXOptions);
		1440	SFXHead.DefOVW := MapOverwriteModeToStub(SFXOverwriteMode);
		1441	SFXHead.StartMsgType := fSFXMessageFlags;
		1442	ds := nil;
		1443	ms := TMemoryStream.Create;
		1444	try
		1445	WriteCommand(ms, SFXCaption, sc_Caption);
		1446	WriteCommand(ms, SFXCommandLine, sc_CmdLine);
		1447	WriteCommand(ms, SFXDefaultDir, sc_Path);
		1448	WriteCommand(ms, SFXMessage, sc_StartMsg);
		1449	WriteCommand(ms, RegFailPath, sc_RegFailPath);
		1450	l := 0;
		1451	ms.WriteBuffer(l, 1);
		1452	// check string lengths
		1453	if ms.Size > 4000 then
		1454	raise EZipMaster.CreateResDisp(SF_StringTooLong, true);
		1455
		1456	if ms.Size > 100 then
		1457	begin
		1458	cdata.USize := ms.Size;
		1459	ms.Position := 0;
		1460	ds := TMemoryStream.Create;
		1461	dflt := ZMDeflate;
		1462	Deflate(ds, ms, ms.Size, dflt, cdata.crc);
		1463	cdata.CSize := ds.Size;
		1464	if (dflt = ZMDeflate) and (ms.Size > (cdata.CSize + sizeof(cdata))) then
		1465	begin
		1466	// use compressed
		1467	ms.Size := 0;
		1468	ds.Position := 0;
		1469	ms.WriteBuffer(cdata, sizeof(cdata));
		1470	ms.CopyFrom(ds, ds.Size);
		1471	SFXHead.Options := SFXHead.Options or so_CompressedCmd;
		1472	end;
		1473	end;
		1474	// DWord Alignment.
		1475	i := ms.Size and 3;
		1476	if i <> 0 then
		1477	ms.WriteBuffer(l, 4 - i); // dword align
		1478	SFXBlkSize := sizeof(TSFXFileHeader) + ms.Size;
		1479	// // create header
		1480	SFXHead.Size := Word(SFXBlkSize);
		1481
		1482	fSFXBinStream.Seek(0, soFromEnd);
		1483	fSFXBinStream.WriteBuffer(SFXHead, sizeof(SFXHead));
		1484	l := SFXBlkSize - sizeof(SFXHead);
		1485	i := ms.Size;
		1486	if i > 0 then
		1487	begin
		1488	ms.Position := 0;
		1489	fSFXBinStream.CopyFrom(ms, i);
		1490	Dec(l, i);
		1491	end;
		1492	// check DWORD align
		1493	if l <> 0 then
		1494	raise EZipMaster.CreateResDisp(AZ_InternalError, true);
		1495
		1496	Result := 0;
		1497	finally
		1498	ms.Free;
		1499	ds.Free;
		1500	end;
		1501	except
		1502	on E: EZipMaster do
		1503	begin
		1504	FreeAndNil(fSFXBinStream);
		1505	ShowExceptionError(E);
		1506	Result := -E.ResId;
		1507	end
		1508	else
		1509	begin
		1510	FreeAndNil(fSFXBinStream);
		1511	Result := -GE_Unknown;
		1512	end;
		1513	end;
		1514	end;
		1515
		1516	function TZMWAux.ReadSpan(const InFileName: String; var OutFilePath: String;
		1517	UseXProgress: Boolean): Integer;
		1518	var
		1519	fd: TZMZipCopy;
		1520	fs: TZMZipFile;
		1521	begin
		1522	ClearErr;
		1523	ShowProgress := zspNone;
		1524	fd := nil;
		1525	fs := nil;
		1526	Result := 0;
		1527
		1528	try
		1529	try
		1530	// If we don't have a filename we make one first.
		1531	if ExtractFileName(OutFilePath) = '' then
		1532	begin
		1533	OutFilePath := MakeTempFileName('', '');
		1534	if OutFilePath = '' then
		1535	Result := -DS_NoTempFile;
		1536	end
		1537	else
		1538	begin
		1539	EraseFile(OutFilePath, HowToDelete = htdFinal);
		1540	OutFilePath := ChangeFileExt(OutFilePath, EXT_ZIP);
		1541	end;
		1542
		1543	if Result = 0 then
		1544	begin
		1545	fs := TZMZipFile.Create(self);
		1546	// Try to get the last disk from the user if part of Volume numbered set
		1547	fs.FileName := InFileName;
		1548	Result := fs.Open(false, false);
		1549	end;
		1550	if Result >= 0 then
		1551	begin
		1552	// InFileName opened successfully
		1553	Result := -DS_NoOutFile;
		1554	fd := TZMZipCopy.Create(self);
		1555	if fd.File_Create(OutFilePath) then
		1556	begin
		1557	if UseXProgress then
		1558	fd.ShowProgress := zspExtra
		1559	else
		1560	fd.ShowProgress := zspFull;
		1561	if UseXProgress then
		1562	fd.EncodeAs := zeoUTF8; // preserve file names for internal operations
		1563	Result := fd.WriteFile(fs, true);
		1564	end;
		1565	end;
		1566	if Result < 0 then
		1567	ShowZipMessage(-Result, '');
		1568	except
		1569	on ers: EZipMaster do
		1570	begin
		1571	// All ReadSpan specific errors.
		1572	ShowExceptionError(ers);
		1573	Result := -7;
		1574	end;
		1575	on E: Exception do
		1576	begin
		1577	// The remaining errors, should not occur.
		1578	ShowZipMessage(DS_ErrorUnknown, E.Message);
		1579	Result := -9;
		1580	end;
		1581	end;
		1582	finally
		1583	FreeAndNil(fs);
		1584	if (fd <> nil) and (fd.IsOpen) then
		1585	begin
		1586	fd.File_Close;
		1587	if Result <> 0 then
		1588	begin
		1589	// An error somewhere, OutFile is not reliable.
		1590	SysUtils.DeleteFile(OutFilePath);
		1591	OutFilePath := '';
		1592	end;
		1593	end;
		1594	FreeAndNil(fd);
		1595	end;
		1596	end;
		1597
		1598	(* ? TZMWAux.Recreate
		1599	recreate the 'theZip' file from the intermediate result
		1600	to make as SFX
		1601	- theZip.UseSFX is set
		1602	- theZip.Stub must hold the stub to use
		1603	*)
		1604	function TZMWAux.Recreate(Intermed, theZip: TZMZipFile): Integer;
		1605	var
		1606	czip: TZMZipFile;
		1607	DestZip: TZMZipCopy;
		1608	detchSFX: Boolean;
		1609	detchsz: Integer;
		1610	existed: Boolean;
		1611	r: Integer;
		1612	tmp: String;
		1613	wantNewDisk: Boolean;
		1614	begin
		1615	detchsz := 0;
		1616	detchSFX := false;
		1617	existed := (zfi_Loaded and theZip.info) <> 0;
		1618	if theZip.MultiDisk or ((not existed) and (zwoDiskSpan in theZip.WriteOptions)) then
		1619	begin
		1620	if Verbosity >= zvVerbose then
		1621	Diag('Recreate multi-part: ' + theZip.ReqFileName);
		1622	if theZip.UseSFX then
		1623	detchSFX := true;
		1624	Result := -GE_Unknown;
		1625	Intermed.File_Close;
		1626	czip := theZip;
		1627	// theZip must have proper stub
		1628	if detchSFX and not assigned(czip.stub) then
		1629	begin
		1630	Result := -CF_SFXCopyError; // no stub available - cannot convert
		1631	exit;
		1632	end;
		1633	wantNewDisk := true; // assume need to ask for new disk
		1634	if existed then
		1635	begin
		1636	czip.GetNewDisk(0, true); // ask to enter the first disk again
		1637	czip.File_Close;
		1638	wantNewDisk := false;
		1639	end;
		1640	tmp := theZip.ReqFileName;
		1641	if detchSFX then
		1642	begin
		1643	if Verbosity >= zvVerbose then // Verbose or Trace then
		1644	Diag('Recreate detached SFX');
		1645	// allow room detchSFX stub
		1646	detchsz := DetachedSize(Intermed);
		1647	tmp := ChangeFileExt(tmp, EXT_ZIP); // name of the zip files
		1648	end;
		1649	// now create the spanned archive similar to theZip from Intermed
		1650	DestZip := TZMZipCopy.Create(self);
		1651	try
		1652	DestZip.Boss := theZip.Boss;
		1653	DestZip.WriteOptions := theZip.WriteOptions;
		1654	DestZip.FileName := tmp;
		1655	DestZip.ReqFileName := theZip.ReqFileName;
		1656	DestZip.KeepFreeOnDisk1 := DestZip.KeepFreeOnDisk1 + Cardinal(detchsz);
		1657	DestZip.ShowProgress := zspExtra;
		1658	DestZip.TotalDisks := 0;
		1659	if detchSFX and (DestZip.Numbering = znsExt) then
		1660	DestZip.Numbering := znsName//;
		1661	else
		1662	DestZip.Numbering := theZip.Numbering; // number same as source
		1663	DestZip.PrepareWrite(zwMultiple);
		1664	DestZip.NewDisk := wantNewDisk;
		1665	// DestZip.DiskNr := 0;
		1666	DestZip.File_Size := Intermed.File_Size; // to calc TotalDisks
		1667	Intermed.File_Open(fmOpenRead);
		1668	DestZip.StampDate := Intermed.FileDate;
		1669	AnswerAll := AnswerAll + [zaaYesOvrwrt];
		1670	r := DestZip.WriteFile(Intermed, true);
		1671	DestZip.File_Close;
		1672	if r < 0 then
		1673	raise EZipMaster.CreateResDisp(-r, true);
		1674	if detchSFX then
		1675	begin
		1676	DestZip.FileName := DestZip.CreateMVFileNameEx(tmp, false, false);
		1677	DestZip.GetNewDisk(0, false);
		1678	DestZip.AssignStub(czip);
		1679	DestZip.FileName := tmp; // restore base name
		1680	if WriteDetached(DestZip) >= 0 then
		1681	Result := 0;
		1682	end
		1683	else
		1684	Result := 0;
		1685	finally
		1686	Intermed.File_Close;
		1687	DestZip.Free;
		1688	end;
		1689	theZip.Invalidate; // must reload
		1690	end
		1691	else
		1692	// not split
		1693	Result := RecreateSingle(Intermed, theZip); // just copy it
		1694	end;
		1695
		1696	// recreate main file (ZipFileName) from temporary file (TmpZipName)
		1697	function TZMWAux.RecreateMVArchive(const TmpZipName: String; Recreate:
		1698	Boolean): Boolean;
		1699	var
		1700	OutPath: String;
		1701	r: Integer;
		1702	tmp: String;
		1703	tzip: TZMZipFile;
		1704	begin
		1705	Result := false;
		1706	try
		1707	tzip := TZMZipFile.Create(self);
		1708
		1709	tzip.FileName := CentralDir.Current.FileName;
		1710	tzip.DiskNr := -1;
		1711	tzip.IsMultiPart := true;
		1712	if Recreate then
		1713	begin
		1714	try
		1715	tzip.GetNewDisk(0, true); // ask to enter the first disk again
		1716	tzip.File_Close;
		1717	except
		1718	on E: Exception do
		1719	begin
		1720	SysUtils.DeleteFile(TmpZipName); // delete the temp file
		1721	raise ; // throw last exception again
		1722	end;
		1723	end;
		1724	end;
		1725
		1726	if AnsiSameText('.exe', ExtractFileExt(ZipFileName)) then
		1727	begin // make 'detached' SFX
		1728	OutPath := ZipFileName; // remember it
		1729	Set_ZipFileName(TmpZipName, zloFull); // reload
		1730	// create an header first to now its size
		1731	tmp := ExtractFileName(OutPath);
		1732	r := ConvertToSpanSFX(OutPath, CentralDir.Current);
		1733	if r >= 0 then
		1734	begin
		1735	SysUtils.DeleteFile(TmpZipName);
		1736	Set_ZipFileName(OutPath, zloNoLoad); // restore it
		1737	end
		1738	else
		1739	begin
		1740	SuccessCnt := 0; // failed
		1741	ShowZipMessage(DS_NoOutFile, 'Error ' + IntToStr(r));
		1742	end;
		1743	end { if SameText(...) }
		1744	else
		1745	begin
		1746	if Recreate then
		1747	// reproduce orig numbering
		1748	SpanOptions := CentralDir.Current.MapNumbering(SpanOptions);
		1749	if WriteSpan(TmpZipName, ZipFileName, true) <> 0 then
		1750	SuccessCnt := 0;
		1751	SysUtils.DeleteFile(TmpZipName);
		1752	end;
		1753	finally
		1754	FreeAndNil(tzip);
		1755	end;
		1756	end;
		1757
		1758	(* ? TZMWAux.RecreateSingle
		1759	Recreate the 'current' file from the intermediate result
		1760	to make as SFX
		1761	- Current.UseSFX is set
		1762	- Current.Stub must hold the stub to use
		1763	*)
		1764	function TZMWAux.RecreateSingle(Intermed, theZip: TZMZipFile): Integer;
		1765	var
		1766	DestZip: TZMZipCopy;
		1767	begin
		1768	theZip.File_Close;
		1769	if Verbosity >= zvVerbose then
		1770	Diag('Replacing: ' + theZip.ReqFileName);
		1771	Result := EraseFile(theZip.ReqFileName, theZip.Worker.HowToDelete = htdAllowUndo);
		1772	if Result > 0 then
		1773	raise EZipMaster.CreateResDisp(DS_WriteError, true);
		1774	// rename/copy Intermed
		1775	AnswerAll := AnswerAll + [zaaYesOvrwrt];
		1776	if assigned(theZip.stub) and theZip.UseSFX and (Intermed.Sig <> zfsDOS)
		1777	then
		1778	begin // rebuild with sfx
		1779	if Verbosity >= zvVerbose then
		1780	Diag('Rebuild with SFX');
		1781	Intermed.File_Close;
		1782	Intermed.File_Open(fmOpenRead);
		1783	Result := Intermed.Open(false, false);
		1784	if Result < 0 then
		1785	exit;
		1786	DestZip := TZMZipCopy.Create(self);
		1787	try
		1788	DestZip.Boss := theZip.Boss;
		1789	DestZip.WriteOptions := theZip.WriteOptions;
		1790	DestZip.AssignStub(theZip);
		1791	DestZip.UseSFX := true;
		1792	DestZip.StampDate := Intermed.StampDate; // will be 'orig' or now
		1793	DestZip.DiskNr := 0;
		1794	DestZip.ZipComment := theZip.ZipComment; // keep orig
		1795	DestZip.ShowProgress := zspExtra;
		1796	DestZip.File_Create(theZip.ReqFileName);
		1797	Result := DestZip.WriteFile(Intermed, true);
		1798	Intermed.File_Close;
		1799	DestZip.File_Close;
		1800	if Result < 0 then
		1801	raise EZipMaster.CreateResDisp(-Result, true);
		1802	finally
		1803	DestZip.Free;
		1804	end;
		1805	end
		1806	else
		1807	begin
		1808	theZip.File_Close;
		1809	Result := -DS_FileError;
		1810	if Intermed.File_Rename(theZip.ReqFileName) then
		1811	Result := 0;
		1812	end;
		1813	theZip.Invalidate; // changed - must reload
		1814	end;
		1815
		1816	function TZMWAux.RejoinMVArchive(var TmpZipName: String): Integer;
		1817	var
		1818	Attrs: Integer;
		1819	curz: TZMZipFile;
		1820	drt: Integer;
		1821	tempzip: TZMZipCopy;
		1822	tmpMessage: TZMMessageEvent;
		1823	zname: String;
		1824	begin
		1825	zname := ZipFileName;
		1826	TmpZipName := MakeTempFileName('', '');
		1827	if Verbosity >= zvVerbose then
		1828	begin
		1829	tmpMessage := Master.OnMessage;
		1830	if assigned(tmpMessage) then
		1831	tmpMessage(Master, 0, ZipFmtLoadStr(GE_TempZip, [TmpZipName]));
		1832	end;
		1833	Result := 0;
		1834	if CentralDir.Current.TotalEntries > 0 then
		1835	begin
		1836	if (AddFreshen in AddOptions) or (AddUpdate in AddOptions) then
		1837	begin
		1838	// is it detached SFX
		1839	if CentralDir.Current.MultiDisk and (CentralDir.Current.Sig = zfsDOS)
		1840	then
		1841	// load the actual zip instead of the loader (without events)
		1842	LoadZip(ChangeFileExt(zname, EXT_ZIPL), true);
		1843
		1844	curz := CentralDir.Current;
		1845	// test if output can eventually be produced
		1846	drt := curz.WorkDrive.DriveType;
		1847	// we can't re-write on a CD-ROM
		1848
		1849	if (drt = DRIVE_CDROM) then
		1850	begin
		1851	Attrs := FileGetAttr(zname);
		1852	if Attrs and faReadOnly <> 0 then
		1853	begin
		1854	ShowZipFmtMsg(DS_NotChangeable, [zname], true);
		1855	Result := -7;
		1856	exit;
		1857	end;
		1858	end;
		1859	// rebuild a temp archive
		1860	Result := DS_FileError;
		1861	tempzip := TZMZipCopy.Create(self);
		1862	try
		1863	if tempzip.File_Create(TmpZipName) then
		1864	begin
		1865	tempzip.ShowProgress := zspExtra;
		1866	if curz.File_Open(fmOpenRead) then
		1867	begin
		1868	// tempzip.AddOptions := [];
		1869	tempzip.EncodeAs := zeoUTF8;
		1870	Result := tempzip.WriteFile(curz, true);
		1871	end;
		1872	end;
		1873	finally
		1874	tempzip.Free;
		1875	curz.File_Close;
		1876	end;
		1877	end;
		1878	if Result <> 0 then
		1879	begin
		1880	ErrCode := Result;
		1881	Result := ErrCode;
		1882	exit;
		1883	end;
		1884	AnswerAll := AnswerAll + [zaaYesOvrwrt];
		1885	end;
		1886	Result := 0;
		1887	end;
		1888
		1889	function TZMWAux.ReleaseSFXBin: TMemoryStream;
		1890	begin
		1891	Result := fSFXBinStream;
		1892	fSFXBinStream := nil;
		1893	end;
		1894
		1895	function TZMWAux.RemakeTemp(temp: TZMZipFile; Recreate, detach: Boolean)
		1896	: Integer;
		1897	var
		1898	czip: TZMZipFile;
		1899	fd: TZMZipCopy;
		1900	r: Integer;
		1901	tmp: String;
		1902	wantNewDisk: Boolean;
		1903	begin
		1904	Result := -GE_Unknown;
		1905	temp.File_Close;
		1906	try
		1907	czip := CentralDir.Current;
		1908	// Current must have proper stub
		1909	if detach and not assigned(czip.stub) then
		1910	begin
		1911	Result := -CF_SFXCopyError; // no stub available - cannot convert
		1912	exit;
		1913	end;
		1914	wantNewDisk := true; // assume need to ask for new disk
		1915	if (zfi_Loaded and czip.info) = 0 then
		1916	Recreate := false; // was no file
		1917	if Recreate then
		1918	begin
		1919	czip.GetNewDisk(0, true); // ask to enter the first disk again
		1920	czip.File_Close;
		1921	wantNewDisk := false;
		1922	end;
		1923	tmp := ZipFileName;
		1924	// now create the spanned archive
		1925	fd := TZMZipCopy.Create(self);
		1926	try
		1927	if detach then
		1928	begin
		1929	// allow room detached stub
		1930	tmp := ExtractFileName(tmp);
		1931	fd.KeepFreeOnDisk1 := KeepFreeOnDisk1 + Cardinal(DetachedSize(temp));
		1932	// write the temp zipfile to the right target:
		1933	tmp := ChangeFileExt(ZipFileName, EXT_ZIP); // name of the zip files
		1934	end;
		1935	fd.FileName := tmp;
		1936	fd.NewDisk := wantNewDisk;
		1937	fd.StampDate := temp.StampDate;
		1938	fd.ShowProgress := zspExtra;
		1939	fd.TotalDisks := 0;
		1940	fd.PrepareWrite(zwMultiple);
		1941	fd.DiskNr := 0;
		1942	fd.File_Size := temp.File_Size; // to calc TotalDisks
		1943	temp.File_Open(fmOpenRead);
		1944	AnswerAll := AnswerAll + [zaaYesOvrwrt];
		1945	r := fd.WriteFile(temp, true);
		1946	if r < 0 then
		1947	raise EZipMaster.CreateResDisp(-r, true);
		1948	fd.File_Close;
		1949	if detach then
		1950	begin
		1951	fd.GetNewDisk(0, false);
		1952	if WriteDetached(fd) >= 0 then
		1953	Result := 0;
		1954	end
		1955	else
		1956	Result := 0;
		1957	finally
		1958	fd.Free;
		1959	end;
		1960	CentralDir.Current := nil; // force reload
		1961	except
		1962	on z: EZipMaster do
		1963	begin
		1964	Result := -z.ResId;
		1965	end;
		1966	on E: Exception do
		1967	begin
		1968	Result := -GE_Unknown;
		1969	end;
		1970	end;
		1971	end;
		1972
		1973	function TZMWAux.SearchResDirEntry(ResStart: PIRD; entry: PIRDirE;
		1974	Depth: Integer): PIRDatE;
		1975	var
		1976	x: PByte;
		1977	begin
		1978	Result := nil;
		1979	if entry.un1.NameIsString <> 0 then
		1980	exit; // No named resources.
		1981	if (Depth = 0) and (entry.un1.Id <> 3) then
		1982	exit; // Only icon resources.
		1983	if (Depth = 1) and (entry.un1.Id <> 1) then
		1984	exit; // Only icon with ID 0x1.
		1985	if entry.un2.DataIsDirectory = 0 then
		1986	begin
		1987	x := PByte(ResStart);
		1988	Inc(x, entry.un2.OffsetToData);
		1989	Result := PIRDatE(x);
		1990	end
		1991	else
		1992	begin
		1993	x := PByte(ResStart);
		1994	Inc(x, entry.un2.OffsetToDirectory);
		1995	Result := BrowseResDir(ResStart, PIRD(x), Depth + 1);
		1996	end;
		1997	end;
		1998
		1999	procedure TZMWAux.SetSFXCommandLine(const Value: String);
		2000	begin
		2001	if fSFXCommandLine <> Value then
		2002	fSFXCommandLine := Value;
		2003	end;
		2004
		2005	procedure TZMWAux.Set_ZipFileName(const zname: String; Load: TZLoadOpts);
		2006	begin
		2007	fZipFileName := zname;
		2008	if Load <> zloNoLoad then
		2009	LoadZip(zname, Load = zloSilent); // automatically load the file
		2010	end;
		2011
		2012	procedure TZMWAux.StartUp;
		2013	var
		2014	Want: Integer;
		2015	begin
		2016	inherited;
		2017	SFXOverwriteMode := Master.SFXOverwriteMode;
		2018	RegFailPath := Master.SFXRegFailPath;
		2019	SFXCaption := Master.SFXCaption;
		2020	SFXCommandLine := Master.SFXCommandLine;
		2021	SFXDefaultDir := Master.SFXDefaultDir;
		2022	if assigned(Master.SFXIcon) then
		2023	begin
		2024	fSFXIcon := TIcon.Create;
		2025	fSFXIcon.Assign(Master.SFXIcon);
		2026	end;
		2027	SFXMessage := Master.SFXMessage;
		2028	fSFXMessageFlags := MB_OK;
		2029	if (Length(SFXMessage) >= 1) then
		2030	begin
		2031	Want := 1; // want the lot
		2032	if (Length(SFXMessage) > 1) and (SFXMessage[2] = '\|') then
		2033	begin
		2034	case SFXMessage[1] of
		2035	'1':
		2036	fSFXMessageFlags := MB_OKCANCEL or MB_ICONINFORMATION;
		2037	'2':
		2038	fSFXMessageFlags := MB_YESNO or MB_ICONQUESTION;
		2039	'\|': Want := 2;
		2040	end;
		2041	if fSFXMessageFlags <> MB_OK then
		2042	Want := 3;
		2043	end;
		2044	if Want > 1 then
		2045	SFXMessage := Copy(SFXMessage, Want, 2048);
		2046	end;
		2047	SFXOptions := Master.SFXOptions;
		2048	SFXPath := Master.SFXPath;
		2049	end;
		2050
		2051	function TZMWAux.TrimDetached(stub: TMemoryStream): Boolean;
		2052	type
		2053	T_header = packed record
		2054	Sig: DWORD;
		2055	Size: Word;
		2056	x: Word;
		2057	end;
		2058	P_header = ^T_header;
		2059	var
		2060	i: Integer;
		2061	NumSections: Integer;
		2062	p: PByte;
		2063	phed: P_header;
		2064	sz: Cardinal;
		2065	begin
		2066	Result := false;
		2067	if (stub <> nil) and (stub.Size > MinStubSize) then
		2068	begin
		2069	sz := 0;
		2070	p := stub.Memory;
		2071	if (PImageDosHeader(p).e_magic <> IMAGE_DOS_SIGNATURE) then
		2072	exit;
		2073	Inc(p, PImageDosHeader(p)._lfanew);
		2074	if PCardinal(p)^ <> IMAGE_PE_SIGNATURE then
		2075	exit; // not exe
		2076	Inc(p, sizeof(Cardinal));
		2077	NumSections := PImageFileHeader(p).NumberOfSections;
		2078	Inc(p, sizeof(TImageFileHeader) + sizeof(TImageOptionalHeader));
		2079	for i := 1 to NumSections do
		2080	begin
		2081	with PImageSectionHeader(p)^ do
		2082	if PointerToRawData + SizeOfRawData > sz then
		2083	sz := PointerToRawData + SizeOfRawData;
		2084	Inc(p, sizeof(TImageSectionHeader));
		2085	end;
		2086	// sz = end of stub
		2087	p := stub.Memory;
		2088	Inc(p, sz);
		2089	phed := P_header(p);
		2090	if phed.Sig <> SFX_HEADER_SIG then
		2091	exit; // bad
		2092	sz := sz + phed.Size;
		2093	// posn := sz;
		2094	Inc(p, phed.Size);
		2095	phed := P_header(p);
		2096	if (phed.Sig = CentralFileHeaderSig) then
		2097	begin
		2098	stub.Size := sz; // remove file header
		2099	Result := true;
		2100	end;
		2101	end;
		2102	end;
		2103
		2104	function TZMWAux.MapSFXSettings(stub: TMemoryStream): Integer;
		2105	type
		2106	T_header = packed record
		2107	Sig: DWORD;
		2108	Size: Word;
		2109	x: Word;
		2110	end;
		2111	P_header = ^T_header;
		2112	var
		2113	i: Integer;
		2114	NumSections: Integer;
		2115	p: PByte;
		2116	phed: P_header;
		2117	sz: Cardinal;
		2118	begin
		2119	Result := 0;
		2120	if (stub <> nil) and (stub.Size > MinStubSize) then
		2121	begin
		2122	sz := 0;
		2123	p := stub.Memory;
		2124	if (PImageDosHeader(p).e_magic <> IMAGE_DOS_SIGNATURE) then
		2125	exit;
		2126	Result := -DS_SFXBadRead; // 'unknown sfx'
		2127	Inc(p, PImageDosHeader(p)._lfanew);
		2128	if PCardinal(p)^ <> IMAGE_PE_SIGNATURE then
		2129	exit; // not exe
		2130	Inc(p, sizeof(Cardinal));
		2131	NumSections := PImageFileHeader(p).NumberOfSections;
		2132	Inc(p, sizeof(TImageFileHeader) + sizeof(TImageOptionalHeader));
		2133	for i := 1 to NumSections do
		2134	begin
		2135	with PImageSectionHeader(p)^ do
		2136	if PointerToRawData + SizeOfRawData > sz then
		2137	sz := PointerToRawData + SizeOfRawData;
		2138	Inc(p, sizeof(TImageSectionHeader));
		2139	end;
		2140	// sz = end of stub
		2141	p := stub.Memory;
		2142	Inc(p, sz);
		2143	phed := P_header(p);
		2144	if phed.Sig = SFX_HEADER_SIG then
		2145	begin
		2146	Result := MapSFXSettings19(p, stub);
		2147	end
		2148	else if phed.Sig = SFX_HEADER_SIG_17 then
		2149	begin
		2150	Result := MapSFXSettings17(p, stub);
		2151	end;
		2152	end;
		2153	end;
		2154
		2155	function ReadSFXStr17(var p: PByte; len: Byte): Ansistring;
		2156	var
		2157	i: Integer;
		2158	begin
		2159	Result := '';
		2160	if len > 0 then
		2161	begin
		2162	SetLength(Result, len);
		2163	for I := 1 to len do
		2164	begin
		2165	Result[i] := AnsiChar(P^);
		2166	inc(p);
		2167	end;
		2168	end;
		2169	end;
		2170
		2171	procedure TZMWAux.AfterConstruction;
		2172	begin
		2173	inherited;
		2174	fSuccessCnt := 0;
		2175	fCentralDir := TZMCenDir.Create(self);
		2176	FZipComment := '';
		2177	fZipFileName := '';
		2178	fSFXIcon := nil;
		2179	fUseDelphiBin := true;
		2180	fSFXBinStream := nil;
		2181	end;
		2182
		2183	procedure TZMWAux.BeforeDestruction;
		2184	begin
		2185	FreeAndNil(fCentralDir);
		2186	FreeAndNil(fSFXIcon);
		2187	FreeAndNil(fSFXBinStream);
		2188	inherited;
		2189	end;
		2190
		2191	function TZMWAux.MapSFXSettings17(pheder: PByte; stub: TMemoryStream): Integer;
		2192	type
		2193	T_header = packed record
		2194	Sig: DWORD;
		2195	Size: Word;
		2196	x: Word;
		2197	end;
		2198	P_header = ^T_header;
		2199	var
		2200	ico: TIcon;
		2201	p: PByte;
		2202	PSFXHeader: PSFXFileHeader_17;
		2203	X_Caption, X_Path, X_CmdLine, X_RegFailPath, X_StartMsg: AnsiString;
		2204	begin
		2205	Result := -DS_SFXBadRead;
		2206	PSFXHeader := PSFXFileHeader_17(pheder);
		2207	p := pheder;
		2208	Inc(p, Sizeof(TSFXFileHeader_17)); // point to strings
		2209	X_Caption := ReadSFXStr17(p, PSFXHeader^.CaptionSize);
		2210	X_Path := ReadSFXStr17(p, PSFXHeader^.PathSize);
		2211	X_CmdLine := ReadSFXStr17(p, PSFXHeader^.CmdLineSize);
		2212	X_RegFailPath := ReadSFXStr17(p, PSFXHeader^.RegFailPathSize);
		2213	X_StartMsg := ReadSFXStr17(p, PSFXHeader^.StartMsgSize);
		2214
		2215	// read icon
		2216	try
		2217	ico := GetFirstIcon(stub);
		2218	// should test valid
		2219	Master.SFXIcon := ico;
		2220	ico.Free;
		2221	except
		2222	On E: EZMException do
		2223	begin
		2224	Result := -E.ResId;
		2225	exit;
		2226	end
		2227	else
		2228	exit;
		2229	end;
		2230	Master.SFXOptions := MapOptionsFrom17(PSFXHeader^.Options);
		2231	Master.SFXOverwriteMode := MapOverwriteModeFromStub(PSFXHeader^.DefOVW);
		2232	if (PSFXHeader^.StartMsgType and (MB_OKCANCEL or MB_YESNO)) <> 0 then
		2233	begin
		2234	if (PSFXHeader^.StartMsgType and MB_OKCANCEL) <> 0 then
		2235	X_StartMsg := '1\|' + X_StartMsg
		2236	else if (PSFXHeader^.StartMsgType and MB_YESNO) <> 0 then
		2237	X_StartMsg := '2\|' + X_StartMsg;
		2238	end;
		2239	Master.SFXMessage := String(X_StartMsg);
		2240	Master.SFXCaption := String(X_Caption);
		2241	Master.SFXDefaultDir := String(X_Path);
		2242	Master.SFXCommandLine := String(X_CmdLine);
		2243	Master.SFXRegFailPath := String(X_RegFailPath);
		2244	Result := 0; // all is well
		2245	end;
		2246
		2247	// table format - ident: byte, strng[]: byte, 0: byte; ...;0
		2248	function TZMWAux.LoadSFXStr(ptbl: pByte; ident: Byte): String;
		2249	var
		2250	id: Byte;
		2251	begin
		2252	Result := '';
		2253	if (ptbl = nil) or (ident = 0) then
		2254	exit;
		2255	id := ptbl^;
		2256	while (id <> 0) and (id <> ident) do
		2257	begin
		2258	while ptbl^ <> 0 do
		2259	inc(ptbl);
		2260	inc(ptbl);
		2261	id := ptbl^;
		2262	end;
		2263	if id = ident then
		2264	begin
		2265	inc(ptbl);
		2266	{$ifdef UNICODE}
		2267	Result := PUTF8ToStr(pAnsiChar(ptbl), -1);
		2268	{$else}
		2269	if UseUTF8 then
		2270	Result := UTF8String(pAnsiChar(ptbl))
		2271	else
		2272	Result := PUTF8ToStr(pAnsiChar(ptbl), -1);
		2273	{$endif}
		2274	end;
		2275	end;
		2276
		2277	function TZMWAux.MapOptionsFrom17(opts: Word): TZMSFXOpts;
		2278	begin
		2279	Result := [];
		2280	if (so_AskCmdLine_17 and opts) <> 0 then
		2281	Result := Result + [soAskCmdLine];
		2282	if (so_AskFiles_17 and opts) <> 0 then
		2283	Result := Result + [soAskFiles];
		2284	if (so_HideOverWriteBox_17 and opts) <> 0 then
		2285	Result := Result + [soHideOverWriteBox];
		2286	if (so_AutoRun_17 and opts) <> 0 then
		2287	Result := Result + [soAutoRun];
		2288	if (so_NoSuccessMsg_17 and opts) <> 0 then
		2289	Result := Result + [soNoSuccessMsg];
		2290	if (so_ExpandVariables_17 and opts) <> 0 then
		2291	Result := Result + [soExpandVariables];
		2292	if (so_InitiallyHideFiles_17 and opts) <> 0 then
		2293	Result := Result + [soInitiallyHideFiles];
		2294	if (so_ForceHideFiles_17 and opts) <> 0 then
		2295	Result := Result + [soForceHideFiles];
		2296	if (so_CheckAutoRunFileName_17 and opts) <> 0 then
		2297	Result := Result + [soCheckAutoRunFileName];
		2298	if (so_CanBeCancelled_17 and opts) <> 0 then
		2299	Result := Result + [soCanBeCancelled];
		2300	if (so_CreateEmptyDirs_17 and opts) <> 0 then
		2301	Result := Result + [soCreateEmptyDirs];
		2302	end;
		2303
		2304	function TZMWAux.MapSFXSettings19(pheder: PByte; stub: TMemoryStream): Integer;
		2305	var
		2306	cmnds: PByte;
		2307	CRC: Cardinal;
		2308	cstream: TMemoryStream;
		2309	ico: TIcon;
		2310	msg: string;
		2311	method: TZMDeflates;
		2312	delta: Integer;
		2313	p: PByte;
		2314	phed: PSFXFileHeader;
		2315	psdat: PSFXStringsData;
		2316	begin
		2317	Result := -DS_SFXBadRead;
		2318	phed := PSFXFileHeader(pheder);
		2319	cstream := nil;
		2320	cmnds := @phed^.StartMsgType;
		2321	inc(cmnds, sizeof(WORD));
		2322	try
		2323	// get command strings
		2324	if (so_CompressedCmd and phed^.Options) <> 0 then
		2325	begin
		2326	// needs dll!!!!
		2327	p := cmnds;
		2328	cmnds := nil;
		2329	psdat := PSFXStringsData(p);
		2330	Inc(p, sizeof(TSFXStringsData)); // point to compressed data
		2331	delta := Cardinal(p) - Cardinal(stub.Memory);
		2332	if stub.Seek(delta, soFromBeginning) = delta then
		2333	begin
		2334	cstream := TMemoryStream.Create;
		2335	method := ZMDeflate; // deflated
		2336	Undeflate(cstream, stub, psdat.CSize, method, CRC);
		2337	if (cstream.Size = psdat.USize) and (CRC = psdat.CRC) then
		2338	cmnds := cstream.Memory; // ok
		2339	end;
		2340	end;
		2341	if cmnds <> nil then
		2342	begin
		2343	// read icon
		2344	try
		2345	ico := GetFirstIcon(stub);
		2346	// should test valid
		2347	Master.SFXIcon := ico;
		2348	ico.Free;
		2349	except
		2350	On E: EZMException do
		2351	begin
		2352	Result := -E.ResId;
		2353	exit;
		2354	end
		2355	else
		2356	exit;
		2357	end;
		2358	// we have strings
		2359	Master.SFXCaption := LoadSFXStr(cmnds, sc_Caption);
		2360	Master.SFXDefaultDir := LoadSFXStr(cmnds, sc_Path);
		2361	Master.SFXCommandLine := LoadSFXStr(cmnds, sc_CmdLine);
		2362	Master.SFXRegFailPath := LoadSFXStr(cmnds, sc_RegFailPath);
		2363	msg := LoadSFXStr(cmnds, sc_StartMsg);
		2364	Master.SFXOptions := MapOptionsFromStub(phed^.Options);
		2365	Master.SFXOverwriteMode := MapOverwriteModeFromStub(phed^.DefOVW);
		2366	if (phed^.StartMsgType and (MB_OKCANCEL or MB_YESNO)) <> 0 then
		2367	begin
		2368	if (phed^.StartMsgType and MB_OKCANCEL) <> 0 then
		2369	msg := '1\|' + msg
		2370	else if (phed^.StartMsgType and MB_YESNO) <> 0 then
		2371	msg := '2\|' + msg;
		2372	end;
		2373	Master.SFXMessage := msg;
		2374	Result := 0; // all is well
		2375	end;
		2376	finally
		2377	if cstream <> nil then
		2378	cstream.Free;
		2379	end;
		2380	end;
		2381
		2382	function TZMWAux.WriteDetached(zf: TZMZipFile): Integer;
		2383	var
		2384	xf: TZMLoader;
		2385	begin
		2386	Diag('Write detached SFX stub');
		2387	Result := -DS_FileError;
		2388	xf := TZMLoader.Create(self);
		2389	try
		2390	xf.ForZip := zf;
		2391	if xf.File_Create(ChangeFileExt(zf.FileName, DotExtExe)) then
		2392	Result := xf.Commit(false);
		2393	finally
		2394	xf.Free;
		2395	end;
		2396	end;
		2397
		2398	function TZMWAux.WriteEOC(Current: TZMZipFile; OutFile: Integer): Integer;
		2399	var
		2400	r: Integer;
		2401	begin
		2402	Current.Handle := OutFile;
		2403	Current.Position := FileSeek(OutFile, 0, soFromCurrent);
		2404	r := Current.WriteEOC();
		2405	OutSize := FileSeek(OutFile, 0, soFromEnd);
		2406	Current.Handle := -1; // closes OutFile
		2407	Result := r;
		2408	end;
		2409
		2410	function TZMWAux.WriteMulti(Src: TZMZipFile; Dest: TZMZipCopy;
		2411	UseXProgress: Boolean): Integer;
		2412	begin
		2413	try
		2414	if ExtractFileName(Src.FileName) = '' then
		2415	raise EZipMaster.CreateResDisp(DS_NoInFile, true);
		2416	if ExtractFileName(Dest.FileName) = '' then
		2417	raise EZipMaster.CreateResDisp(DS_NoOutFile, true);
		2418	Result := Src.Open(false, false);
		2419	if Result < 0 then
		2420	raise EZipMaster.CreateResDisp(-Result, true);
		2421	Dest.StampDate := Src.StampDate;
		2422	if UseXProgress then
		2423	Dest.ShowProgress := zspExtra
		2424	else
		2425	Dest.ShowProgress := zspFull;
		2426	Dest.TotalDisks := 0;
		2427	Dest.PrepareWrite(zwMultiple);
		2428	// Dest.DiskNr := 0;
		2429	Dest.File_Size := Src.File_Size; // to calc TotalDisks
		2430	Result := Dest.WriteFile(Src, true);
		2431	Dest.File_Close;
		2432	Src.File_Close;
		2433	if Result < 0 then
		2434	raise EZipMaster.CreateResDisp(-Result, true);
		2435	except
		2436	on ews: EZipMaster do // All WriteSpan specific errors.
		2437	begin
		2438	ShowExceptionError(ews);
		2439	Result := -7;
		2440	end;
		2441	on EOutOfMemory do // All memory allocation errors.
		2442	begin
		2443	ShowZipMessage(GE_NoMem, '');
		2444	Result := -8;
		2445	end;
		2446	on E: Exception do
		2447	begin
		2448	// The remaining errors, should not occur.
		2449	ShowZipMessage(DS_ErrorUnknown, E.Message);
		2450	Result := -9;
		2451	end;
		2452	end;
		2453	end;
		2454
		2455	function TZMWAux.WriteSpan(const InFileName, OutFileName: String;
		2456	UseXProgress: Boolean): Integer;
		2457	var
		2458	fd: TZMZipCopy;
		2459	fs: TZMZipFile;
		2460	begin
		2461	ClearErr;
		2462	Result := -1;
		2463	fd := nil;
		2464	fs := TZMZipFile.Create(self);
		2465	try
		2466	fs.FileName := InFileName;
		2467	fd := TZMZipCopy.Create(self);
		2468	fd.FileName := OutFileName;
		2469	if Unattended and not fd.WorkDrive.DriveIsFixed then
		2470	raise EZipMaster.CreateResDisp(DS_NoUnattSpan, true);
		2471	Result := WriteMulti(fs, fd, UseXProgress);
		2472	finally
		2473	fs.Free;
		2474	if fd <> nil then
		2475	fd.Free;
		2476	end;
		2477	end;
		2478
		2479	function WriteCommand(Dest: TMemoryStream; const cmd: string; ident: Integer)
		2480	: Integer;
		2481	var
		2482	ucmd: UTF8String;
		2483	z: Byte;
		2484	begin
		2485	Result := 0;
		2486	if Length(cmd) > 0 then
		2487	begin
		2488	ucmd := AsUTF8Str(cmd);
		2489	Dest.Write(ident, 1);
		2490	Result := Dest.Write(PAnsiChar(ucmd)^, Length(ucmd)) + 2;
		2491	z := 0;
		2492	Dest.Write(z, 1);
		2493	end;
		2494	end;
		2495
		2496	constructor TZMLoader.Create(Wrkr: TZMCore);
		2497	begin
		2498	inherited Create(Wrkr);
		2499	fSFXWorker := Wrkr as TZMWAux;
		2500	end;
		2501
		2502	function TZMLoader.AddStripped(const rec: TZMIRec): Integer;
		2503	var
		2504	Data: TZMRawBytes;
		2505	idx: Integer;
		2506	ixN: Integer;
		2507	ixU: Integer;
		2508	ixZ: Integer;
		2509	ndata: TZMRawBytes;
		2510	ni: TZMRawBytes;
		2511	nrec: TZMIRec;
		2512	siz: Integer;
		2513	szN: Integer;
		2514	szU: Integer;
		2515	szZ: Integer;
		2516	begin
		2517	ixZ := 0;
		2518	szZ := 0;
		2519	ixU := 0;
		2520	szU := 0;
		2521	ixN := 0;
		2522	szN := 0;
		2523	nrec := TZMIRec.Create(self);
		2524	nrec.VersionMadeBy := rec.VersionMadeBy;
		2525	nrec.VersionNeeded := rec.VersionNeeded;
		2526	nrec.Flag := rec.Flag;
		2527	nrec.ComprMethod := rec.ComprMethod;
		2528	nrec.ModifDateTime := rec.ModifDateTime;
		2529	nrec.CRC32 := rec.CRC32;
		2530	nrec.CompressedSize := rec.CompressedSize;
		2531	nrec.UncompressedSize := rec.UncompressedSize;
		2532	nrec.FileCommentLen := 0;
		2533	nrec.DiskStart := rec.DiskStart;
		2534	nrec.IntFileAttrib := rec.IntFileAttrib;
		2535	nrec.ExtFileAttrib := rec.ExtFileAttrib;
		2536	nrec.RelOffLocal := rec.RelOffLocal;
		2537	nrec.StatusBits := rec.StatusBits;
		2538	ndata := '';
		2539	siz := 0;
		2540	ni := rec.HeaderName;
		2541	if rec.ExtraFieldLength > 4 then
		2542	begin
		2543	Data := rec.ExtraField;
		2544	if XData(Data, Zip64_data_tag, ixZ, szZ) then
		2545	siz := siz + szZ;
		2546	if XData(Data, UPath_Data_Tag, ixU, szU) then
		2547	siz := siz + szU;
		2548	if XData(Data, NTFS_data_tag, ixN, szN) and (szN >= 36) then
		2549	siz := siz + szN;
		2550	end;
		2551	nrec.HeaderName := ni;
		2552	nrec.FileNameLength := Length(ni);
		2553	if siz > 0 then
		2554	begin
		2555	// copy required extra data fields
		2556	SetLength(ndata, siz);
		2557	idx := 1;
		2558	if szZ > 0 then
		2559	move(Data[ixZ], ndata[idx], szZ);
		2560	Inc(idx, szZ);
		2561	if szU > 0 then
		2562	move(Data[ixU], ndata[idx], szU);
		2563	Inc(idx, szU);
		2564	if szN >= 36 then
		2565	move(Data[ixN], ndata[idx], szN);
		2566	nrec.ExtraField := ndata;
		2567	ndata := '';
		2568	end;
		2569	Result := Add(nrec);
		2570	if Result < 0 then
		2571	begin
		2572	nrec.Free; // could not add it
		2573	Result := -AZ_InternalError;
		2574	end;
		2575	end;
		2576
		2577	procedure TZMLoader.AfterConstruction;
		2578	begin
		2579	inherited;
		2580	ForZip := nil;
		2581	fname := '';
		2582	DiskNr := MAX_WORD - 1;
		2583	end;
		2584
		2585	function TZMLoader.BeforeCommit: Integer;
		2586	begin
		2587	Result := inherited BeforeCommit;
		2588	// Prepare detached header
		2589	if Result = 0 then
		2590	begin
		2591	if Entries.Count < 0 then
		2592	raise EZipMaster.CreateResDisp(AZ_NothingToDo, true);
		2593	StampDate := ForZip.StampDate;
		2594	Result := PrepareDetached;
		2595	end;
		2596	end;
		2597
		2598	function TZMLoader.PrepareDetached: Integer;
		2599	begin
		2600	if not assigned(stub) then
		2601	begin
		2602	Result := SFXWorker.PrepareStub;
		2603	if Result < 0 then
		2604	exit; // something went wrong
		2605	stub := SFXWorker.ReleaseSFXBin; // we now own it
		2606	end;
		2607	UseSFX := true;
		2608	Result := 0;
		2609	end;
		2610
		2611	procedure TZMLoader.SetForZip(const Value: TZMZipFile);
		2612	begin
		2613	if ForZip <> Value then
		2614	begin
		2615	fForZip := Value;
		2616	ClearEntries;
		2617	StripEntries;
		2618	DiskNr := ForZip.DiskNr + 1;
		2619	end;
		2620	end;
		2621
		2622	function TZMLoader.StripEntries: Integer;
		2623	var
		2624	i: Integer;
		2625	begin
		2626	Result := -AZ_NothingToDo;
		2627	// fill list from ForFile
		2628	for i := 0 to ForZip.Count - 1 do
		2629	begin
		2630	Result := AddStripped(ForZip[i]);
		2631	if Result < 0 then
		2632	Break;
		2633	end;
		2634	end;
		2635
		2636	end.

Subversion Repositories autosfx

autosfx/zmstr1900102/ZMWAUX19.pas – Rev 1