WebSVN – autosfx – Diff – /ExtractorMain.pas


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

Subversion Repositories autosfx

autosfx/ExtractorMain.pas – Rev 1 → 2