Details | Last modification | View Log | RSS feed
Rev | Author | Line No. | Line |
---|---|---|---|
1 | daniel-mar | 1 | unit ZMCore19; |
2 | |||
3 | (* |
||
4 | ZMCore19.pas - event triggering |
||
5 | TZipMaster19 VCL by Chris Vleghert and Eric W. Engler |
||
6 | v1.9 |
||
7 | Copyright (C) 2009 Russell Peters |
||
8 | |||
9 | |||
10 | This library is free software; you can redistribute it and/or |
||
11 | modify it under the terms of the GNU Lesser General Public |
||
12 | License as published by the Free Software Foundation; either |
||
13 | version 2.1 of the License, or (at your option) any later version. |
||
14 | |||
15 | This library is distributed in the hope that it will be useful, |
||
16 | but WITHOUT ANY WARRANTY; without even the implied warranty of |
||
17 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
||
18 | Lesser General Public License (licence.txt) for more details. |
||
19 | |||
20 | You should have received a copy of the GNU Lesser General Public |
||
21 | License along with this library; if not, write to the Free Software |
||
22 | Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA |
||
23 | |||
24 | contact: problems AT delphizip DOT org |
||
25 | updates: http://www.delphizip.org |
||
26 | |||
27 | modified 2009-08-19 |
||
28 | --------------------------------------------------------------------------- *) |
||
29 | |||
30 | interface |
||
31 | |||
32 | // {$DEFINE DEBUG_PROGRESS} |
||
33 | |||
34 | uses |
||
35 | Classes, SysUtils, Controls, Forms, Dialogs, |
||
36 | ZipMstr19, ZMXcpt19, ZMDelZip19, ZMStructs19, ZMCompat19; |
||
37 | |||
38 | const |
||
39 | zprFile = 0; |
||
40 | zprArchive = 1; |
||
41 | zprCopyTemp = 2; |
||
42 | zprSFX = 3; |
||
43 | zprHeader = 4; |
||
44 | zprFinish = 5; |
||
45 | zprCompressed = 6; |
||
46 | zprCentral = 7; |
||
47 | zprChecking = 8; |
||
48 | zprLoading = 9; |
||
49 | zprJoining = 10; |
||
50 | zprSplitting = 11; |
||
51 | zprWriting = 12; |
||
52 | |||
53 | const |
||
54 | EXT_EXE = '.EXE'; |
||
55 | EXT_EXEL = '.exe'; |
||
56 | EXT_ZIP = '.ZIP'; |
||
57 | EXT_ZIPL = '.zip'; |
||
58 | PRE_INTER = 'ZI$'; |
||
59 | PRE_SFX = 'ZX$'; |
||
60 | |||
61 | type |
||
62 | TZLoadOpts = (zloNoLoad, zloFull, zloSilent); |
||
63 | |||
64 | type |
||
65 | TZMVerbosity = (zvOff, zvVerbose, zvTrace); |
||
66 | TZMEncodingDir = (zedFromInt, zedToInt); |
||
67 | TZipShowProgress = (zspNone, zspFull, zspExtra); |
||
68 | |||
69 | TZipAllwaysItems = (zaaYesOvrwrt); |
||
70 | TZipAnswerAlls = set of TZipAllwaysItems; |
||
71 | |||
72 | type |
||
73 | TZipNameType = (zntExternal, zntInternal); |
||
74 | |||
75 | type |
||
76 | TProgDetails = class(TZMProgressDetails) |
||
77 | private |
||
78 | fDelta: Int64; |
||
79 | fInBatch: Boolean; |
||
80 | fItemCount: Int64; |
||
81 | fItemName: TZMString; |
||
82 | fItemNumber: Integer; |
||
83 | fItemPosition: Int64; |
||
84 | fItemSize: Int64; |
||
85 | fProgType: TZMProgressType; |
||
86 | fTotalPosition: Int64; |
||
87 | fTotalSize: Int64; |
||
88 | fWritten: Int64; |
||
89 | protected |
||
90 | function GetBytesWritten: Int64; override; |
||
91 | function GetDelta: Int64; override; |
||
92 | function GetItemName: TZMString; override; |
||
93 | function GetItemNumber: Integer; override; |
||
94 | function GetItemPosition: Int64; override; |
||
95 | function GetItemSize: Int64; override; |
||
96 | function GetOrder: TZMProgressType; override; |
||
97 | function GetTotalCount: Int64; override; |
||
98 | function GetTotalPosition: Int64; override; |
||
99 | function GetTotalSize: Int64; override; |
||
100 | public |
||
101 | procedure Advance(adv: Int64); |
||
102 | procedure AdvanceXtra(adv: Cardinal); |
||
103 | procedure Clear; |
||
104 | procedure SetCount(Count: Int64); |
||
105 | procedure SetEnd; |
||
106 | procedure SetItem(const FName: TZMString; FSize: Int64); |
||
107 | procedure SetItemXtra(const xmsg: TZMString; FSize: Int64); |
||
108 | procedure SetSize(FullSize: Int64); |
||
109 | procedure Written(bytes: Int64); |
||
110 | property BytesWritten: Int64 read GetBytesWritten write fWritten; |
||
111 | property InBatch: Boolean Read fInBatch; |
||
112 | property ItemName: TZMString read GetItemName write fItemName; |
||
113 | property ItemNumber: Integer read GetItemNumber write fItemNumber; |
||
114 | property ItemPosition: Int64 read GetItemPosition write fItemPosition; |
||
115 | property ItemSize: Int64 read GetItemSize write fItemSize; |
||
116 | property Order: TZMProgressType read GetOrder write fProgType; |
||
117 | property TotalCount: Int64 read GetTotalCount write fItemCount; |
||
118 | property TotalPosition: Int64 read GetTotalPosition write fTotalPosition; |
||
119 | property TotalSize: Int64 read GetTotalSize write fTotalSize; |
||
120 | end; |
||
121 | |||
122 | type |
||
123 | TZCentralValues = (zcvDirty, zcvEmpty, zcvError, zcvBadStruct, zcvBusy); |
||
124 | TZCentralStatus = set of TZCentralValues; |
||
125 | |||
126 | type |
||
127 | TZMPipeImp = class(TZMPipe) |
||
128 | private |
||
129 | FAttributes: Cardinal; |
||
130 | FDOSDate: Cardinal; |
||
131 | FFileName: string; |
||
132 | FOwnsStream: boolean; |
||
133 | FSize: Integer; |
||
134 | FStream: TStream; |
||
135 | protected |
||
136 | function GetAttributes: Cardinal; override; |
||
137 | function GetDOSDate: Cardinal; override; |
||
138 | function GetFileName: string; override; |
||
139 | function GetOwnsStream: boolean; override; |
||
140 | function GetSize: Integer; override; |
||
141 | function GetStream: TStream; override; |
||
142 | procedure SetAttributes(const Value: Cardinal); override; |
||
143 | procedure SetDOSDate(const Value: Cardinal); override; |
||
144 | procedure SetFileName(const Value: string); override; |
||
145 | procedure SetOwnsStream(const Value: boolean); override; |
||
146 | procedure SetSize(const Value: Integer); override; |
||
147 | procedure SetStream(const Value: TStream); override; |
||
148 | public |
||
149 | procedure AfterConstruction; override; |
||
150 | procedure AssignTo(Dest: TZMPipeImp); |
||
151 | procedure BeforeDestruction; override; |
||
152 | end; |
||
153 | |||
154 | TZMPipeListImp = class(TZMPipeList) |
||
155 | private |
||
156 | List: TList; |
||
157 | protected |
||
158 | function GetCount: Integer; override; |
||
159 | function GetPipe(Index: Integer): TZMPipe; override; |
||
160 | procedure SetCount(const Value: Integer); override; |
||
161 | procedure SetPipe(Index: Integer; const Value: TZMPipe); override; |
||
162 | public |
||
163 | function Add(aStream: TStream; const FileName: string; Own: boolean): integer; override; |
||
164 | procedure AfterConstruction; override; |
||
165 | procedure AssignTo(Dest: TZMPipeListImp); |
||
166 | procedure BeforeDestruction; override; |
||
167 | procedure Clear; override; |
||
168 | function HasStream(Index: Integer): boolean; |
||
169 | function KillStream(Index: Integer): boolean; |
||
170 | end; |
||
171 | |||
172 | const |
||
173 | MAX_PIPE = 9; |
||
174 | |||
175 | |||
176 | type |
||
177 | TZMCore = class |
||
178 | private |
||
179 | fAnswerAll: TZipAnswerAlls; |
||
180 | fCancel: Integer; |
||
181 | fCheckNo: Integer; |
||
182 | fConfirmErase: Boolean; |
||
183 | FEncodeAs: TZMEncodingOpts; |
||
184 | FEncoding_CP: Cardinal; |
||
185 | fFErrCode: Integer; |
||
186 | fFileCleanup: TStringList; |
||
187 | fFSpecArgs: TStrings; |
||
188 | fFSpecArgsExcl: TStrings; |
||
189 | fHandle: Cardinal; |
||
190 | fHowToDelete: TZMDeleteOpts; |
||
191 | FIgnoreDirOnly: Boolean; |
||
192 | fKeepFreeOnAllDisks: Cardinal; |
||
193 | fKeepFreeOnDisk1: Cardinal; |
||
194 | fMaster: TCustomZipMaster19; |
||
195 | FMaxVolumeSize: Int64; |
||
196 | fMinFreeVolumeSize: Integer; |
||
197 | FNoSkipping: TZMSkipAborts; |
||
198 | fShowProgress: TZipShowProgress; |
||
199 | fSniffer: Cardinal; |
||
200 | fSniffNo: Integer; |
||
201 | fSpanOptions: TZMSpanOpts; |
||
202 | fUnattended: Boolean; |
||
203 | {$IFNDEF UNICODE} |
||
204 | fUseUTF8: Boolean; |
||
205 | {$ENDIF} |
||
206 | fWinXP: Boolean; |
||
207 | FWriteOptions: TZMWriteOpts; |
||
208 | function GetErrMessage: TZMString; |
||
209 | function GetTotalWritten: Int64; |
||
210 | procedure SetCancel(Value: Integer); |
||
211 | procedure SetErrCode(Value: Integer); |
||
212 | procedure SetProgDetail(const Value: TProgDetails); |
||
213 | procedure SetTotalWritten(const Value: Int64); |
||
214 | protected |
||
215 | FAddOptions: TZMAddOpts; |
||
216 | fBusy: Boolean; |
||
217 | fEncoding: TZMEncodingOpts; |
||
218 | FErrMessage: TZMString; |
||
219 | fEventErr: String; |
||
220 | FDllErrCode: Integer; |
||
221 | fIsDestructing: Boolean; |
||
222 | fNotMainTask: Boolean; |
||
223 | fProgDetails: TProgDetails; |
||
224 | FTempDir: String; |
||
225 | fVerbosity: TZMVerbosity; |
||
226 | procedure EncodingChanged(New_Enc: TZMEncodingOpts); virtual; abstract; |
||
227 | procedure Encoding_CPChanged(New_CP: Cardinal); virtual; abstract; |
||
228 | // 1 Locate sniffer and get overrides |
||
229 | function FindSniffer: Cardinal; |
||
230 | function GetTotalSizeToProcess: Int64; |
||
231 | procedure ReportToSniffer(err: Integer; const msg: TZMString); |
||
232 | procedure SetEncoding(const Value: TZMEncodingOpts); |
||
233 | procedure SetEncoding_CP(const Value: Cardinal); //virtual; |
||
234 | procedure StartUp; virtual; |
||
235 | property Sniffer: Cardinal Read fSniffer Write fSniffer; |
||
236 | property SniffNo: Integer Read fSniffNo Write fSniffNo; |
||
237 | public |
||
238 | constructor Create(AMaster: TCustomZipMaster19); |
||
239 | procedure AddCleanupFile(const fn: String; always: Boolean = False); |
||
240 | procedure AfterConstruction; override; |
||
241 | procedure BeforeDestruction; override; |
||
242 | procedure CheckCancel; |
||
243 | procedure CleanupFiles(IsError: Boolean); |
||
244 | procedure Clear; virtual; |
||
245 | procedure ClearErr; |
||
246 | procedure Diag(const msg: String); |
||
247 | procedure Done(Good: boolean = true); virtual; |
||
248 | function FNMatch(const pattern, spec: TZMString): Boolean; |
||
249 | function KeepAlive: Boolean; |
||
250 | procedure Kill; virtual; |
||
251 | function MakeTempFileName(Prefix, Extension: String): String; |
||
252 | function NextCheckNo: Integer; |
||
253 | procedure OnDirUpdate; |
||
254 | procedure OnNewName(idx: Integer); |
||
255 | function RemoveFileCleanup(const fn: String): Boolean; |
||
256 | procedure ReportMessage(err: Integer; const msg: TZMString); |
||
257 | procedure ReportMessage1(err: Integer; const msg: TZMString); |
||
258 | procedure ReportMsg(id: Integer; const Args: array of const ); |
||
259 | procedure ReportProgress(ActionCode: TActionCodes; ErrorCode: Integer; msg: |
||
260 | TZMString; File_Size: Int64); |
||
261 | function ReportSkipping(const FName: String; err: Integer; |
||
262 | typ: TZMSkipTypes): Boolean; |
||
263 | procedure ShowExceptionError(const ZMExcept: Exception); |
||
264 | procedure ShowMsg(const msg: TZMString; err: Integer; display: Boolean); |
||
265 | procedure ShowZipFmtMsg(id: Integer; const Args: array of const ; |
||
266 | display: Boolean); |
||
267 | procedure ShowZipMessage(Ident: Integer; const UserStr: String); |
||
268 | procedure ShowZipMsg(Ident: Integer; display: Boolean); |
||
269 | function ZipFmtLoadStr(id: Integer; const Args: array of const ): TZMString; |
||
270 | function ZipLoadStr(id: Integer): TZMString; |
||
271 | function ZipMessageDialog(const title: String; var msg: String; |
||
272 | context: Integer; btns: TMsgDlgButtons): TModalResult; |
||
273 | procedure ZipMessageDlg(const msg: String; context: Integer); |
||
274 | function ZipMessageDlgEx(const title, msg: String; context: Integer; |
||
275 | btns: TMsgDlgButtons): TModalResult; |
||
276 | property AddOptions: TZMAddOpts read FAddOptions write FAddOptions; |
||
277 | property AnswerAll: TZipAnswerAlls Read fAnswerAll Write fAnswerAll; |
||
278 | property Busy: Boolean Read fBusy Write fBusy; |
||
279 | property Cancel: Integer Read fCancel Write SetCancel; |
||
280 | property ConfirmErase |
||
281 | : Boolean Read fConfirmErase Write fConfirmErase default True; |
||
282 | property EncodeAs: TZMEncodingOpts read FEncodeAs write FEncodeAs; |
||
283 | property Encoding: TZMEncodingOpts Read fEncoding Write SetEncoding; |
||
284 | property ErrCode: Integer Read fFErrCode Write SetErrCode; |
||
285 | property ErrMessage: TZMString read GetErrMessage write FErrMessage; |
||
286 | property FSpecArgs: TStrings Read fFSpecArgs Write fFSpecArgs; |
||
287 | property FSpecArgsExcl: TStrings Read fFSpecArgsExcl Write fFSpecArgsExcl; |
||
288 | property DllErrCode: Integer read FDllErrCode write FDllErrCode; |
||
289 | property Encoding_CP: Cardinal read FEncoding_CP write SetEncoding_CP; |
||
290 | property Handle: Cardinal Read fHandle; |
||
291 | property HowToDelete: TZMDeleteOpts Read fHowToDelete Write fHowToDelete; |
||
292 | property IgnoreDirOnly: Boolean read FIgnoreDirOnly; |
||
293 | property KeepFreeOnAllDisks |
||
294 | : Cardinal Read fKeepFreeOnAllDisks Write fKeepFreeOnAllDisks; |
||
295 | property KeepFreeOnDisk1 |
||
296 | : Cardinal Read fKeepFreeOnDisk1 Write fKeepFreeOnDisk1; |
||
297 | property Master: TCustomZipMaster19 Read fMaster; |
||
298 | property MaxVolumeSize: Int64 read FMaxVolumeSize write FMaxVolumeSize; |
||
299 | property MinFreeVolumeSize |
||
300 | : Integer Read fMinFreeVolumeSize Write fMinFreeVolumeSize; |
||
301 | property NoSkipping: TZMSkipAborts read FNoSkipping; |
||
302 | property NotMainTask: Boolean Read fNotMainTask Write fNotMainTask; |
||
303 | property ProgDetail: TProgDetails Read fProgDetails Write SetProgDetail; |
||
304 | property ShowProgress |
||
305 | : TZipShowProgress Read fShowProgress Write fShowProgress; |
||
306 | property SpanOptions: TZMSpanOpts Read fSpanOptions Write fSpanOptions; |
||
307 | property TempDir: String read FTempDir write FTempDir; |
||
308 | property TotalWritten: Int64 read GetTotalWritten write SetTotalWritten; |
||
309 | property Unattended: Boolean Read fUnattended Write fUnattended; |
||
310 | {$IFNDEF UNICODE} |
||
311 | property UseUTF8: Boolean read fUseUTF8 write fUseUTF8; |
||
312 | {$ENDIF} |
||
313 | property Verbosity: TZMVerbosity Read fVerbosity Write fVerbosity; |
||
314 | property WinXP: Boolean Read fWinXP; |
||
315 | property WriteOptions: TZMWriteOpts read FWriteOptions write FWriteOptions; |
||
316 | end; |
||
317 | |||
318 | implementation |
||
319 | |||
320 | {$INCLUDE '.\ZipVers19.inc'} |
||
321 | |||
322 | uses Windows, Messages, ZMUtils19, ZMDlg19, ZMMsg19, ZMCtx19, ZMMsgStr19, |
||
323 | ZMUTF819, ZMMatch19; |
||
324 | |||
325 | const |
||
326 | SZipMasterSniffer = 'ZipMaster Sniffer'; |
||
327 | STZipSniffer = 'TZipSniffer'; |
||
328 | WM_SNIFF_START = WM_APP + $3F42; |
||
329 | WM_SNIFF_STOP = WM_APP + $3F44; |
||
330 | SNIFF_MASK = $FFFFFF; |
||
331 | RESOURCE_ERROR: String = |
||
332 | 'ZMRes19_???.res is probably not linked to the executable' + #10 + |
||
333 | 'Missing String ID is: %d '; |
||
334 | |||
335 | { TProgDetails } |
||
336 | procedure TProgDetails.Advance(adv: Int64); |
||
337 | begin |
||
338 | fDelta := adv; |
||
339 | fTotalPosition := fTotalPosition + adv; |
||
340 | fItemPosition := fItemPosition + adv; |
||
341 | fProgType := ProgressUpdate; |
||
342 | end; |
||
343 | |||
344 | procedure TProgDetails.AdvanceXtra(adv: Cardinal); |
||
345 | begin |
||
346 | fDelta := adv; |
||
347 | Inc(fItemPosition, adv); |
||
348 | fProgType := ExtraUpdate; |
||
349 | end; |
||
350 | |||
351 | procedure TProgDetails.Clear; |
||
352 | begin |
||
353 | fProgType := EndOfBatch; |
||
354 | fDelta := 0; |
||
355 | fItemCount := 0; |
||
356 | fWritten := 0; |
||
357 | fTotalSize := 0; |
||
358 | fTotalPosition := 0; |
||
359 | fItemSize := 0; |
||
360 | fItemPosition := 0; |
||
361 | fItemName := ''; |
||
362 | fItemNumber := 0; |
||
363 | end; |
||
364 | |||
365 | function TProgDetails.GetBytesWritten: Int64; |
||
366 | begin |
||
367 | Result := fWritten; |
||
368 | end; |
||
369 | |||
370 | function TProgDetails.GetDelta: Int64; |
||
371 | begin |
||
372 | Result := fDelta; |
||
373 | end; |
||
374 | |||
375 | function TProgDetails.GetItemName: TZMString; |
||
376 | begin |
||
377 | Result := fItemName; |
||
378 | end; |
||
379 | |||
380 | function TProgDetails.GetItemNumber: Integer; |
||
381 | begin |
||
382 | Result := fItemNumber; |
||
383 | end; |
||
384 | |||
385 | function TProgDetails.GetItemPosition: Int64; |
||
386 | begin |
||
387 | Result := fItemPosition; |
||
388 | end; |
||
389 | |||
390 | function TProgDetails.GetItemSize: Int64; |
||
391 | begin |
||
392 | Result := fItemSize; |
||
393 | end; |
||
394 | |||
395 | function TProgDetails.GetOrder: TZMProgressType; |
||
396 | begin |
||
397 | Result := fProgType; |
||
398 | end; |
||
399 | |||
400 | function TProgDetails.GetTotalCount: Int64; |
||
401 | begin |
||
402 | Result := fItemCount; |
||
403 | end; |
||
404 | |||
405 | function TProgDetails.GetTotalPosition: Int64; |
||
406 | begin |
||
407 | Result := fTotalPosition; |
||
408 | end; |
||
409 | |||
410 | function TProgDetails.GetTotalSize: Int64; |
||
411 | begin |
||
412 | Result := fTotalSize; |
||
413 | end; |
||
414 | |||
415 | procedure TProgDetails.SetCount(Count: Int64); |
||
416 | begin |
||
417 | Clear; |
||
418 | fItemCount := Count; |
||
419 | fItemNumber := 0; |
||
420 | fProgType := TotalFiles2Process; |
||
421 | end; |
||
422 | |||
423 | procedure TProgDetails.SetEnd; |
||
424 | begin |
||
425 | fItemName := ''; |
||
426 | fItemSize := 0; |
||
427 | fInBatch := False; |
||
428 | fProgType := EndOfBatch; |
||
429 | end; |
||
430 | |||
431 | procedure TProgDetails.SetItem(const FName: TZMString; FSize: Int64); |
||
432 | begin |
||
433 | Inc(fItemNumber); |
||
434 | fItemName := FName; |
||
435 | fItemSize := FSize; |
||
436 | fItemPosition := 0; |
||
437 | fProgType := NewFile; |
||
438 | end; |
||
439 | |||
440 | procedure TProgDetails.SetItemXtra(const xmsg: TZMString; FSize: Int64); |
||
441 | begin |
||
442 | fItemName := xmsg; |
||
443 | fItemSize := FSize; |
||
444 | fItemPosition := 0; |
||
445 | fProgType := NewExtra; |
||
446 | end; |
||
447 | |||
448 | procedure TProgDetails.SetSize(FullSize: Int64); |
||
449 | begin |
||
450 | fTotalSize := FullSize; |
||
451 | fTotalPosition := 0; |
||
452 | fItemName := ''; |
||
453 | fItemSize := 0; |
||
454 | fItemPosition := 0; |
||
455 | fProgType := TotalSize2Process; |
||
456 | fWritten := 0; |
||
457 | fInBatch := True; // start of batch |
||
458 | end; |
||
459 | |||
460 | procedure TProgDetails.Written(bytes: Int64); |
||
461 | begin |
||
462 | fWritten := bytes; |
||
463 | end; |
||
464 | |||
465 | { TZMCore } |
||
466 | constructor TZMCore.Create(AMaster: TCustomZipMaster19); |
||
467 | begin |
||
468 | fMaster := AMaster; |
||
469 | end; |
||
470 | |||
471 | procedure TZMCore.AddCleanupFile(const fn: String; always: Boolean = False); |
||
472 | var |
||
473 | f: String; |
||
474 | obj: TObject; |
||
475 | begin |
||
476 | f := ExpandFileName(fn); // need full path incase current dir changes |
||
477 | obj := nil; |
||
478 | if always then |
||
479 | obj := TObject(self); |
||
480 | fFileCleanup.AddObject(f, obj); |
||
481 | end; |
||
482 | |||
483 | procedure TZMCore.AfterConstruction; |
||
484 | begin |
||
485 | inherited; |
||
486 | fHandle := Application.Handle; |
||
487 | fProgDetails := TProgDetails.Create; |
||
488 | fFSpecArgs := TStringList.Create; |
||
489 | fFSpecArgsExcl := TStringList.Create; |
||
490 | fFileCleanup := TStringList.Create; |
||
491 | fHowToDelete := htdAllowUndo; |
||
492 | fSpanOptions := []; |
||
493 | FErrMessage := ''; |
||
494 | fFErrCode := -1; |
||
495 | fVerbosity := zvOff; |
||
496 | fUnattended := True; // during construction |
||
497 | fEncoding := zeoAuto; |
||
498 | FEncodeAs := zeoAuto; |
||
499 | fVerbosity := zvOff; |
||
500 | fTempDir := ''; |
||
501 | fNotMainTask := False; |
||
502 | fWinXP := IsWinXP; // set flag; |
||
503 | end; |
||
504 | |||
505 | procedure TZMCore.BeforeDestruction; |
||
506 | begin |
||
507 | fCancel := DS_Canceled; |
||
508 | fVerbosity := zvOff; |
||
509 | FreeAndNil(fFileCleanup); |
||
510 | FreeAndNil(fProgDetails); |
||
511 | FreeAndNil(fFSpecArgsExcl); |
||
512 | FreeAndNil(fFSpecArgs); |
||
513 | inherited; |
||
514 | end; |
||
515 | |||
516 | procedure TZMCore.CheckCancel; |
||
517 | begin |
||
518 | KeepAlive; |
||
519 | if fCancel <> 0 then |
||
520 | raise EZipMaster.CreateResDisp(Cancel, True); |
||
521 | end; |
||
522 | |||
523 | procedure TZMCore.CleanupFiles(IsError: Boolean); |
||
524 | var |
||
525 | AlwaysClean: Boolean; |
||
526 | fn: String; |
||
527 | i: Integer; |
||
528 | begin |
||
529 | if (fFileCleanup.Count > 0) then |
||
530 | begin |
||
531 | for i := fFileCleanup.Count - 1 downto 0 do |
||
532 | begin |
||
533 | fn := fFileCleanup[i]; |
||
534 | if Length(fn) < 2 then |
||
535 | continue; |
||
536 | AlwaysClean := fFileCleanup.Objects[i] <> nil; |
||
537 | if IsError or AlwaysClean then |
||
538 | begin |
||
539 | if CharInSet(fn[Length(fn)], ['/', '\']) then |
||
540 | begin |
||
541 | fn := ExcludeTrailingBackslash(fn); |
||
542 | if DirExists(fn) then |
||
543 | RemoveDir(fn); |
||
544 | end |
||
545 | else |
||
546 | begin |
||
547 | if FileExists(fn) then |
||
548 | SysUtils.DeleteFile(fn); |
||
549 | end; |
||
550 | end; |
||
551 | end; |
||
552 | fFileCleanup.Clear; |
||
553 | end; |
||
554 | end; |
||
555 | |||
556 | procedure TZMCore.Clear; |
||
557 | begin |
||
558 | Cancel := 0; |
||
559 | ClearErr; |
||
560 | fHowToDelete := htdAllowUndo; |
||
561 | fUnattended := False; |
||
562 | fEncoding := zeoAuto; |
||
563 | FEncodeAs := zeoAuto; |
||
564 | fVerbosity := zvOff; |
||
565 | TProgDetails(fProgDetails).Clear; |
||
566 | fFSpecArgs.Clear; |
||
567 | fFSpecArgsExcl.Clear; |
||
568 | fEventErr := ''; |
||
569 | fIsDestructing := False; |
||
570 | fSpanOptions := []; |
||
571 | FWriteOptions := []; |
||
572 | end; |
||
573 | |||
574 | procedure TZMCore.ClearErr; |
||
575 | begin |
||
576 | FErrMessage := ''; |
||
577 | fFErrCode := 0; |
||
578 | FDllErrCode := 0; |
||
579 | end; |
||
580 | |||
581 | procedure TZMCore.Diag(const msg: String); |
||
582 | begin |
||
583 | if Verbosity >= zvVerbose then |
||
584 | ShowMsg('Trace: ' + msg, 0, False); // quicker |
||
585 | end; |
||
586 | |||
587 | procedure TZMCore.Done(Good: boolean = true); |
||
588 | begin |
||
589 | CleanupFiles(not Good); |
||
590 | if Sniffer <> 0 then |
||
591 | begin |
||
592 | // send finished |
||
593 | SendMessage(Sniffer, WM_SNIFF_STOP, 0, SniffNo); |
||
594 | Sniffer := 0; |
||
595 | end; |
||
596 | fBusy := False; |
||
597 | end; |
||
598 | |||
599 | function TZMCore.FindSniffer: Cardinal; |
||
600 | var |
||
601 | flgs: Cardinal; |
||
602 | res: Integer; |
||
603 | begin |
||
604 | Result := FindWindow(PChar(STZipSniffer), PChar(SZipMasterSniffer)); |
||
605 | if Result <> 0 then |
||
606 | begin |
||
607 | res := SendMessage(Result, WM_SNIFF_START, Longint(Handle), Ord(Verbosity)); |
||
608 | if res < 0 then |
||
609 | begin |
||
610 | Result := 0; // invalid |
||
611 | exit; |
||
612 | end; |
||
613 | // in range so hopefully valid response |
||
614 | flgs := Cardinal(res) shr 24; |
||
615 | if flgs >= 8 then |
||
616 | begin |
||
617 | Result := 0; // invalid |
||
618 | exit; |
||
619 | end; |
||
620 | // treat it as valid |
||
621 | if flgs > 3 then |
||
622 | Verbosity := TZMVerbosity(flgs and 3); // force it |
||
623 | SniffNo := res and SNIFF_MASK; // operation number |
||
624 | end; |
||
625 | end; |
||
626 | |||
627 | function TZMCore.FNMatch(const pattern, spec: TZMString): Boolean; |
||
628 | begin |
||
629 | {$IFDEF UNICODE} |
||
630 | Result := FileNameMatch(pattern, spec); |
||
631 | {$ELSE} |
||
632 | Result := FileNameMatch(pattern, spec, UseUTF8); |
||
633 | {$ENDIF} |
||
634 | end; |
||
635 | |||
636 | (* ? TZMCore.GetErrMessage |
||
637 | 1.73 13 July 2003 RP only return ErrMessage if error |
||
638 | *) |
||
639 | function TZMCore.GetErrMessage: TZMString; |
||
640 | begin |
||
641 | Result := ''; |
||
642 | if ErrCode <> 0 then |
||
643 | begin |
||
644 | Result := FErrMessage; |
||
645 | if Result = '' then |
||
646 | Result := ZipLoadStr(ErrCode); |
||
647 | if Result = '' then |
||
648 | Result := ZipFmtLoadStr(GE_Unknown, [ErrCode]); |
||
649 | end; |
||
650 | end; |
||
651 | |||
652 | function TZMCore.GetTotalSizeToProcess: Int64; |
||
653 | begin |
||
654 | Result := TProgDetails(fProgDetails).TotalSize; |
||
655 | end; |
||
656 | |||
657 | function TZMCore.GetTotalWritten: Int64; |
||
658 | begin |
||
659 | Result := ProgDetail.BytesWritten; |
||
660 | end; |
||
661 | |||
662 | function TZMCore.KeepAlive: Boolean; |
||
663 | var |
||
664 | DoStop: Boolean; |
||
665 | tmpCheckTerminate: TZMCheckTerminateEvent; |
||
666 | tmpTick: TZMTickEvent; |
||
667 | begin |
||
668 | Result := Cancel <> 0; |
||
669 | tmpTick := Master.OnTick; |
||
670 | if assigned(tmpTick) then |
||
671 | tmpTick(Master); |
||
672 | tmpCheckTerminate := Master.OnCheckTerminate; |
||
673 | if assigned(tmpCheckTerminate) then |
||
674 | begin |
||
675 | DoStop := Cancel <> 0; |
||
676 | tmpCheckTerminate(Master, DoStop); |
||
677 | if DoStop then |
||
678 | Cancel := DS_Canceled; |
||
679 | end |
||
680 | else if not fNotMainTask then |
||
681 | Application.ProcessMessages; |
||
682 | end; |
||
683 | |||
684 | procedure TZMCore.Kill; |
||
685 | begin |
||
686 | fCancel := DS_Canceled; |
||
687 | end; |
||
688 | |||
689 | (* ? TZMCore.MakeTempFileName |
||
690 | Make a temporary filename like: C:\...\zipxxxx.zip |
||
691 | Prefix and extension are default: 'zip' and '.zip' |
||
692 | *) |
||
693 | function TZMCore.MakeTempFileName(Prefix, Extension: String): String; |
||
694 | var |
||
695 | buf: String; |
||
696 | len: DWORD; |
||
697 | tmpDir: String; |
||
698 | begin |
||
699 | if Prefix = '' then |
||
700 | Prefix := 'zip'; |
||
701 | if Extension = '' then |
||
702 | Extension := EXT_ZIPL; |
||
703 | if Length(fTempDir) = 0 then // Get the system temp dir |
||
704 | begin |
||
705 | // 1. The path specified by the TMP environment variable. |
||
706 | // 2. The path specified by the TEMP environment variable, if TMP is not defined. |
||
707 | // 3. The current directory, if both TMP and TEMP are not defined. |
||
708 | len := GetTempPath(0, PChar(tmpDir)); |
||
709 | SetLength(tmpDir, len); |
||
710 | GetTempPath(len, PChar(tmpDir)); |
||
711 | end |
||
712 | else // Use Temp dir provided by ZipMaster |
||
713 | begin |
||
714 | tmpDir := DelimitPath(fTempDir, True); |
||
715 | end; |
||
716 | SetLength(buf, MAX_PATH + 12); |
||
717 | if GetTempFileName(PChar(tmpDir), PChar(Prefix), 0, PChar(buf)) <> 0 then |
||
718 | begin |
||
719 | buf := PChar(buf); |
||
720 | SysUtils.DeleteFile(buf); // Needed because GetTempFileName creates the file also. |
||
721 | Result := ChangeFileExt(buf, Extension); |
||
722 | // And finally change the extension. |
||
723 | end; |
||
724 | end; |
||
725 | |||
726 | function TZMCore.NextCheckNo: Integer; |
||
727 | begin |
||
728 | Inc(fCheckNo); |
||
729 | Result := fCheckNo; |
||
730 | end; |
||
731 | |||
732 | procedure TZMCore.OnDirUpdate; |
||
733 | begin |
||
734 | if assigned(Master.OnDirUpdate) then |
||
735 | Master.OnDirUpdate(Master); |
||
736 | end; |
||
737 | |||
738 | procedure TZMCore.OnNewName(idx: Integer); |
||
739 | begin |
||
740 | if assigned(Master.OnNewName) then |
||
741 | Master.OnNewName(Master, idx); |
||
742 | end; |
||
743 | |||
744 | function TZMCore.RemoveFileCleanup(const fn: String): Boolean; |
||
745 | var |
||
746 | f: String; |
||
747 | i: Integer; |
||
748 | begin |
||
749 | Result := False; |
||
750 | f := ExpandFileName(fn); |
||
751 | for i := fFileCleanup.Count - 1 downto 0 do |
||
752 | if AnsiSameText(fFileCleanup[i], f) then |
||
753 | begin |
||
754 | fFileCleanup.Delete(i); |
||
755 | Result := True; |
||
756 | break; |
||
757 | end; |
||
758 | end; |
||
759 | |||
760 | procedure TZMCore.ReportMessage(err: Integer; const msg: TZMString); |
||
761 | begin |
||
762 | if Sniffer <> 0 then |
||
763 | ReportToSniffer(err, msg); |
||
764 | ReportMessage1(err, msg); |
||
765 | end; |
||
766 | |||
767 | procedure TZMCore.ReportMessage1(err: Integer; const msg: TZMString); |
||
768 | var |
||
769 | tmpMessage: TZMMessageEvent; |
||
770 | begin |
||
771 | if (err <> 0) and (ErrCode = 0) then // only catch first |
||
772 | begin |
||
773 | if DllErrCode = 0 then |
||
774 | FDllErrCode := err; |
||
775 | fFErrCode := err; |
||
776 | FErrMessage := msg; |
||
777 | end; |
||
778 | tmpMessage := Master.OnMessage; |
||
779 | if assigned(tmpMessage) then |
||
780 | tmpMessage(Master, err, msg); |
||
781 | KeepAlive; // process messages or check terminate |
||
782 | end; |
||
783 | |||
784 | procedure TZMCore.ReportMsg(id: Integer; const Args: array of const ); |
||
785 | var |
||
786 | msg: TZMString; |
||
787 | p: Integer; |
||
788 | begin |
||
789 | msg := ZipFmtLoadStr(id, Args); |
||
790 | if msg <> '' then |
||
791 | begin |
||
792 | p := 0; |
||
793 | case msg[1] of |
||
794 | '#': |
||
795 | p := TM_Trace; |
||
796 | '!': |
||
797 | p := TM_Verbose; |
||
798 | end; |
||
799 | if p <> 0 then |
||
800 | begin |
||
801 | msg := ZipLoadStr(p) + copy(msg, 2, Length(msg) - 1); |
||
802 | end; |
||
803 | end; |
||
804 | ReportMessage(0, msg); |
||
805 | end; |
||
806 | |||
807 | (* ? TZMCore.ReportProgress |
||
808 | 1.77.2.0 14 September 2004 - RP fix setting ErrCode caused re-entry |
||
809 | 1.77.2.0 14 September 2004 - RP alter thread support & OnCheckTerminate |
||
810 | 1.77 16 July 2004 - RP preserve last errors ErrMessage |
||
811 | 1.76 24 April 2004 - only handle 'progress' and information |
||
812 | *) |
||
813 | procedure TZMCore.ReportProgress(ActionCode: TActionCodes; ErrorCode: Integer; |
||
814 | msg: TZMString; File_Size: Int64); |
||
815 | var |
||
816 | Details: TProgDetails; |
||
817 | SendDetails: Boolean; |
||
818 | tmpProgress: TZMProgressEvent; |
||
819 | begin |
||
820 | if fIsDestructing then |
||
821 | exit; |
||
822 | if ActionCode <= zacXProgress then |
||
823 | begin |
||
824 | Details := fProgDetails as TProgDetails; |
||
825 | SendDetails := True; |
||
826 | case ActionCode of |
||
827 | zacTick: { 'Tick' Just checking / processing messages } |
||
828 | begin |
||
829 | KeepAlive; |
||
830 | SendDetails := False; |
||
831 | end; |
||
832 | |||
833 | zacItem: { progress type 1 = StartUp any ZIP operation on a new file } |
||
834 | Details.SetItem(msg, File_Size); |
||
835 | |||
836 | zacProgress: { progress type 2 = increment bar } |
||
837 | Details.Advance(File_Size); |
||
838 | |||
839 | zacEndOfBatch: { end of a batch of 1 or more files } |
||
840 | begin |
||
841 | if Details.InBatch then |
||
842 | Details.SetEnd |
||
843 | else |
||
844 | SendDetails := False; |
||
845 | end; |
||
846 | |||
847 | zacCount: { total number of files to process } |
||
848 | Details.SetCount(File_Size); |
||
849 | |||
850 | zacSize: { total size of all files to be processed } |
||
851 | Details.SetSize(File_Size); |
||
852 | |||
853 | zacXItem: { progress type 15 = StartUp new extra operation } |
||
854 | begin |
||
855 | if ErrorCode < 20 then |
||
856 | ErrorCode := PR_Progress + ErrorCode; |
||
857 | msg := ZipLoadStr(ErrorCode); |
||
858 | Details.SetItemXtra(msg, File_Size); |
||
859 | end; |
||
860 | |||
861 | zacXProgress: { progress type 16 = increment bar for extra operation } |
||
862 | Details.AdvanceXtra(File_Size); |
||
863 | end; { end case } |
||
864 | {$IFDEF DEBUG_PROGRESS} |
||
865 | if Verbosity >= zvVerbose then |
||
866 | case ActionCode of |
||
867 | zacItem: |
||
868 | Diag(Format('#Item - "%s" %d', [Details.ItemName, Details.ItemSize])); |
||
869 | zacProgress: |
||
870 | Diag(Format('#Progress - [inc:%d] ipos:%d isiz:%d, tpos:%d tsiz:%d', |
||
871 | [File_Size, Details.ItemPosition, Details.ItemSize, |
||
872 | Details.TotalPosition, Details.TotalSize])); |
||
873 | zacEndOfBatch: |
||
874 | if SendDetails then |
||
875 | Diag('#End Of Batch') |
||
876 | else |
||
877 | Diag('#End Of Batch with no batch'); |
||
878 | zacCount: |
||
879 | Diag(Format('#Count - %d', [Details.TotalCount])); |
||
880 | zacSize: |
||
881 | Diag(Format('#Size - %d', [Details.TotalSize])); |
||
882 | zacXItem: |
||
883 | Diag(Format('#XItem - %s size = %d', [Details.ItemName, File_Size])); |
||
884 | zacXProgress: |
||
885 | Diag(Format('#XProgress - [inc:%d] pos:%d siz:%d', |
||
886 | [File_Size, Details.ItemPosition, Details.ItemSize])); |
||
887 | end; |
||
888 | {$ENDIF} |
||
889 | tmpProgress := Master.OnProgress; |
||
890 | if SendDetails and (assigned(tmpProgress)) then |
||
891 | tmpProgress(Master, Details); |
||
892 | end; |
||
893 | |||
894 | KeepAlive; |
||
895 | end; |
||
896 | |||
897 | // returns True if skipping not allowed |
||
898 | function TZMCore.ReportSkipping(const FName: String; err: Integer; |
||
899 | typ: TZMSkipTypes): Boolean; |
||
900 | var |
||
901 | ti: Integer; |
||
902 | tmpMessage: ZipMstr19.TZMMessageEvent; |
||
903 | tmpSkipped: TZMSkippedEvent; |
||
904 | begin |
||
905 | Result := False; |
||
906 | if typ in NoSkipping then |
||
907 | begin |
||
908 | if err = 0 then |
||
909 | err := GE_NoSkipping; |
||
910 | end; |
||
911 | ti := err; |
||
912 | if ti < 0 then |
||
913 | ti := -ti; |
||
914 | if (ti <> 0) and (typ in NoSkipping) then |
||
915 | ti := -ti; // default to abort |
||
916 | tmpSkipped := Master.OnSkipped; |
||
917 | if assigned(tmpSkipped) then |
||
918 | tmpSkipped(Master, FName, typ, ti) |
||
919 | else if Verbosity >= zvVerbose then |
||
920 | begin |
||
921 | tmpMessage := Master.OnMessage; |
||
922 | if assigned(tmpMessage) then |
||
923 | tmpMessage(Master, GE_Unknown, ZipFmtLoadStr |
||
924 | (GE_Skipped, [FName, Ord(typ)])); |
||
925 | end; |
||
926 | if ti < 0 then |
||
927 | Result := True; // Skipping not allowed |
||
928 | if Sniffer <> 0 then |
||
929 | ReportToSniffer(0, Format('[Skipped] IN=%d,%d OUT=%d', [err, Ord(typ), Ord |
||
930 | (Result)])); |
||
931 | end; |
||
932 | |||
933 | procedure TZMCore.ReportToSniffer(err: Integer; const msg: TZMString); |
||
934 | var |
||
935 | aCopyData: TCopyDataStruct; |
||
936 | msg8: UTF8String; |
||
937 | begin |
||
938 | if Sniffer = 0 then // should not happen |
||
939 | exit; |
||
940 | // always feed Sniffer with UTF8 |
||
941 | {$IFDEF UNICODE} |
||
942 | msg8 := StrToUTF8(msg); |
||
943 | {$ELSE} |
||
944 | if UseUTF8 then |
||
945 | msg8 := msg |
||
946 | else |
||
947 | msg8 := StrToUTF8(msg); |
||
948 | {$ENDIF} |
||
949 | aCopyData.dwData := Cardinal(err); |
||
950 | aCopyData.cbData := (Length(msg8) + 1) * sizeof(AnsiChar); |
||
951 | aCopyData.lpData := @msg8[1]; |
||
952 | if SendMessage(Sniffer, WM_COPYDATA, SniffNo, Longint(@aCopyData)) = 0 then |
||
953 | Sniffer := 0; // could not process it -don't try again |
||
954 | end; |
||
955 | |||
956 | procedure TZMCore.SetCancel(Value: Integer); |
||
957 | begin |
||
958 | fCancel := Value; |
||
959 | end; |
||
960 | |||
961 | procedure TZMCore.SetEncoding(const Value: TZMEncodingOpts); |
||
962 | begin |
||
963 | if Encoding <> Value then |
||
964 | begin |
||
965 | FEncoding := Value; |
||
966 | EncodingChanged(Value); |
||
967 | end; |
||
968 | end; |
||
969 | |||
970 | procedure TZMCore.SetEncoding_CP(const Value: Cardinal); |
||
971 | begin |
||
972 | if Encoding_CP <> Value then |
||
973 | begin |
||
974 | FEncoding_CP := Value; |
||
975 | Encoding_CPChanged(Value); |
||
976 | end; |
||
977 | end; |
||
978 | |||
979 | (* ? TZMCore.SetErrCode |
||
980 | Some functions return -error - normalise these values |
||
981 | *) |
||
982 | procedure TZMCore.SetErrCode(Value: Integer); |
||
983 | begin |
||
984 | if Value < 0 then |
||
985 | fFErrCode := -Value |
||
986 | else |
||
987 | fFErrCode := Value; |
||
988 | end; |
||
989 | |||
990 | procedure TZMCore.SetProgDetail(const Value: TProgDetails); |
||
991 | begin |
||
992 | // do not change |
||
993 | end; |
||
994 | |||
995 | procedure TZMCore.SetTotalWritten(const Value: Int64); |
||
996 | begin |
||
997 | ProgDetail.Written(Value); |
||
998 | end; |
||
999 | |||
1000 | (* ? TZMCore.ShowExceptionError |
||
1001 | 1.80 strings already formatted |
||
1002 | // Somewhat different from ShowZipMessage() because the loading of the resource |
||
1003 | // string is already done in the constructor of the exception class. |
||
1004 | *) |
||
1005 | procedure TZMCore.ShowExceptionError(const ZMExcept: Exception); |
||
1006 | var |
||
1007 | display: Boolean; |
||
1008 | msg: String; |
||
1009 | ResID: Integer; |
||
1010 | begin |
||
1011 | if ZMExcept is EZMException then |
||
1012 | begin |
||
1013 | ResID := EZMException(ZMExcept).ResID; |
||
1014 | display := EZMException(ZMExcept).DisplayMsg; |
||
1015 | {$IFDEF UNICODE} |
||
1016 | msg := EZMException(ZMExcept).Message; |
||
1017 | {$ELSE} |
||
1018 | msg := EZMException(ZMExcept).TheMessage(UseUTF8); |
||
1019 | {$ENDIF} |
||
1020 | end |
||
1021 | else |
||
1022 | begin |
||
1023 | ResID := GE_ExceptErr; |
||
1024 | display := True; |
||
1025 | msg := ZMExcept.Message; |
||
1026 | end; |
||
1027 | ShowMsg(msg, ResID, display); |
||
1028 | end; |
||
1029 | |||
1030 | procedure TZMCore.ShowMsg(const msg: TZMString; err: Integer; display: Boolean); |
||
1031 | begin |
||
1032 | FErrMessage := msg; |
||
1033 | if err < 0 then |
||
1034 | fFErrCode := -err |
||
1035 | else |
||
1036 | fFErrCode := err; |
||
1037 | if display and (not fUnattended) and (ErrCode <> GE_Abort) and |
||
1038 | (ErrCode <> DS_Canceled) then |
||
1039 | ZipMessageDlg(msg, zmtInformation + DHC_ZipMessage); |
||
1040 | |||
1041 | ReportMessage(ErrCode, msg); |
||
1042 | end; |
||
1043 | |||
1044 | (* ? TZMCore.ShowZipFmtMsg |
||
1045 | 1.79 added |
||
1046 | *) |
||
1047 | procedure TZMCore.ShowZipFmtMsg(id: Integer; const Args: array of const ; |
||
1048 | display: Boolean); |
||
1049 | begin |
||
1050 | if id < 0 then |
||
1051 | id := -id; |
||
1052 | ShowMsg(ZipFmtLoadStr(id, Args), id, display); |
||
1053 | end; |
||
1054 | |||
1055 | (* ? TZMCore.ShowZipMessage |
||
1056 | *) |
||
1057 | procedure TZMCore.ShowZipMessage(Ident: Integer; const UserStr: String); |
||
1058 | var |
||
1059 | msg: String; |
||
1060 | begin |
||
1061 | if Ident < 0 then |
||
1062 | Ident := -Ident; |
||
1063 | msg := ZipLoadStr(Ident); |
||
1064 | if msg = '' then |
||
1065 | msg := Format(RESOURCE_ERROR, [Ident]); |
||
1066 | msg := msg + UserStr; |
||
1067 | ShowMsg(msg, Ident, True); |
||
1068 | end; |
||
1069 | |||
1070 | procedure TZMCore.ShowZipMsg(Ident: Integer; display: Boolean); |
||
1071 | var |
||
1072 | msg: String; |
||
1073 | begin |
||
1074 | if Ident < 0 then |
||
1075 | Ident := -Ident; |
||
1076 | msg := ZipLoadStr(Ident); |
||
1077 | if msg = '' then |
||
1078 | msg := Format(RESOURCE_ERROR, [Ident]); |
||
1079 | ShowMsg(msg, Ident, display); |
||
1080 | end; |
||
1081 | |||
1082 | (* ? TZMCore.StartUp |
||
1083 | *) |
||
1084 | procedure TZMCore.StartUp; |
||
1085 | var |
||
1086 | s: String; |
||
1087 | begin |
||
1088 | fBusy := True; |
||
1089 | Cancel := 0; |
||
1090 | fAnswerAll := []; |
||
1091 | ClearErr; |
||
1092 | {$IFNDEF UNICODE} |
||
1093 | fUseUTF8 := Master.UseUTF8; |
||
1094 | {$ENDIF} |
||
1095 | fHandle := Master.Handle; |
||
1096 | FAddOptions := Master.AddOptions; |
||
1097 | fUnattended := Master.Unattended; |
||
1098 | fConfirmErase := Master.ConfirmErase; |
||
1099 | fKeepFreeOnAllDisks := Master.KeepFreeOnAllDisks; |
||
1100 | fKeepFreeOnDisk1 := Master.KeepFreeOnDisk1; |
||
1101 | if Master.MaxVolumeSizeKb = 0 then |
||
1102 | FMaxVolumeSize := Master.MaxVolumeSize |
||
1103 | else |
||
1104 | FMaxVolumeSize := Master.MaxVolumeSizeKb * 1024; |
||
1105 | fMinFreeVolumeSize := Master.MinFreeVolumeSize; |
||
1106 | FNoSkipping := Master.NoSkipping; |
||
1107 | fSpanOptions := Master.SpanOptions; |
||
1108 | FWriteOptions := Master.WriteOptions; |
||
1109 | if Master.Trace then |
||
1110 | fVerbosity := zvTrace |
||
1111 | else if Master.Verbose then |
||
1112 | fVerbosity := zvVerbose |
||
1113 | else |
||
1114 | fVerbosity := zvOff; |
||
1115 | {f}Encoding := Master.Encoding; |
||
1116 | Encoding_CP := Master.Encoding_CP; |
||
1117 | FEncodeAs := Master.EncodeAs; |
||
1118 | fHowToDelete := Master.HowToDelete; |
||
1119 | TempDir := Master.TempDir; |
||
1120 | fFSpecArgs.Assign(Master.FSpecArgs); |
||
1121 | fFSpecArgsExcl.Assign(Master.FSpecArgsExcl); |
||
1122 | FIgnoreDirOnly := not Master.UseDirOnlyEntries; |
||
1123 | fNotMainTask := Master.NotMainThread; |
||
1124 | if GetCurrentThreadID <> MainThreadID then |
||
1125 | fNotMainTask := True; |
||
1126 | Sniffer := FindSniffer; |
||
1127 | if Sniffer <> 0 then |
||
1128 | begin |
||
1129 | if Master.Owner <> nil then |
||
1130 | begin |
||
1131 | s := Master.Owner.Name; |
||
1132 | if s <> '' then |
||
1133 | s := s + '.'; |
||
1134 | end; |
||
1135 | if Master.Name = '' then |
||
1136 | s := '<unknown>' |
||
1137 | else |
||
1138 | s := s + Master.Name; |
||
1139 | if fNotMainTask then |
||
1140 | s := '*' + s; |
||
1141 | ReportToSniffer(0, 'Starting ' + s); |
||
1142 | end; |
||
1143 | fFileCleanup.Clear; |
||
1144 | end; |
||
1145 | |||
1146 | function TZMCore.ZipFmtLoadStr(id: Integer; const Args: array of const ) |
||
1147 | : TZMString; |
||
1148 | begin |
||
1149 | Result := ZipLoadStr(id); |
||
1150 | |||
1151 | if Result <> '' then |
||
1152 | Result := Format(Result, Args); |
||
1153 | end; |
||
1154 | |||
1155 | function TZMCore.ZipLoadStr(id: Integer): TZMString; |
||
1156 | begin |
||
1157 | Result := LoadZipStr(id); |
||
1158 | {$IFNDEF UNICODE} |
||
1159 | if (Result <> '') and UseUTF8 then |
||
1160 | Result := StrToUTF8(Result); |
||
1161 | {$ENDIF} |
||
1162 | end; |
||
1163 | |||
1164 | function TZMCore.ZipMessageDialog(const title: String; var msg: String; |
||
1165 | context: Integer; btns: TMsgDlgButtons): TModalResult; |
||
1166 | var |
||
1167 | ctx: Integer; |
||
1168 | dlg: TZipDialogBox; |
||
1169 | s: String; |
||
1170 | t: String; |
||
1171 | tmpZipDialog: TZMDialogEvent; |
||
1172 | begin |
||
1173 | t := title; |
||
1174 | if title = '' then |
||
1175 | t := Application.title; |
||
1176 | if Verbosity >= zvVerbose then |
||
1177 | t := Format('%s (%d)', [t, context and MAX_WORD]); |
||
1178 | tmpZipDialog := Master.OnZipDialog; |
||
1179 | if assigned(tmpZipDialog) then |
||
1180 | begin |
||
1181 | s := msg; |
||
1182 | ctx := context; |
||
1183 | tmpZipDialog(Master, t, s, ctx, btns); |
||
1184 | if (ctx > 0) and (ctx <= Ord(mrYesToAll)) then |
||
1185 | begin |
||
1186 | msg := s; |
||
1187 | Result := TModalResult(ctx); |
||
1188 | exit; |
||
1189 | end; |
||
1190 | end; |
||
1191 | dlg := TZipDialogBox.CreateNew2(Application, context); |
||
1192 | try |
||
1193 | dlg.Build(t, msg, btns {$IFNDEF UNICODE}, UseUTF8 {$ENDIF}); |
||
1194 | dlg.ShowModal(); |
||
1195 | Result := dlg.ModalResult; |
||
1196 | if dlg.DlgType = zmtPassword then |
||
1197 | begin |
||
1198 | if (Result = mrOk) then |
||
1199 | msg := dlg.PWrd |
||
1200 | else |
||
1201 | msg := ''; |
||
1202 | end; |
||
1203 | finally |
||
1204 | FreeAndNil(dlg); |
||
1205 | end; |
||
1206 | end; |
||
1207 | |||
1208 | procedure TZMCore.ZipMessageDlg(const msg: String; context: Integer); |
||
1209 | begin |
||
1210 | ZipMessageDlgEx('', msg, context, [mbOK]); |
||
1211 | end; |
||
1212 | |||
1213 | function TZMCore.ZipMessageDlgEx(const title, msg: String; context: Integer; |
||
1214 | btns: TMsgDlgButtons): TModalResult; |
||
1215 | var |
||
1216 | m: String; |
||
1217 | begin |
||
1218 | m := msg; |
||
1219 | Result := ZipMessageDialog(title, m, context, btns); |
||
1220 | end; |
||
1221 | |||
1222 | procedure TZMPipeImp.AfterConstruction; |
||
1223 | begin |
||
1224 | inherited; |
||
1225 | FStream := nil; |
||
1226 | fSize := 0; |
||
1227 | fDOSDate := Cardinal(DateTimeToFileDate(now)); |
||
1228 | fAttributes := 0; |
||
1229 | end; |
||
1230 | |||
1231 | procedure TZMPipeImp.AssignTo(Dest: TZMPipeImp); |
||
1232 | begin |
||
1233 | if Dest <> self then |
||
1234 | begin |
||
1235 | Dest.Stream := FStream; |
||
1236 | FStream := nil; |
||
1237 | Dest.Size := FSize; |
||
1238 | Dest.DOSDate := fDOSDate; |
||
1239 | Dest.Attributes := FAttributes; |
||
1240 | Dest.OwnsStream := FOwnsStream; |
||
1241 | end; |
||
1242 | end; |
||
1243 | |||
1244 | procedure TZMPipeImp.BeforeDestruction; |
||
1245 | begin |
||
1246 | if OwnsStream and (FStream <> nil) then |
||
1247 | FStream.Free; |
||
1248 | inherited; |
||
1249 | end; |
||
1250 | |||
1251 | function TZMPipeImp.GetAttributes: Cardinal; |
||
1252 | begin |
||
1253 | Result := FAttributes; |
||
1254 | end; |
||
1255 | |||
1256 | function TZMPipeImp.GetDOSDate: Cardinal; |
||
1257 | begin |
||
1258 | Result := FDOSDate; |
||
1259 | end; |
||
1260 | |||
1261 | function TZMPipeImp.GetFileName: string; |
||
1262 | begin |
||
1263 | Result := FFileName; |
||
1264 | end; |
||
1265 | |||
1266 | function TZMPipeImp.GetOwnsStream: boolean; |
||
1267 | begin |
||
1268 | Result := FOwnsStream; |
||
1269 | end; |
||
1270 | |||
1271 | function TZMPipeImp.GetSize: Integer; |
||
1272 | begin |
||
1273 | Result := FSize; |
||
1274 | end; |
||
1275 | |||
1276 | function TZMPipeImp.GetStream: TStream; |
||
1277 | begin |
||
1278 | Result := FStream; |
||
1279 | end; |
||
1280 | |||
1281 | procedure TZMPipeImp.SetAttributes(const Value: Cardinal); |
||
1282 | begin |
||
1283 | FAttributes := Value; |
||
1284 | end; |
||
1285 | |||
1286 | procedure TZMPipeImp.SetDOSDate(const Value: Cardinal); |
||
1287 | begin |
||
1288 | FDOSDate := Value; |
||
1289 | end; |
||
1290 | |||
1291 | procedure TZMPipeImp.SetFileName(const Value: string); |
||
1292 | begin |
||
1293 | if FFileName <> Value then |
||
1294 | begin |
||
1295 | FFileName := Value; |
||
1296 | end; |
||
1297 | end; |
||
1298 | |||
1299 | procedure TZMPipeImp.SetOwnsStream(const Value: boolean); |
||
1300 | begin |
||
1301 | FOwnsStream := Value; |
||
1302 | end; |
||
1303 | |||
1304 | procedure TZMPipeImp.SetSize(const Value: Integer); |
||
1305 | begin |
||
1306 | if Value <> FSize then |
||
1307 | begin |
||
1308 | if FStream = nil then |
||
1309 | FSize := 0 |
||
1310 | else |
||
1311 | begin |
||
1312 | if Value > FStream.Size then |
||
1313 | FSize := Integer(FStream.Size) |
||
1314 | else |
||
1315 | FSize := Value; |
||
1316 | end; |
||
1317 | end; |
||
1318 | end; |
||
1319 | |||
1320 | procedure TZMPipeImp.SetStream(const Value: TStream); |
||
1321 | begin |
||
1322 | if FStream <> Value then |
||
1323 | begin |
||
1324 | if Value = nil then |
||
1325 | FStream.Free; |
||
1326 | FStream := Value; |
||
1327 | if Value <> nil then |
||
1328 | begin |
||
1329 | FSize := Integer(FStream.Size); |
||
1330 | FStream.Position := 0; |
||
1331 | end; |
||
1332 | end; |
||
1333 | end; |
||
1334 | |||
1335 | function TZMPipeListImp.Add(aStream: TStream; const FileName: string; Own: |
||
1336 | boolean): integer; |
||
1337 | var |
||
1338 | tmpPipe: TZMPipe; |
||
1339 | begin |
||
1340 | Result := List.Count; |
||
1341 | tmpPipe := Pipe[Result]; |
||
1342 | tmpPipe.Stream := aStream; |
||
1343 | tmpPipe.FileName := FileName; |
||
1344 | tmpPipe.OwnsStream := Own; |
||
1345 | end; |
||
1346 | |||
1347 | procedure TZMPipeListImp.AfterConstruction; |
||
1348 | begin |
||
1349 | inherited; |
||
1350 | List := TList.Create; |
||
1351 | end; |
||
1352 | |||
1353 | procedure TZMPipeListImp.AssignTo(Dest: TZMPipeListImp); |
||
1354 | var |
||
1355 | I: Integer; |
||
1356 | begin |
||
1357 | if (Dest <> nil) and (Dest <> Self) then |
||
1358 | begin |
||
1359 | Dest.Clear; |
||
1360 | for I := 0 to Count - 1 do |
||
1361 | Dest.List.Add(List[i]); |
||
1362 | List.Clear; |
||
1363 | end; |
||
1364 | end; |
||
1365 | |||
1366 | procedure TZMPipeListImp.BeforeDestruction; |
||
1367 | begin |
||
1368 | Clear; |
||
1369 | List.Free; |
||
1370 | inherited; |
||
1371 | end; |
||
1372 | |||
1373 | procedure TZMPipeListImp.Clear; |
||
1374 | var |
||
1375 | i: Integer; |
||
1376 | tmp: TZMPipeImp; |
||
1377 | begin |
||
1378 | if (List <> nil) and (List.Count > 0) then |
||
1379 | begin |
||
1380 | for I := 0 to List.Count - 1 do |
||
1381 | begin |
||
1382 | if TObject(List[i]) is TZMPipeImp then |
||
1383 | begin |
||
1384 | tmp := TZMPipeImp(List[i]); |
||
1385 | List[i] := nil; |
||
1386 | tmp.Free; |
||
1387 | end; |
||
1388 | end; |
||
1389 | List.Clear; |
||
1390 | end; |
||
1391 | end; |
||
1392 | |||
1393 | function TZMPipeListImp.GetCount: Integer; |
||
1394 | begin |
||
1395 | Result := List.Count; |
||
1396 | end; |
||
1397 | |||
1398 | function TZMPipeListImp.GetPipe(Index: Integer): TZMPipe; |
||
1399 | var |
||
1400 | tmpPipe: TZMPipeImp; |
||
1401 | begin |
||
1402 | if (Index <0) or (Index > MAX_PIPE) then |
||
1403 | raise EZipMaster.CreateResFmt(GE_RangeError, [Index, MAX_PIPE]); |
||
1404 | if Index >= List.Count then |
||
1405 | List.Count := Index + 1; |
||
1406 | if not (TObject(List[Index]) is TZMPipeImp) then |
||
1407 | begin |
||
1408 | // need a new one |
||
1409 | tmpPipe := TZMPipeImp.Create; |
||
1410 | List[Index] := tmpPipe; |
||
1411 | end; |
||
1412 | Result := TZMPipeImp(List[Index]); |
||
1413 | end; |
||
1414 | |||
1415 | function TZMPipeListImp.HasStream(Index: Integer): boolean; |
||
1416 | begin |
||
1417 | Result := (Index >= 0) and (Index < count) and (Pipe[Index].Stream <> nil); |
||
1418 | end; |
||
1419 | |||
1420 | function TZMPipeListImp.KillStream(Index: Integer): boolean; |
||
1421 | var |
||
1422 | tmp: TZMPipe; |
||
1423 | begin |
||
1424 | Result := False; |
||
1425 | if (Index >= 0) and (Index < count) then |
||
1426 | begin |
||
1427 | tmp := Pipe[Index]; |
||
1428 | if tmp.OwnsStream and (tmp.Stream <> nil) then |
||
1429 | tmp.Stream := nil; |
||
1430 | end; |
||
1431 | end; |
||
1432 | |||
1433 | procedure TZMPipeListImp.SetCount(const Value: Integer); |
||
1434 | var |
||
1435 | I: Integer; |
||
1436 | begin |
||
1437 | if (Value <0) or (Value > MAX_PIPE) then |
||
1438 | raise EZipMaster.CreateResInt(GE_RangeError, Value); |
||
1439 | if Value > List.Count then |
||
1440 | begin |
||
1441 | I := List.Count; |
||
1442 | while I < Value do |
||
1443 | List.Add(nil); |
||
1444 | end; |
||
1445 | end; |
||
1446 | |||
1447 | procedure TZMPipeListImp.SetPipe(Index: Integer; const Value: TZMPipe); |
||
1448 | var |
||
1449 | tmpPipe: TZMPipeImp; |
||
1450 | begin |
||
1451 | if (Index <0) or (Index > MAX_PIPE) then |
||
1452 | raise EZipMaster.CreateResInt(GE_RangeError, Index); |
||
1453 | if Index >= List.Count then |
||
1454 | List.Count := Index + 1; |
||
1455 | if not (TObject(List[Index]) is TZMPipeImp) then |
||
1456 | List[Index] := Value |
||
1457 | else |
||
1458 | begin |
||
1459 | tmpPipe := TZMPipeImp(List[Index]); |
||
1460 | if Value <> tmpPipe then |
||
1461 | begin |
||
1462 | tmpPipe.Free; |
||
1463 | List[Index] := Value; |
||
1464 | end; |
||
1465 | end; |
||
1466 | end; |
||
1467 | |||
1468 | |||
1469 | end. |