Subversion Repositories autosfx

Compare Revisions

No changes between revisions

Regard whitespace Rev 1 → Rev HEAD

/Icon.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
/Readme.txt
File deleted
/td.txt
File deleted
/zmstr1900102/Demos/Demo7/Unit1.dcu
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
/zmstr1900102/Demos/Demo7/ImageStream.bdsproj.local
File deleted
/zmstr1900102/Demos/Demo7/ImageStream.identcache
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
/LICENSE
0,0 → 1,202
 
Apache License
Version 2.0, January 2004
http://www.apache.org/licenses/
 
TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION
 
1. Definitions.
 
"License" shall mean the terms and conditions for use, reproduction,
and distribution as defined by Sections 1 through 9 of this document.
 
"Licensor" shall mean the copyright owner or entity authorized by
the copyright owner that is granting the License.
 
"Legal Entity" shall mean the union of the acting entity and all
other entities that control, are controlled by, or are under common
control with that entity. For the purposes of this definition,
"control" means (i) the power, direct or indirect, to cause the
direction or management of such entity, whether by contract or
otherwise, or (ii) ownership of fifty percent (50%) or more of the
outstanding shares, or (iii) beneficial ownership of such entity.
 
"You" (or "Your") shall mean an individual or Legal Entity
exercising permissions granted by this License.
 
"Source" form shall mean the preferred form for making modifications,
including but not limited to software source code, documentation
source, and configuration files.
 
"Object" form shall mean any form resulting from mechanical
transformation or translation of a Source form, including but
not limited to compiled object code, generated documentation,
and conversions to other media types.
 
"Work" shall mean the work of authorship, whether in Source or
Object form, made available under the License, as indicated by a
copyright notice that is included in or attached to the work
(an example is provided in the Appendix below).
 
"Derivative Works" shall mean any work, whether in Source or Object
form, that is based on (or derived from) the Work and for which the
editorial revisions, annotations, elaborations, or other modifications
represent, as a whole, an original work of authorship. For the purposes
of this License, Derivative Works shall not include works that remain
separable from, or merely link (or bind by name) to the interfaces of,
the Work and Derivative Works thereof.
 
"Contribution" shall mean any work of authorship, including
the original version of the Work and any modifications or additions
to that Work or Derivative Works thereof, that is intentionally
submitted to Licensor for inclusion in the Work by the copyright owner
or by an individual or Legal Entity authorized to submit on behalf of
the copyright owner. For the purposes of this definition, "submitted"
means any form of electronic, verbal, or written communication sent
to the Licensor or its representatives, including but not limited to
communication on electronic mailing lists, source code control systems,
and issue tracking systems that are managed by, or on behalf of, the
Licensor for the purpose of discussing and improving the Work, but
excluding communication that is conspicuously marked or otherwise
designated in writing by the copyright owner as "Not a Contribution."
 
"Contributor" shall mean Licensor and any individual or Legal Entity
on behalf of whom a Contribution has been received by Licensor and
subsequently incorporated within the Work.
 
2. Grant of Copyright License. Subject to the terms and conditions of
this License, each Contributor hereby grants to You a perpetual,
worldwide, non-exclusive, no-charge, royalty-free, irrevocable
copyright license to reproduce, prepare Derivative Works of,
publicly display, publicly perform, sublicense, and distribute the
Work and such Derivative Works in Source or Object form.
 
3. Grant of Patent License. Subject to the terms and conditions of
this License, each Contributor hereby grants to You a perpetual,
worldwide, non-exclusive, no-charge, royalty-free, irrevocable
(except as stated in this section) patent license to make, have made,
use, offer to sell, sell, import, and otherwise transfer the Work,
where such license applies only to those patent claims licensable
by such Contributor that are necessarily infringed by their
Contribution(s) alone or by combination of their Contribution(s)
with the Work to which such Contribution(s) was submitted. If You
institute patent litigation against any entity (including a
cross-claim or counterclaim in a lawsuit) alleging that the Work
or a Contribution incorporated within the Work constitutes direct
or contributory patent infringement, then any patent licenses
granted to You under this License for that Work shall terminate
as of the date such litigation is filed.
 
4. Redistribution. You may reproduce and distribute copies of the
Work or Derivative Works thereof in any medium, with or without
modifications, and in Source or Object form, provided that You
meet the following conditions:
 
(a) You must give any other recipients of the Work or
Derivative Works a copy of this License; and
 
(b) You must cause any modified files to carry prominent notices
stating that You changed the files; and
 
(c) You must retain, in the Source form of any Derivative Works
that You distribute, all copyright, patent, trademark, and
attribution notices from the Source form of the Work,
excluding those notices that do not pertain to any part of
the Derivative Works; and
 
(d) If the Work includes a "NOTICE" text file as part of its
distribution, then any Derivative Works that You distribute must
include a readable copy of the attribution notices contained
within such NOTICE file, excluding those notices that do not
pertain to any part of the Derivative Works, in at least one
of the following places: within a NOTICE text file distributed
as part of the Derivative Works; within the Source form or
documentation, if provided along with the Derivative Works; or,
within a display generated by the Derivative Works, if and
wherever such third-party notices normally appear. The contents
of the NOTICE file are for informational purposes only and
do not modify the License. You may add Your own attribution
notices within Derivative Works that You distribute, alongside
or as an addendum to the NOTICE text from the Work, provided
that such additional attribution notices cannot be construed
as modifying the License.
 
You may add Your own copyright statement to Your modifications and
may provide additional or different license terms and conditions
for use, reproduction, or distribution of Your modifications, or
for any such Derivative Works as a whole, provided Your use,
reproduction, and distribution of the Work otherwise complies with
the conditions stated in this License.
 
5. Submission of Contributions. Unless You explicitly state otherwise,
any Contribution intentionally submitted for inclusion in the Work
by You to the Licensor shall be under the terms and conditions of
this License, without any additional terms or conditions.
Notwithstanding the above, nothing herein shall supersede or modify
the terms of any separate license agreement you may have executed
with Licensor regarding such Contributions.
 
6. Trademarks. This License does not grant permission to use the trade
names, trademarks, service marks, or product names of the Licensor,
except as required for reasonable and customary use in describing the
origin of the Work and reproducing the content of the NOTICE file.
 
7. Disclaimer of Warranty. Unless required by applicable law or
agreed to in writing, Licensor provides the Work (and each
Contributor provides its Contributions) on an "AS IS" BASIS,
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or
implied, including, without limitation, any warranties or conditions
of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A
PARTICULAR PURPOSE. You are solely responsible for determining the
appropriateness of using or redistributing the Work and assume any
risks associated with Your exercise of permissions under this License.
 
8. Limitation of Liability. In no event and under no legal theory,
whether in tort (including negligence), contract, or otherwise,
unless required by applicable law (such as deliberate and grossly
negligent acts) or agreed to in writing, shall any Contributor be
liable to You for damages, including any direct, indirect, special,
incidental, or consequential damages of any character arising as a
result of this License or out of the use or inability to use the
Work (including but not limited to damages for loss of goodwill,
work stoppage, computer failure or malfunction, or any and all
other commercial damages or losses), even if such Contributor
has been advised of the possibility of such damages.
 
9. Accepting Warranty or Additional Liability. While redistributing
the Work or Derivative Works thereof, You may choose to offer,
and charge a fee for, acceptance of support, warranty, indemnity,
or other liability obligations and/or rights consistent with this
License. However, in accepting such obligations, You may act only
on Your own behalf and on Your sole responsibility, not on behalf
of any other Contributor, and only if You agree to indemnify,
defend, and hold each Contributor harmless for any liability
incurred by, or claims asserted against, such Contributor by reason
of your accepting any such warranty or additional liability.
 
END OF TERMS AND CONDITIONS
 
APPENDIX: How to apply the Apache License to your work.
 
To apply the Apache License to your work, attach the following
boilerplate notice, with the fields enclosed by brackets "[]"
replaced with your own identifying information. (Don't include
the brackets!) The text should be enclosed in the appropriate
comment syntax for the file format. We also recommend that a
file or class name and description of purpose be included on the
same "printed page" as the copyright notice for easier
identification within third-party archives.
 
Copyright 2018 Daniel Marschall, ViaThinkSoft
 
Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at
 
http://www.apache.org/licenses/LICENSE-2.0
 
Unless required by applicable law or agreed to in writing, software
distributed under the License is distributed on an "AS IS" BASIS,
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
See the License for the specific language governing permissions and
limitations under the License.
/Readme.md
0,0 → 1,104
 
VIATHINKSOFT AUTOSFX
====================
 
Benefits
--------
 
* Compatible with WinRAR and other software (Stub is small enough)
* Compatible with Linux' UnZip (No Warnings!)
* Compatible with AuthentiCode
* Compatible with Windows 7
* Compatible with Windows 95
* Accepts encrypted files (currently only ZIP 2.0 Standard)
 
Currently not supported
-----------------------
 
* AES-Encryption (128, 256 Bit)
 
Current overhead
----------------
 
458 KB (Delphi 2006)
 
Cancel
------
 
Press ESC to cancel.
 
The program waits 1 second before starting extraction (Prevention of malicious
AutoRun's, which call the creator SFX in an infinite loop)
 
Structure of a ViaThinkSoft AutoSFX Archive
-------------------------------------------
 
1. Extractor [UPX'ed]
includes DelZip190.dll (B4) as Resource
2. ZIP (Offset adjusted)
File comment includes "ViaThinkSoft AutoSFX Archive"
3. Optional: Authenticode Certificate
 
Process
-------
 
1. Extract DelZip DLL into TempDir
2. Extract contents directly
3. Open the extracted data and/or execute special AutoRun.inf (see below)
4. Delete the DLL from TempDir
 
Behavior
--------
 
ZIP has 1 file
=> Extract DIRECTLY in the specified directory
Is it a directory?
=> Open the new directory in Windows Explorer
is it a file?
=> Open Windows Explorer and select the new file.
ZIP has 2+ files
=> Create a directory with the name of the SFX and extract into it
=> Open the new created directory in Windows Explorer
 
Semantic archive comment
------------------------
 
The extractor looks into the file comment to determinate the behavior
while unzipping. YOU can influence the behavior when creating your
ZIP files.
 
Following switches are possible:
 
C_ASFX_CB_OVR = 'AutoSFX Conflict Behavior: Overwrite all';
C_ASFX_CB_NEW = 'AutoSFX Conflict Behavior: Overwrite older';
C_ASFX_CB_ASK = 'AutoSFX Conflict Behavior: Ask';
C_ASFX_CB_AVO = 'AutoSFX Conflict Behavior: Avoid'; (default)
 
C_ASFX_CP_BEF = 'AutoSFX Comment Presentation: Before extracting';
C_ASFX_CP_AFT = 'AutoSFX Comment Presentation: After extracting';
C_ASFX_CP_NON = 'AutoSFX Comment Presentation: None'; (default)
 
C_ASFX_FC_THS = 'AutoSFX Extraction Target: Extract here'; (default)
C_ASFX_FC_DSK = 'AutoSFX Extraction Target: Extract to Desktop';
C_ASFX_FC_ASK = 'AutoSFX Extraction Target: Choose directory';
 
Note: If you are running the SFX from a CD-Rom, a write-protected
directory or a flobby (doesn't matter if it is write-protected!),
the extraction "Here" will be ignored and converted into "Desktop".
 
Note: "Avoid" means that an alternative file/foldername will be
determinated.
 
Special AutoRun.inf
-------------------
 
[AutoSFX]
Operation=open ; Part of ShellExecute. Usually 'open' or 'runass' (e.g. for admin privilegies)
FileName=AutoRun.exe ; The filename to be executed
Parameters= ; Optional parameters
Directory= ; Optional Working directory
ShowCmd= ; (See MSDN Reference) Usually WS_NORMAL or WS_HIDE
OpenUnzippedContent=true ; After we have opened the application, should we still show the extracted data in Windows Explorer? (Default behavior if not AutoRun is set)
 
More information about the first 5 values:
http://msdn.microsoft.com/en-us/library/bb762153(VS.85).aspx
/TODO.TXT
0,0 → 1,20
sfxmaker ohne argumente: datei open dialog + folder selection dialog
 
Kompatibel mit Filenameencryption?
 
- ein besseres win7 highres icon machen?
- spanned sfx possible?
 
 
Delphi 6: Projekteinstellungen prüfen. Debugging bei Extractor aus
Versioninfo für alle Projekte
 
BUG:
- W95 issue
 
???
- Ist es möglich, dass erst Pwd-Dialog und dann Overwrite-Dialog kommt?
=> Overwrite dialog soll nicht kommen bei "StopAskingPassword" + Verschlüsselt
 
Extractor: OpenDialog wenn extractor nackt?
 
/Future.txt
10,3 → 10,7
testen, was bei leerer zip passieren würde
 
type TZMReplaceOpts = (rplConfirm, rplAlways, rplNewer, rplNever);
 
Bei MakeSFX.exe vorher einen Extraktionstest durchführen? (um z.B. Compressionsfehler etc. auszuschließen?)
 
Einen ZIP-Packer/Modifier, der auch korrekte Kommentare erstellt (Checkboxes zur Unterstützung) machen?
/ExtractorError.dfm
1,11 → 1,9
object ErrorForm: TErrorForm
Left = 222
Top = 133
BorderIcons = [biSystemMenu]
BorderStyle = bsSingle
Caption = 'Fehler'
ClientHeight = 365
ClientWidth = 355
ClientHeight = 406
ClientWidth = 583
Color = clBtnFace
Font.Charset = ANSI_CHARSET
Font.Color = clWindowText
14,6 → 12,7
Font.Style = []
OldCreateOrder = False
Position = poMainFormCenter
OnResize = FormResize
PixelsPerInch = 96
TextHeight = 13
object ErrorImg: TImage
815,4 → 814,20
ParentFont = False
TabOrder = 1
end
object SaveBtn: TButton
Left = 64
Top = 328
Width = 97
Height = 25
Caption = 'Liste speichern'
TabOrder = 2
OnClick = SaveBtnClick
end
object SaveDialog: TSaveDialog
DefaultExt = '.txt'
Filter = 'Textdateien (*.txt)|*.txt|Alle Dateien (*.*)|*.*'
Options = [ofOverwritePrompt, ofHideReadOnly, ofPathMustExist, ofEnableSizing]
Left = 320
Top = 8
end
end
/ExtractorMain.pas
1,17 → 1,13
unit ExtractorMain;
 
{$DEFINE DEBUG_MODE}
{$DEFINE USE_DZIP_UNPACK} // recommended
 
{$DEFINE USE_DZIP_UNPACK}
 
// TODO: Implement ExtractionTarget switch
 
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);
28,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;
35,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;
60,10 → 58,11
implementation
 
uses
ExtractorPassword, ExtractorError, Functions, SFXAutoRun, ExtractorComment;
ExtractorPassword, ExtractorError, Functions, SFXAutoRun, ExtractorComment,
BrowseFolder;
 
const
MaxTries = 15;
EvPasswordTries = 15;
 
{$R *.dfm}
 
145,23 → 144,33
 
procedure TMainForm.ExtractZipHere(AZipfile: string);
var
uz: TZipMaster19;
l: TStringList;
s: string;
ec: Integer;
ar: TExecuteSFXAutoRunResult;
GeneralBaseDir: string;
ok: boolean;
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!';
Lng_SelectDir = 'Bitte wählen Sie ein Verzeichnis zum Extrahieren aus. Es wird maximal 1 Datei bzw. Ordner erstellt!';
Lng_WriteProtected = 'Das Verzeichnis ist nicht schreibbar! Bitte wählen Sie ein Anderes.';
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}
175,19 → 184,59
uz.ExtrOptions := [ExtrDirNames, ExtrOverWrite, ExtrFreshen, ExtrUpdate,
ExtrForceDirs, ExtrNTFS];
 
if zb.ConflictBehavior <> cbAvoid then
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
 
GeneralBaseDir := '';
 
if zb.ExtractionTarget = etExtractHere then
begin
uz.OnExtractOverwrite := ConfirmOverwrite;
GeneralBaseDir := ExtractFilePath(AZipfile); // Default
 
if not IsDirectoryWritable(GeneralBaseDir) or
IsAtFlobbyDisk(GeneralBaseDir) then
begin
zb.ExtractionTarget := etDesktop;
end;
uz.OnProgress := ArcProzess;
uz.OnTick := ArcTick;
uz.OnCheckTerminate := ArcCheckTerminate;
uz.OnPasswordError := ArcPassword;
uz.PasswordReqCount := MaxTries;
// TODO: Mehr events?
uz.OnSkipped := SkipEvent;
uz.OnSetExtName := ArcExtFNChange;
end;
 
if zb.ExtractionTarget = etDesktop then
begin
GeneralBaseDir := GetSpecialFolderPath(CSIDL_DESKTOP);
 
if not IsDirectoryWritable(GeneralBaseDir) or
IsAtFlobbyDisk(GeneralBaseDir) then
begin
zb.ExtractionTarget := etAsk;
end;
end;
 
if zb.ExtractionTarget = etAsk then
begin
repeat
GeneralBaseDir := MySelectDirectory(Lng_SelectDir);
if GeneralBaseDir = '' then Exit;
 
ok := IsDirectoryWritable(GeneralBaseDir);
if not ok then
begin
MessageDlg(Lng_WriteProtected, mtWarning, [mbOk], 0);
end;
until ok;
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
202,23 → 251,25
else if l.Count = 1 then
begin
// 1 Object = Extract it right here!
s := ExtractFilePath(AZipfile) + l.Strings[0];
BaseDir := ExtractFilePath(AZipfile);
RenamingOldPrefix := StripBaseDir(S);
BaseDir := GeneralBaseDir;
s := BaseDir + l.Strings[0];
 
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
229,7 → 280,7
end;
BaseDir := IncludeTrailingPathDelimiter(BaseDir);
 
uz.ExtrBaseDir := BaseDir; // TODO: andere ordner erlauben
uz.ExtrBaseDir := BaseDir;
 
// Pre-Extract-Dialog
 
258,6 → 309,7
 
if ErrorForm.ErrorsAvailable then
begin
Hide;
ErrorForm.ShowModal;
end;
 
285,8 → 337,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
296,23 → 349,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;
 
325,27 → 382,26
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 = 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.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?';
372,27 → 428,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;
414,7 → 474,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.
431,19 → 491,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;
 
451,9 → 526,6
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 := '';
500,6 → 572,10
{$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;
 
508,7 → 584,21
{$ENDIF}
 
try
{$IFDEF DEBUG_MODE}
if IsExtractable(ParamStr(0)) then
begin
ExtractZipHere(ParamStr(0));
end
else
begin
// Der Extractor ist "nackt" oder das SFX beschädigt
 
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
begin
ExtractZipHere(ParamStr(1));
515,15 → 605,16
end
else
begin
{$ENDIF}
 
ExtractZipHere(ParamStr(0));
 
{$IFDEF DEBUG_MODE}
MessageDlg(Lng_FileNotFound, mtError, [mbOk], 0);
end;
{$ENDIF}
end
else if ParamCount = 2 then
begin
// Future: Mehr als nur 1 Parameter erlauben?
MessageDlg(Lng_TooManyArguments, mtError, [mbOk], 0);
end;
end;
finally
AbortUnzip := true; // Damit es zu keiner Abfrage kommt
Close;
end;
end;
535,7 → 626,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.';
545,7 → 636,7
MessageDlg(Format(Lng_PasswordWrong, [ForFile]), mtError, [mbOk], 0);
LastTriedPassword := '';
end;
ErrorForm.NewError(StripBaseDir(ForFile));
ErrorForm.NewError(ForFile, SkipType);
end;
 
end.
/MakeSFX.exe
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
/Functions.pas
3,7 → 3,8
interface
 
uses
Windows, Classes, SysUtils, ShellAPI;
Forms, Windows, Classes, SysUtils, ShellAPI,
ZipMstr19, ZmUtils19, ShlObj, ActiveX;
 
type
TLineBreak = (lbWindows, lbLinux, lbMac);
15,7 → 16,11
function GetTempDirectory: String;
function NormalizeLineBreaks(s: string; mode: TLineBreak): string;
function ExtractFileNameWithoutExt(const fil: string): string;
function SearchNextFreeName(s: string): string;
function SearchNextFreeName(s: string; wantDir: boolean): string;
function GetSpecialFolderPath(const Folder: integer): string;
function IsExtractable(AFilename: string): boolean;
function IsDirectoryWritable(const Dir: String): Boolean;
function IsAtFlobbyDisk(AFileOrDir: string): boolean;
 
implementation
 
150,7 → 155,7
result := Copy(ExtractFileName(fil), 1, Length(ExtractFileName(fil))-Length(ExtractFileExt(fil)));
end;
 
function SearchNextFreeName(s: string): string;
function SearchNextFreeName(s: string; wantDir: boolean): string;
var
i: integer;
begin
157,27 → 162,87
if not FileExists(s) and not DirectoryExists(s) then
begin
result := s;
if wantDir then result := IncludeTrailingPathDelimiter(result);
Exit;
end;
 
i := 2;
 
if FileExists(s) then
if wantDir then
begin
s := ExcludeTrailingPathDelimiter(s);
repeat
result := Format('%s (%d)%s', [ExtractFileNameWithoutExt(s), i, ExtractFileExt(s)]);
result := Format('%s (%d)', [s, i]);
inc(i);
until not DirectoryExists(result);
until not DirectoryExists(result) and not FileExists(result);
result := IncludeTrailingPathDelimiter(result);
end
else if DirectoryExists(s) then
else
begin
s := ExcludeTrailingPathDelimiter(s);
repeat
result := Format('%s (%d)', [s, i]);
result := Format('%s (%d)%s', [ExtractFilePath(s)+ExtractFileNameWithoutExt(s), i, ExtractFileExt(s)]);
inc(i);
until not DirectoryExists(result); // Todo: Legt man sich hier nun auf einen ordnernamen fest???
result := IncludeTrailingPathDelimiter(result);
until not DirectoryExists(result) and not FileExists(result);
end;
end;
 
// GetSpecialFolderPath
// Ref: http://www.wer-weiss-was.de/theme159/article1058561.html
function GetSpecialFolderPath(const Folder: integer): string;
var
PIDL: PItemIDList;
Path: array[0..MAX_PATH] of char;
Malloc: IMalloc;
begin
Path := '';
if Succeeded((SHGetSpecialFolderLocation(0, Folder, PIDL))) then
if (SHGetPathFromIDList(PIDL, Path)) then
if Succeeded(ShGetMalloc(Malloc)) then
begin
Malloc.Free(PIDL);
Malloc := nil;
end;
Result := Path;
end;
 
function IsExtractable(AFilename: string): boolean;
var
q: integer;
uz: TZipMaster19;
begin
// TODO: Ist die Funktion gut? Fraglich, ob EOC64 ein Teil von EOC ist.
uz := TZipMaster19.Create(nil);
try
q := uz.QueryZip(AFilename);
result := true;
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;
finally
uz.Free;
end;
end;
 
// Ref: http://www.delphiarea.com/articles/how-to-find-if-a-directory-is-writable/
function IsDirectoryWritable(const Dir: String): Boolean;
var
TempFile: array[0..MAX_PATH] of Char;
begin
if GetTempFileName(PChar(Dir), 'DA', 0, TempFile) <> 0 then
Result := Windows.DeleteFile(TempFile)
else
Result := False;
end;
 
function IsAtFlobbyDisk(AFileOrDir: string): boolean;
var
s: string;
begin
s := ExtractFileDrive(AFileOrDir);
s := UpperCase(s);
 
result := (s = 'A:') or (s = 'B:');
end;
 
end.
/Extractor.exe
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
/Tools/RemoveSignature.exe
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
/Tools/RC.Exe
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
/Tools/RcDll.Dll
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
/Tools/Sources.txt
6,3 → 6,6
 
upx.exe
http://upx.sourceforge.net/
 
rc.dll, rcdll.dll
Windows Server 2003 SP1 SDK
/ExtractorError.pas
2,10 → 2,11
 
interface
 
// TODO: Dialog sizeable
// TODO: Richtige Ordnerliste mit Icons anzeigen?
 
uses
Forms, StdCtrls, ExtCtrls, Controls, Graphics, Classes;
Forms, StdCtrls, ExtCtrls, Controls, Graphics, Classes, Dialogs,
ZipMstr19, SysUtils;
 
type
TErrorForm = class(TForm)
13,9 → 14,13
ErrorImg: TImage;
ErrorLabel: TLabel;
OKBtn: TButton;
SaveBtn: TButton;
SaveDialog: TSaveDialog;
procedure FormResize(Sender: TObject);
procedure SaveBtnClick(Sender: TObject);
public
function ErrorsAvailable: boolean;
procedure NewError(Filename: string);
procedure NewError(Filename: string; SkipType: TZMSkipTypes);
end;
 
var
25,15 → 30,58
 
{$R *.dfm}
 
function SkipTypeToStr(SkipType: TZMSkipTypes): string;
begin
case SkipType of
stOnFreshen: result := 'stOnFreshen';
stNoOverwrite: result := 'stNoOverwrite';
stFileExists: result := 'stFileExists';
stBadPassword: result := 'stBadPassword';
stBadName: result := 'stBadName';
stCompressionUnknown: result := 'stCompressionUnknown';
stUnknownZipHost: result := 'stUnknownZipHost';
stZipFileFormatWrong: result := 'stZipFileFormatWrong';
stGeneralExtractError: result := 'stGeneralExtractError';
stUser: result := 'stUser';
stCannotDo: result := 'stCannotDo';
stNotFound: result := 'stNotFound';
stNoShare: result := 'stNoShare';
stNoAccess: result := 'stNoAccess';
stNoOpen: result := 'stNoOpen';
stDupName: result := 'stDupName';
stReadError: result := 'stReadError';
stSizeChange: result := 'stSizeChange';
end;
end;
 
function TErrorForm.ErrorsAvailable: boolean;
begin
result := ErrorList.Items.Count > 0;
end;
 
procedure TErrorForm.NewError(Filename: string);
procedure TErrorForm.FormResize(Sender: TObject);
begin
ErrorList.Width := ClientWidth - ErrorList.Left - ErrorImg.Left;
ErrorList.Height := ClientHeight - ErrorList.Top - (2 * ErrorImg.Left + OkBtn.Height);
OkBtn.Top := ErrorList.Top + ErrorList.Height + ErrorImg.Left;
OkBtn.Left := ErrorList.Left + ErrorList.Width - OkBtn.Width;
SaveBtn.Top := OkBtn.Top;
end;
 
procedure TErrorForm.NewError(Filename: string; SkipType: TZMSkipTypes);
resourcestring
Lng_Err_Entry = '%s (Grund: %s)';
begin
// In future: Also add reason into list?
ErrorList.Items.Add(Filename);
ErrorList.Items.Add(Format(Lng_Err_Entry, [Filename, SkipTypeToStr(SkipType)]));
end;
 
procedure TErrorForm.SaveBtnClick(Sender: TObject);
begin
if SaveDialog.Execute then
begin
ErrorList.Items.SaveToFile(SaveDialog.FileName);
end;
end;
 
end.
/Extractor.bdsproj
53,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>
130,7 → 130,7
<Directories Name="UsePackages">False</Directories>
</Directories>
<Parameters>
<Parameters Name="RunParams">helloworld.exe</Parameters>
<Parameters Name="RunParams">"Tests\128-Bit Enc.zip"</Parameters>
<Parameters Name="HostApplication"></Parameters>
<Parameters Name="Launcher"></Parameters>
<Parameters Name="UseLauncher">False</Parameters>
/MakeSFX.res
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
/BuildTests.bat
1,4 → 1,5
@echo off
MakeSFX helloworld.zip
MakeSFX test.zip
MakeSFX Tests\helloworld.zip
MakeSFX Tests\single_file.zip
MakeSFX Tests\test.zip
pause.
/MakeSFX.dpr
10,6 → 10,7
Windows,
Classes,
ZipMstr19,
Dialogs,
Functions in 'Functions.pas',
SFXBehavior in 'SFXBehavior.pas';
 
19,14 → 20,12
ZIP_EXE = 'Tools\zip.exe';
RemoveSignature_EXE = 'Tools\RemoveSignature.exe';
 
procedure DoMakeSFX(AFilename: string);
var
Src, Dst: string;
i: integer;
Dst: string;
s1, s2: TFileStream;
x: TZipMaster19;
 
resourcestring
ImportantFileNotFound = 'Error: Important file "%s" not found!';
LngErrorWhileCopy = 'Error: Could not copy "%s" to "%s".';
LngErrorWhileExecuting = 'Error while executing "%s".';
SourceFileNotFound = 'Source file "%s" not found.';
38,46 → 37,20
Lng_ModifyZIPComment = 'Modify ZIP Comment...';
Lng_SignSfx = 'Sign the SFX...';
Lng_Finished = 'Finished! :-)';
Lng_Title = 'ViaThinkSoft AutoSFX';
Lng_Usage1 = 'Usage:';
Lng_Usage2 = 'MakeSFX [File1.zip [File2.zip...]]';
 
{$R *.res}
 
begin
WriteLn(Lng_Title);
WriteLn('');
WriteLn(Lng_Usage1);
WriteLn(Lng_Usage2);
WriteLn('');
 
if not FileExists(ExtractFilePath(ParamStr(0)) + Extractor_EXE) then
if not FileExists(AFilename) then
begin
WriteLn(Format(ImportantFileNotFound, [Extractor_EXE]));
WriteLn(Format(SourceFileNotFound, [AFilename]));
{$IFDEF DELAY_ON_ERROR}
Sleep(2000);
{$ENDIF}
ExitCode := 2;
ExitCode := 1;
Exit;
end;
 
for i := 1 to ParamCount do
begin
Src := ParamStr(i);
Dst := ChangeFileExt(AFilename, '.exe');
 
if not FileExists(Src) then
begin
WriteLn(Format(SourceFileNotFound, [Src]));
{$IFDEF DELAY_ON_ERROR}
Sleep(2000);
{$ENDIF}
ExitCode := 1;
Continue;
end;
 
Dst := ChangeFileExt(Src, '.exe');
 
WriteLn(Format(Lng_In+#9+'%s', [Src]));
WriteLn(Format(Lng_In+#9+'%s', [AFilename]));
WriteLn(Format(Lng_Out+#9+'%s', [Dst]));
WriteLn('');
 
88,7 → 61,7
Sleep(2000);
{$ENDIF}
ExitCode := 1;
Continue;
Exit;
end;
 
// Remove the signature of Extractor first (otherwise signing will fail later)
104,7 → 77,7
Sleep(2000);
{$ENDIF}
ExitCode := 1;
Continue;
Exit;
{$ENDIF}
end;
 
114,7 → 87,7
try
s1.Seek(0, soEnd);
 
s2 := TFileStream.Create(Src, fmOpenRead or fmShareDenyWrite);
s2 := TFileStream.Create(AFilename, fmOpenRead or fmShareDenyWrite);
try
s1.CopyFrom(s2, s2.Size);
finally
134,7 → 107,7
Sleep(2000);
{$ENDIF}
ExitCode := 1;
Continue;
Exit;
end;
 
WriteLn(#9 + Lng_ModifyZIPComment);
177,7 → 150,7
Sleep(2000);
{$ENDIF}
ExitCode := 1;
Continue;
Exit;
{$ENDIF}
end;
 
185,5 → 158,59
WriteLn('');
end;
 
{$R *.res}
 
var
i: integer;
od: TOpenDialog;
resourcestring
Lng_Title = 'ViaThinkSoft AutoSFX';
Lng_Usage1 = 'Usage:';
Lng_Usage2 = 'MakeSFX [File1.zip [File2.zip...]]';
ImportantFileNotFound = 'Error: Important file "%s" not found!';
begin
WriteLn(Lng_Title);
WriteLn('');
WriteLn(Lng_Usage1);
WriteLn(Lng_Usage2);
WriteLn('');
 
if not FileExists(ExtractFilePath(ParamStr(0)) + Extractor_EXE) then
begin
WriteLn(Format(ImportantFileNotFound, [Extractor_EXE]));
{$IFDEF DELAY_ON_ERROR}
Sleep(2000);
{$ENDIF}
ExitCode := 2;
Exit;
end;
 
if ParamCount = 0 then
begin
od := TOpenDialog.Create(nil);
try
od.DefaultExt := '.zip';
od.Filter := 'ZIP-Archiv (*.zip)|*.zip|Alle Dateien (*.*)|*.*';
od.Options := [ofAllowMultiSelect, ofFileMustExist, ofHideReadOnly,
ofPathMustExist, ofEnableSizing];
if od.Execute then
begin
for i := 0 to od.Files.Count - 1 do
begin
DoMakeSFX(od.Files.Strings[i]);
end;
end;
finally
od.Free;
end;
end
else
begin
for i := 1 to ParamCount do
begin
DoMakeSFX(ParamStr(i));
end;
end;
 
// TODO: Es gibt bei Win2000 außerhalb des debuggers eine AV...
end.
/MakeSFX.bdsproj
130,7 → 130,7
<Directories Name="UsePackages">False</Directories>
</Directories>
<Parameters>
<Parameters Name="RunParams">helloworld.zip</Parameters>
<Parameters Name="RunParams"></Parameters>
<Parameters Name="HostApplication"></Parameters>
<Parameters Name="Launcher"></Parameters>
<Parameters Name="UseLauncher">False</Parameters>
/BrowseFolder.pas
0,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,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,0 → 1,30
#include "resource.h"
 
MAINICON ICON "Icons\RarSFX.ico"
 
1 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
/Extractor.res
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
/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
/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
/Extractor.dpr
14,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}
 
/Extractor.exe.manifest
0,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
1,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.rc
0,0 → 1,30
#include "resource.h"
 
MAINICON ICON "Icons\RarSFX.ico"
 
1 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
/SFXBehavior.pas
41,7 → 41,7
C_ASFX_ET_DES = 'AutoSFX Extraction Target: Extract to Desktop';
C_ASFX_ET_ASK = 'AutoSFX Extraction Target: Choose directory';
 
EINRUECK = '> '; // Optional
EINRUECK = '> '; // Optional to all C_ASFX
 
const
CB_DEFAULT = cbAvoid;
109,12 → 109,15
 
function StripBehavior(c: string): string;
 
procedure StripIt(s: string);
procedure StripIt(s: string; allowEinrueck: boolean);
begin
if allowEinrueck then
begin
c := StringReplace(c, EINRUECK + s+#13#10, '', [rfReplaceAll, rfIgnoreCase]);
c := StringReplace(c, EINRUECK + s+#13, '', [rfReplaceAll, rfIgnoreCase]);
c := StringReplace(c, EINRUECK + s+#10, '', [rfReplaceAll, rfIgnoreCase]);
c := StringReplace(c, EINRUECK + s, '', [rfReplaceAll, rfIgnoreCase]);
end;
 
c := StringReplace(c, s+#13#10, '', [rfReplaceAll, rfIgnoreCase]);
c := StringReplace(c, s+#13, '', [rfReplaceAll, rfIgnoreCase]);
123,20 → 126,20
end;
 
begin
StripIt(C_SIGNATURE);
StripIt(C_SIGNATURE, false);
 
StripIt(C_ASFX_CB_AVO);
StripIt(C_ASFX_CB_OVR);
StripIt(C_ASFX_CB_NEW);
StripIt(C_ASFX_CB_ASK);
StripIt(C_ASFX_CB_AVO, true);
StripIt(C_ASFX_CB_OVR, true);
StripIt(C_ASFX_CB_NEW, true);
StripIt(C_ASFX_CB_ASK, true);
 
StripIt(C_ASFX_CP_NON);
StripIt(C_ASFX_CP_BEF);
StripIt(C_ASFX_CP_AFT);
StripIt(C_ASFX_CP_NON, true);
StripIt(C_ASFX_CP_BEF, true);
StripIt(C_ASFX_CP_AFT, true);
 
StripIt(C_ASFX_ET_HER);
StripIt(C_ASFX_ET_DES);
StripIt(C_ASFX_ET_ASK);
StripIt(C_ASFX_ET_HER, true);
StripIt(C_ASFX_ET_DES, true);
StripIt(C_ASFX_ET_ASK, true);
 
result := c;
end;
/ExtractorPassword.dfm
7,7 → 7,11
ClientHeight = 140
ClientWidth = 290
Color = clBtnFace
ParentFont = True
Font.Charset = ANSI_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = True
Position = poMainFormCenter
OnShow = FormShow
16,7 → 20,7
object PwEnterLabel: TLabel
Left = 8
Top = 56
Width = 120
Width = 117
Height = 13
Caption = 'Bitte Passwort eingeben.'
end
23,7 → 27,7
object FileLabel: TLabel
Left = 8
Top = 6
Width = 29
Width = 28
Height = 13
Caption = 'Datei:'
end
/ExtractorComment.dfm
5,10 → 5,10
ClientHeight = 499
ClientWidth = 521
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Charset = ANSI_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
Position = poMainFormCenter
38,7 → 38,13
Height = 25
Caption = 'OK'
Default = True
Font.Charset = ANSI_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ModalResult = 1
ParentFont = False
TabOrder = 0
end
object CancelBtn: TButton
48,7 → 54,13
Height = 25
Cancel = True
Caption = 'Abbrechen'
Font.Charset = ANSI_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ModalResult = 2
ParentFont = False
TabOrder = 1
end
end