WebSVN – autosfx – Path Comparison – /

Regard whitespace Rev 3 → Rev 2

/Extractor.exe.manifest
File deleted

/Extractor.rc
File deleted

/BrowseFolder.pas
File deleted

/MakeSFX.rc
File deleted

/MakeSFX.exe.manifest
File deleted

/resource.h
File deleted

 /ExtractorMain.pas
 ,6 → 2,8
 {$DEFINE USE_DZIP_UNPACK}
+// todo: compilerswitch, der auch selectdirectory() anzeigt (ohne foldercreate)
 interface
 uses
 ,8 → 26,6
     procedure AutoTimerTimer(Sender: TObject);
     procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
   private
-    ExtractionInProcess: boolean;
-    uz: TZipMaster19;
     RenamingOldPrefix: string;
     RenamingNewPrefix: string;
     zb: TZIPBehavior;
 ,21 → 33,21
     AbortUnzip: boolean;
     StopAskingPassword: boolean;
     LastTriedPassword: string;
-    CachedOverwriteDecision: TOverwriteDecision;
+    OverwriteDecision: TOverwriteDecision;
     {$IFNDEF USE_DZIP_UNPACK}
     procedure ExtractDllFromResource(ADirectory: string);
     {$ENDIF}
     procedure ExtractZipHere(AZipfile: string);
-    procedure EvExtFNChange(Sender: TObject; var FileName: TZMString; const BaseDir: TZMString; var IsChanged: Boolean);
-    procedure EvProgress(Sender: TObject; details: TZMProgressDetails);
-    procedure EvTick(Sender: TObject);
-    procedure EvCheckTerminate(Sender: TObject; var abort: Boolean);
-    procedure EvConfirmOverwrite(Sender: TObject; const ForFile: TZMString;
+    procedure ArcExtFNChange(Sender: TObject; var FileName: TZMString; const BaseDir: TZMString; var IsChanged: Boolean);
+    procedure ArcProzess(Sender: TObject; details: TZMProgressDetails);
+    procedure ArcTick(Sender: TObject);
+    procedure ArcCheckTerminate(Sender: TObject; var abort: Boolean);
+    procedure ConfirmOverwrite(Sender: TObject; const ForFile: TZMString;
       IsOlder: Boolean; var DoOverwrite: Boolean; DirIndex: Integer);
-    procedure EvPasswordEvent(Sender: TObject; IsZipAction: Boolean;
+    procedure ArcPassword(Sender: TObject; IsZipAction: Boolean;
       var NewPassword: String; const ForFile: TZMString; var RepeatCount: Longword;
       var Action: TMsgDlgBtn);
-    procedure EvSkipEvent(Sender: TObject; const ForFile: TZMString;
+    procedure SkipEvent(Sender: TObject; const ForFile: TZMString;
       SkipType: TZMSkipTypes; var ExtError: Integer);
     function StripBaseDir(const s: string): string;
   end;
 ,11 → 58,10
 implementation
 uses
-  ExtractorPassword, ExtractorError, Functions, SFXAutoRun, ExtractorComment,
-  BrowseFolder;
+  ExtractorPassword, ExtractorError, Functions, SFXAutoRun, ExtractorComment;
 const
-  EvPasswordTries = 15;
+  MaxTries = 15;
 {$R *.dfm}
 ,15 → 143,12
 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)';
 ,11 → 160,8
   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}
 ,14 → 175,18
     uz.ExtrOptions := [ExtrDirNames, ExtrOverWrite, ExtrFreshen, ExtrUpdate,
       ExtrForceDirs, ExtrNTFS];
-    uz.OnExtractOverwrite := EvConfirmOverwrite;
-    uz.OnProgress := EvProgress;
-    uz.OnTick := EvTick;
-    uz.OnCheckTerminate := EvCheckTerminate;
-    uz.OnPasswordError := EvPasswordEvent;
-    uz.PasswordReqCount := EvPasswordTries;
-    uz.OnSkipped := EvSkipEvent;
-    uz.OnSetExtName := EvExtFNChange;
+    if zb.ConflictBehavior <> cbAvoid then
+    begin
+      uz.OnExtractOverwrite := ConfirmOverwrite;
+    end;
+    uz.OnProgress := ArcProzess;
+    uz.OnTick := ArcTick;
+    uz.OnCheckTerminate := ArcCheckTerminate;
+    uz.OnPasswordError := ArcPassword;
+    uz.PasswordReqCount := MaxTries;
+    uz.OnSkipped := SkipEvent;
+    uz.OnSetExtName := ArcExtFNChange;
+    // TODO: Mehr events?
     // Find out base dirtory
 ,10 → 202,12
         end;
       etAsk:
         begin
-          GeneralBaseDir := MySelectDirectory(Lng_SelectDir);
-          if GeneralBaseDir = '' then Exit;
+          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
 ,9 → 311,8
         if DirectoryExists(s) then
         begin
           // If it is a folder, open it
-          ShellExecute(0, 'open', EXPLORER_EXE,
-            PChar(Format(C_Explorer_Open_Param, [s])), '', SW_NORMAL);
+          ShellExecute(0, 'open', 'explorer',
+            PChar('"'+s+'"'), '', SW_NORMAL);
         end
         else if FileExists(s) then
         begin
 ,27 → 322,23
           // Im Moment wird bei einem BESTEHENDEN Fenster
           // die Selektion nicht durchgeführt.
-          ShellExecute(0, 'open', EXPLORER_EXE,
-            PChar(Format(C_Explorer_Select_Param, [s])), '', SW_NORMAL);
+          ShellExecute(0, 'open', 'explorer',
+            PChar('/n,/select,"'+s+'"'), '', SW_NORMAL);
         end
         else
         begin
-          if not AbortUnzip then
-          begin
             MessageDlg(Lng_Unknown_Error, mtError, [mbOk], 0);
           end;
         end;
-      end;
     finally
       l.Free;
     end;
   finally
     uz.Free;
-    ExtractionInProcess := false;
   end;
 end;
-procedure TMainForm.EvProgress(Sender: TObject; details: TZMProgressDetails);
+procedure TMainForm.ArcProzess(Sender: TObject; details: TZMProgressDetails);
 begin
   CurrentFileLabel.Caption := details.ItemName;
 ,7 → 351,7
   Application.ProcessMessages;
 end;
-procedure TMainForm.EvExtFNChange(Sender: TObject;
+procedure TMainForm.ArcExtFNChange(Sender: TObject;
   var FileName: TZMString; const BaseDir: TZMString;
   var IsChanged: Boolean);
 begin
 ,17 → 360,17
   IsChanged := true;
 end;
-procedure TMainForm.EvTick(Sender: TObject);
+procedure TMainForm.ArcTick(Sender: TObject);
 begin
   Application.ProcessMessages;
 end;
-procedure TMainForm.EvCheckTerminate(Sender: TObject; var abort: Boolean);
+procedure TMainForm.ArcCheckTerminate(Sender: TObject; var abort: Boolean);
 begin
   abort := AbortUnzip;
 end;
-procedure TMainForm.EvConfirmOverwrite(Sender: TObject; const ForFile: TZMString;
+procedure TMainForm.ConfirmOverwrite(Sender: TObject; const ForFile: TZMString;
   IsOlder: Boolean; var DoOverwrite: Boolean; DirIndex: Integer);
 resourcestring
   Lng_Overwrite = 'Bestehende Datei "%s" überschreiben?';
 ,31 → 397,27
       Exit;
     end;
-    if CachedOverwriteDecision = odUndefined then
+    if OverwriteDecision = 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 CachedOverwriteDecision := odOverwriteNothing;
-      if res = mrYesToAll then CachedOverwriteDecision := odOverwriteAll;
+      if res = mrNoToAll then OverwriteDecision := odOverwriteNothing;
+      if res = mrYesToAll then OverwriteDecision := odOverwriteAll;
     end
     else
     begin
-      DoOverwrite := CachedOverwriteDecision = odOverwriteAll;
+      DoOverwrite := OverwriteDecision = odOverwriteAll;
     end;
-  end
-  else if zb.ConflictBehavior = cbAvoid then
-  begin
-    // Nothing to do
   end;
 end;
-procedure TMainForm.EvPasswordEvent(Sender: TObject; IsZipAction: Boolean;
+procedure TMainForm.ArcPassword(Sender: TObject; IsZipAction: Boolean;
   var NewPassword: String; const ForFile: TZMString; var RepeatCount: Longword;
   var Action: TMsgDlgBtn);
 var
   repc: integer;
 begin
-  repc := EvPasswordTries - RepeatCount + 1;
+  repc := MaxTries - RepeatCount + 1;
   // Eine Passworteingabe wurde abgebrochen. Frage nicht mehr nach.
   if StopAskingPassword then Exit;
 ,7 → 439,7
     end;
   end;
-  if PasswordDlg.ShowModal(StripBaseDir(ForFile), repc, EvPasswordTries) = mrOk then
+  if PasswordDlg.ShowModal(StripBaseDir(ForFile), repc, MaxTries) = mrOk then
   begin
     NewPassword := PasswordDlg.Password.Text;
     if NewPassword = '' then NewPassword := ' '; // Neue Eingabe erzwingen.
 ,34 → 456,19
 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;
 ,6 → 565,7
       end;
     end;
   finally
+    AbortUnzip := true; // Damit es zu keiner Abfrage in OnCloseQuery kommt
     Close;
   end;
 end;
 ,7 → 577,7
   result := Copy(s, Length(BaseDir)+1, Length(s)-Length(BaseDir));
 end;
-procedure TMainForm.EvSkipEvent(Sender: TObject; const ForFile: TZMString;
+procedure TMainForm.SkipEvent(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.';

 /td.txt
 ,9 → 1,3
-sfxmaker ohne argumente: datei open dialog + folder selection dialog
-wenn sich das sfx auf cd oder diskette befindet, auf desktop oder ASK extrahieren
-Kompatibel mit Filenameencryption?
 - ein besseres win7 highres icon machen?
 - spanned sfx possible?
 test 2files, 1file, 1folder

 /Functions.pas
 ,8 → 3,8
 interface
 uses
-  Forms, Windows, Classes, SysUtils, ShellAPI,
-  ZipMstr19, ZmUtils19, ShlObj, ActiveX;
+  Forms, Windows, Classes, SysUtils, ShellAPI, ShlObj, ActiveX,
+  ZipMstr19, ZmUtils19;
 type
   TLineBreak = (lbWindows, lbLinux, lbMac);
 ,6 → 17,9
 function NormalizeLineBreaks(s: string; mode: TLineBreak): string;
 function ExtractFileNameWithoutExt(const fil: string): string;
 function SearchNextFreeName(s: string; wantDir: boolean): string;
+function AdvSelectDirectory(const Caption: string; const Root: WideString;
+  var Directory: string; EditBox: Boolean = False; ShowFiles: Boolean = False;
+  AllowCreateDirs: Boolean = True): Boolean;
 function GetSpecialFolderPath(const Folder: integer): string;
 function IsExtractable(AFilename: string): boolean;
 ,8 → 187,114
   end;
 end;
-// GetSpecialFolderPath
-// Ref: http://www.wer-weiss-was.de/theme159/article1058561.html
+{
+  This code shows the SelectDirectory dialog with additional expansions:
+  - an edit box, where the user can type the path name,
+  - also files can appear in the list,
+  - a button to create new directories.
+  Dieser Code zeigt den SelectDirectory-Dialog mit zusätzlichen Erweiterungen:
+  - eine Edit-Box, wo der Benutzer den Verzeichnisnamen eingeben kann,
+  - auch Dateien können in der Liste angezeigt werden,
+  - eine Schaltfläche zum Erstellen neuer Verzeichnisse.
+  Ref: http://www.swissdelphicenter.ch/de/showcode.php?id=1802
+}
+function AdvSelectDirectory(const Caption: string; const Root: WideString;
+  var Directory: string; EditBox: Boolean = False; ShowFiles: Boolean = False;
+  AllowCreateDirs: Boolean = True): Boolean;
+  // callback function that is called when the dialog has been initialized
+  //or a new directory has been selected
+  // Callback-Funktion, die aufgerufen wird, wenn der Dialog initialisiert oder
+  //ein neues Verzeichnis selektiert wurde
+  function SelectDirCB(Wnd: HWND; uMsg: UINT; lParam, lpData: lParam): Integer;
+    stdcall;
+//  var
+//    PathName: array[0..MAX_PATH] of Char;
+  begin
+    case uMsg of
+      BFFM_INITIALIZED: SendMessage(Wnd, BFFM_SETSELECTION, Ord(True), Integer(lpData));
+      // include the following comment into your code if you want to react on the
+      //event that is called when a new directory has been selected
+      // binde den folgenden Kommentar in deinen Code ein, wenn du auf das Ereignis
+      //reagieren willst, das aufgerufen wird, wenn ein neues Verzeichnis selektiert wurde
+      {BFFM_SELCHANGED:
+      begin
+        SHGetPathFromIDList(PItemIDList(lParam), @PathName);
+        // the directory "PathName" has been selected
+        // das Verzeichnis "PathName" wurde selektiert
+      end;}
+    end;
+    Result := 0;
+  end;
+var
+  WindowList: Pointer;
+  BrowseInfo: TBrowseInfo;
+  Buffer: PChar;
+  RootItemIDList, ItemIDList: PItemIDList;
+  ShellMalloc: IMalloc;
+  IDesktopFolder: IShellFolder;
+  Eaten, Flags: LongWord;
+const
+  // necessary for some of the additional expansions
+  // notwendig für einige der zusätzlichen Erweiterungen
+  BIF_USENEWUI = $0040;
+  BIF_NOCREATEDIRS = $0200;
+begin
+  Result := False;
+  if not DirectoryExists(Directory) then
+    Directory := '';
+  FillChar(BrowseInfo, SizeOf(BrowseInfo), 0);
+  if (ShGetMalloc(ShellMalloc) = S_OK) and (ShellMalloc <> nil) then
+  begin
+    Buffer := ShellMalloc.Alloc(MAX_PATH);
+    try
+      RootItemIDList := nil;
+      if Root <> '' then
+      begin
+        SHGetDesktopFolder(IDesktopFolder);
+        IDesktopFolder.ParseDisplayName(Application.Handle, nil,
+          POleStr(Root), Eaten, RootItemIDList, Flags);
+      end;
+      OleInitialize(nil);
+      with BrowseInfo do
+      begin
+        hwndOwner := Application.Handle;
+        pidlRoot := RootItemIDList;
+        pszDisplayName := Buffer;
+        lpszTitle := PChar(Caption);
+        // defines how the dialog will appear:
+        // legt fest, wie der Dialog erscheint:
+        ulFlags := BIF_RETURNONLYFSDIRS or BIF_USENEWUI or
+          BIF_EDITBOX * Ord(EditBox) or BIF_BROWSEINCLUDEFILES * Ord(ShowFiles) or
+          BIF_NOCREATEDIRS * Ord(not AllowCreateDirs);
+        lpfn    := @SelectDirCB;
+        if Directory <> '' then
+          lParam := Integer(PChar(Directory));
+      end;
+      WindowList := DisableTaskWindows(0);
+      try
+        ItemIDList := ShBrowseForFolder(BrowseInfo);
+      finally
+        EnableTaskWindows(WindowList);
+      end;
+      Result := ItemIDList <> nil;
+      if Result then
+      begin
+        ShGetPathFromIDList(ItemIDList, Buffer);
+        ShellMalloc.Free(ItemIDList);
+        Directory := Buffer;
+      end;
+    finally
+      ShellMalloc.Free(Buffer);
+    end;
+  end;
+end;
 function GetSpecialFolderPath(const Folder: integer): string;
 var
   PIDL: PItemIDList;
 ,7 → 325,7
     if (q and zqbHasLocal) <> zqbHasLocal then result := false;
     if (q and zqbHasCentral) <> zqbHasCentral then result := false;
     if ((q and zqbHasEOC) <> zqbHasEOC) and
-       ((q and zqbHasEOC64) <> zqbHasEOC64) then result := false;
+       ((q and zqbHasEOC64) <> zqbHasEOC) then result := false;
   finally
     uz.Free;
   end;

/Tools/Sources.txt
6,6 → 6,3

upx.exe
http://upx.sourceforge.net/

rc.dll, rcdll.dll
Windows Server 2003 SP1 SDK

 /Extractor.bdsproj
 ,7 → 53,7
                         <Compiler Name="SymbolPlatform">True</Compiler>
                         <Compiler Name="SymbolExperimental">True</Compiler>
                         <Compiler Name="UnitLibrary">True</Compiler>
-                        <Compiler Name="UnitPlatform">False</Compiler>
+                        <Compiler Name="UnitPlatform">True</Compiler>
                         <Compiler Name="UnitDeprecated">True</Compiler>
                         <Compiler Name="UnitExperimental">True</Compiler>
                         <Compiler Name="HResultCompat">True</Compiler>
 ,7 → 130,7
                         <Directories Name="UsePackages">False</Directories>
                 </Directories>
                 <Parameters>
-                        <Parameters Name="RunParams">Tests\single_file.zip</Parameters>
+                        <Parameters Name="RunParams">single_file.zip</Parameters>
                         <Parameters Name="HostApplication"></Parameters>
                         <Parameters Name="Launcher"></Parameters>
                         <Parameters Name="UseLauncher">False</Parameters>
 ,7 → 172,8
                         <VersionInfoKeys Name="Comments"></VersionInfoKeys>
                         <VersionInfoKeys Name="Webseite">www.viathinksoft.de</VersionInfoKeys>
                         <VersionInfoKeys Name="Projektleiter">Daniel Marschall - www.daniel-marschall.de</VersionInfoKeys>
-                </VersionInfoKeys>  <Excluded_Packages>
+                </VersionInfoKeys>
+    <Excluded_Packages>
       <Excluded_Packages Name="c:\programme\borland\bds\4.0\Bin\dclib100.bpl">Borland InterBase Express Components</Excluded_Packages>
       <Excluded_Packages Name="c:\programme\borland\bds\4.0\Bin\dclIntraweb_80_100.bpl">Intraweb 8.0 Design Package for Borland Development Studio 2006</Excluded_Packages>
       <Excluded_Packages Name="c:\programme\borland\bds\4.0\Bin\dclIndyCore100.bpl">Indy 10 Core Design Time</Excluded_Packages>

/Extractor.cfg
37,7 → 37,6
-O"c:\programme\borland\bds\4.0\lib\Debug;c:\programme\borland\bds\4.0\Lib\Debug\Indy10;zmstr1900102"
-I"c:\programme\borland\bds\4.0\lib\Debug;c:\programme\borland\bds\4.0\Lib\Debug\Indy10;zmstr1900102"
-R"c:\programme\borland\bds\4.0\lib\Debug;c:\programme\borland\bds\4.0\Lib\Debug\Indy10;zmstr1900102"
-w-UNIT_PLATFORM
-w-UNSAFE_TYPE
-w-UNSAFE_CODE
-w-UNSAFE_CAST

/Icons/Software used.txt
File deleted

/Icons/RarSFX.ico
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Property changes:
Deleted: svn:mime-type
-application/octet-stream
\ No newline at end of property

/Icons/RarSFX Source/RarSFX.png
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Property changes:
Deleted: svn:mime-type
-application/octet-stream
\ No newline at end of property

/Icons/RarSFX Source/RarSFX.psd
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Property changes:
Deleted: svn:mime-type
-application/octet-stream
\ No newline at end of property

/Icons/RarSFX Source/Source.txt
File deleted

/ExtractorMain.dfm
67,7 → 67,6
Font.Style = []
ParentFont = False
TabOrder = 1
TabStop = False
OnClick = CancelBtnClick
end
object itemBar: TProgressBar
79,6 → 78,7
TabOrder = 2
end
object AutoTimer: TTimer
Interval = 100
OnTimer = AutoTimerTimer
Left = 320
Top = 8

 /Extractor.dpr
 ,8 → 14,7
   ExtractorComment in 'ExtractorComment.pas' {CommentForm},
   Functions in 'Functions.pas',
   SFXAutoRun in 'SFXAutoRun.pas',
-  SFXBehavior in 'SFXBehavior.pas',
-  BrowseFolder in 'BrowseFolder.pas';
+  SFXBehavior in 'SFXBehavior.pas';
 {$R *.res}

 /_PreBuild.bat
 ,10 → 1,4
 @echo off
-rem brcc32 is not compatible with Vista icons
-Tools\rc Extractor.rc
-Tools\rc MakeSFX.rc
 cd zmstr1900102\DLL\ResDLL-Maker\
 call MakeResDll.bat
 pause.

Subversion Repositories autosfx

Compare Revisions

Regard whitespace Rev 3 → Rev 2