Details | Last modification | View Log | RSS feed
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. |