WebSVN – autosfx – Diff – /ExtractorMain.pas


unit ExtractorMain;
 
{$DEFINE USE_DZIP_UNPACK}
 
 
 
interface
 
uses
  Windows, SysUtils, Classes, Controls, Forms, Dialogs, StdCtrls, ShellAPI,
  ExtCtrls, ComCtrls, ZipMstr19, ZMMsgStr19, ZMMsg19, ZMDelZip19,
  ZMCompat19, SFXBehavior, ShlObj;
 
type
  TOverwriteDecision = (odUndefined, odOverwriteAll, odOverwriteNothing);
 
  TMainForm = class(TForm)
    ProgressBar: TProgressBar;
    WaitLabel: TLabel;
    CancelBtn: TButton;
    CurrentFileLabel: TLabel;
    AutoTimer: TTimer;
    itemBar: TProgressBar;
    procedure CancelBtnClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure AutoTimerTimer(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  private
    ExtractionInProcess: boolean;
    uz: TZipMaster19;
    RenamingOldPrefix: string;
    RenamingNewPrefix: string;
    zb: TZIPBehavior;
    BaseDir: string;
    AbortUnzip: boolean;
    StopAskingPassword: boolean;
    LastTriedPassword: string;
    CachedOverwriteDecision: 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;
      IsOlder: Boolean; var DoOverwrite: Boolean; DirIndex: Integer);
    procedure EvPasswordEvent(Sender: TObject; IsZipAction: Boolean;
      var NewPassword: String; const ForFile: TZMString; var RepeatCount: Longword;
      var Action: TMsgDlgBtn);
    procedure EvSkipEvent(Sender: TObject; const ForFile: TZMString;
      SkipType: TZMSkipTypes; var ExtError: Integer);
    function StripBaseDir(const s: string): string;
  end;
 
var
  MainForm: TMainForm;
 
implementation
 
uses
  ExtractorPassword, ExtractorError, Functions, SFXAutoRun, ExtractorComment,
  BrowseFolder;
 
const
  EvPasswordTries = 15;
 
{$R *.dfm}
 
{$R zmstr1900102\DLL\ResDLL-Maker\ZMRes19_dll.res}
 
function IsRootFile(s: string): boolean;
var
  i: integer;
begin
  if s = '' then
  begin
    result := false;
    Exit;
  end;
  if LooksLikeDir(s) then
  begin
    s := Copy(s, 1, Length(s)-1);
  end;
  for i := 1 to Length(s) do
  begin
    if s[i] = PathDelim then
    begin
      result := false;
      Exit;
    end;
  end;
  result := true;
end;
 
function FEListAll(theRec: TZMDirEntry; var Data): Integer;
var
  l: TStringList absolute Data;
  s: string;
begin
  Result := 0;
 
  s := theRec.FileName;
  l.Add(s);
 
  s := ExtractFilePath(s);
  if l.IndexOf(s) = -1 then l.Add(s);
end;
 
procedure ListRootFiles(uz: TZipMaster19; List: TStringList);
var
  s: string;
  l: TStringList;
  i: Integer;
resourcestring
  Lng_ForeachFailed = 'Dateiiteration fehlgeschlagen!';
begin
  List.Clear;
 
  l := TStringList.Create;
  try
    // Fill list (inclusive Directories)
 
    uz.FSpecArgs.Add('*');
    if uz.ForEach(FEListAll, l) <> 0 then
    begin
      MessageDlg(Lng_ForeachFailed, mtError, [mbOk], 0);
    end;
 
    // Now look for root files
 
    for i := 0 to l.Count - 1 do
    begin
      s := l.Strings[i];
 
      if IsRootFile(s) then
      begin
        List.Add(s);
      end;
    end;
  finally
    l.Free;
  end;
end;
 
procedure TMainForm.ExtractZipHere(AZipfile: string);
var
 
  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)';
  Lng_AutoRunFailed = 'SFX-AutoRun fehlgeschlagen. Die entpackten Inhalte werden nun angezeigt.';
  Lng_Unknown_Error = 'Unbekannter Fehler: Dateien sind nicht aufzufinden!';
  Lng_SelectDir = 'Bitte wählen Sie ein Verzeichnis zum Extrahieren aus. Es wird maximal 1 Datei bzw. Ordner erstellt!';
begin
  AZipfile := ExpandUNCFileName(AZipfile);
  RenamingOldPrefix := '';
  RenamingNewPrefix := '';
 
  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}
    uz.DLL_Load := true;
 
    uz.ZipFileName := AZipFile;
    uz.Active := true;
    zb := ReadBehavior(uz.ZipComment);
 
    uz.Unattended := true;
    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 := '';
    case zb.ExtractionTarget of
      etExtractHere:
        begin
          GeneralBaseDir := ExtractFilePath(AZipfile); // Default
        end;
      etDesktop:
        begin
          GeneralBaseDir := GetSpecialFolderPath(CSIDL_DESKTOP);
        end;
      etAsk:
        begin
          GeneralBaseDir := MySelectDirectory(Lng_SelectDir);
 
          if GeneralBaseDir = '' then Exit;
 
        end;
    end;
    GeneralBaseDir := IncludeTrailingPathDelimiter(GeneralBaseDir);
 
    // Semantic scanning of ZIP to determinate the final extraction directory
 
    l := TStringList.Create;
    try
      // Count the root objects (files OR dirs) in the ZIP
 
      ListRootFiles(uz, l);
 
      if l.Count = 0 then
      begin
        // Empty ZIP or Extractor.exe was called without ZIP attached
        Exit;
      end
      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);
 
        if zb.ConflictBehavior = cbAvoid then
        begin
          s := SearchNextFreeName(s, LooksLikeDir(s));
        end;
 
        RenamingNewPrefix := StripBaseDir(s);
      end
      else
      begin
        // 2+ Objects = Extract them in a separate folder
        s := GeneralBaseDir + ExtractFileNameWithoutExt(AZipfile) + PathDelim;
        if zb.ConflictBehavior = cbAvoid then
        begin
          s := SearchNextFreeName(s, true);
          MkDir(s);
        end
        else
        begin
          if not DirectoryExists(s) then MkDir(s);
        end;
        BaseDir := s;
      end;
      BaseDir := IncludeTrailingPathDelimiter(BaseDir);
 
      uz.ExtrBaseDir := BaseDir;
 
      // Pre-Extract-Dialog
 
      if zb.CommentPresentation = cpBeforeExtracting then
      begin
        if not CommentForm.ShowCommentModal(uz.ZipComment) then exit;
      end;
 
      // Extract
 
      ec := uz.Extract;
 
      if ec <> 0 then
      begin
        if ec = DS_Canceled then
        begin
          MessageDlg(Lng_Aborted, mtWarning, [mbOk], 0);
        end
        else
        begin
          MessageDlg(Format(Lng_Zip_Error, [uz.ErrMessage, ec]), mtError, [mbOk], 0);
        end;
      end;
 
      // Errors?
 
      if ErrorForm.ErrorsAvailable then
      begin
        ErrorForm.ShowModal;
      end;
 
      // Show After-Extracting comment?
 
      if zb.CommentPresentation = cpAfterExtracting then
      begin
        if not CommentForm.ShowCommentModal(uz.ZipComment) then exit;
      end;
 
      // Now search for an AutoRun.inf
 
      ar := ExecuteSFXAutoRun(BaseDir);
 
      if ar.AutoRunSectionAvailable and not ar.ExecutionSucceed then
      begin
        MessageDlg(Lng_AutoRunFailed, mtError, [mbOk], 0);
        ar.OpenUnzippedContent := true;
      end;
 
      // Now open the file for the user
 
      if not ar.AutoRunSectionAvailable or ar.OpenUnzippedContent then
      begin
        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);
        end
        else if FileExists(s) then
        begin
          // If it is a file, then only select it
 
          // Que: Funktioniert das auch ohne "/n"?
          // 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);
        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);
begin
  CurrentFileLabel.Caption := details.ItemName;
 
  progressBar.Position := details.TotalPosition;
  progressBar.Max := details.TotalSize;
 
  itemBar.Position := details.ItemPosition;
  itemBar.Max := details.ItemSize;
 
  Application.ProcessMessages;
end;
 
procedure TMainForm.EvExtFNChange(Sender: TObject;
  var FileName: TZMString; const BaseDir: TZMString;
  var IsChanged: Boolean);
begin
  if RenamingOldPrefix = RenamingNewPrefix then Exit;
  FileName := RenamingNewPrefix + Copy(FileName, 1+Length(RenamingOldPrefix), Length(FileName)-Length(RenamingOldPrefix));
  IsChanged := true;
end;
 
procedure TMainForm.EvTick(Sender: TObject);
begin
  Application.ProcessMessages;
end;
 
procedure TMainForm.EvCheckTerminate(Sender: TObject; var abort: Boolean);
begin
  abort := AbortUnzip;
end;
 
procedure TMainForm.EvConfirmOverwrite(Sender: TObject; const ForFile: TZMString;
  IsOlder: Boolean; var DoOverwrite: Boolean; DirIndex: Integer);
resourcestring
  Lng_Overwrite = 'Bestehende Datei "%s" überschreiben?';
var
  res: Integer;
begin
  if zb.ConflictBehavior = cbOverwrite then
  begin
    DoOverwrite := true;
    Exit;
  end
  else if zb.ConflictBehavior = cbNewer then
  begin
    DoOverwrite := IsOlder; // If file on DISK is older, then overwrite.
    Exit;
  end
  else if zb.ConflictBehavior = cbAsk then
  begin
    // Workaround: Verzeichnisse brauchen das nicht,
    // denn es wird bei den Dateien nochmal nachgefragt
    if LooksLikeDir(ForFile) then
    begin
      DoOverwrite := true;
      Exit;
    end;
 
    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 CachedOverwriteDecision := odOverwriteNothing;
      if res = mrYesToAll then CachedOverwriteDecision := odOverwriteAll;
    end
    else
    begin
      DoOverwrite := CachedOverwriteDecision = odOverwriteAll;
    end;
  end
  else if zb.ConflictBehavior = cbAvoid then
  begin
    // Nothing to do
  end;
end;
 
procedure TMainForm.EvPasswordEvent(Sender: TObject; IsZipAction: Boolean;
  var NewPassword: String; const ForFile: TZMString; var RepeatCount: Longword;
  var Action: TMsgDlgBtn);
var
  repc: integer;
begin
  repc := EvPasswordTries - RepeatCount + 1;
 
  // Eine Passworteingabe wurde abgebrochen. Frage nicht mehr nach.
  if StopAskingPassword then Exit;
 
  // Wurde schonmal ein Passwort eingegeben?
  if LastTriedPassword <> '' then
  begin
    // Schauen, ob das letzte Passwort auch mit dieser Datei geht.
    if repc = 1 then
    begin
      // Ja, geht
      NewPassword := LastTriedPassword;
      Exit;
    end
    else
    begin
      // Leider nein
      LastTriedPassword := '';
    end;
  end;
 
  if PasswordDlg.ShowModal(StripBaseDir(ForFile), repc, EvPasswordTries) = mrOk then
  begin
    NewPassword := PasswordDlg.Password.Text;
    if NewPassword = '' then NewPassword := ' '; // Neue Eingabe erzwingen.
    LastTriedPassword := NewPassword;
  end
  else
  begin
    StopAskingPassword := true;
    Action := mbCancel;
  end;
end;
 
procedure TMainForm.CancelBtnClick(Sender: TObject);
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;
  end;
end;
 
procedure TMainForm.FormCreate(Sender: TObject);
resourcestring
  Lng_Extracting = 'Extrahiere Dateien. Bitte warten...';
begin
  WaitLabel.Caption := Lng_Extracting;
  WaitLabel.Left := progressBar.Width div 2 - WaitLabel.Width div 2;
  CurrentFileLabel.Caption := '';
end;
 
{$IFNDEF USE_DZIP_UNPACK}
procedure TMainForm.ExtractDllFromResource(ADirectory: string);
var
  s: TResourceStream;
  o: TFileStream;
  AOutFile: string;
begin
  AOutFile := IncludeTrailingPathDelimiter(ADirectory) + DelZipDLL_Name;
  s := TResourceStream.Create(0, DZRES_Dll, RT_RCDATA);
  try
    try
      s.Seek(SizeOf(Integer), soFromBeginning); // Ref: ZMDllLoad19.pas:427
      if FileExists(AOutFile) then
        o := TFileStream.Create(AOutFile, fmOpenWrite or fmShareDenyNone)
      else
        o := TFileStream.Create(AOutFile, fmCreate or fmShareDenyNone);
      try
        o.CopyFrom(s, s.Size-s.Position);
      finally
        o.Free;
      end;
    except
      if FileExists(AOutFile) then
      begin
        // Probably the file is write-locked (maybe some other Extractor is
        // using it right now? Even if we run into danger that the target DLL
        // is a write-protected old/incompatible version of DelZip190.dll,
        // we do count this as success, since the file exists.
      end
      else
      begin
        raise;
      end;
    end;
  finally
    s.Free;
  end;
end;
{$ENDIF}
 
procedure TMainForm.AutoTimerTimer(Sender: TObject);
resourcestring
  Lng_NakedSFX = 'Das selbstentpackende Archiv (SFX) beschädigt oder ungültig. Wenn Sie diese Datei aus dem Internet bezogen haben, laden Sie sie bitte erneut herunter.';
  Lng_FileNotFound = 'Die durch Parameter angegebene Datei "%s" kann nicht gefunden werden!';
  Lng_TooManyArguments = 'Zu viele Argumente!';
begin
  AutoTimer.Enabled := false;
 
  {$IFNDEF USE_DZIP_UNPACK}
  ExtractDllFromResource(GetTempDirectory);
  {$ENDIF}
 
  try
    if IsExtractable(ParamStr(0)) then
    begin
      ExtractZipHere(ParamStr(0));
    end
    else
    begin
      // Der Extractor ist "nackt" oder das SFX beschädigt
 
      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));
        end
        else
        begin
          MessageDlg(Lng_FileNotFound, mtError, [mbOk], 0);
        end;
      end
      else if ParamCount = 2 then
      begin
        // Future: Mehr als nur 1 Parameter erlauben?
        MessageDlg(Lng_TooManyArguments, mtError, [mbOk], 0);
      end;
    end;
  finally
 
    Close;
  end;
end;
 
function TMainForm.StripBaseDir(const s: string): string;
begin
  // Warnung: Es wird nicht überprüft, ob der String auch
  // wirklich mit dem BaseDir beginnt!
  result := Copy(s, Length(BaseDir)+1, Length(s)-Length(BaseDir));
end;
 
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.';
begin
  if (SkipType = stBadPassword) and not StopAskingPassword then
  begin
    MessageDlg(Format(Lng_PasswordWrong, [ForFile]), mtError, [mbOk], 0);
    LastTriedPassword := '';
  end;
  ErrorForm.NewError(StripBaseDir(ForFile));
end;
 
end.
 

Rev 2	Rev 3
1	unit ExtractorMain;	1	unit ExtractorMain;
2		2
3	{$DEFINE USE_DZIP_UNPACK}	3	{$DEFINE USE_DZIP_UNPACK}
4		4
5	// todo: compilerswitch, der auch selectdirectory() anzeigt (ohne foldercreate)	-
6		-
7	interface	5	interface
8		6
9	uses	7	uses
10	Windows, SysUtils, Classes, Controls, Forms, Dialogs, StdCtrls, ShellAPI,	8	Windows, SysUtils, Classes, Controls, Forms, Dialogs, StdCtrls, ShellAPI,
11	ExtCtrls, ComCtrls, ZipMstr19, ZMMsgStr19, ZMMsg19, ZMDelZip19,	9	ExtCtrls, ComCtrls, ZipMstr19, ZMMsgStr19, ZMMsg19, ZMDelZip19,
12	ZMCompat19, SFXBehavior, ShlObj;	10	ZMCompat19, SFXBehavior, ShlObj;
13		11
14	type	12	type
15	TOverwriteDecision = (odUndefined, odOverwriteAll, odOverwriteNothing);	13	TOverwriteDecision = (odUndefined, odOverwriteAll, odOverwriteNothing);
16		14
17	TMainForm = class(TForm)	15	TMainForm = class(TForm)
18	ProgressBar: TProgressBar;	16	ProgressBar: TProgressBar;
19	WaitLabel: TLabel;	17	WaitLabel: TLabel;
20	CancelBtn: TButton;	18	CancelBtn: TButton;
21	CurrentFileLabel: TLabel;	19	CurrentFileLabel: TLabel;
22	AutoTimer: TTimer;	20	AutoTimer: TTimer;
23	itemBar: TProgressBar;	21	itemBar: TProgressBar;
24	procedure CancelBtnClick(Sender: TObject);	22	procedure CancelBtnClick(Sender: TObject);
25	procedure FormCreate(Sender: TObject);	23	procedure FormCreate(Sender: TObject);
26	procedure AutoTimerTimer(Sender: TObject);	24	procedure AutoTimerTimer(Sender: TObject);
27	procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);	25	procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
28	private	26	private
-		27	ExtractionInProcess: boolean;
-		28	uz: TZipMaster19;
29	RenamingOldPrefix: string;	29	RenamingOldPrefix: string;
30	RenamingNewPrefix: string;	30	RenamingNewPrefix: string;
31	zb: TZIPBehavior;	31	zb: TZIPBehavior;
32	BaseDir: string;	32	BaseDir: string;
33	AbortUnzip: boolean;	33	AbortUnzip: boolean;
34	StopAskingPassword: boolean;	34	StopAskingPassword: boolean;
35	LastTriedPassword: string;	35	LastTriedPassword: string;
36	OverwriteDecision: TOverwriteDecision;	36	CachedOverwriteDecision: TOverwriteDecision;
37	{$IFNDEF USE_DZIP_UNPACK}	37	{$IFNDEF USE_DZIP_UNPACK}
38	procedure ExtractDllFromResource(ADirectory: string);	38	procedure ExtractDllFromResource(ADirectory: string);
39	{$ENDIF}	39	{$ENDIF}
40	procedure ExtractZipHere(AZipfile: string);	40	procedure ExtractZipHere(AZipfile: string);
41	procedure ArcExtFNChange(Sender: TObject; var FileName: TZMString; const BaseDir: TZMString; var IsChanged: Boolean);	41	procedure EvExtFNChange(Sender: TObject; var FileName: TZMString; const BaseDir: TZMString; var IsChanged: Boolean);
42	procedure ArcProzess(Sender: TObject; details: TZMProgressDetails);	42	procedure EvProgress(Sender: TObject; details: TZMProgressDetails);
43	procedure ArcTick(Sender: TObject);	43	procedure EvTick(Sender: TObject);
44	procedure ArcCheckTerminate(Sender: TObject; var abort: Boolean);	44	procedure EvCheckTerminate(Sender: TObject; var abort: Boolean);
45	procedure ConfirmOverwrite(Sender: TObject; const ForFile: TZMString;	45	procedure EvConfirmOverwrite(Sender: TObject; const ForFile: TZMString;
46	IsOlder: Boolean; var DoOverwrite: Boolean; DirIndex: Integer);	46	IsOlder: Boolean; var DoOverwrite: Boolean; DirIndex: Integer);
47	procedure ArcPassword(Sender: TObject; IsZipAction: Boolean;	47	procedure EvPasswordEvent(Sender: TObject; IsZipAction: Boolean;
48	var NewPassword: String; const ForFile: TZMString; var RepeatCount: Longword;	48	var NewPassword: String; const ForFile: TZMString; var RepeatCount: Longword;
49	var Action: TMsgDlgBtn);	49	var Action: TMsgDlgBtn);
50	procedure SkipEvent(Sender: TObject; const ForFile: TZMString;	50	procedure EvSkipEvent(Sender: TObject; const ForFile: TZMString;
51	SkipType: TZMSkipTypes; var ExtError: Integer);	51	SkipType: TZMSkipTypes; var ExtError: Integer);
52	function StripBaseDir(const s: string): string;	52	function StripBaseDir(const s: string): string;
53	end;	53	end;
54		54
55	var	55	var
56	MainForm: TMainForm;	56	MainForm: TMainForm;
57		57
58	implementation	58	implementation
59		59
60	uses	60	uses
61	ExtractorPassword, ExtractorError, Functions, SFXAutoRun, ExtractorComment;	61	ExtractorPassword, ExtractorError, Functions, SFXAutoRun, ExtractorComment,
-		62	BrowseFolder;
62		63
63	const	64	const
64	MaxTries = 15;	65	EvPasswordTries = 15;
65		66
66	{$R *.dfm}	67	{$R *.dfm}
67		68
68	{$R zmstr1900102\DLL\ResDLL-Maker\ZMRes19_dll.res}	69	{$R zmstr1900102\DLL\ResDLL-Maker\ZMRes19_dll.res}
69		70
70	function IsRootFile(s: string): boolean;	71	function IsRootFile(s: string): boolean;
71	var	72	var
72	i: integer;	73	i: integer;
73	begin	74	begin
74	if s = '' then	75	if s = '' then
75	begin	76	begin
76	result := false;	77	result := false;
77	Exit;	78	Exit;
78	end;	79	end;
79	if LooksLikeDir(s) then	80	if LooksLikeDir(s) then
80	begin	81	begin
81	s := Copy(s, 1, Length(s)-1);	82	s := Copy(s, 1, Length(s)-1);
82	end;	83	end;
83	for i := 1 to Length(s) do	84	for i := 1 to Length(s) do
84	begin	85	begin
85	if s[i] = PathDelim then	86	if s[i] = PathDelim then
86	begin	87	begin
87	result := false;	88	result := false;
88	Exit;	89	Exit;
89	end;	90	end;
90	end;	91	end;
91	result := true;	92	result := true;
92	end;	93	end;
93		94
94	function FEListAll(theRec: TZMDirEntry; var Data): Integer;	95	function FEListAll(theRec: TZMDirEntry; var Data): Integer;
95	var	96	var
96	l: TStringList absolute Data;	97	l: TStringList absolute Data;
97	s: string;	98	s: string;
98	begin	99	begin
99	Result := 0;	100	Result := 0;
100		101
101	s := theRec.FileName;	102	s := theRec.FileName;
102	l.Add(s);	103	l.Add(s);
103		104
104	s := ExtractFilePath(s);	105	s := ExtractFilePath(s);
105	if l.IndexOf(s) = -1 then l.Add(s);	106	if l.IndexOf(s) = -1 then l.Add(s);
106	end;	107	end;
107		108
108	procedure ListRootFiles(uz: TZipMaster19; List: TStringList);	109	procedure ListRootFiles(uz: TZipMaster19; List: TStringList);
109	var	110	var
110	s: string;	111	s: string;
111	l: TStringList;	112	l: TStringList;
112	i: Integer;	113	i: Integer;
113	resourcestring	114	resourcestring
114	Lng_ForeachFailed = 'Dateiiteration fehlgeschlagen!';	115	Lng_ForeachFailed = 'Dateiiteration fehlgeschlagen!';
115	begin	116	begin
116	List.Clear;	117	List.Clear;
117		118
118	l := TStringList.Create;	119	l := TStringList.Create;
119	try	120	try
120	// Fill list (inclusive Directories)	121	// Fill list (inclusive Directories)
121		122
122	uz.FSpecArgs.Add('*');	123	uz.FSpecArgs.Add('*');
123	if uz.ForEach(FEListAll, l) <> 0 then	124	if uz.ForEach(FEListAll, l) <> 0 then
124	begin	125	begin
125	MessageDlg(Lng_ForeachFailed, mtError, [mbOk], 0);	126	MessageDlg(Lng_ForeachFailed, mtError, [mbOk], 0);
126	end;	127	end;
127		128
128	// Now look for root files	129	// Now look for root files
129		130
130	for i := 0 to l.Count - 1 do	131	for i := 0 to l.Count - 1 do
131	begin	132	begin
132	s := l.Strings[i];	133	s := l.Strings[i];
133		134
134	if IsRootFile(s) then	135	if IsRootFile(s) then
135	begin	136	begin
136	List.Add(s);	137	List.Add(s);
137	end;	138	end;
138	end;	139	end;
139	finally	140	finally
140	l.Free;	141	l.Free;
141	end;	142	end;
142	end;	143	end;
143		144
144	procedure TMainForm.ExtractZipHere(AZipfile: string);	145	procedure TMainForm.ExtractZipHere(AZipfile: string);
145	var	146	var
146	uz: TZipMaster19;	-
147	l: TStringList;	147	l: TStringList;
148	s: string;	148	s: string;
149	ec: Integer;	149	ec: Integer;
150	ar: TExecuteSFXAutoRunResult;	150	ar: TExecuteSFXAutoRunResult;
151	GeneralBaseDir: string;	151	GeneralBaseDir: string;
-		152	const
-		153	C_Explorer_Open_Param = '"%s"';
-		154	C_Explorer_Select_Param = '/n,/select,"%s"';
-		155	EXPLORER_EXE = 'explorer';
152	resourcestring	156	resourcestring
153	Lng_Aborted = 'Der laufende Prozess wurde abgebrochen. Das extrahierten Dateien sind somit unvollständig.';	157	Lng_Aborted = 'Der laufende Prozess wurde abgebrochen. Das extrahierten Dateien sind somit unvollständig.';
154	Lng_Zip_Error = 'ZIP-Master Fehler "%s" (%d)';	158	Lng_Zip_Error = 'ZIP-Master Fehler "%s" (%d)';
155	Lng_AutoRunFailed = 'SFX-AutoRun fehlgeschlagen. Die entpackten Inhalte werden nun angezeigt.';	159	Lng_AutoRunFailed = 'SFX-AutoRun fehlgeschlagen. Die entpackten Inhalte werden nun angezeigt.';
156	Lng_Unknown_Error = 'Unbekannter Fehler: Dateien sind nicht aufzufinden!';	160	Lng_Unknown_Error = 'Unbekannter Fehler: Dateien sind nicht aufzufinden!';
157	Lng_SelectDir = 'Bitte wählen Sie ein Verzeichnis zum Extrahieren aus. Es wird maximal 1 Datei bzw. Ordner erstellt!';	161	Lng_SelectDir = 'Bitte wählen Sie ein Verzeichnis zum Extrahieren aus. Es wird maximal 1 Datei bzw. Ordner erstellt!';
158	begin	162	begin
159	AZipfile := ExpandUNCFileName(AZipfile);	163	AZipfile := ExpandUNCFileName(AZipfile);
160	RenamingOldPrefix := '';	164	RenamingOldPrefix := '';
161	RenamingNewPrefix := '';	165	RenamingNewPrefix := '';
162		166
-		167	if Assigned(uz) then uz.Free; // uz ist global, damit AbortDLL aufgerufen werden kann
-		168
163	uz := TZipMaster19.Create(nil);	169	uz := TZipMaster19.Create(nil);
164	try	170	try
-		171	ExtractionInProcess := true;
165	{$IFNDEF USE_DZIP_UNPACK}	172	{$IFNDEF USE_DZIP_UNPACK}
166	uz.DLLDirectory := GetTempDirectory + DelZipDLL_Name;	173	uz.DLLDirectory := GetTempDirectory + DelZipDLL_Name;
167	{$ENDIF}	174	{$ENDIF}
168	uz.DLL_Load := true;	175	uz.DLL_Load := true;
169		176
170	uz.ZipFileName := AZipFile;	177	uz.ZipFileName := AZipFile;
171	uz.Active := true;	178	uz.Active := true;
172	zb := ReadBehavior(uz.ZipComment);	179	zb := ReadBehavior(uz.ZipComment);
173		180
174	uz.Unattended := true;	181	uz.Unattended := true;
175	uz.ExtrOptions := [ExtrDirNames, ExtrOverWrite, ExtrFreshen, ExtrUpdate,	182	uz.ExtrOptions := [ExtrDirNames, ExtrOverWrite, ExtrFreshen, ExtrUpdate,
176	ExtrForceDirs, ExtrNTFS];	183	ExtrForceDirs, ExtrNTFS];
177		184
178	if zb.ConflictBehavior <> cbAvoid then	-
179	begin	-
180	uz.OnExtractOverwrite := ConfirmOverwrite;	185	uz.OnExtractOverwrite := EvConfirmOverwrite;
181	end;	-
182	uz.OnProgress := ArcProzess;	186	uz.OnProgress := EvProgress;
183	uz.OnTick := ArcTick;	187	uz.OnTick := EvTick;
184	uz.OnCheckTerminate := ArcCheckTerminate;	188	uz.OnCheckTerminate := EvCheckTerminate;
185	uz.OnPasswordError := ArcPassword;	189	uz.OnPasswordError := EvPasswordEvent;
186	uz.PasswordReqCount := MaxTries;	190	uz.PasswordReqCount := EvPasswordTries;
187	uz.OnSkipped := SkipEvent;	191	uz.OnSkipped := EvSkipEvent;
188	uz.OnSetExtName := ArcExtFNChange;	192	uz.OnSetExtName := EvExtFNChange;
189	// TODO: Mehr events?	-
190		193
191	// Find out base dirtory	194	// Find out base dirtory
192		195
193	GeneralBaseDir := '';	196	GeneralBaseDir := '';
194	case zb.ExtractionTarget of	197	case zb.ExtractionTarget of
195	etExtractHere:	198	etExtractHere:
196	begin	199	begin
197	GeneralBaseDir := ExtractFilePath(AZipfile); // Default	200	GeneralBaseDir := ExtractFilePath(AZipfile); // Default
198	end;	201	end;
199	etDesktop:	202	etDesktop:
200	begin	203	begin
201	GeneralBaseDir := GetSpecialFolderPath(CSIDL_DESKTOP);	204	GeneralBaseDir := GetSpecialFolderPath(CSIDL_DESKTOP);
202	end;	205	end;
203	etAsk:	206	etAsk:
204	begin	207	begin
205	if not AdvSelectDirectory(Lng_SelectDir, '', GeneralBaseDir, False, False, True) then	208	GeneralBaseDir := MySelectDirectory(Lng_SelectDir);
206	begin	-
207	Exit;	209	if GeneralBaseDir = '' then Exit;
208	end;	-
209	end;	210	end;
210	end;	211	end;
211	GeneralBaseDir := IncludeTrailingPathDelimiter(GeneralBaseDir);	212	GeneralBaseDir := IncludeTrailingPathDelimiter(GeneralBaseDir);
212		213
213	// Semantic scanning of ZIP to determinate the final extraction directory	214	// Semantic scanning of ZIP to determinate the final extraction directory
214		215
215	l := TStringList.Create;	216	l := TStringList.Create;
216	try	217	try
217	// Count the root objects (files OR dirs) in the ZIP	218	// Count the root objects (files OR dirs) in the ZIP
218		219
219	ListRootFiles(uz, l);	220	ListRootFiles(uz, l);
220		221
221	if l.Count = 0 then	222	if l.Count = 0 then
222	begin	223	begin
223	// Empty ZIP or Extractor.exe was called without ZIP attached	224	// Empty ZIP or Extractor.exe was called without ZIP attached
224	Exit;	225	Exit;
225	end	226	end
226	else if l.Count = 1 then	227	else if l.Count = 1 then
227	begin	228	begin
228	// 1 Object = Extract it right here!	229	// 1 Object = Extract it right here!
229	BaseDir := GeneralBaseDir;	230	BaseDir := GeneralBaseDir;
230	s := BaseDir + l.Strings[0];	231	s := BaseDir + l.Strings[0];
231		232
232	RenamingOldPrefix := l.Strings[0]; // = StripBaseDir(S);	233	RenamingOldPrefix := l.Strings[0]; // = StripBaseDir(S);
233		234
234	if zb.ConflictBehavior = cbAvoid then	235	if zb.ConflictBehavior = cbAvoid then
235	begin	236	begin
236	s := SearchNextFreeName(s, LooksLikeDir(s));	237	s := SearchNextFreeName(s, LooksLikeDir(s));
237	end;	238	end;
238		239
239	RenamingNewPrefix := StripBaseDir(s);	240	RenamingNewPrefix := StripBaseDir(s);
240	end	241	end
241	else	242	else
242	begin	243	begin
243	// 2+ Objects = Extract them in a separate folder	244	// 2+ Objects = Extract them in a separate folder
244	s := GeneralBaseDir + ExtractFileNameWithoutExt(AZipfile) + PathDelim;	245	s := GeneralBaseDir + ExtractFileNameWithoutExt(AZipfile) + PathDelim;
245	if zb.ConflictBehavior = cbAvoid then	246	if zb.ConflictBehavior = cbAvoid then
246	begin	247	begin
247	s := SearchNextFreeName(s, true);	248	s := SearchNextFreeName(s, true);
248	MkDir(s);	249	MkDir(s);
249	end	250	end
250	else	251	else
251	begin	252	begin
252	if not DirectoryExists(s) then MkDir(s);	253	if not DirectoryExists(s) then MkDir(s);
253	end;	254	end;
254	BaseDir := s;	255	BaseDir := s;
255	end;	256	end;
256	BaseDir := IncludeTrailingPathDelimiter(BaseDir);	257	BaseDir := IncludeTrailingPathDelimiter(BaseDir);
257		258
258	uz.ExtrBaseDir := BaseDir;	259	uz.ExtrBaseDir := BaseDir;
259		260
260	// Pre-Extract-Dialog	261	// Pre-Extract-Dialog
261		262
262	if zb.CommentPresentation = cpBeforeExtracting then	263	if zb.CommentPresentation = cpBeforeExtracting then
263	begin	264	begin
264	if not CommentForm.ShowCommentModal(uz.ZipComment) then exit;	265	if not CommentForm.ShowCommentModal(uz.ZipComment) then exit;
265	end;	266	end;
266		267
267	// Extract	268	// Extract
268		269
269	ec := uz.Extract;	270	ec := uz.Extract;
270		271
271	if ec <> 0 then	272	if ec <> 0 then
272	begin	273	begin
273	if ec = DS_Canceled then	274	if ec = DS_Canceled then
274	begin	275	begin
275	MessageDlg(Lng_Aborted, mtWarning, [mbOk], 0);	276	MessageDlg(Lng_Aborted, mtWarning, [mbOk], 0);
276	end	277	end
277	else	278	else
278	begin	279	begin
279	MessageDlg(Format(Lng_Zip_Error, [uz.ErrMessage, ec]), mtError, [mbOk], 0);	280	MessageDlg(Format(Lng_Zip_Error, [uz.ErrMessage, ec]), mtError, [mbOk], 0);
280	end;	281	end;
281	end;	282	end;
282		283
283	// Errors?	284	// Errors?
284		285
285	if ErrorForm.ErrorsAvailable then	286	if ErrorForm.ErrorsAvailable then
286	begin	287	begin
287	ErrorForm.ShowModal;	288	ErrorForm.ShowModal;
288	end;	289	end;
289		290
290	// Show After-Extracting comment?	291	// Show After-Extracting comment?
291		292
292	if zb.CommentPresentation = cpAfterExtracting then	293	if zb.CommentPresentation = cpAfterExtracting then
293	begin	294	begin
294	if not CommentForm.ShowCommentModal(uz.ZipComment) then exit;	295	if not CommentForm.ShowCommentModal(uz.ZipComment) then exit;
295	end;	296	end;
296		297
297	// Now search for an AutoRun.inf	298	// Now search for an AutoRun.inf
298		299
299	ar := ExecuteSFXAutoRun(BaseDir);	300	ar := ExecuteSFXAutoRun(BaseDir);
300		301
301	if ar.AutoRunSectionAvailable and not ar.ExecutionSucceed then	302	if ar.AutoRunSectionAvailable and not ar.ExecutionSucceed then
302	begin	303	begin
303	MessageDlg(Lng_AutoRunFailed, mtError, [mbOk], 0);	304	MessageDlg(Lng_AutoRunFailed, mtError, [mbOk], 0);
304	ar.OpenUnzippedContent := true;	305	ar.OpenUnzippedContent := true;
305	end;	306	end;
306		307
307	// Now open the file for the user	308	// Now open the file for the user
308		309
309	if not ar.AutoRunSectionAvailable or ar.OpenUnzippedContent then	310	if not ar.AutoRunSectionAvailable or ar.OpenUnzippedContent then
310	begin	311	begin
311	if DirectoryExists(s) then	312	if DirectoryExists(s) then
312	begin	313	begin
313	// If it is a folder, open it	314	// If it is a folder, open it
-		315
314	ShellExecute(0, 'open', 'explorer',	316	ShellExecute(0, 'open', EXPLORER_EXE,
315	PChar('"'+s+'"'), '', SW_NORMAL);	317	PChar(Format(C_Explorer_Open_Param, [s])), '', SW_NORMAL);
316	end	318	end
317	else if FileExists(s) then	319	else if FileExists(s) then
318	begin	320	begin
319	// If it is a file, then only select it	321	// If it is a file, then only select it
320		322
321	// Que: Funktioniert das auch ohne "/n"?	323	// Que: Funktioniert das auch ohne "/n"?
322	// Im Moment wird bei einem BESTEHENDEN Fenster	324	// Im Moment wird bei einem BESTEHENDEN Fenster
323	// die Selektion nicht durchgeführt.	325	// die Selektion nicht durchgeführt.
324		326
325	ShellExecute(0, 'open', 'explorer',	327	ShellExecute(0, 'open', EXPLORER_EXE,
326	PChar('/n,/select,"'+s+'"'), '', SW_NORMAL);	328	PChar(Format(C_Explorer_Select_Param, [s])), '', SW_NORMAL);
327	end	329	end
328	else	330	else
329	begin	331	begin
-		332	if not AbortUnzip then
-		333	begin
330	MessageDlg(Lng_Unknown_Error, mtError, [mbOk], 0);	334	MessageDlg(Lng_Unknown_Error, mtError, [mbOk], 0);
331	end;	335	end;
332	end;	336	end;
-		337	end;
333	finally	338	finally
334	l.Free;	339	l.Free;
335	end;	340	end;
336	finally	341	finally
337	uz.Free;	342	uz.Free;
-		343	ExtractionInProcess := false;
338	end;	344	end;
339	end;	345	end;
340		346
341	procedure TMainForm.ArcProzess(Sender: TObject; details: TZMProgressDetails);	347	procedure TMainForm.EvProgress(Sender: TObject; details: TZMProgressDetails);
342	begin	348	begin
343	CurrentFileLabel.Caption := details.ItemName;	349	CurrentFileLabel.Caption := details.ItemName;
344		350
345	progressBar.Position := details.TotalPosition;	351	progressBar.Position := details.TotalPosition;
346	progressBar.Max := details.TotalSize;	352	progressBar.Max := details.TotalSize;
347		353
348	itemBar.Position := details.ItemPosition;	354	itemBar.Position := details.ItemPosition;
349	itemBar.Max := details.ItemSize;	355	itemBar.Max := details.ItemSize;
350		356
351	Application.ProcessMessages;	357	Application.ProcessMessages;
352	end;	358	end;
353		359
354	procedure TMainForm.ArcExtFNChange(Sender: TObject;	360	procedure TMainForm.EvExtFNChange(Sender: TObject;
355	var FileName: TZMString; const BaseDir: TZMString;	361	var FileName: TZMString; const BaseDir: TZMString;
356	var IsChanged: Boolean);	362	var IsChanged: Boolean);
357	begin	363	begin
358	if RenamingOldPrefix = RenamingNewPrefix then Exit;	364	if RenamingOldPrefix = RenamingNewPrefix then Exit;
359	FileName := RenamingNewPrefix + Copy(FileName, 1+Length(RenamingOldPrefix), Length(FileName)-Length(RenamingOldPrefix));	365	FileName := RenamingNewPrefix + Copy(FileName, 1+Length(RenamingOldPrefix), Length(FileName)-Length(RenamingOldPrefix));
360	IsChanged := true;	366	IsChanged := true;
361	end;	367	end;
362		368
363	procedure TMainForm.ArcTick(Sender: TObject);	369	procedure TMainForm.EvTick(Sender: TObject);
364	begin	370	begin
365	Application.ProcessMessages;	371	Application.ProcessMessages;
366	end;	372	end;
367		373
368	procedure TMainForm.ArcCheckTerminate(Sender: TObject; var abort: Boolean);	374	procedure TMainForm.EvCheckTerminate(Sender: TObject; var abort: Boolean);
369	begin	375	begin
370	abort := AbortUnzip;	376	abort := AbortUnzip;
371	end;	377	end;
372		378
373	procedure TMainForm.ConfirmOverwrite(Sender: TObject; const ForFile: TZMString;	379	procedure TMainForm.EvConfirmOverwrite(Sender: TObject; const ForFile: TZMString;
374	IsOlder: Boolean; var DoOverwrite: Boolean; DirIndex: Integer);	380	IsOlder: Boolean; var DoOverwrite: Boolean; DirIndex: Integer);
375	resourcestring	381	resourcestring
376	Lng_Overwrite = 'Bestehende Datei "%s" überschreiben?';	382	Lng_Overwrite = 'Bestehende Datei "%s" überschreiben?';
377	var	383	var
378	res: Integer;	384	res: Integer;
379	begin	385	begin
380	if zb.ConflictBehavior = cbOverwrite then	386	if zb.ConflictBehavior = cbOverwrite then
381	begin	387	begin
382	DoOverwrite := true;	388	DoOverwrite := true;
383	Exit;	389	Exit;
384	end	390	end
385	else if zb.ConflictBehavior = cbNewer then	391	else if zb.ConflictBehavior = cbNewer then
386	begin	392	begin
387	DoOverwrite := IsOlder; // If file on DISK is older, then overwrite.	393	DoOverwrite := IsOlder; // If file on DISK is older, then overwrite.
388	Exit;	394	Exit;
389	end	395	end
390	else if zb.ConflictBehavior = cbAsk then	396	else if zb.ConflictBehavior = cbAsk then
391	begin	397	begin
392	// Workaround: Verzeichnisse brauchen das nicht,	398	// Workaround: Verzeichnisse brauchen das nicht,
393	// denn es wird bei den Dateien nochmal nachgefragt	399	// denn es wird bei den Dateien nochmal nachgefragt
394	if LooksLikeDir(ForFile) then	400	if LooksLikeDir(ForFile) then
395	begin	401	begin
396	DoOverwrite := true;	402	DoOverwrite := true;
397	Exit;	403	Exit;
398	end;	404	end;
399		405
400	if OverwriteDecision = odUndefined then	406	if CachedOverwriteDecision = odUndefined then
401	begin	407	begin
402	res := MessageDlg(Format(Lng_Overwrite, [ForFile]), mtConfirmation, [mbYes, mbNo, mbYesToAll, mbNoToAll], 0);	408	res := MessageDlg(Format(Lng_Overwrite, [ForFile]), mtConfirmation, [mbYes, mbNo, mbYesToAll, mbNoToAll], 0);
403	DoOverwrite := (res = mrYes) or (res = mrYesToAll);	409	DoOverwrite := (res = mrYes) or (res = mrYesToAll);
404	if res = mrNoToAll then OverwriteDecision := odOverwriteNothing;	410	if res = mrNoToAll then CachedOverwriteDecision := odOverwriteNothing;
405	if res = mrYesToAll then OverwriteDecision := odOverwriteAll;	411	if res = mrYesToAll then CachedOverwriteDecision := odOverwriteAll;
406	end	412	end
407	else	413	else
408	begin	414	begin
409	DoOverwrite := OverwriteDecision = odOverwriteAll;	415	DoOverwrite := CachedOverwriteDecision = odOverwriteAll;
410	end;	416	end;
-		417	end
-		418	else if zb.ConflictBehavior = cbAvoid then
-		419	begin
-		420	// Nothing to do
411	end;	421	end;
412	end;	422	end;
413		423
414	procedure TMainForm.ArcPassword(Sender: TObject; IsZipAction: Boolean;	424	procedure TMainForm.EvPasswordEvent(Sender: TObject; IsZipAction: Boolean;
415	var NewPassword: String; const ForFile: TZMString; var RepeatCount: Longword;	425	var NewPassword: String; const ForFile: TZMString; var RepeatCount: Longword;
416	var Action: TMsgDlgBtn);	426	var Action: TMsgDlgBtn);
417	var	427	var
418	repc: integer;	428	repc: integer;
419	begin	429	begin
420	repc := MaxTries - RepeatCount + 1;	430	repc := EvPasswordTries - RepeatCount + 1;
421		431
422	// Eine Passworteingabe wurde abgebrochen. Frage nicht mehr nach.	432	// Eine Passworteingabe wurde abgebrochen. Frage nicht mehr nach.
423	if StopAskingPassword then Exit;	433	if StopAskingPassword then Exit;
424		434
425	// Wurde schonmal ein Passwort eingegeben?	435	// Wurde schonmal ein Passwort eingegeben?
426	if LastTriedPassword <> '' then	436	if LastTriedPassword <> '' then
427	begin	437	begin
428	// Schauen, ob das letzte Passwort auch mit dieser Datei geht.	438	// Schauen, ob das letzte Passwort auch mit dieser Datei geht.
429	if repc = 1 then	439	if repc = 1 then
430	begin	440	begin
431	// Ja, geht	441	// Ja, geht
432	NewPassword := LastTriedPassword;	442	NewPassword := LastTriedPassword;
433	Exit;	443	Exit;
434	end	444	end
435	else	445	else
436	begin	446	begin
437	// Leider nein	447	// Leider nein
438	LastTriedPassword := '';	448	LastTriedPassword := '';
439	end;	449	end;
440	end;	450	end;
441		451
442	if PasswordDlg.ShowModal(StripBaseDir(ForFile), repc, MaxTries) = mrOk then	452	if PasswordDlg.ShowModal(StripBaseDir(ForFile), repc, EvPasswordTries) = mrOk then
443	begin	453	begin
444	NewPassword := PasswordDlg.Password.Text;	454	NewPassword := PasswordDlg.Password.Text;
445	if NewPassword = '' then NewPassword := ' '; // Neue Eingabe erzwingen.	455	if NewPassword = '' then NewPassword := ' '; // Neue Eingabe erzwingen.
446	LastTriedPassword := NewPassword;	456	LastTriedPassword := NewPassword;
447	end	457	end
448	else	458	else
449	begin	459	begin
450	StopAskingPassword := true;	460	StopAskingPassword := true;
451	Action := mbCancel;	461	Action := mbCancel;
452	end;	462	end;
453	end;	463	end;
454		464
455	procedure TMainForm.CancelBtnClick(Sender: TObject);	465	procedure TMainForm.CancelBtnClick(Sender: TObject);
456	resourcestring	466	resourcestring
457	Lng_AbortExtract = 'Extrahieren abbrechen?';	467	Lng_AbortExtract = 'Extrahieren abbrechen?';
458	begin	468	begin
-		469	if not ExtractionInProcess then
-		470	begin
-		471	Close;
-		472	Exit;
-		473	end;
-		474
459	if MessageDlg(Lng_AbortExtract, mtConfirmation, mbYesNoCancel, 0) = mrYes then	475	if MessageDlg(Lng_AbortExtract, mtConfirmation, mbYesNoCancel, 0) = mrYes then
460	begin	476	begin
461	CancelBtn.Enabled := false;	477	CancelBtn.Enabled := false;
-		478	uz.AbortDLL;
462	AbortUnzip := true;	479	AbortUnzip := true;
-		480	// Close wird durch den Timer durchgeführt
-		481	Exit;
463	end;	482	end;
464	end;	483	end;
465		484
466	procedure TMainForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);	485	procedure TMainForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
467	begin	486	begin
-		487	if not ExtractionInProcess then
-		488	begin
-		489	CanClose := true;
-		490	Exit;
-		491	end;

Subversion Repositories autosfx

autosfx/ExtractorMain.pas – Rev 2 → 3