Rev 3 | Details | Compare with Previous | Last modification | View Log | RSS feed
Rev | Author | Line No. | Line |
---|---|---|---|
1 | daniel-mar | 1 | unit ExtractorMain; |
2 | |||
5 | daniel-mar | 3 | {$DEFINE USE_DZIP_UNPACK} // recommended |
1 | daniel-mar | 4 | |
5 | interface |
||
6 | |||
7 | uses |
||
8 | Windows, SysUtils, Classes, Controls, Forms, Dialogs, StdCtrls, ShellAPI, |
||
9 | ExtCtrls, ComCtrls, ZipMstr19, ZMMsgStr19, ZMMsg19, ZMDelZip19, |
||
2 | daniel-mar | 10 | ZMCompat19, SFXBehavior, ShlObj; |
1 | daniel-mar | 11 | |
12 | type |
||
13 | TOverwriteDecision = (odUndefined, odOverwriteAll, odOverwriteNothing); |
||
14 | |||
15 | TMainForm = class(TForm) |
||
16 | ProgressBar: TProgressBar; |
||
17 | WaitLabel: TLabel; |
||
18 | CancelBtn: TButton; |
||
19 | CurrentFileLabel: TLabel; |
||
20 | AutoTimer: TTimer; |
||
21 | itemBar: TProgressBar; |
||
22 | procedure CancelBtnClick(Sender: TObject); |
||
23 | procedure FormCreate(Sender: TObject); |
||
24 | procedure AutoTimerTimer(Sender: TObject); |
||
25 | procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean); |
||
26 | private |
||
3 | daniel-mar | 27 | ExtractionInProcess: boolean; |
28 | uz: TZipMaster19; |
||
1 | daniel-mar | 29 | RenamingOldPrefix: string; |
30 | RenamingNewPrefix: string; |
||
31 | zb: TZIPBehavior; |
||
32 | BaseDir: string; |
||
33 | AbortUnzip: boolean; |
||
34 | StopAskingPassword: boolean; |
||
35 | LastTriedPassword: string; |
||
3 | daniel-mar | 36 | CachedOverwriteDecision: TOverwriteDecision; |
1 | daniel-mar | 37 | {$IFNDEF USE_DZIP_UNPACK} |
38 | procedure ExtractDllFromResource(ADirectory: string); |
||
39 | {$ENDIF} |
||
40 | procedure ExtractZipHere(AZipfile: string); |
||
3 | daniel-mar | 41 | procedure EvExtFNChange(Sender: TObject; var FileName: TZMString; const BaseDir: TZMString; var IsChanged: Boolean); |
42 | procedure EvProgress(Sender: TObject; details: TZMProgressDetails); |
||
43 | procedure EvTick(Sender: TObject); |
||
44 | procedure EvCheckTerminate(Sender: TObject; var abort: Boolean); |
||
45 | procedure EvConfirmOverwrite(Sender: TObject; const ForFile: TZMString; |
||
1 | daniel-mar | 46 | IsOlder: Boolean; var DoOverwrite: Boolean; DirIndex: Integer); |
3 | daniel-mar | 47 | procedure EvPasswordEvent(Sender: TObject; IsZipAction: Boolean; |
1 | daniel-mar | 48 | var NewPassword: String; const ForFile: TZMString; var RepeatCount: Longword; |
49 | var Action: TMsgDlgBtn); |
||
3 | daniel-mar | 50 | procedure EvSkipEvent(Sender: TObject; const ForFile: TZMString; |
1 | daniel-mar | 51 | SkipType: TZMSkipTypes; var ExtError: Integer); |
52 | function StripBaseDir(const s: string): string; |
||
53 | end; |
||
54 | |||
55 | var |
||
56 | MainForm: TMainForm; |
||
57 | |||
58 | implementation |
||
59 | |||
60 | uses |
||
3 | daniel-mar | 61 | ExtractorPassword, ExtractorError, Functions, SFXAutoRun, ExtractorComment, |
62 | BrowseFolder; |
||
1 | daniel-mar | 63 | |
64 | const |
||
3 | daniel-mar | 65 | EvPasswordTries = 15; |
1 | daniel-mar | 66 | |
67 | {$R *.dfm} |
||
68 | |||
69 | {$R zmstr1900102\DLL\ResDLL-Maker\ZMRes19_dll.res} |
||
70 | |||
71 | function IsRootFile(s: string): boolean; |
||
72 | var |
||
73 | i: integer; |
||
74 | begin |
||
75 | if s = '' then |
||
76 | begin |
||
77 | result := false; |
||
78 | Exit; |
||
79 | end; |
||
80 | if LooksLikeDir(s) then |
||
81 | begin |
||
82 | s := Copy(s, 1, Length(s)-1); |
||
83 | end; |
||
84 | for i := 1 to Length(s) do |
||
85 | begin |
||
86 | if s[i] = PathDelim then |
||
87 | begin |
||
88 | result := false; |
||
89 | Exit; |
||
90 | end; |
||
91 | end; |
||
92 | result := true; |
||
93 | end; |
||
94 | |||
95 | function FEListAll(theRec: TZMDirEntry; var Data): Integer; |
||
96 | var |
||
97 | l: TStringList absolute Data; |
||
98 | s: string; |
||
99 | begin |
||
100 | Result := 0; |
||
101 | |||
102 | s := theRec.FileName; |
||
103 | l.Add(s); |
||
104 | |||
105 | s := ExtractFilePath(s); |
||
106 | if l.IndexOf(s) = -1 then l.Add(s); |
||
107 | end; |
||
108 | |||
109 | procedure ListRootFiles(uz: TZipMaster19; List: TStringList); |
||
110 | var |
||
111 | s: string; |
||
112 | l: TStringList; |
||
113 | i: Integer; |
||
114 | resourcestring |
||
115 | Lng_ForeachFailed = 'Dateiiteration fehlgeschlagen!'; |
||
116 | begin |
||
117 | List.Clear; |
||
118 | |||
119 | l := TStringList.Create; |
||
120 | try |
||
121 | // Fill list (inclusive Directories) |
||
122 | |||
123 | uz.FSpecArgs.Add('*'); |
||
124 | if uz.ForEach(FEListAll, l) <> 0 then |
||
125 | begin |
||
126 | MessageDlg(Lng_ForeachFailed, mtError, [mbOk], 0); |
||
127 | end; |
||
128 | |||
129 | // Now look for root files |
||
130 | |||
131 | for i := 0 to l.Count - 1 do |
||
132 | begin |
||
133 | s := l.Strings[i]; |
||
134 | |||
135 | if IsRootFile(s) then |
||
136 | begin |
||
137 | List.Add(s); |
||
138 | end; |
||
139 | end; |
||
140 | finally |
||
141 | l.Free; |
||
142 | end; |
||
143 | end; |
||
144 | |||
145 | procedure TMainForm.ExtractZipHere(AZipfile: string); |
||
146 | var |
||
147 | l: TStringList; |
||
148 | s: string; |
||
149 | ec: Integer; |
||
150 | ar: TExecuteSFXAutoRunResult; |
||
2 | daniel-mar | 151 | GeneralBaseDir: string; |
5 | daniel-mar | 152 | ok: boolean; |
3 | daniel-mar | 153 | const |
154 | C_Explorer_Open_Param = '"%s"'; |
||
155 | C_Explorer_Select_Param = '/n,/select,"%s"'; |
||
156 | EXPLORER_EXE = 'explorer'; |
||
1 | daniel-mar | 157 | resourcestring |
158 | Lng_Aborted = 'Der laufende Prozess wurde abgebrochen. Das extrahierten Dateien sind somit unvollständig.'; |
||
159 | Lng_Zip_Error = 'ZIP-Master Fehler "%s" (%d)'; |
||
160 | Lng_AutoRunFailed = 'SFX-AutoRun fehlgeschlagen. Die entpackten Inhalte werden nun angezeigt.'; |
||
161 | Lng_Unknown_Error = 'Unbekannter Fehler: Dateien sind nicht aufzufinden!'; |
||
2 | daniel-mar | 162 | Lng_SelectDir = 'Bitte wählen Sie ein Verzeichnis zum Extrahieren aus. Es wird maximal 1 Datei bzw. Ordner erstellt!'; |
5 | daniel-mar | 163 | Lng_WriteProtected = 'Das Verzeichnis ist nicht schreibbar! Bitte wählen Sie ein Anderes.'; |
1 | daniel-mar | 164 | begin |
165 | AZipfile := ExpandUNCFileName(AZipfile); |
||
166 | RenamingOldPrefix := ''; |
||
167 | RenamingNewPrefix := ''; |
||
168 | |||
3 | daniel-mar | 169 | if Assigned(uz) then uz.Free; // uz ist global, damit AbortDLL aufgerufen werden kann |
170 | |||
1 | daniel-mar | 171 | uz := TZipMaster19.Create(nil); |
172 | try |
||
3 | daniel-mar | 173 | ExtractionInProcess := true; |
1 | daniel-mar | 174 | {$IFNDEF USE_DZIP_UNPACK} |
175 | uz.DLLDirectory := GetTempDirectory + DelZipDLL_Name; |
||
176 | {$ENDIF} |
||
177 | uz.DLL_Load := true; |
||
178 | |||
179 | uz.ZipFileName := AZipFile; |
||
180 | uz.Active := true; |
||
181 | zb := ReadBehavior(uz.ZipComment); |
||
182 | |||
183 | uz.Unattended := true; |
||
184 | uz.ExtrOptions := [ExtrDirNames, ExtrOverWrite, ExtrFreshen, ExtrUpdate, |
||
185 | ExtrForceDirs, ExtrNTFS]; |
||
186 | |||
3 | daniel-mar | 187 | uz.OnExtractOverwrite := EvConfirmOverwrite; |
188 | uz.OnProgress := EvProgress; |
||
189 | uz.OnTick := EvTick; |
||
190 | uz.OnCheckTerminate := EvCheckTerminate; |
||
191 | uz.OnPasswordError := EvPasswordEvent; |
||
192 | uz.PasswordReqCount := EvPasswordTries; |
||
193 | uz.OnSkipped := EvSkipEvent; |
||
194 | uz.OnSetExtName := EvExtFNChange; |
||
1 | daniel-mar | 195 | |
2 | daniel-mar | 196 | // Find out base dirtory |
197 | |||
198 | GeneralBaseDir := ''; |
||
5 | daniel-mar | 199 | |
200 | if zb.ExtractionTarget = etExtractHere then |
||
201 | begin |
||
202 | GeneralBaseDir := ExtractFilePath(AZipfile); // Default |
||
203 | |||
204 | if not IsDirectoryWritable(GeneralBaseDir) or |
||
205 | IsAtFlobbyDisk(GeneralBaseDir) then |
||
206 | begin |
||
207 | zb.ExtractionTarget := etDesktop; |
||
208 | end; |
||
209 | end; |
||
210 | |||
211 | if zb.ExtractionTarget = etDesktop then |
||
212 | begin |
||
213 | GeneralBaseDir := GetSpecialFolderPath(CSIDL_DESKTOP); |
||
214 | |||
215 | if not IsDirectoryWritable(GeneralBaseDir) or |
||
216 | IsAtFlobbyDisk(GeneralBaseDir) then |
||
217 | begin |
||
218 | zb.ExtractionTarget := etAsk; |
||
219 | end; |
||
220 | end; |
||
221 | |||
222 | if zb.ExtractionTarget = etAsk then |
||
223 | begin |
||
224 | repeat |
||
225 | GeneralBaseDir := MySelectDirectory(Lng_SelectDir); |
||
226 | if GeneralBaseDir = '' then Exit; |
||
227 | |||
228 | ok := IsDirectoryWritable(GeneralBaseDir); |
||
229 | if not ok then |
||
2 | daniel-mar | 230 | begin |
5 | daniel-mar | 231 | MessageDlg(Lng_WriteProtected, mtWarning, [mbOk], 0); |
2 | daniel-mar | 232 | end; |
5 | daniel-mar | 233 | until ok; |
2 | daniel-mar | 234 | end; |
5 | daniel-mar | 235 | |
2 | daniel-mar | 236 | GeneralBaseDir := IncludeTrailingPathDelimiter(GeneralBaseDir); |
237 | |||
238 | // Semantic scanning of ZIP to determinate the final extraction directory |
||
239 | |||
1 | daniel-mar | 240 | l := TStringList.Create; |
241 | try |
||
242 | // Count the root objects (files OR dirs) in the ZIP |
||
243 | |||
244 | ListRootFiles(uz, l); |
||
245 | |||
246 | if l.Count = 0 then |
||
247 | begin |
||
248 | // Empty ZIP or Extractor.exe was called without ZIP attached |
||
249 | Exit; |
||
250 | end |
||
251 | else if l.Count = 1 then |
||
252 | begin |
||
253 | // 1 Object = Extract it right here! |
||
2 | daniel-mar | 254 | BaseDir := GeneralBaseDir; |
255 | s := BaseDir + l.Strings[0]; |
||
256 | |||
257 | RenamingOldPrefix := l.Strings[0]; // = StripBaseDir(S); |
||
258 | |||
1 | daniel-mar | 259 | if zb.ConflictBehavior = cbAvoid then |
260 | begin |
||
2 | daniel-mar | 261 | s := SearchNextFreeName(s, LooksLikeDir(s)); |
1 | daniel-mar | 262 | end; |
2 | daniel-mar | 263 | |
264 | RenamingNewPrefix := StripBaseDir(s); |
||
1 | daniel-mar | 265 | end |
266 | else |
||
267 | begin |
||
268 | // 2+ Objects = Extract them in a separate folder |
||
2 | daniel-mar | 269 | s := GeneralBaseDir + ExtractFileNameWithoutExt(AZipfile) + PathDelim; |
1 | daniel-mar | 270 | if zb.ConflictBehavior = cbAvoid then |
271 | begin |
||
2 | daniel-mar | 272 | s := SearchNextFreeName(s, true); |
1 | daniel-mar | 273 | MkDir(s); |
274 | end |
||
275 | else |
||
276 | begin |
||
277 | if not DirectoryExists(s) then MkDir(s); |
||
278 | end; |
||
279 | BaseDir := s; |
||
280 | end; |
||
281 | BaseDir := IncludeTrailingPathDelimiter(BaseDir); |
||
282 | |||
2 | daniel-mar | 283 | uz.ExtrBaseDir := BaseDir; |
1 | daniel-mar | 284 | |
285 | // Pre-Extract-Dialog |
||
286 | |||
287 | if zb.CommentPresentation = cpBeforeExtracting then |
||
288 | begin |
||
289 | if not CommentForm.ShowCommentModal(uz.ZipComment) then exit; |
||
290 | end; |
||
291 | |||
292 | // Extract |
||
293 | |||
294 | ec := uz.Extract; |
||
295 | |||
296 | if ec <> 0 then |
||
297 | begin |
||
298 | if ec = DS_Canceled then |
||
299 | begin |
||
300 | MessageDlg(Lng_Aborted, mtWarning, [mbOk], 0); |
||
301 | end |
||
302 | else |
||
303 | begin |
||
304 | MessageDlg(Format(Lng_Zip_Error, [uz.ErrMessage, ec]), mtError, [mbOk], 0); |
||
305 | end; |
||
306 | end; |
||
307 | |||
308 | // Errors? |
||
309 | |||
310 | if ErrorForm.ErrorsAvailable then |
||
311 | begin |
||
5 | daniel-mar | 312 | Hide; |
1 | daniel-mar | 313 | ErrorForm.ShowModal; |
314 | end; |
||
315 | |||
316 | // Show After-Extracting comment? |
||
317 | |||
318 | if zb.CommentPresentation = cpAfterExtracting then |
||
319 | begin |
||
320 | if not CommentForm.ShowCommentModal(uz.ZipComment) then exit; |
||
321 | end; |
||
322 | |||
323 | // Now search for an AutoRun.inf |
||
324 | |||
325 | ar := ExecuteSFXAutoRun(BaseDir); |
||
326 | |||
327 | if ar.AutoRunSectionAvailable and not ar.ExecutionSucceed then |
||
328 | begin |
||
329 | MessageDlg(Lng_AutoRunFailed, mtError, [mbOk], 0); |
||
330 | ar.OpenUnzippedContent := true; |
||
331 | end; |
||
332 | |||
333 | // Now open the file for the user |
||
334 | |||
335 | if not ar.AutoRunSectionAvailable or ar.OpenUnzippedContent then |
||
336 | begin |
||
337 | if DirectoryExists(s) then |
||
338 | begin |
||
339 | // If it is a folder, open it |
||
3 | daniel-mar | 340 | |
341 | ShellExecute(0, 'open', EXPLORER_EXE, |
||
342 | PChar(Format(C_Explorer_Open_Param, [s])), '', SW_NORMAL); |
||
1 | daniel-mar | 343 | end |
344 | else if FileExists(s) then |
||
345 | begin |
||
346 | // If it is a file, then only select it |
||
347 | |||
348 | // Que: Funktioniert das auch ohne "/n"? |
||
349 | // Im Moment wird bei einem BESTEHENDEN Fenster |
||
350 | // die Selektion nicht durchgeführt. |
||
351 | |||
3 | daniel-mar | 352 | ShellExecute(0, 'open', EXPLORER_EXE, |
353 | PChar(Format(C_Explorer_Select_Param, [s])), '', SW_NORMAL); |
||
1 | daniel-mar | 354 | end |
355 | else |
||
356 | begin |
||
3 | daniel-mar | 357 | if not AbortUnzip then |
358 | begin |
||
359 | MessageDlg(Lng_Unknown_Error, mtError, [mbOk], 0); |
||
360 | end; |
||
1 | daniel-mar | 361 | end; |
362 | end; |
||
363 | finally |
||
364 | l.Free; |
||
365 | end; |
||
366 | finally |
||
367 | uz.Free; |
||
3 | daniel-mar | 368 | ExtractionInProcess := false; |
1 | daniel-mar | 369 | end; |
370 | end; |
||
371 | |||
3 | daniel-mar | 372 | procedure TMainForm.EvProgress(Sender: TObject; details: TZMProgressDetails); |
1 | daniel-mar | 373 | begin |
374 | CurrentFileLabel.Caption := details.ItemName; |
||
375 | |||
376 | progressBar.Position := details.TotalPosition; |
||
377 | progressBar.Max := details.TotalSize; |
||
378 | |||
379 | itemBar.Position := details.ItemPosition; |
||
380 | itemBar.Max := details.ItemSize; |
||
381 | |||
382 | Application.ProcessMessages; |
||
383 | end; |
||
384 | |||
3 | daniel-mar | 385 | procedure TMainForm.EvExtFNChange(Sender: TObject; |
1 | daniel-mar | 386 | var FileName: TZMString; const BaseDir: TZMString; |
387 | var IsChanged: Boolean); |
||
388 | begin |
||
2 | daniel-mar | 389 | if RenamingOldPrefix = RenamingNewPrefix then Exit; |
1 | daniel-mar | 390 | FileName := RenamingNewPrefix + Copy(FileName, 1+Length(RenamingOldPrefix), Length(FileName)-Length(RenamingOldPrefix)); |
391 | IsChanged := true; |
||
392 | end; |
||
393 | |||
3 | daniel-mar | 394 | procedure TMainForm.EvTick(Sender: TObject); |
1 | daniel-mar | 395 | begin |
396 | Application.ProcessMessages; |
||
397 | end; |
||
398 | |||
3 | daniel-mar | 399 | procedure TMainForm.EvCheckTerminate(Sender: TObject; var abort: Boolean); |
1 | daniel-mar | 400 | begin |
401 | abort := AbortUnzip; |
||
402 | end; |
||
403 | |||
3 | daniel-mar | 404 | procedure TMainForm.EvConfirmOverwrite(Sender: TObject; const ForFile: TZMString; |
1 | daniel-mar | 405 | IsOlder: Boolean; var DoOverwrite: Boolean; DirIndex: Integer); |
406 | resourcestring |
||
407 | Lng_Overwrite = 'Bestehende Datei "%s" überschreiben?'; |
||
408 | var |
||
409 | res: Integer; |
||
410 | begin |
||
411 | if zb.ConflictBehavior = cbOverwrite then |
||
412 | begin |
||
413 | DoOverwrite := true; |
||
414 | Exit; |
||
415 | end |
||
416 | else if zb.ConflictBehavior = cbNewer then |
||
417 | begin |
||
418 | DoOverwrite := IsOlder; // If file on DISK is older, then overwrite. |
||
419 | Exit; |
||
420 | end |
||
421 | else if zb.ConflictBehavior = cbAsk then |
||
422 | begin |
||
423 | // Workaround: Verzeichnisse brauchen das nicht, |
||
424 | // denn es wird bei den Dateien nochmal nachgefragt |
||
425 | if LooksLikeDir(ForFile) then |
||
426 | begin |
||
427 | DoOverwrite := true; |
||
428 | Exit; |
||
429 | end; |
||
430 | |||
3 | daniel-mar | 431 | if CachedOverwriteDecision = odUndefined then |
1 | daniel-mar | 432 | begin |
433 | res := MessageDlg(Format(Lng_Overwrite, [ForFile]), mtConfirmation, [mbYes, mbNo, mbYesToAll, mbNoToAll], 0); |
||
434 | DoOverwrite := (res = mrYes) or (res = mrYesToAll); |
||
3 | daniel-mar | 435 | if res = mrNoToAll then CachedOverwriteDecision := odOverwriteNothing; |
436 | if res = mrYesToAll then CachedOverwriteDecision := odOverwriteAll; |
||
1 | daniel-mar | 437 | end |
438 | else |
||
439 | begin |
||
3 | daniel-mar | 440 | DoOverwrite := CachedOverwriteDecision = odOverwriteAll; |
1 | daniel-mar | 441 | end; |
3 | daniel-mar | 442 | end |
443 | else if zb.ConflictBehavior = cbAvoid then |
||
444 | begin |
||
445 | // Nothing to do |
||
1 | daniel-mar | 446 | end; |
447 | end; |
||
448 | |||
3 | daniel-mar | 449 | procedure TMainForm.EvPasswordEvent(Sender: TObject; IsZipAction: Boolean; |
1 | daniel-mar | 450 | var NewPassword: String; const ForFile: TZMString; var RepeatCount: Longword; |
451 | var Action: TMsgDlgBtn); |
||
452 | var |
||
453 | repc: integer; |
||
454 | begin |
||
3 | daniel-mar | 455 | repc := EvPasswordTries - RepeatCount + 1; |
1 | daniel-mar | 456 | |
457 | // Eine Passworteingabe wurde abgebrochen. Frage nicht mehr nach. |
||
458 | if StopAskingPassword then Exit; |
||
459 | |||
460 | // Wurde schonmal ein Passwort eingegeben? |
||
461 | if LastTriedPassword <> '' then |
||
462 | begin |
||
463 | // Schauen, ob das letzte Passwort auch mit dieser Datei geht. |
||
464 | if repc = 1 then |
||
465 | begin |
||
466 | // Ja, geht |
||
467 | NewPassword := LastTriedPassword; |
||
468 | Exit; |
||
469 | end |
||
470 | else |
||
471 | begin |
||
472 | // Leider nein |
||
473 | LastTriedPassword := ''; |
||
474 | end; |
||
475 | end; |
||
476 | |||
3 | daniel-mar | 477 | if PasswordDlg.ShowModal(StripBaseDir(ForFile), repc, EvPasswordTries) = mrOk then |
1 | daniel-mar | 478 | begin |
479 | NewPassword := PasswordDlg.Password.Text; |
||
480 | if NewPassword = '' then NewPassword := ' '; // Neue Eingabe erzwingen. |
||
481 | LastTriedPassword := NewPassword; |
||
482 | end |
||
483 | else |
||
484 | begin |
||
485 | StopAskingPassword := true; |
||
486 | Action := mbCancel; |
||
487 | end; |
||
488 | end; |
||
489 | |||
490 | procedure TMainForm.CancelBtnClick(Sender: TObject); |
||
491 | resourcestring |
||
492 | Lng_AbortExtract = 'Extrahieren abbrechen?'; |
||
493 | begin |
||
3 | daniel-mar | 494 | if not ExtractionInProcess then |
495 | begin |
||
496 | Close; |
||
497 | Exit; |
||
498 | end; |
||
499 | |||
1 | daniel-mar | 500 | if MessageDlg(Lng_AbortExtract, mtConfirmation, mbYesNoCancel, 0) = mrYes then |
501 | begin |
||
502 | CancelBtn.Enabled := false; |
||
3 | daniel-mar | 503 | uz.AbortDLL; |
1 | daniel-mar | 504 | AbortUnzip := true; |
3 | daniel-mar | 505 | // Close wird durch den Timer durchgeführt |
506 | Exit; |
||
1 | daniel-mar | 507 | end; |
508 | end; |
||
509 | |||
510 | procedure TMainForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean); |
||
511 | begin |
||
3 | daniel-mar | 512 | if not ExtractionInProcess then |
513 | begin |
||
514 | CanClose := true; |
||
515 | Exit; |
||
516 | end; |
||
517 | |||
1 | daniel-mar | 518 | if not AbortUnzip then |
519 | begin |
||
3 | daniel-mar | 520 | CanClose := false; |
1 | daniel-mar | 521 | CancelBtn.Click; |
522 | end; |
||
523 | end; |
||
524 | |||
525 | procedure TMainForm.FormCreate(Sender: TObject); |
||
526 | resourcestring |
||
527 | Lng_Extracting = 'Extrahiere Dateien. Bitte warten...'; |
||
528 | begin |
||
529 | WaitLabel.Caption := Lng_Extracting; |
||
530 | WaitLabel.Left := progressBar.Width div 2 - WaitLabel.Width div 2; |
||
531 | CurrentFileLabel.Caption := ''; |
||
532 | end; |
||
533 | |||
534 | {$IFNDEF USE_DZIP_UNPACK} |
||
535 | procedure TMainForm.ExtractDllFromResource(ADirectory: string); |
||
536 | var |
||
537 | s: TResourceStream; |
||
538 | o: TFileStream; |
||
539 | AOutFile: string; |
||
540 | begin |
||
541 | AOutFile := IncludeTrailingPathDelimiter(ADirectory) + DelZipDLL_Name; |
||
542 | s := TResourceStream.Create(0, DZRES_Dll, RT_RCDATA); |
||
543 | try |
||
544 | try |
||
545 | s.Seek(SizeOf(Integer), soFromBeginning); // Ref: ZMDllLoad19.pas:427 |
||
546 | if FileExists(AOutFile) then |
||
547 | o := TFileStream.Create(AOutFile, fmOpenWrite or fmShareDenyNone) |
||
548 | else |
||
549 | o := TFileStream.Create(AOutFile, fmCreate or fmShareDenyNone); |
||
550 | try |
||
551 | o.CopyFrom(s, s.Size-s.Position); |
||
552 | finally |
||
553 | o.Free; |
||
554 | end; |
||
555 | except |
||
556 | if FileExists(AOutFile) then |
||
557 | begin |
||
558 | // Probably the file is write-locked (maybe some other Extractor is |
||
559 | // using it right now? Even if we run into danger that the target DLL |
||
560 | // is a write-protected old/incompatible version of DelZip190.dll, |
||
561 | // we do count this as success, since the file exists. |
||
562 | end |
||
563 | else |
||
564 | begin |
||
565 | raise; |
||
566 | end; |
||
567 | end; |
||
568 | finally |
||
569 | s.Free; |
||
570 | end; |
||
571 | end; |
||
572 | {$ENDIF} |
||
573 | |||
574 | procedure TMainForm.AutoTimerTimer(Sender: TObject); |
||
2 | daniel-mar | 575 | resourcestring |
576 | Lng_NakedSFX = 'Das selbstentpackende Archiv (SFX) beschädigt oder ungültig. Wenn Sie diese Datei aus dem Internet bezogen haben, laden Sie sie bitte erneut herunter.'; |
||
577 | Lng_FileNotFound = 'Die durch Parameter angegebene Datei "%s" kann nicht gefunden werden!'; |
||
578 | Lng_TooManyArguments = 'Zu viele Argumente!'; |
||
1 | daniel-mar | 579 | begin |
580 | AutoTimer.Enabled := false; |
||
581 | |||
582 | {$IFNDEF USE_DZIP_UNPACK} |
||
583 | ExtractDllFromResource(GetTempDirectory); |
||
584 | {$ENDIF} |
||
585 | |||
586 | try |
||
2 | daniel-mar | 587 | if IsExtractable(ParamStr(0)) then |
1 | daniel-mar | 588 | begin |
2 | daniel-mar | 589 | ExtractZipHere(ParamStr(0)); |
1 | daniel-mar | 590 | end |
591 | else |
||
592 | begin |
||
2 | daniel-mar | 593 | // Der Extractor ist "nackt" oder das SFX beschädigt |
1 | daniel-mar | 594 | |
2 | daniel-mar | 595 | if ParamCount = 0 then |
596 | begin |
||
597 | MessageDlg(Lng_NakedSFX, mtError, [mbOk], 0); |
||
598 | end |
||
599 | else if ParamCount = 1 then |
||
600 | begin |
||
601 | // In diesem Zustand erlauben wir, fremde SFX zu entpacken (auch für Debugging-Zwecke) |
||
602 | if FileExists(ParamStr(1)) then |
||
603 | begin |
||
604 | ExtractZipHere(ParamStr(1)); |
||
605 | end |
||
606 | else |
||
607 | begin |
||
608 | MessageDlg(Lng_FileNotFound, mtError, [mbOk], 0); |
||
609 | end; |
||
610 | end |
||
611 | else if ParamCount = 2 then |
||
612 | begin |
||
613 | // Future: Mehr als nur 1 Parameter erlauben? |
||
614 | MessageDlg(Lng_TooManyArguments, mtError, [mbOk], 0); |
||
615 | end; |
||
1 | daniel-mar | 616 | end; |
617 | finally |
||
618 | Close; |
||
619 | end; |
||
620 | end; |
||
621 | |||
622 | function TMainForm.StripBaseDir(const s: string): string; |
||
623 | begin |
||
624 | // Warnung: Es wird nicht überprüft, ob der String auch |
||
625 | // wirklich mit dem BaseDir beginnt! |
||
626 | result := Copy(s, Length(BaseDir)+1, Length(s)-Length(BaseDir)); |
||
627 | end; |
||
628 | |||
3 | daniel-mar | 629 | procedure TMainForm.EvSkipEvent(Sender: TObject; const ForFile: TZMString; |
1 | daniel-mar | 630 | SkipType: TZMSkipTypes; var ExtError: Integer); |
631 | resourcestring |
||
632 | Lng_PasswordWrong = 'Das Passwort wurde zu oft falsch eingegeben. Die Datei "%s" wird nicht extrahiert.'; |
||
633 | begin |
||
634 | if (SkipType = stBadPassword) and not StopAskingPassword then |
||
635 | begin |
||
636 | MessageDlg(Format(Lng_PasswordWrong, [ForFile]), mtError, [mbOk], 0); |
||
637 | LastTriedPassword := ''; |
||
638 | end; |
||
5 | daniel-mar | 639 | ErrorForm.NewError(ForFile, SkipType); |
1 | daniel-mar | 640 | end; |
641 | |||
642 | end. |