Subversion Repositories autosfx

Compare Revisions

Regard whitespace Rev HEAD → Rev 1

/ExtractorMain.pas
1,13 → 1,17
unit ExtractorMain;
 
{$DEFINE USE_DZIP_UNPACK} // recommended
{$DEFINE DEBUG_MODE}
 
{$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, ShlObj;
ZMCompat19, SFXBehavior;
 
type
TOverwriteDecision = (odUndefined, odOverwriteAll, odOverwriteNothing);
24,8 → 28,6
procedure AutoTimerTimer(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
private
ExtractionInProcess: boolean;
uz: TZipMaster19;
RenamingOldPrefix: string;
RenamingNewPrefix: string;
zb: TZIPBehavior;
33,21 → 35,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;
58,11 → 60,10
implementation
 
uses
ExtractorPassword, ExtractorError, Functions, SFXAutoRun, ExtractorComment,
BrowseFolder;
ExtractorPassword, ExtractorError, Functions, SFXAutoRun, ExtractorComment;
 
const
EvPasswordTries = 15;
MaxTries = 15;
 
{$R *.dfm}
 
144,33 → 145,23
 
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}
184,59 → 175,19
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;
 
// Find out base dirtory
 
GeneralBaseDir := '';
 
if zb.ExtractionTarget = etExtractHere then
if zb.ConflictBehavior <> cbAvoid then
begin
GeneralBaseDir := ExtractFilePath(AZipfile); // Default
 
if not IsDirectoryWritable(GeneralBaseDir) or
IsAtFlobbyDisk(GeneralBaseDir) then
begin
zb.ExtractionTarget := etDesktop;
uz.OnExtractOverwrite := ConfirmOverwrite;
end;
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;
 
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
251,25 → 202,23
else if l.Count = 1 then
begin
// 1 Object = Extract it right here!
BaseDir := GeneralBaseDir;
s := BaseDir + l.Strings[0];
 
RenamingOldPrefix := l.Strings[0]; // = StripBaseDir(S);
 
s := ExtractFilePath(AZipfile) + l.Strings[0];
BaseDir := ExtractFilePath(AZipfile);
RenamingOldPrefix := StripBaseDir(S);
if zb.ConflictBehavior = cbAvoid then
begin
s := SearchNextFreeName(s, LooksLikeDir(s));
s := SearchNextFreeName(s);
end;
 
RenamingNewPrefix := StripBaseDir(s);
// TODO: helloworld.exe schlägt fehl!
RenamingNewPrefix := StripBaseDir(S); // We need to change the name!
end
else
begin
// 2+ Objects = Extract them in a separate folder
s := GeneralBaseDir + ExtractFileNameWithoutExt(AZipfile) + PathDelim;
s := ChangeFileExt(AZipfile, '');
if zb.ConflictBehavior = cbAvoid then
begin
s := SearchNextFreeName(s, true);
s := SearchNextFreeName(s);
MkDir(s);
end
else
280,7 → 229,7
end;
BaseDir := IncludeTrailingPathDelimiter(BaseDir);
 
uz.ExtrBaseDir := BaseDir;
uz.ExtrBaseDir := BaseDir; // TODO: andere ordner erlauben
 
// Pre-Extract-Dialog
 
309,7 → 258,6
 
if ErrorForm.ErrorsAvailable then
begin
Hide;
ErrorForm.ShowModal;
end;
 
337,9 → 285,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
349,27 → 296,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;
 
382,26 → 325,27
Application.ProcessMessages;
end;
 
procedure TMainForm.EvExtFNChange(Sender: TObject;
procedure TMainForm.ArcExtFNChange(Sender: TObject;
var FileName: TZMString; const BaseDir: TZMString;
var IsChanged: Boolean);
begin
if RenamingOldPrefix = RenamingNewPrefix then Exit;
if RenamingOldPrefix = RenamingOldPrefix then Exit;
 
FileName := RenamingNewPrefix + Copy(FileName, 1+Length(RenamingOldPrefix), Length(FileName)-Length(RenamingOldPrefix));
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?';
428,31 → 372,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;
474,7 → 414,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.
491,34 → 431,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;
 
526,6 → 451,9
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 := '';
572,10 → 500,6
{$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;
 
584,21 → 508,7
{$ENDIF}
 
try
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)
{$IFDEF DEBUG_MODE}
if FileExists(ParamStr(1)) then
begin
ExtractZipHere(ParamStr(1));
605,16 → 515,15
end
else
begin
MessageDlg(Lng_FileNotFound, mtError, [mbOk], 0);
{$ENDIF}
 
ExtractZipHere(ParamStr(0));
 
{$IFDEF DEBUG_MODE}
end;
end
else if ParamCount = 2 then
begin
// Future: Mehr als nur 1 Parameter erlauben?
MessageDlg(Lng_TooManyArguments, mtError, [mbOk], 0);
end;
end;
{$ENDIF}
finally
AbortUnzip := true; // Damit es zu keiner Abfrage kommt
Close;
end;
end;
626,7 → 535,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.';
636,7 → 545,7
MessageDlg(Format(Lng_PasswordWrong, [ForFile]), mtError, [mbOk], 0);
LastTriedPassword := '';
end;
ErrorForm.NewError(ForFile, SkipType);
ErrorForm.NewError(StripBaseDir(ForFile));
end;
 
end.