WebSVN – autosfx – Diff – /ExtractorMain.pas

 unit ExtractorMain;
-{$DEFINE DEBUG_MODE}
 {$DEFINE USE_DZIP_UNPACK}
-// TODO: Implement ExtractionTarget switch
+// todo: compilerswitch, der auch selectdirectory() anzeigt (ohne foldercreate)
 interface
 uses
   Windows, SysUtils, Classes, Controls, Forms, Dialogs, StdCtrls, ShellAPI,
   ExtCtrls, ComCtrls, ZipMstr19, ZMMsgStr19, ZMMsg19, ZMDelZip19,
-  ZMCompat19, SFXBehavior;
+  ZMCompat19, SFXBehavior, ShlObj;
 type
   TOverwriteDecision = (odUndefined, odOverwriteAll, odOverwriteNothing);
   TMainForm = class(TForm)
   uz: TZipMaster19;
   l: TStringList;
   s: string;
   ec: Integer;
   ar: TExecuteSFXAutoRunResult;
+  GeneralBaseDir: string;
 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!';
+  Lng_SelectDir = 'Bitte wählen Sie ein Verzeichnis zum Extrahieren aus. Es wird maximal 1 Datei bzw. Ordner erstellt!';
 begin
   AZipfile := ExpandUNCFileName(AZipfile);
   RenamingOldPrefix := '';
   RenamingNewPrefix := '';
     uz.OnProgress := ArcProzess;
     uz.OnTick := ArcTick;
     uz.OnCheckTerminate := ArcCheckTerminate;
     uz.OnPasswordError := ArcPassword;
     uz.PasswordReqCount := MaxTries;
-    // TODO: Mehr events?
     uz.OnSkipped := SkipEvent;
     uz.OnSetExtName := ArcExtFNChange;
+    // TODO: Mehr events?
+    // Find out base dirtory
+    GeneralBaseDir := '';
+    case zb.ExtractionTarget of
+      etExtractHere:
+        begin
+          GeneralBaseDir := ExtractFilePath(AZipfile); // Default
+        end;
+      etDesktop:
+        begin
+          GeneralBaseDir := GetSpecialFolderPath(CSIDL_DESKTOP);
+        end;
+      etAsk:
+        begin
+          if not AdvSelectDirectory(Lng_SelectDir, '', GeneralBaseDir, False, False, True) then
+          begin
+            Exit;
+          end;
+        end;
+    end;
+    GeneralBaseDir := IncludeTrailingPathDelimiter(GeneralBaseDir);
+    // Semantic scanning of ZIP to determinate the final extraction directory
     l := TStringList.Create;
     try
       // Count the root objects (files OR dirs) in the ZIP
         Exit;
       end
       else if l.Count = 1 then
       begin
         // 1 Object = Extract it right here!
-        s := ExtractFilePath(AZipfile) + l.Strings[0];
+        BaseDir := GeneralBaseDir;
-        BaseDir := ExtractFilePath(AZipfile);
+        s := BaseDir + l.Strings[0];
-        RenamingOldPrefix := StripBaseDir(S);
+        RenamingOldPrefix := l.Strings[0]; // = StripBaseDir(S);
         if zb.ConflictBehavior = cbAvoid then
         begin
-          s := SearchNextFreeName(s);
+          s := SearchNextFreeName(s, LooksLikeDir(s));
         end;
-        // TODO: helloworld.exe schlägt fehl!
-        RenamingNewPrefix := StripBaseDir(S); // We need to change the name!
+        RenamingNewPrefix := StripBaseDir(s);
       end
       else
       begin
         // 2+ Objects = Extract them in a separate folder
-        s := ChangeFileExt(AZipfile, '');
+        s := GeneralBaseDir + ExtractFileNameWithoutExt(AZipfile) + PathDelim;
         if zb.ConflictBehavior = cbAvoid then
         begin
-          s := SearchNextFreeName(s);
+          s := SearchNextFreeName(s, true);
           MkDir(s);
         end
         else
         begin
           if not DirectoryExists(s) then MkDir(s);
         end;
         BaseDir := s;
       end;
       BaseDir := IncludeTrailingPathDelimiter(BaseDir);
-      uz.ExtrBaseDir := BaseDir; // TODO: andere ordner erlauben
+      uz.ExtrBaseDir := BaseDir;
       // Pre-Extract-Dialog
       if zb.CommentPresentation = cpBeforeExtracting then
       begin
 procedure TMainForm.ArcExtFNChange(Sender: TObject;
   var FileName: TZMString; const BaseDir: TZMString;
   var IsChanged: Boolean);
 begin
-  if RenamingOldPrefix = RenamingOldPrefix then Exit;
+  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.FormCreate(Sender: TObject);
 resourcestring
   Lng_Extracting = 'Extrahiere Dateien. Bitte warten...';
 begin
-  {$IFDEF DEBUG_MODE}
-  Caption := Caption + ' (Debug)';
-  {$ENDIF}
   WaitLabel.Caption := Lng_Extracting;
   WaitLabel.Left := progressBar.Width div 2 - WaitLabel.Width div 2;
   CurrentFileLabel.Caption := '';
 end;
   end;
 end;
 {$ENDIF}
 procedure TMainForm.AutoTimerTimer(Sender: TObject);
+resourcestring
+  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.';
+  Lng_FileNotFound = 'Die durch Parameter angegebene Datei "%s" kann nicht gefunden werden!';
+  Lng_TooManyArguments = 'Zu viele Argumente!';
 begin
   AutoTimer.Enabled := false;
   {$IFNDEF USE_DZIP_UNPACK}
   ExtractDllFromResource(GetTempDirectory);
   {$ENDIF}
   try
+    if IsExtractable(ParamStr(0)) then
+    begin
+      ExtractZipHere(ParamStr(0));
+    end
+    else
+    begin
+      // Der Extractor ist "nackt" oder das SFX beschädigt
-    {$IFDEF DEBUG_MODE}
+      if ParamCount = 0 then
+      begin
+        MessageDlg(Lng_NakedSFX, mtError, [mbOk], 0);
+      end
+      else if ParamCount = 1 then
+      begin
+        // In diesem Zustand erlauben wir, fremde SFX zu entpacken (auch für Debugging-Zwecke)
-    if FileExists(ParamStr(1)) then
+        if FileExists(ParamStr(1)) then
-    begin
+        begin
-      ExtractZipHere(ParamStr(1));
+          ExtractZipHere(ParamStr(1));
-    end
+        end
-    else
+        else
-    begin
+        begin
+          MessageDlg(Lng_FileNotFound, mtError, [mbOk], 0);
-    {$ENDIF}
+        end;
+      end
-    ExtractZipHere(ParamStr(0));
+      else if ParamCount = 2 then
+      begin
+        // Future: Mehr als nur 1 Parameter erlauben?
+        MessageDlg(Lng_TooManyArguments, mtError, [mbOk], 0);
-    {$IFDEF DEBUG_MODE}
+      end;
     end;
-    {$ENDIF}
   finally
-    AbortUnzip := true; // Damit es zu keiner Abfrage kommt
+    AbortUnzip := true; // Damit es zu keiner Abfrage in OnCloseQuery kommt
     Close;
   end;
 end;
 function TMainForm.StripBaseDir(const s: string): string;

Subversion Repositories autosfx

autosfx/ExtractorMain.pas – Rev 1 → 2