Subversion Repositories autosfx

Rev

Rev 3 | Only display areas with differences | Regard whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 3 Rev 5
1 
unit ExtractorMain;
 1 
unit ExtractorMain;
2 
 
 2 
 
3 
{$DEFINE USE_DZIP_UNPACK}
 3 
{$DEFINE USE_DZIP_UNPACK} // recommended
4 
 
 4 
 
5 
interface
 5 
interface
6 
 
 6 
 
7 
uses
 7 
uses
8 
  Windows, SysUtils, Classes, Controls, Forms, Dialogs, StdCtrls, ShellAPI,
 8 
  Windows, SysUtils, Classes, Controls, Forms, Dialogs, StdCtrls, ShellAPI,
9 
  ExtCtrls, ComCtrls, ZipMstr19, ZMMsgStr19, ZMMsg19, ZMDelZip19,
 9 
  ExtCtrls, ComCtrls, ZipMstr19, ZMMsgStr19, ZMMsg19, ZMDelZip19,
10 
  ZMCompat19, SFXBehavior, ShlObj;
 10 
  ZMCompat19, SFXBehavior, ShlObj;
11 
 
 11 
 
12 
type
 12 
type
13 
  TOverwriteDecision = (odUndefined, odOverwriteAll, odOverwriteNothing);
 13 
  TOverwriteDecision = (odUndefined, odOverwriteAll, odOverwriteNothing);
14 
 
 14 
 
15 
  TMainForm = class(TForm)
 15 
  TMainForm = class(TForm)
16 
    ProgressBar: TProgressBar;
 16 
    ProgressBar: TProgressBar;
17 
    WaitLabel: TLabel;
 17 
    WaitLabel: TLabel;
18 
    CancelBtn: TButton;
 18 
    CancelBtn: TButton;
19 
    CurrentFileLabel: TLabel;
 19 
    CurrentFileLabel: TLabel;
20 
    AutoTimer: TTimer;
 20 
    AutoTimer: TTimer;
21 
    itemBar: TProgressBar;
 21 
    itemBar: TProgressBar;
22 
    procedure CancelBtnClick(Sender: TObject);
 22 
    procedure CancelBtnClick(Sender: TObject);
23 
    procedure FormCreate(Sender: TObject);
 23 
    procedure FormCreate(Sender: TObject);
24 
    procedure AutoTimerTimer(Sender: TObject);
 24 
    procedure AutoTimerTimer(Sender: TObject);
25 
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
 25 
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
26 
  private
 26 
  private
27 
    ExtractionInProcess: boolean;
 27 
    ExtractionInProcess: boolean;
28 
    uz: TZipMaster19;
 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 
    CachedOverwriteDecision: 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 EvExtFNChange(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 EvProgress(Sender: TObject; details: TZMProgressDetails);
 42 
    procedure EvProgress(Sender: TObject; details: TZMProgressDetails);
43 
    procedure EvTick(Sender: TObject);
 43 
    procedure EvTick(Sender: TObject);
44 
    procedure EvCheckTerminate(Sender: TObject; var abort: Boolean);
 44 
    procedure EvCheckTerminate(Sender: TObject; var abort: Boolean);
45 
    procedure EvConfirmOverwrite(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 EvPasswordEvent(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 EvSkipEvent(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 
  BrowseFolder;
63 
 
 63 
 
64 
const
 64 
const
65 
  EvPasswordTries = 15;
 65 
  EvPasswordTries = 15;
66 
 
 66 
 
67 
{$R *.dfm}
 67 
{$R *.dfm}
68 
 
 68 
 
69 
{$R zmstr1900102\DLL\ResDLL-Maker\ZMRes19_dll.res}
 69 
{$R zmstr1900102\DLL\ResDLL-Maker\ZMRes19_dll.res}
70 
 
 70 
 
71 
function IsRootFile(s: string): boolean;
 71 
function IsRootFile(s: string): boolean;
72 
var
 72 
var
73 
  i: integer;
 73 
  i: integer;
74 
begin
 74 
begin
75 
  if s = '' then
 75 
  if s = '' then
76 
  begin
 76 
  begin
77 
    result := false;
 77 
    result := false;
78 
    Exit;
 78 
    Exit;
79 
  end;
 79 
  end;
80 
  if LooksLikeDir(s) then
 80 
  if LooksLikeDir(s) then
81 
  begin
 81 
  begin
82 
    s := Copy(s, 1, Length(s)-1);
 82 
    s := Copy(s, 1, Length(s)-1);
83 
  end;
 83 
  end;
84 
  for i := 1 to Length(s) do
 84 
  for i := 1 to Length(s) do
85 
  begin
 85 
  begin
86 
    if s[i] = PathDelim then
 86 
    if s[i] = PathDelim then
87 
    begin
 87 
    begin
88 
      result := false;
 88 
      result := false;
89 
      Exit;
 89 
      Exit;
90 
    end;
 90 
    end;
91 
  end;
 91 
  end;
92 
  result := true;
 92 
  result := true;
93 
end;
 93 
end;
94 
 
 94 
 
95 
function FEListAll(theRec: TZMDirEntry; var Data): Integer;
 95 
function FEListAll(theRec: TZMDirEntry; var Data): Integer;
96 
var
 96 
var
97 
  l: TStringList absolute Data;
 97 
  l: TStringList absolute Data;
98 
  s: string;
 98 
  s: string;
99 
begin
 99 
begin
100 
  Result := 0;
 100 
  Result := 0;
101 
 
 101 
 
102 
  s := theRec.FileName;
 102 
  s := theRec.FileName;
103 
  l.Add(s);
 103 
  l.Add(s);
104 
 
 104 
 
105 
  s := ExtractFilePath(s);
 105 
  s := ExtractFilePath(s);
106 
  if l.IndexOf(s) = -1 then l.Add(s);
 106 
  if l.IndexOf(s) = -1 then l.Add(s);
107 
end;
 107 
end;
108 
 
 108 
 
109 
procedure ListRootFiles(uz: TZipMaster19; List: TStringList);
 109 
procedure ListRootFiles(uz: TZipMaster19; List: TStringList);
110 
var
 110 
var
111 
  s: string;
 111 
  s: string;
112 
  l: TStringList;
 112 
  l: TStringList;
113 
  i: Integer;
 113 
  i: Integer;
114 
resourcestring
 114 
resourcestring
115 
  Lng_ForeachFailed = 'Dateiiteration fehlgeschlagen!';
 115 
  Lng_ForeachFailed = 'Dateiiteration fehlgeschlagen!';
116 
begin
 116 
begin
117 
  List.Clear;
 117 
  List.Clear;
118 
 
 118 
 
119 
  l := TStringList.Create;
 119 
  l := TStringList.Create;
120 
  try
 120 
  try
121 
    // Fill list (inclusive Directories)
 121 
    // Fill list (inclusive Directories)
122 
 
 122 
 
123 
    uz.FSpecArgs.Add('*');
 123 
    uz.FSpecArgs.Add('*');
124 
    if uz.ForEach(FEListAll, l) <> 0 then
 124 
    if uz.ForEach(FEListAll, l) <> 0 then
125 
    begin
 125 
    begin
126 
      MessageDlg(Lng_ForeachFailed, mtError, [mbOk], 0);
 126 
      MessageDlg(Lng_ForeachFailed, mtError, [mbOk], 0);
127 
    end;
 127 
    end;
128 
 
 128 
 
129 
    // Now look for root files
 129 
    // Now look for root files
130 
 
 130 
 
131 
    for i := 0 to l.Count - 1 do
 131 
    for i := 0 to l.Count - 1 do
132 
    begin
 132 
    begin
133 
      s := l.Strings[i];
 133 
      s := l.Strings[i];
134 
 
 134 
 
135 
      if IsRootFile(s) then
 135 
      if IsRootFile(s) then
136 
      begin
 136 
      begin
137 
        List.Add(s);
 137 
        List.Add(s);
138 
      end;
 138 
      end;
139 
    end;
 139 
    end;
140 
  finally
 140 
  finally
141 
    l.Free;
 141 
    l.Free;
142 
  end;
 142 
  end;
143 
end;
 143 
end;
144 
 
 144 
 
145 
procedure TMainForm.ExtractZipHere(AZipfile: string);
 145 
procedure TMainForm.ExtractZipHere(AZipfile: string);
146 
var
 146 
var
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 
  ok: boolean;
152 
const
 153 
const
153 
  C_Explorer_Open_Param = '"%s"';
 154 
  C_Explorer_Open_Param = '"%s"';
154 
  C_Explorer_Select_Param = '/n,/select,"%s"';
 155 
  C_Explorer_Select_Param = '/n,/select,"%s"';
155 
  EXPLORER_EXE = 'explorer';
 156 
  EXPLORER_EXE = 'explorer';
156 
resourcestring
 157 
resourcestring
157 
  Lng_Aborted = 'Der laufende Prozess wurde abgebrochen. Das extrahierten Dateien sind somit unvollständig.';
 158 
  Lng_Aborted = 'Der laufende Prozess wurde abgebrochen. Das extrahierten Dateien sind somit unvollständig.';
158 
  Lng_Zip_Error = 'ZIP-Master Fehler "%s" (%d)';
 159 
  Lng_Zip_Error = 'ZIP-Master Fehler "%s" (%d)';
159 
  Lng_AutoRunFailed = 'SFX-AutoRun fehlgeschlagen. Die entpackten Inhalte werden nun angezeigt.';
 160 
  Lng_AutoRunFailed = 'SFX-AutoRun fehlgeschlagen. Die entpackten Inhalte werden nun angezeigt.';
160 
  Lng_Unknown_Error = 'Unbekannter Fehler: Dateien sind nicht aufzufinden!';
 161 
  Lng_Unknown_Error = 'Unbekannter Fehler: Dateien sind nicht aufzufinden!';
161 
  Lng_SelectDir = 'Bitte wählen Sie ein Verzeichnis zum Extrahieren aus. Es wird maximal 1 Datei bzw. Ordner erstellt!';
 162 
  Lng_SelectDir = 'Bitte wählen Sie ein Verzeichnis zum Extrahieren aus. Es wird maximal 1 Datei bzw. Ordner erstellt!';
- 
 
 163 
  Lng_WriteProtected = 'Das Verzeichnis ist nicht schreibbar! Bitte wählen Sie ein Anderes.';
162 
begin
 164 
begin
163 
  AZipfile := ExpandUNCFileName(AZipfile);
 165 
  AZipfile := ExpandUNCFileName(AZipfile);
164 
  RenamingOldPrefix := '';
 166 
  RenamingOldPrefix := '';
165 
  RenamingNewPrefix := '';
 167 
  RenamingNewPrefix := '';
166 
 
 168 
 
167 
  if Assigned(uz) then uz.Free; // uz ist global, damit AbortDLL aufgerufen werden kann
 169 
  if Assigned(uz) then uz.Free; // uz ist global, damit AbortDLL aufgerufen werden kann
168 
 
 170 
 
169 
  uz := TZipMaster19.Create(nil);
 171 
  uz := TZipMaster19.Create(nil);
170 
  try
 172 
  try
171 
    ExtractionInProcess := true;
 173 
    ExtractionInProcess := true;
172 
    {$IFNDEF USE_DZIP_UNPACK}
 174 
    {$IFNDEF USE_DZIP_UNPACK}
173 
    uz.DLLDirectory := GetTempDirectory + DelZipDLL_Name;
 175 
    uz.DLLDirectory := GetTempDirectory + DelZipDLL_Name;
174 
    {$ENDIF}
 176 
    {$ENDIF}
175 
    uz.DLL_Load := true;
 177 
    uz.DLL_Load := true;
176 
 
 178 
 
177 
    uz.ZipFileName := AZipFile;
 179 
    uz.ZipFileName := AZipFile;
178 
    uz.Active := true;
 180 
    uz.Active := true;
179 
    zb := ReadBehavior(uz.ZipComment);
 181 
    zb := ReadBehavior(uz.ZipComment);
180 
 
 182 
 
181 
    uz.Unattended := true;
 183 
    uz.Unattended := true;
182 
    uz.ExtrOptions := [ExtrDirNames, ExtrOverWrite, ExtrFreshen, ExtrUpdate,
 184 
    uz.ExtrOptions := [ExtrDirNames, ExtrOverWrite, ExtrFreshen, ExtrUpdate,
183 
      ExtrForceDirs, ExtrNTFS];
 185 
      ExtrForceDirs, ExtrNTFS];
184 
 
 186 
 
185 
    uz.OnExtractOverwrite := EvConfirmOverwrite;
 187 
    uz.OnExtractOverwrite := EvConfirmOverwrite;
186 
    uz.OnProgress := EvProgress;
 188 
    uz.OnProgress := EvProgress;
187 
    uz.OnTick := EvTick;
 189 
    uz.OnTick := EvTick;
188 
    uz.OnCheckTerminate := EvCheckTerminate;
 190 
    uz.OnCheckTerminate := EvCheckTerminate;
189 
    uz.OnPasswordError := EvPasswordEvent;
 191 
    uz.OnPasswordError := EvPasswordEvent;
190 
    uz.PasswordReqCount := EvPasswordTries;
 192 
    uz.PasswordReqCount := EvPasswordTries;
191 
    uz.OnSkipped := EvSkipEvent;
 193 
    uz.OnSkipped := EvSkipEvent;
192 
    uz.OnSetExtName := EvExtFNChange;
 194 
    uz.OnSetExtName := EvExtFNChange;
193 
 
 195 
 
194 
    // Find out base dirtory
 196 
    // Find out base dirtory
195 
 
 197 
 
196 
    GeneralBaseDir := '';
 198 
    GeneralBaseDir := '';
- 
 
 199 
 
197 
    case zb.ExtractionTarget of
 200 
    if zb.ExtractionTarget = etExtractHere then
198 
      etExtractHere:
 - 
 
199 
        begin
 201 
    begin
200 
          GeneralBaseDir := ExtractFilePath(AZipfile); // Default
 202 
      GeneralBaseDir := ExtractFilePath(AZipfile); // Default
- 
 
 203 
 
- 
 
 204 
      if not IsDirectoryWritable(GeneralBaseDir) or
- 
 
 205 
         IsAtFlobbyDisk(GeneralBaseDir) then
- 
 
 206 
      begin
- 
 
 207 
        zb.ExtractionTarget := etDesktop;
201 
        end;
 208 
      end;
202 
      etDesktop:
 209 
    end;
- 
 
 210 
 
- 
 
 211 
    if zb.ExtractionTarget = etDesktop then
203 
        begin
 212 
    begin
204 
          GeneralBaseDir := GetSpecialFolderPath(CSIDL_DESKTOP);
 213 
      GeneralBaseDir := GetSpecialFolderPath(CSIDL_DESKTOP);
- 
 
 214 
 
- 
 
 215 
      if not IsDirectoryWritable(GeneralBaseDir) or
- 
 
 216 
         IsAtFlobbyDisk(GeneralBaseDir) then
- 
 
 217 
      begin
- 
 
 218 
        zb.ExtractionTarget := etAsk;
- 
 
 219 
      end;
205 
        end;
 220 
    end;
- 
 
 221 
 
206 
      etAsk:
 222 
    if zb.ExtractionTarget = etAsk then
207 
        begin
 223 
    begin
- 
 
 224 
      repeat
208 
          GeneralBaseDir := MySelectDirectory(Lng_SelectDir);
 225 
        GeneralBaseDir := MySelectDirectory(Lng_SelectDir);
209 
          if GeneralBaseDir = '' then Exit;
 226 
        if GeneralBaseDir = '' then Exit;
- 
 
 227 
 
- 
 
 228 
        ok := IsDirectoryWritable(GeneralBaseDir);
- 
 
 229 
        if not ok then
- 
 
 230 
        begin
- 
 
 231 
          MessageDlg(Lng_WriteProtected, mtWarning, [mbOk], 0);
210 
        end;
 232 
        end;
- 
 
 233 
      until ok;
211 
    end;
 234 
    end;
- 
 
 235 
 
212 
    GeneralBaseDir := IncludeTrailingPathDelimiter(GeneralBaseDir);
 236 
    GeneralBaseDir := IncludeTrailingPathDelimiter(GeneralBaseDir);
213 
 
 237 
 
214 
    // Semantic scanning of ZIP to determinate the final extraction directory
 238 
    // Semantic scanning of ZIP to determinate the final extraction directory
215 
 
 239 
 
216 
    l := TStringList.Create;
 240 
    l := TStringList.Create;
217 
    try
 241 
    try
218 
      // Count the root objects (files OR dirs) in the ZIP
 242 
      // Count the root objects (files OR dirs) in the ZIP
219 
 
 243 
 
220 
      ListRootFiles(uz, l);
 244 
      ListRootFiles(uz, l);
221 
 
 245 
 
222 
      if l.Count = 0 then
 246 
      if l.Count = 0 then
223 
      begin
 247 
      begin
224 
        // Empty ZIP or Extractor.exe was called without ZIP attached
 248 
        // Empty ZIP or Extractor.exe was called without ZIP attached
225 
        Exit;
 249 
        Exit;
226 
      end
 250 
      end
227 
      else if l.Count = 1 then
 251 
      else if l.Count = 1 then
228 
      begin
 252 
      begin
229 
        // 1 Object = Extract it right here!
 253 
        // 1 Object = Extract it right here!
230 
        BaseDir := GeneralBaseDir;
 254 
        BaseDir := GeneralBaseDir;
231 
        s := BaseDir + l.Strings[0];
 255 
        s := BaseDir + l.Strings[0];
232 
 
 256 
 
233 
        RenamingOldPrefix := l.Strings[0]; // = StripBaseDir(S);
 257 
        RenamingOldPrefix := l.Strings[0]; // = StripBaseDir(S);
234 
 
 258 
 
235 
        if zb.ConflictBehavior = cbAvoid then
 259 
        if zb.ConflictBehavior = cbAvoid then
236 
        begin
 260 
        begin
237 
          s := SearchNextFreeName(s, LooksLikeDir(s));
 261 
          s := SearchNextFreeName(s, LooksLikeDir(s));
238 
        end;
 262 
        end;
239 
 
 263 
 
240 
        RenamingNewPrefix := StripBaseDir(s);
 264 
        RenamingNewPrefix := StripBaseDir(s);
241 
      end
 265 
      end
242 
      else
 266 
      else
243 
      begin
 267 
      begin
244 
        // 2+ Objects = Extract them in a separate folder
 268 
        // 2+ Objects = Extract them in a separate folder
245 
        s := GeneralBaseDir + ExtractFileNameWithoutExt(AZipfile) + PathDelim;
 269 
        s := GeneralBaseDir + ExtractFileNameWithoutExt(AZipfile) + PathDelim;
246 
        if zb.ConflictBehavior = cbAvoid then
 270 
        if zb.ConflictBehavior = cbAvoid then
247 
        begin
 271 
        begin
248 
          s := SearchNextFreeName(s, true);
 272 
          s := SearchNextFreeName(s, true);
249 
          MkDir(s);
 273 
          MkDir(s);
250 
        end
 274 
        end
251 
        else
 275 
        else
252 
        begin
 276 
        begin
253 
          if not DirectoryExists(s) then MkDir(s);
 277 
          if not DirectoryExists(s) then MkDir(s);
254 
        end;
 278 
        end;
255 
        BaseDir := s;
 279 
        BaseDir := s;
256 
      end;
 280 
      end;
257 
      BaseDir := IncludeTrailingPathDelimiter(BaseDir);
 281 
      BaseDir := IncludeTrailingPathDelimiter(BaseDir);
258 
 
 282 
 
259 
      uz.ExtrBaseDir := BaseDir;
 283 
      uz.ExtrBaseDir := BaseDir;
260 
 
 284 
 
261 
      // Pre-Extract-Dialog
 285 
      // Pre-Extract-Dialog
262 
 
 286 
 
263 
      if zb.CommentPresentation = cpBeforeExtracting then
 287 
      if zb.CommentPresentation = cpBeforeExtracting then
264 
      begin
 288 
      begin
265 
        if not CommentForm.ShowCommentModal(uz.ZipComment) then exit;
 289 
        if not CommentForm.ShowCommentModal(uz.ZipComment) then exit;
266 
      end;
 290 
      end;
267 
 
 291 
 
268 
      // Extract
 292 
      // Extract
269 
 
 293 
 
270 
      ec := uz.Extract;
 294 
      ec := uz.Extract;
271 
 
 295 
 
272 
      if ec <> 0 then
 296 
      if ec <> 0 then
273 
      begin
 297 
      begin
274 
        if ec = DS_Canceled then
 298 
        if ec = DS_Canceled then
275 
        begin
 299 
        begin
276 
          MessageDlg(Lng_Aborted, mtWarning, [mbOk], 0);
 300 
          MessageDlg(Lng_Aborted, mtWarning, [mbOk], 0);
277 
        end
 301 
        end
278 
        else
 302 
        else
279 
        begin
 303 
        begin
280 
          MessageDlg(Format(Lng_Zip_Error, [uz.ErrMessage, ec]), mtError, [mbOk], 0);
 304 
          MessageDlg(Format(Lng_Zip_Error, [uz.ErrMessage, ec]), mtError, [mbOk], 0);
281 
        end;
 305 
        end;
282 
      end;
 306 
      end;
283 
 
 307 
 
284 
      // Errors?
 308 
      // Errors?
285 
 
 309 
 
286 
      if ErrorForm.ErrorsAvailable then
 310 
      if ErrorForm.ErrorsAvailable then
287 
      begin
 311 
      begin
- 
 
 312 
        Hide;
288 
        ErrorForm.ShowModal;
 313 
        ErrorForm.ShowModal;
289 
      end;
 314 
      end;
290 
 
 315 
 
291 
      // Show After-Extracting comment?
 316 
      // Show After-Extracting comment?
292 
 
 317 
 
293 
      if zb.CommentPresentation = cpAfterExtracting then
 318 
      if zb.CommentPresentation = cpAfterExtracting then
294 
      begin
 319 
      begin
295 
        if not CommentForm.ShowCommentModal(uz.ZipComment) then exit;
 320 
        if not CommentForm.ShowCommentModal(uz.ZipComment) then exit;
296 
      end;
 321 
      end;
297 
 
 322 
 
298 
      // Now search for an AutoRun.inf
 323 
      // Now search for an AutoRun.inf
299 
 
 324 
 
300 
      ar := ExecuteSFXAutoRun(BaseDir);
 325 
      ar := ExecuteSFXAutoRun(BaseDir);
301 
 
 326 
 
302 
      if ar.AutoRunSectionAvailable and not ar.ExecutionSucceed then
 327 
      if ar.AutoRunSectionAvailable and not ar.ExecutionSucceed then
303 
      begin
 328 
      begin
304 
        MessageDlg(Lng_AutoRunFailed, mtError, [mbOk], 0);
 329 
        MessageDlg(Lng_AutoRunFailed, mtError, [mbOk], 0);
305 
        ar.OpenUnzippedContent := true;
 330 
        ar.OpenUnzippedContent := true;
306 
      end;
 331 
      end;
307 
 
 332 
 
308 
      // Now open the file for the user
 333 
      // Now open the file for the user
309 
 
 334 
 
310 
      if not ar.AutoRunSectionAvailable or ar.OpenUnzippedContent then
 335 
      if not ar.AutoRunSectionAvailable or ar.OpenUnzippedContent then
311 
      begin
 336 
      begin
312 
        if DirectoryExists(s) then
 337 
        if DirectoryExists(s) then
313 
        begin
 338 
        begin
314 
          // If it is a folder, open it
 339 
          // If it is a folder, open it
315 
 
 340 
 
316 
          ShellExecute(0, 'open', EXPLORER_EXE,
 341 
          ShellExecute(0, 'open', EXPLORER_EXE,
317 
            PChar(Format(C_Explorer_Open_Param, [s])), '', SW_NORMAL);
 342 
            PChar(Format(C_Explorer_Open_Param, [s])), '', SW_NORMAL);
318 
        end
 343 
        end
319 
        else if FileExists(s) then
 344 
        else if FileExists(s) then
320 
        begin
 345 
        begin
321 
          // If it is a file, then only select it
 346 
          // If it is a file, then only select it
322 
 
 347 
 
323 
          // Que: Funktioniert das auch ohne "/n"?
 348 
          // Que: Funktioniert das auch ohne "/n"?
324 
          // Im Moment wird bei einem BESTEHENDEN Fenster
 349 
          // Im Moment wird bei einem BESTEHENDEN Fenster
325 
          // die Selektion nicht durchgeführt.
 350 
          // die Selektion nicht durchgeführt.
326 
 
 351 
 
327 
          ShellExecute(0, 'open', EXPLORER_EXE,
 352 
          ShellExecute(0, 'open', EXPLORER_EXE,
328 
            PChar(Format(C_Explorer_Select_Param, [s])), '', SW_NORMAL);
 353 
            PChar(Format(C_Explorer_Select_Param, [s])), '', SW_NORMAL);
329 
        end
 354 
        end
330 
        else
 355 
        else
331 
        begin
 356 
        begin
332 
          if not AbortUnzip then
 357 
          if not AbortUnzip then
333 
          begin
 358 
          begin
334 
            MessageDlg(Lng_Unknown_Error, mtError, [mbOk], 0);
 359 
            MessageDlg(Lng_Unknown_Error, mtError, [mbOk], 0);
335 
          end;
 360 
          end;
336 
        end;
 361 
        end;
337 
      end;
 362 
      end;
338 
    finally
 363 
    finally
339 
      l.Free;
 364 
      l.Free;
340 
    end;
 365 
    end;
341 
  finally
 366 
  finally
342 
    uz.Free;
 367 
    uz.Free;
343 
    ExtractionInProcess := false;
 368 
    ExtractionInProcess := false;
344 
  end;
 369 
  end;
345 
end;
 370 
end;
346 
 
 371 
 
347 
procedure TMainForm.EvProgress(Sender: TObject; details: TZMProgressDetails);
 372 
procedure TMainForm.EvProgress(Sender: TObject; details: TZMProgressDetails);
348 
begin
 373 
begin
349 
  CurrentFileLabel.Caption := details.ItemName;
 374 
  CurrentFileLabel.Caption := details.ItemName;
350 
 
 375 
 
351 
  progressBar.Position := details.TotalPosition;
 376 
  progressBar.Position := details.TotalPosition;
352 
  progressBar.Max := details.TotalSize;
 377 
  progressBar.Max := details.TotalSize;
353 
 
 378 
 
354 
  itemBar.Position := details.ItemPosition;
 379 
  itemBar.Position := details.ItemPosition;
355 
  itemBar.Max := details.ItemSize;
 380 
  itemBar.Max := details.ItemSize;
356 
 
 381 
 
357 
  Application.ProcessMessages;
 382 
  Application.ProcessMessages;
358 
end;
 383 
end;
359 
 
 384 
 
360 
procedure TMainForm.EvExtFNChange(Sender: TObject;
 385 
procedure TMainForm.EvExtFNChange(Sender: TObject;
361 
  var FileName: TZMString; const BaseDir: TZMString;
 386 
  var FileName: TZMString; const BaseDir: TZMString;
362 
  var IsChanged: Boolean);
 387 
  var IsChanged: Boolean);
363 
begin
 388 
begin
364 
  if RenamingOldPrefix = RenamingNewPrefix then Exit;
 389 
  if RenamingOldPrefix = RenamingNewPrefix then Exit;
365 
  FileName := RenamingNewPrefix + Copy(FileName, 1+Length(RenamingOldPrefix), Length(FileName)-Length(RenamingOldPrefix));
 390 
  FileName := RenamingNewPrefix + Copy(FileName, 1+Length(RenamingOldPrefix), Length(FileName)-Length(RenamingOldPrefix));
366 
  IsChanged := true;
 391 
  IsChanged := true;
367 
end;
 392 
end;
368 
 
 393 
 
369 
procedure TMainForm.EvTick(Sender: TObject);
 394 
procedure TMainForm.EvTick(Sender: TObject);
370 
begin
 395 
begin
371 
  Application.ProcessMessages;
 396 
  Application.ProcessMessages;
372 
end;
 397 
end;
373 
 
 398 
 
374 
procedure TMainForm.EvCheckTerminate(Sender: TObject; var abort: Boolean);
 399 
procedure TMainForm.EvCheckTerminate(Sender: TObject; var abort: Boolean);
375 
begin
 400 
begin
376 
  abort := AbortUnzip;
 401 
  abort := AbortUnzip;
377 
end;
 402 
end;
378 
 
 403 
 
379 
procedure TMainForm.EvConfirmOverwrite(Sender: TObject; const ForFile: TZMString;
 404 
procedure TMainForm.EvConfirmOverwrite(Sender: TObject; const ForFile: TZMString;
380 
  IsOlder: Boolean; var DoOverwrite: Boolean; DirIndex: Integer);
 405 
  IsOlder: Boolean; var DoOverwrite: Boolean; DirIndex: Integer);
381 
resourcestring
 406 
resourcestring
382 
  Lng_Overwrite = 'Bestehende Datei "%s" überschreiben?';
 407 
  Lng_Overwrite = 'Bestehende Datei "%s" überschreiben?';
383 
var
 408 
var
384 
  res: Integer;
 409 
  res: Integer;
385 
begin
 410 
begin
386 
  if zb.ConflictBehavior = cbOverwrite then
 411 
  if zb.ConflictBehavior = cbOverwrite then
387 
  begin
 412 
  begin
388 
    DoOverwrite := true;
 413 
    DoOverwrite := true;
389 
    Exit;
 414 
    Exit;
390 
  end
 415 
  end
391 
  else if zb.ConflictBehavior = cbNewer then
 416 
  else if zb.ConflictBehavior = cbNewer then
392 
  begin
 417 
  begin
393 
    DoOverwrite := IsOlder; // If file on DISK is older, then overwrite.
 418 
    DoOverwrite := IsOlder; // If file on DISK is older, then overwrite.
394 
    Exit;
 419 
    Exit;
395 
  end
 420 
  end
396 
  else if zb.ConflictBehavior = cbAsk then
 421 
  else if zb.ConflictBehavior = cbAsk then
397 
  begin
 422 
  begin
398 
    // Workaround: Verzeichnisse brauchen das nicht,
 423 
    // Workaround: Verzeichnisse brauchen das nicht,
399 
    // denn es wird bei den Dateien nochmal nachgefragt
 424 
    // denn es wird bei den Dateien nochmal nachgefragt
400 
    if LooksLikeDir(ForFile) then
 425 
    if LooksLikeDir(ForFile) then
401 
    begin
 426 
    begin
402 
      DoOverwrite := true;
 427 
      DoOverwrite := true;
403 
      Exit;
 428 
      Exit;
404 
    end;
 429 
    end;
405 
 
 430 
 
406 
    if CachedOverwriteDecision = odUndefined then
 431 
    if CachedOverwriteDecision = odUndefined then
407 
    begin
 432 
    begin
408 
      res := MessageDlg(Format(Lng_Overwrite, [ForFile]), mtConfirmation, [mbYes, mbNo, mbYesToAll, mbNoToAll], 0);
 433 
      res := MessageDlg(Format(Lng_Overwrite, [ForFile]), mtConfirmation, [mbYes, mbNo, mbYesToAll, mbNoToAll], 0);
409 
      DoOverwrite := (res = mrYes) or (res = mrYesToAll);
 434 
      DoOverwrite := (res = mrYes) or (res = mrYesToAll);
410 
      if res = mrNoToAll then CachedOverwriteDecision := odOverwriteNothing;
 435 
      if res = mrNoToAll then CachedOverwriteDecision := odOverwriteNothing;
411 
      if res = mrYesToAll then CachedOverwriteDecision := odOverwriteAll;
 436 
      if res = mrYesToAll then CachedOverwriteDecision := odOverwriteAll;
412 
    end
 437 
    end
413 
    else
 438 
    else
414 
    begin
 439 
    begin
415 
      DoOverwrite := CachedOverwriteDecision = odOverwriteAll;
 440 
      DoOverwrite := CachedOverwriteDecision = odOverwriteAll;
416 
    end;
 441 
    end;
417 
  end
 442 
  end
418 
  else if zb.ConflictBehavior = cbAvoid then
 443 
  else if zb.ConflictBehavior = cbAvoid then
419 
  begin
 444 
  begin
420 
    // Nothing to do
 445 
    // Nothing to do
421 
  end;
 446 
  end;
422 
end;
 447 
end;
423 
 
 448 
 
424 
procedure TMainForm.EvPasswordEvent(Sender: TObject; IsZipAction: Boolean;
 449 
procedure TMainForm.EvPasswordEvent(Sender: TObject; IsZipAction: Boolean;
425 
  var NewPassword: String; const ForFile: TZMString; var RepeatCount: Longword;
 450 
  var NewPassword: String; const ForFile: TZMString; var RepeatCount: Longword;
426 
  var Action: TMsgDlgBtn);
 451 
  var Action: TMsgDlgBtn);
427 
var
 452 
var
428 
  repc: integer;
 453 
  repc: integer;
429 
begin
 454 
begin
430 
  repc := EvPasswordTries - RepeatCount + 1;
 455 
  repc := EvPasswordTries - RepeatCount + 1;
431 
 
 456 
 
432 
  // Eine Passworteingabe wurde abgebrochen. Frage nicht mehr nach.
 457 
  // Eine Passworteingabe wurde abgebrochen. Frage nicht mehr nach.
433 
  if StopAskingPassword then Exit;
 458 
  if StopAskingPassword then Exit;
434 
 
 459 
 
435 
  // Wurde schonmal ein Passwort eingegeben?
 460 
  // Wurde schonmal ein Passwort eingegeben?
436 
  if LastTriedPassword <> '' then
 461 
  if LastTriedPassword <> '' then
437 
  begin
 462 
  begin
438 
    // Schauen, ob das letzte Passwort auch mit dieser Datei geht.
 463 
    // Schauen, ob das letzte Passwort auch mit dieser Datei geht.
439 
    if repc = 1 then
 464 
    if repc = 1 then
440 
    begin
 465 
    begin
441 
      // Ja, geht
 466 
      // Ja, geht
442 
      NewPassword := LastTriedPassword;
 467 
      NewPassword := LastTriedPassword;
443 
      Exit;
 468 
      Exit;
444 
    end
 469 
    end
445 
    else
 470 
    else
446 
    begin
 471 
    begin
447 
      // Leider nein
 472 
      // Leider nein
448 
      LastTriedPassword := '';
 473 
      LastTriedPassword := '';
449 
    end;
 474 
    end;
450 
  end;
 475 
  end;
451 
 
 476 
 
452 
  if PasswordDlg.ShowModal(StripBaseDir(ForFile), repc, EvPasswordTries) = mrOk then
 477 
  if PasswordDlg.ShowModal(StripBaseDir(ForFile), repc, EvPasswordTries) = mrOk then
453 
  begin
 478 
  begin
454 
    NewPassword := PasswordDlg.Password.Text;
 479 
    NewPassword := PasswordDlg.Password.Text;
455 
    if NewPassword = '' then NewPassword := ' '; // Neue Eingabe erzwingen.
 480 
    if NewPassword = '' then NewPassword := ' '; // Neue Eingabe erzwingen.
456 
    LastTriedPassword := NewPassword;
 481 
    LastTriedPassword := NewPassword;
457 
  end
 482 
  end
458 
  else
 483 
  else
459 
  begin
 484 
  begin
460 
    StopAskingPassword := true;
 485 
    StopAskingPassword := true;
461 
    Action := mbCancel;
 486 
    Action := mbCancel;
462 
  end;
 487 
  end;
463 
end;
 488 
end;
464 
 
 489 
 
465 
procedure TMainForm.CancelBtnClick(Sender: TObject);
 490 
procedure TMainForm.CancelBtnClick(Sender: TObject);
466 
resourcestring
 491 
resourcestring
467 
  Lng_AbortExtract = 'Extrahieren abbrechen?';
 492 
  Lng_AbortExtract = 'Extrahieren abbrechen?';
468 
begin
 493 
begin
469 
  if not ExtractionInProcess then
 494 
  if not ExtractionInProcess then
470 
  begin
 495 
  begin
471 
    Close;
 496 
    Close;
472 
    Exit;
 497 
    Exit;
473 
  end;
 498 
  end;
474 
 
 499 
 
475 
  if MessageDlg(Lng_AbortExtract, mtConfirmation, mbYesNoCancel, 0) = mrYes then
 500 
  if MessageDlg(Lng_AbortExtract, mtConfirmation, mbYesNoCancel, 0) = mrYes then
476 
  begin
 501 
  begin
477 
    CancelBtn.Enabled := false;
 502 
    CancelBtn.Enabled := false;
478 
    uz.AbortDLL;
 503 
    uz.AbortDLL;
479 
    AbortUnzip := true;
 504 
    AbortUnzip := true;
480 
    // Close wird durch den Timer durchgeführt
 505 
    // Close wird durch den Timer durchgeführt
481 
    Exit;
 506 
    Exit;
482 
  end;
 507 
  end;
483 
end;
 508 
end;
484 
 
 509 
 
485 
procedure TMainForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
 510 
procedure TMainForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
486 
begin
 511 
begin
487 
  if not ExtractionInProcess then
 512 
  if not ExtractionInProcess then
488 
  begin
 513 
  begin
489 
    CanClose := true;
 514 
    CanClose := true;
490 
    Exit;
 515 
    Exit;
491 
  end;
 516 
  end;
492 
 
 517 
 
493 
  if not AbortUnzip then
 518 
  if not AbortUnzip then
494 
  begin
 519 
  begin
495 
    CanClose := false;
 520 
    CanClose := false;
496 
    CancelBtn.Click;
 521 
    CancelBtn.Click;
497 
  end;
 522 
  end;
498 
end;
 523 
end;
499 
 
 524 
 
500 
procedure TMainForm.FormCreate(Sender: TObject);
 525 
procedure TMainForm.FormCreate(Sender: TObject);
501 
resourcestring
 526 
resourcestring
502 
  Lng_Extracting = 'Extrahiere Dateien. Bitte warten...';
 527 
  Lng_Extracting = 'Extrahiere Dateien. Bitte warten...';
503 
begin
 528 
begin
504 
  WaitLabel.Caption := Lng_Extracting;
 529 
  WaitLabel.Caption := Lng_Extracting;
505 
  WaitLabel.Left := progressBar.Width div 2 - WaitLabel.Width div 2;
 530 
  WaitLabel.Left := progressBar.Width div 2 - WaitLabel.Width div 2;
506 
  CurrentFileLabel.Caption := '';
 531 
  CurrentFileLabel.Caption := '';
507 
end;
 532 
end;
508 
 
 533 
 
509 
{$IFNDEF USE_DZIP_UNPACK}
 534 
{$IFNDEF USE_DZIP_UNPACK}
510 
procedure TMainForm.ExtractDllFromResource(ADirectory: string);
 535 
procedure TMainForm.ExtractDllFromResource(ADirectory: string);
511 
var
 536 
var
512 
  s: TResourceStream;
 537 
  s: TResourceStream;
513 
  o: TFileStream;
 538 
  o: TFileStream;
514 
  AOutFile: string;
 539 
  AOutFile: string;
515 
begin
 540 
begin
516 
  AOutFile := IncludeTrailingPathDelimiter(ADirectory) + DelZipDLL_Name;
 541 
  AOutFile := IncludeTrailingPathDelimiter(ADirectory) + DelZipDLL_Name;
517 
  s := TResourceStream.Create(0, DZRES_Dll, RT_RCDATA);
 542 
  s := TResourceStream.Create(0, DZRES_Dll, RT_RCDATA);
518 
  try
 543 
  try
519 
    try
 544 
    try
520 
      s.Seek(SizeOf(Integer), soFromBeginning); // Ref: ZMDllLoad19.pas:427
 545 
      s.Seek(SizeOf(Integer), soFromBeginning); // Ref: ZMDllLoad19.pas:427
521 
      if FileExists(AOutFile) then
 546 
      if FileExists(AOutFile) then
522 
        o := TFileStream.Create(AOutFile, fmOpenWrite or fmShareDenyNone)
 547 
        o := TFileStream.Create(AOutFile, fmOpenWrite or fmShareDenyNone)
523 
      else
 548 
      else
524 
        o := TFileStream.Create(AOutFile, fmCreate or fmShareDenyNone);
 549 
        o := TFileStream.Create(AOutFile, fmCreate or fmShareDenyNone);
525 
      try
 550 
      try
526 
        o.CopyFrom(s, s.Size-s.Position);
 551 
        o.CopyFrom(s, s.Size-s.Position);
527 
      finally
 552 
      finally
528 
        o.Free;
 553 
        o.Free;
529 
      end;
 554 
      end;
530 
    except
 555 
    except
531 
      if FileExists(AOutFile) then
 556 
      if FileExists(AOutFile) then
532 
      begin
 557 
      begin
533 
        // Probably the file is write-locked (maybe some other Extractor is
 558 
        // Probably the file is write-locked (maybe some other Extractor is
534 
        // using it right now? Even if we run into danger that the target DLL
 559 
        // using it right now? Even if we run into danger that the target DLL
535 
        // is a write-protected old/incompatible version of DelZip190.dll,
 560 
        // is a write-protected old/incompatible version of DelZip190.dll,
536 
        // we do count this as success, since the file exists.
 561 
        // we do count this as success, since the file exists.
537 
      end
 562 
      end
538 
      else
 563 
      else
539 
      begin
 564 
      begin
540 
        raise;
 565 
        raise;
541 
      end;
 566 
      end;
542 
    end;
 567 
    end;
543 
  finally
 568 
  finally
544 
    s.Free;
 569 
    s.Free;
545 
  end;
 570 
  end;
546 
end;
 571 
end;
547 
{$ENDIF}
 572 
{$ENDIF}
548 
 
 573 
 
549 
procedure TMainForm.AutoTimerTimer(Sender: TObject);
 574 
procedure TMainForm.AutoTimerTimer(Sender: TObject);
550 
resourcestring
 575 
resourcestring
551 
  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.';
 576 
  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.';
552 
  Lng_FileNotFound = 'Die durch Parameter angegebene Datei "%s" kann nicht gefunden werden!';
 577 
  Lng_FileNotFound = 'Die durch Parameter angegebene Datei "%s" kann nicht gefunden werden!';
553 
  Lng_TooManyArguments = 'Zu viele Argumente!';
 578 
  Lng_TooManyArguments = 'Zu viele Argumente!';
554 
begin
 579 
begin
555 
  AutoTimer.Enabled := false;
 580 
  AutoTimer.Enabled := false;
556 
 
 581 
 
557 
  {$IFNDEF USE_DZIP_UNPACK}
 582 
  {$IFNDEF USE_DZIP_UNPACK}
558 
  ExtractDllFromResource(GetTempDirectory);
 583 
  ExtractDllFromResource(GetTempDirectory);
559 
  {$ENDIF}
 584 
  {$ENDIF}
560 
 
 585 
 
561 
  try
 586 
  try
562 
    if IsExtractable(ParamStr(0)) then
 587 
    if IsExtractable(ParamStr(0)) then
563 
    begin
 588 
    begin
564 
      ExtractZipHere(ParamStr(0));
 589 
      ExtractZipHere(ParamStr(0));
565 
    end
 590 
    end
566 
    else
 591 
    else
567 
    begin
 592 
    begin
568 
      // Der Extractor ist "nackt" oder das SFX beschädigt
 593 
      // Der Extractor ist "nackt" oder das SFX beschädigt
569 
 
 594 
 
570 
      if ParamCount = 0 then
 595 
      if ParamCount = 0 then
571 
      begin
 596 
      begin
572 
        MessageDlg(Lng_NakedSFX, mtError, [mbOk], 0);
 597 
        MessageDlg(Lng_NakedSFX, mtError, [mbOk], 0);
573 
      end
 598 
      end
574 
      else if ParamCount = 1 then
 599 
      else if ParamCount = 1 then
575 
      begin
 600 
      begin
576 
        // In diesem Zustand erlauben wir, fremde SFX zu entpacken (auch für Debugging-Zwecke)
 601 
        // In diesem Zustand erlauben wir, fremde SFX zu entpacken (auch für Debugging-Zwecke)
577 
        if FileExists(ParamStr(1)) then
 602 
        if FileExists(ParamStr(1)) then
578 
        begin
 603 
        begin
579 
          ExtractZipHere(ParamStr(1));
 604 
          ExtractZipHere(ParamStr(1));
580 
        end
 605 
        end
581 
        else
 606 
        else
582 
        begin
 607 
        begin
583 
          MessageDlg(Lng_FileNotFound, mtError, [mbOk], 0);
 608 
          MessageDlg(Lng_FileNotFound, mtError, [mbOk], 0);
584 
        end;
 609 
        end;
585 
      end
 610 
      end
586 
      else if ParamCount = 2 then
 611 
      else if ParamCount = 2 then
587 
      begin
 612 
      begin
588 
        // Future: Mehr als nur 1 Parameter erlauben?
 613 
        // Future: Mehr als nur 1 Parameter erlauben?
589 
        MessageDlg(Lng_TooManyArguments, mtError, [mbOk], 0);
 614 
        MessageDlg(Lng_TooManyArguments, mtError, [mbOk], 0);
590 
      end;
 615 
      end;
591 
    end;
 616 
    end;
592 
  finally
 617 
  finally
593 
    Close;
 618 
    Close;
594 
  end;
 619 
  end;
595 
end;
 620 
end;
596 
 
 621 
 
597 
function TMainForm.StripBaseDir(const s: string): string;
 622 
function TMainForm.StripBaseDir(const s: string): string;
598 
begin
 623 
begin
599 
  // Warnung: Es wird nicht überprüft, ob der String auch
 624 
  // Warnung: Es wird nicht überprüft, ob der String auch
600 
  // wirklich mit dem BaseDir beginnt!
 625 
  // wirklich mit dem BaseDir beginnt!
601 
  result := Copy(s, Length(BaseDir)+1, Length(s)-Length(BaseDir));
 626 
  result := Copy(s, Length(BaseDir)+1, Length(s)-Length(BaseDir));
602 
end;
 627 
end;
603 
 
 628 
 
604 
procedure TMainForm.EvSkipEvent(Sender: TObject; const ForFile: TZMString;
 629 
procedure TMainForm.EvSkipEvent(Sender: TObject; const ForFile: TZMString;
605 
  SkipType: TZMSkipTypes; var ExtError: Integer);
 630 
  SkipType: TZMSkipTypes; var ExtError: Integer);
606 
resourcestring
 631 
resourcestring
607 
  Lng_PasswordWrong = 'Das Passwort wurde zu oft falsch eingegeben. Die Datei "%s" wird nicht extrahiert.';
 632 
  Lng_PasswordWrong = 'Das Passwort wurde zu oft falsch eingegeben. Die Datei "%s" wird nicht extrahiert.';
608 
begin
 633 
begin
609 
  if (SkipType = stBadPassword) and not StopAskingPassword then
 634 
  if (SkipType = stBadPassword) and not StopAskingPassword then
610 
  begin
 635 
  begin
611 
    MessageDlg(Format(Lng_PasswordWrong, [ForFile]), mtError, [mbOk], 0);
 636 
    MessageDlg(Format(Lng_PasswordWrong, [ForFile]), mtError, [mbOk], 0);
612 
    LastTriedPassword := '';
 637 
    LastTriedPassword := '';
613 
  end;
 638 
  end;
614 
  ErrorForm.NewError(StripBaseDir(ForFile));
 639 
  ErrorForm.NewError(ForFile, SkipType);
615 
end;
 640 
end;
616 
 
 641 
 
617 
end.
 642 
end.
618 
 
 643