WebSVN – autosfx – Path Comparison – /

Regard whitespace Rev 2 → Rev 3

 /BrowseFolder.pas
 ,0 → 1,165
+unit BrowseFolder platform;
+{.$DEFINE USE_FILECTRL_FUNCTIONS} // not recommended!
+{$DEFINE USE_FORMS} // important
+interface
+uses
+  Windows, SysUtils, ShlObj, ActiveX
+  {$IFDEF USE_FILECTRL_FUNCTIONS}, FileCtrl{$ENDIF}
+  {$IFDEF USE_FORMS}, Forms{$ENDIF};
+function MySelectDirectory(AMsg: string): string;
+implementation
+{$IFNDEF USE_FILECTRL_FUNCTIONS}
+{
+  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
+  MODIFIED for AutoSFX!
+}
+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);
+        if PathName = '' then
+        begin
+          SendMessage(Wnd, BFFM_ENABLEOK, 0, 0);
+        end;
+        // the directory "PathName" has been selected
+        // das Verzeichnis "PathName" wurde selektiert
+      end;
+    end;
+    Result := 0;
+  end;
+var
+  {$IFDEF USE_FORMS}
+  WindowList: Pointer;
+  {$ENDIF}
+  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({$IFDEF USE_FORMS}Application.Handle{$ELSE}0{$ENDIF}, nil,
+          POleStr(Root), Eaten, RootItemIDList, Flags);
+      end;
+      OleInitialize(nil);
+      with BrowseInfo do
+      begin
+        hwndOwner := {$IFDEF USE_FORMS}Application.Handle{$ELSE}0{$ENDIF};
+        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;
+      {$IFDEF USE_FORMS}
+      WindowList := DisableTaskWindows(0);
+      {$ENDIF}
+      try
+        ItemIDList := ShBrowseForFolder(BrowseInfo);
+      finally
+        {$IFDEF USE_FORMS}
+        EnableTaskWindows(WindowList);
+        {$ENDIF}
+      end;
+      Result := ItemIDList <> nil;
+      if Result then
+      begin
+        ShGetPathFromIDList(ItemIDList, Buffer);
+        ShellMalloc.Free(ItemIDList);
+        Directory := Buffer;
+      end;
+    finally
+      ShellMalloc.Free(Buffer);
+    end;
+  end;
+end;
+{$ENDIF}
+function MySelectDirectory(AMsg: string): string;
+begin
+  {$IFNDEF USE_FILECTRL_FUNCTIONS}
+  if not AdvSelectDirectory(AMsg, '', result, False, False, True) then
+  begin
+    result := '';
+    Exit;
+  end;
+  {$ELSE}
+  // Nicht so gut: "Arbeitsplatz" etc nicht ausgegraut
+  if not SelectDirectory(AMsg, '', result, [sdNewUi, sdNewFolder]) then
+  begin
+    result := '';
+    Exit;
+  end;
+  {$ENDIF}
+  // Optional
+  result := IncludeTrailingPathDelimiter(result);
+  result := ExpandUNCFileName(result);
+end;
+end.

 /MakeSFX.exe.manifest
 ,0 → 1,45
+<?xml version="1.0" encoding="UTF-8" standalone="yes"?>
+<assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestVersion="1.0">
+        <trustInfo xmlns="urn:schemas-microsoft-com:asm.v2">
+                <security>
+                        <requestedPrivileges>
+                                <requestedExecutionLevel
+                                        level="asInvoker"
+                                        uiAccess="false"
+                                />
+                        </requestedPrivileges>
+                </security>
+        </trustInfo>
+        <compatibility xmlns="urn:schemas-microsoft-com:compatibility.v1">
+                        <application>
+                                <!-- This Id value indicates the application supports Windows Vista functionality -->
+                                <supportedOS Id="{e2011457-1546-43c5-a5fe-008deee3d3f0}" />
+                                <!-- This Id value indicates the application supports Windows 7 functionality -->
+                                <supportedOS Id="{35138b9a-5d96-4fbd-8e2d-a2440225f93a}" />
+                        </application>
+        </compatibility>
+        <assemblyIdentity
+                version="1.0.0.0"
+                processorArchitecture="X86"
+                name="viathinksoft.autosfx.creator"
+                type="win32"
+        />
+        <description>ViaThinkSoft AutoSFX Maker</description>
+        <dependency>
+                <dependentAssembly>
+                        <assemblyIdentity
+                                type="win32"
+                                name="Microsoft.Windows.Common-Controls"
+                                version="6.0.0.0"
+                                publicKeyToken="6595b64144ccf1df"
+                                language="*"
+                                processorArchitecture="*"
+                        />
+                </dependentAssembly>
+        </dependency>
+</assembly>

 /MakeSFX.rc
 ,0 → 1,30
+#include "resource.h"
+MAINICON ICON "Icons\RarSFX.ico"
+24 "MakeSFX.exe.manifest"
+VS_VERSION_INFO VERSIONINFO
+FILEVERSION 1, 0, 0, 0
+PRODUCTVERSION 1, 0, 0, 0
+FILEOS VOS_WINDOWS32 // 0x4
+FILETYPE VFT_APP // 0x1
+BEGIN
+        BLOCK "StringFileInfo"
+        BEGIN
+                BLOCK "040704E4"
+                BEGIN
+                        VALUE "CompanyName", "ViaThinkSoft"
+                        VALUE "FileDescription", "ViaThinkSoft AutoSFX Maker"
+                        VALUE "FileVersion", "1.0.0.0"
+                        VALUE "InternalName", "AutoSFX"
+                        VALUE "LegalCopyright", "© Copyright 2010 ViaThinkSoft"
+                        VALUE "LegalTrademarks", "Keine"
+                        VALUE "OriginalFilename", "MakeSFX.exe"
+                        VALUE "ProductName", "ViaThinkSoft AutoSFX"
+                        VALUE "ProductVersion", "1.0.0.0"
+                        VALUE "Webseite", "www.viathinksoft.de"
+                        VALUE "Projektleiter", "Daniel Marschall - www.daniel-marschall.de"
+                END
+        END
+END

 /ExtractorMain.pas
 ,8 → 2,6
 {$DEFINE USE_DZIP_UNPACK}
-// todo: compilerswitch, der auch selectdirectory() anzeigt (ohne foldercreate)
 interface
 uses
 ,6 → 24,8
     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;
-    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 ArcProzess(Sender: TObject; details: TZMProgressDetails);
-    procedure ArcTick(Sender: TObject);
-    procedure ArcCheckTerminate(Sender: TObject; var abort: Boolean);
-    procedure ConfirmOverwrite(Sender: TObject; const ForFile: TZMString;
+    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;
       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;
 ,10 → 58,11
 implementation
 uses
-  ExtractorPassword, ExtractorError, Functions, SFXAutoRun, ExtractorComment;
+  ExtractorPassword, ExtractorError, Functions, SFXAutoRun, ExtractorComment,
+  BrowseFolder;
 const
-  MaxTries = 15;
+  EvPasswordTries = 15;
 {$R *.dfm}
 ,12 → 144,15
 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)';
 ,8 → 164,11
   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}
 ,18 → 182,14
     uz.ExtrOptions := [ExtrDirNames, ExtrOverWrite, ExtrFreshen, ExtrUpdate,
       ExtrForceDirs, ExtrNTFS];
-    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?
+    uz.OnExtractOverwrite := EvConfirmOverwrite;
+    uz.OnProgress := EvProgress;
+    uz.OnTick := EvTick;
+    uz.OnCheckTerminate := EvCheckTerminate;
+    uz.OnPasswordError := EvPasswordEvent;
+    uz.PasswordReqCount := EvPasswordTries;
+    uz.OnSkipped := EvSkipEvent;
+    uz.OnSetExtName := EvExtFNChange;
     // Find out base dirtory
 ,12 → 205,10
         end;
       etAsk:
         begin
-          if not AdvSelectDirectory(Lng_SelectDir, '', GeneralBaseDir, False, False, True) then
-          begin
-            Exit;
+          GeneralBaseDir := MySelectDirectory(Lng_SelectDir);
+          if GeneralBaseDir = '' then Exit;
           end;
         end;
-    end;
     GeneralBaseDir := IncludeTrailingPathDelimiter(GeneralBaseDir);
     // Semantic scanning of ZIP to determinate the final extraction directory
 ,8 → 312,9
         if DirectoryExists(s) then
         begin
           // If it is a folder, open it
-          ShellExecute(0, 'open', 'explorer',
-            PChar('"'+s+'"'), '', SW_NORMAL);
+          ShellExecute(0, 'open', EXPLORER_EXE,
+            PChar(Format(C_Explorer_Open_Param, [s])), '', SW_NORMAL);
         end
         else if FileExists(s) then
         begin
 ,23 → 324,27
           // Im Moment wird bei einem BESTEHENDEN Fenster
           // die Selektion nicht durchgeführt.
-          ShellExecute(0, 'open', 'explorer',
-            PChar('/n,/select,"'+s+'"'), '', SW_NORMAL);
+          ShellExecute(0, 'open', EXPLORER_EXE,
+            PChar(Format(C_Explorer_Select_Param, [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.ArcProzess(Sender: TObject; details: TZMProgressDetails);
+procedure TMainForm.EvProgress(Sender: TObject; details: TZMProgressDetails);
 begin
   CurrentFileLabel.Caption := details.ItemName;
 ,7 → 357,7
   Application.ProcessMessages;
 end;
-procedure TMainForm.ArcExtFNChange(Sender: TObject;
+procedure TMainForm.EvExtFNChange(Sender: TObject;
   var FileName: TZMString; const BaseDir: TZMString;
   var IsChanged: Boolean);
 begin
 ,17 → 366,17
   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?';
 ,27 → 403,31
       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 = mrYesToAll then OverwriteDecision := odOverwriteAll;
+      if res = mrNoToAll then CachedOverwriteDecision := odOverwriteNothing;
+      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;
 ,7 → 449,7
     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.
 ,19 → 466,34
 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
+    CanClose := false;
     CancelBtn.Click;
-    CanClose := false;
   end;
 end;
 ,7 → 590,6
       end;
     end;
   finally
-    AbortUnzip := true; // Damit es zu keiner Abfrage in OnCloseQuery kommt
     Close;
   end;
 end;
 ,7 → 601,7
   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.';

/Extractor.cfg
37,6 → 37,7
-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/RarSFX Source/RarSFX.png
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Property changes:
Added: 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:
Added: svn:mime-type
+application/octet-stream
\ No newline at end of property

/Icons/RarSFX Source/Source.txt
0,0 → 1,2
by Elmer BeFuddled @ DA

/Icons/Software used.txt
0,0 → 1,0
IcoFX

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

/resource.h
0,0 → 1,2
#define VOS_WINDOWS32 0x4
#define VFT_APP 0x1

 /td.txt
 ,3 → 1,9
+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

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

 /Functions.pas
 ,8 → 3,8
 interface
 uses
-  Forms, Windows, Classes, SysUtils, ShellAPI, ShlObj, ActiveX,
-  ZipMstr19, ZmUtils19;
+  Forms, Windows, Classes, SysUtils, ShellAPI,
+  ZipMstr19, ZmUtils19, ShlObj, ActiveX;
 type
   TLineBreak = (lbWindows, lbLinux, lbMac);
 ,9 → 17,6
 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;
 ,114 → 184,8
   end;
 end;
-{
-  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;
+// GetSpecialFolderPath
+// Ref: http://www.wer-weiss-was.de/theme159/article1058561.html
 function GetSpecialFolderPath(const Folder: integer): string;
 var
   PIDL: PItemIDList;
 ,7 → 216,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) <> zqbHasEOC) then result := false;
+       ((q and zqbHasEOC64) <> zqbHasEOC64) then result := false;
   finally
     uz.Free;
   end;

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

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

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

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

 /Extractor.exe.manifest
 ,0 → 1,45
+<?xml version="1.0" encoding="UTF-8" standalone="yes"?>
+<assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestVersion="1.0">
+        <trustInfo xmlns="urn:schemas-microsoft-com:asm.v2">
+                <security>
+                        <requestedPrivileges>
+                                <requestedExecutionLevel
+                                        level="asInvoker"
+                                        uiAccess="false"
+                                />
+                        </requestedPrivileges>
+                </security>
+        </trustInfo>
+        <compatibility xmlns="urn:schemas-microsoft-com:compatibility.v1">
+                        <application>
+                                <!-- This Id value indicates the application supports Windows Vista functionality -->
+                                <supportedOS Id="{e2011457-1546-43c5-a5fe-008deee3d3f0}" />
+                                <!-- This Id value indicates the application supports Windows 7 functionality -->
+                                <supportedOS Id="{35138b9a-5d96-4fbd-8e2d-a2440225f93a}" />
+                        </application>
+        </compatibility>
+        <assemblyIdentity
+                version="1.0.0.0"
+                processorArchitecture="X86"
+                name="viathinksoft.autosfx.creator"
+                type="win32"
+        />
+        <description>ViaThinkSoft AutoSFX Maker</description>
+        <dependency>
+                <dependentAssembly>
+                        <assemblyIdentity
+                                type="win32"
+                                name="Microsoft.Windows.Common-Controls"
+                                version="6.0.0.0"
+                                publicKeyToken="6595b64144ccf1df"
+                                language="*"
+                                processorArchitecture="*"
+                        />
+                </dependentAssembly>
+        </dependency>
+</assembly>

 /_PreBuild.bat
 ,4 → 1,10
 @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.

 /Extractor.bdsproj
 ,7 → 53,7
                         <Compiler Name="SymbolPlatform">True</Compiler>
                         <Compiler Name="SymbolExperimental">True</Compiler>
                         <Compiler Name="UnitLibrary">True</Compiler>
-                        <Compiler Name="UnitPlatform">True</Compiler>
+                        <Compiler Name="UnitPlatform">False</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">single_file.zip</Parameters>
+                        <Parameters Name="RunParams">Tests\single_file.zip</Parameters>
                         <Parameters Name="HostApplication"></Parameters>
                         <Parameters Name="Launcher"></Parameters>
                         <Parameters Name="UseLauncher">False</Parameters>
 ,8 → 172,7
                         <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.rc
 ,0 → 1,30
+#include "resource.h"
+MAINICON ICON "Icons\RarSFX.ico"
+24 "Extractor.exe.manifest"
+VS_VERSION_INFO VERSIONINFO
+FILEVERSION 1, 0, 0, 0
+PRODUCTVERSION 1, 0, 0, 0
+FILEOS VOS_WINDOWS32 // 0x4
+FILETYPE VFT_APP // 0x1
+BEGIN
+        BLOCK "StringFileInfo"
+        BEGIN
+                BLOCK "040704E4"
+                BEGIN
+                        VALUE "CompanyName", "ViaThinkSoft"
+                        VALUE "FileDescription", "ViaThinkSoft AutoSFX Extractor"
+                        VALUE "FileVersion", "1.0.0.0"
+                        VALUE "InternalName", "AutoSFX Extractor"
+                        VALUE "LegalCopyright", "© Copyright 2010 ViaThinkSoft"
+                        VALUE "LegalTrademarks", "Keine"
+                        VALUE "OriginalFilename", "Extractor.exe"
+                        VALUE "ProductName", "ViaThinkSoft AutoSFX"
+                        VALUE "ProductVersion", "1.0.0.0"
+                        VALUE "Webseite", "www.viathinksoft.de"
+                        VALUE "Projektleiter", "Daniel Marschall - www.daniel-marschall.de"
+                END
+        END
+END

Subversion Repositories autosfx

Compare Revisions

Regard whitespace Rev 2 → Rev 3