WebSVN – autosfx – Diff – /ExtractorMain.pas

 unit ExtractorMain;
 {$DEFINE USE_DZIP_UNPACK}
-// todo: compilerswitch, der auch selectdirectory() anzeigt (ohne foldercreate)
 interface
 uses
   Windows, SysUtils, Classes, Controls, Forms, Dialogs, StdCtrls, ShellAPI,
   ExtCtrls, ComCtrls, ZipMstr19, ZMMsgStr19, ZMMsg19, ZMDelZip19,
     procedure CancelBtnClick(Sender: TObject);
     procedure FormCreate(Sender: TObject);
     procedure AutoTimerTimer(Sender: TObject);
     procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
   private
+    ExtractionInProcess: boolean;
+    uz: TZipMaster19;
     RenamingOldPrefix: string;
     RenamingNewPrefix: string;
     zb: TZIPBehavior;
     BaseDir: string;
     AbortUnzip: boolean;
     StopAskingPassword: boolean;
     LastTriedPassword: string;
-    OverwriteDecision: TOverwriteDecision;
+    CachedOverwriteDecision: TOverwriteDecision;
     {$IFNDEF USE_DZIP_UNPACK}
     procedure ExtractDllFromResource(ADirectory: string);
     {$ENDIF}
     procedure ExtractZipHere(AZipfile: string);
-    procedure ArcExtFNChange(Sender: TObject; var FileName: TZMString; const BaseDir: TZMString; var IsChanged: Boolean);
+    procedure EvExtFNChange(Sender: TObject; var FileName: TZMString; const BaseDir: TZMString; var IsChanged: Boolean);
-    procedure ArcProzess(Sender: TObject; details: TZMProgressDetails);
+    procedure EvProgress(Sender: TObject; details: TZMProgressDetails);
-    procedure ArcTick(Sender: TObject);
+    procedure EvTick(Sender: TObject);
-    procedure ArcCheckTerminate(Sender: TObject; var abort: Boolean);
+    procedure EvCheckTerminate(Sender: TObject; var abort: Boolean);
-    procedure ConfirmOverwrite(Sender: TObject; const ForFile: TZMString;
+    procedure EvConfirmOverwrite(Sender: TObject; const ForFile: TZMString;
       IsOlder: Boolean; var DoOverwrite: Boolean; DirIndex: Integer);
-    procedure ArcPassword(Sender: TObject; IsZipAction: Boolean;
+    procedure EvPasswordEvent(Sender: TObject; IsZipAction: Boolean;
       var NewPassword: String; const ForFile: TZMString; var RepeatCount: Longword;
       var Action: TMsgDlgBtn);
-    procedure SkipEvent(Sender: TObject; const ForFile: TZMString;
+    procedure EvSkipEvent(Sender: TObject; const ForFile: TZMString;
       SkipType: TZMSkipTypes; var ExtError: Integer);
     function StripBaseDir(const s: string): string;
   end;
 var
   MainForm: TMainForm;
 implementation
 uses
-  ExtractorPassword, ExtractorError, Functions, SFXAutoRun, ExtractorComment;
+  ExtractorPassword, ExtractorError, Functions, SFXAutoRun, ExtractorComment,
+  BrowseFolder;
 const
-  MaxTries = 15;
+  EvPasswordTries = 15;
 {$R *.dfm}
 {$R zmstr1900102\DLL\ResDLL-Maker\ZMRes19_dll.res}
   end;
 end;
 procedure TMainForm.ExtractZipHere(AZipfile: string);
 var
-  uz: TZipMaster19;
   l: TStringList;
   s: string;
   ec: Integer;
   ar: TExecuteSFXAutoRunResult;
   GeneralBaseDir: string;
+const
+  C_Explorer_Open_Param = '"%s"';
+  C_Explorer_Select_Param = '/n,/select,"%s"';
+  EXPLORER_EXE = 'explorer';
 resourcestring
   Lng_Aborted = 'Der laufende Prozess wurde abgebrochen. Das extrahierten Dateien sind somit unvollständig.';
   Lng_Zip_Error = 'ZIP-Master Fehler "%s" (%d)';
   Lng_AutoRunFailed = 'SFX-AutoRun fehlgeschlagen. Die entpackten Inhalte werden nun angezeigt.';
   Lng_Unknown_Error = 'Unbekannter Fehler: Dateien sind nicht aufzufinden!';
 begin
   AZipfile := ExpandUNCFileName(AZipfile);
   RenamingOldPrefix := '';
   RenamingNewPrefix := '';
+  if Assigned(uz) then uz.Free; // uz ist global, damit AbortDLL aufgerufen werden kann
   uz := TZipMaster19.Create(nil);
   try
+    ExtractionInProcess := true;
     {$IFNDEF USE_DZIP_UNPACK}
     uz.DLLDirectory := GetTempDirectory + DelZipDLL_Name;
     {$ENDIF}
     uz.DLL_Load := true;
     uz.Unattended := true;
     uz.ExtrOptions := [ExtrDirNames, ExtrOverWrite, ExtrFreshen, ExtrUpdate,
       ExtrForceDirs, ExtrNTFS];
-    if zb.ConflictBehavior <> cbAvoid then
-    begin
-      uz.OnExtractOverwrite := ConfirmOverwrite;
+    uz.OnExtractOverwrite := EvConfirmOverwrite;
-    end;
-    uz.OnProgress := ArcProzess;
+    uz.OnProgress := EvProgress;
-    uz.OnTick := ArcTick;
+    uz.OnTick := EvTick;
-    uz.OnCheckTerminate := ArcCheckTerminate;
+    uz.OnCheckTerminate := EvCheckTerminate;
-    uz.OnPasswordError := ArcPassword;
+    uz.OnPasswordError := EvPasswordEvent;
-    uz.PasswordReqCount := MaxTries;
+    uz.PasswordReqCount := EvPasswordTries;
-    uz.OnSkipped := SkipEvent;
+    uz.OnSkipped := EvSkipEvent;
-    uz.OnSetExtName := ArcExtFNChange;
+    uz.OnSetExtName := EvExtFNChange;
-    // TODO: Mehr events?
     // Find out base dirtory
     GeneralBaseDir := '';
     case zb.ExtractionTarget of
         begin
           GeneralBaseDir := GetSpecialFolderPath(CSIDL_DESKTOP);
         end;
       etAsk:
         begin
-          if not AdvSelectDirectory(Lng_SelectDir, '', GeneralBaseDir, False, False, True) then
+          GeneralBaseDir := MySelectDirectory(Lng_SelectDir);
-          begin
-            Exit;
+          if GeneralBaseDir = '' then Exit;
-          end;
         end;
     end;
     GeneralBaseDir := IncludeTrailingPathDelimiter(GeneralBaseDir);
     // Semantic scanning of ZIP to determinate the final extraction directory
       if not ar.AutoRunSectionAvailable or ar.OpenUnzippedContent then
       begin
         if DirectoryExists(s) then
         begin
           // If it is a folder, open it
-          ShellExecute(0, 'open', 'explorer',
+          ShellExecute(0, 'open', EXPLORER_EXE,
-            PChar('"'+s+'"'), '', SW_NORMAL);
+            PChar(Format(C_Explorer_Open_Param, [s])), '', SW_NORMAL);
         end
         else if FileExists(s) then
         begin
           // If it is a file, then only select it
           // Que: Funktioniert das auch ohne "/n"?
           // Im Moment wird bei einem BESTEHENDEN Fenster
           // die Selektion nicht durchgeführt.
-          ShellExecute(0, 'open', 'explorer',
+          ShellExecute(0, 'open', EXPLORER_EXE,
-            PChar('/n,/select,"'+s+'"'), '', SW_NORMAL);
+            PChar(Format(C_Explorer_Select_Param, [s])), '', SW_NORMAL);
         end
         else
         begin
+          if not AbortUnzip then
+          begin
-          MessageDlg(Lng_Unknown_Error, mtError, [mbOk], 0);
+            MessageDlg(Lng_Unknown_Error, mtError, [mbOk], 0);
-        end;
+          end;
-      end;
+        end;
+      end;
     finally
       l.Free;
     end;
   finally
     uz.Free;
+    ExtractionInProcess := false;
   end;
 end;
-procedure TMainForm.ArcProzess(Sender: TObject; details: TZMProgressDetails);
+procedure TMainForm.EvProgress(Sender: TObject; details: TZMProgressDetails);
 begin
   CurrentFileLabel.Caption := details.ItemName;
   progressBar.Position := details.TotalPosition;
   progressBar.Max := details.TotalSize;
   itemBar.Max := details.ItemSize;
   Application.ProcessMessages;
 end;
-procedure TMainForm.ArcExtFNChange(Sender: TObject;
+procedure TMainForm.EvExtFNChange(Sender: TObject;
   var FileName: TZMString; const BaseDir: TZMString;
   var IsChanged: Boolean);
 begin
   if RenamingOldPrefix = RenamingNewPrefix then Exit;
   FileName := RenamingNewPrefix + Copy(FileName, 1+Length(RenamingOldPrefix), Length(FileName)-Length(RenamingOldPrefix));
   IsChanged := true;
 end;
-procedure TMainForm.ArcTick(Sender: TObject);
+procedure TMainForm.EvTick(Sender: TObject);
 begin
   Application.ProcessMessages;
 end;
-procedure TMainForm.ArcCheckTerminate(Sender: TObject; var abort: Boolean);
+procedure TMainForm.EvCheckTerminate(Sender: TObject; var abort: Boolean);
 begin
   abort := AbortUnzip;
 end;
-procedure TMainForm.ConfirmOverwrite(Sender: TObject; const ForFile: TZMString;
+procedure TMainForm.EvConfirmOverwrite(Sender: TObject; const ForFile: TZMString;
   IsOlder: Boolean; var DoOverwrite: Boolean; DirIndex: Integer);
 resourcestring
   Lng_Overwrite = 'Bestehende Datei "%s" überschreiben?';
 var
   res: Integer;
     begin
       DoOverwrite := true;
       Exit;
     end;
-    if OverwriteDecision = odUndefined then
+    if CachedOverwriteDecision = odUndefined then
     begin
       res := MessageDlg(Format(Lng_Overwrite, [ForFile]), mtConfirmation, [mbYes, mbNo, mbYesToAll, mbNoToAll], 0);
       DoOverwrite := (res = mrYes) or (res = mrYesToAll);
-      if res = mrNoToAll then OverwriteDecision := odOverwriteNothing;
+      if res = mrNoToAll then CachedOverwriteDecision := odOverwriteNothing;
-      if res = mrYesToAll then OverwriteDecision := odOverwriteAll;
+      if res = mrYesToAll then CachedOverwriteDecision := odOverwriteAll;
     end
     else
     begin
-      DoOverwrite := OverwriteDecision = odOverwriteAll;
+      DoOverwrite := CachedOverwriteDecision = odOverwriteAll;
     end;
+  end
+  else if zb.ConflictBehavior = cbAvoid then
+  begin
+    // Nothing to do
   end;
 end;
-procedure TMainForm.ArcPassword(Sender: TObject; IsZipAction: Boolean;
+procedure TMainForm.EvPasswordEvent(Sender: TObject; IsZipAction: Boolean;
   var NewPassword: String; const ForFile: TZMString; var RepeatCount: Longword;
   var Action: TMsgDlgBtn);
 var
   repc: integer;
 begin
-  repc := MaxTries - RepeatCount + 1;
+  repc := EvPasswordTries - RepeatCount + 1;
   // Eine Passworteingabe wurde abgebrochen. Frage nicht mehr nach.
   if StopAskingPassword then Exit;
   // Wurde schonmal ein Passwort eingegeben?
       // Leider nein
       LastTriedPassword := '';
     end;
   end;
-  if PasswordDlg.ShowModal(StripBaseDir(ForFile), repc, MaxTries) = mrOk then
+  if PasswordDlg.ShowModal(StripBaseDir(ForFile), repc, EvPasswordTries) = mrOk then
   begin
     NewPassword := PasswordDlg.Password.Text;
     if NewPassword = '' then NewPassword := ' '; // Neue Eingabe erzwingen.
     LastTriedPassword := NewPassword;
   end
 procedure TMainForm.CancelBtnClick(Sender: TObject);
 resourcestring
   Lng_AbortExtract = 'Extrahieren abbrechen?';
 begin
+  if not ExtractionInProcess then
+  begin
+    Close;
+    Exit;
+  end;
   if MessageDlg(Lng_AbortExtract, mtConfirmation, mbYesNoCancel, 0) = mrYes then
   begin
     CancelBtn.Enabled := false;
+    uz.AbortDLL;
     AbortUnzip := true;
+    // Close wird durch den Timer durchgeführt
+    Exit;
   end;
 end;
 procedure TMainForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
 begin
+  if not ExtractionInProcess then
+  begin
+    CanClose := true;
+    Exit;
+  end;
   if not AbortUnzip then
   begin
-    CancelBtn.Click;
     CanClose := false;
+    CancelBtn.Click;
   end;
 end;
 procedure TMainForm.FormCreate(Sender: TObject);
 resourcestring
         // Future: Mehr als nur 1 Parameter erlauben?
         MessageDlg(Lng_TooManyArguments, mtError, [mbOk], 0);
       end;
     end;
   finally
-    AbortUnzip := true; // Damit es zu keiner Abfrage in OnCloseQuery kommt
     Close;
   end;
 end;
 function TMainForm.StripBaseDir(const s: string): string;
   // Warnung: Es wird nicht überprüft, ob der String auch
   // wirklich mit dem BaseDir beginnt!
   result := Copy(s, Length(BaseDir)+1, Length(s)-Length(BaseDir));
 end;
-procedure TMainForm.SkipEvent(Sender: TObject; const ForFile: TZMString;
+procedure TMainForm.EvSkipEvent(Sender: TObject; const ForFile: TZMString;
   SkipType: TZMSkipTypes; var ExtError: Integer);
 resourcestring
   Lng_PasswordWrong = 'Das Passwort wurde zu oft falsch eingegeben. Die Datei "%s" wird nicht extrahiert.';
 begin
   if (SkipType = stBadPassword) and not StopAskingPassword then

Subversion Repositories autosfx

autosfx/ExtractorMain.pas – Rev 2 → 3