TZipFile + SubDirectory

[stahli]

Mit XE3 nutze ich jetzt TZipFile zum packen.

Vielleicht nützt das ja jemandem. Ausschnitte der Quellen anbei.

Zwei Probleme habe ich:
- Bei in Benutzung befindlichen Files gibt es einen Fehler (obwohl sie ja nur gelesen werden und sich andererseits kopieren lassen würden).
- Aus der abgeschlossenen Zip lassen sich nachträglich keine Dateien löschen (mit Win7-Explorer).

Hat jemand Rat?

Delphi-Quellcode:

...
procedure DoZip(SourceDir: string; ZipFile: TZipFile);
var
  FileName: String;

  procedure ZipFiles(RealDir, ZipDir: string);
  var
    E: Integer;
    sr: TSearchRec;
  begin
    ZipDir := StringReplace(RealDir, ZipDir, '', []);
    E := FindFirst(RealDir + '*.*', (faAnyFile and not faDirectory), sr);
    while E = 0 do
    begin
      if (sr.Attr and faDirectory) = 0 then
      begin
        FileName := sr.Name;
        if RealDir + FileName <> ParamStr(0) then
          ZipFile.Add(RealDir + FileName, ZipDir + FileName);
      end;
      E := FindNext(sr);
    end;
    FindClose(sr);
  end;

  procedure ZipPath(RealDir, ZipDir: string);
  var
    E: Integer;
    sr: TSearchRec;
    F: Boolean;
  begin
    RealDir := RealDir + '\';
    if ZipDir = '' then
    begin
      ZipDir := RealDir;
      E := Length(ZipDir);
      F := True;
      while (E > 0) and ((Copy(ZipDir, E, 1) <> '\')) or (F) do
      begin
        Delete(ZipDir, E, 1);
        Dec(E);
        F := False;
      end;
    end;
    E := FindFirst(RealDir + '*.*', faDirectory, sr);
    while E = 0 do
    begin
      if (sr.Attr and faDirectory) = faDirectory then
      begin
        FileName := sr.Name;
        if (FileName <> '.') and (FileName <> '..') then
        begin
          ZipPath(RealDir + FileName, ZipDir);
        end;
      end;
      E := FindNext(sr);
    end;
    FindClose(sr);
    ZipFiles(RealDir, ZipDir);
  end;

begin
  ZipPath(SourceDir, '');
end;

...
    FN := DestPath + '\' + 'xxx.zip';
    ZipFile := TZipFile.Create;
    ZipFile.Open(FN, zmWrite);
    DoZip(SourcePath, ZipFile);
    ZipFile.Close;
    FreeAndNil(ZipFile);
...

[cookie22]

Zitat:

Aus der abgeschlossenen Zip lassen sich nachträglich keine Dateien löschen (mit Win7-Explorer).

Was für Zip-Dateien erstellt XE 3 denn? Denn es gibt da einen Haufen unterschiedliche Version angefangen von 1 bishin zu 4 oder 5. Das steht im Header der Zip-Datei. Es gibt dort ein Flag, "Version made by" und eines "Version needed to Extract".

Auch könnte die Zip-Datei in irgendeiner Form beschädigt sein. Beides lässt sich mit Standard Zip-Programmen wie z.B. UltimateZip heraus finden.

[stahli]

Danke, das wusste ich nicht.
Beide Flags enthalten "2.0" (genau wie mit dem Explorer erzeugte Zips).

Löschen von Einträgen ist in TZipFile-Zip aber nicht möglich.
Optisch scheint das erfolgreich, beim nächsten Öffnen ist der Inhalt aber noch da.
Ggf. gibt es auch eine Fehlermeldung.

Habe mal im Netz gesucht. Da scheint es einige Probleme mit der Zip-Komponente zu geben.
Insgesamt komme ich da aber auf keinen grünen Zweig.

Packen und Entpacken geht zwar, aber vertrauenserweckend ist das nicht...

[Union]

Benutze lieber Abbrevia o.ä.

[ralfschwalbe]

Normalerweise kann man nicht in Archiven löschen oder eine einzelne Datei entpacken, wenn es sich um Solid-Archive handelt.

Ich seh grad auf Deinen Screenshots: Das ist es wohl nicht...

[cookie22]

Es gibt keine Solid Zip-Archive. Das können Formate wie RAR, SQX oder 7Zip.

Kannst du denn mit dem Zipper Dateien löschen oder hinzufügen? Wenn nein, was sagt ein Test über die Datei? Lass mal die Repair-Funktion drüber laufen und schau ob es dann geht. Wenn ja, dann stimmt was beim Header deiner Datei nicht, die Repair-Funktiom versucht einen validen header zu konstruieren.

Ich denke auch Abbrevia oder etwas vergleichbares spart viel Zeit und Ärger.

[cookie22]

P.S. Sehe gerade den Error-Screen. Ich glaube, dass liegt nicht an der Zip-Datei selbst sondern eher an Dateirechten. Schau mal hier: http://www.windowsanswers.net/articles/fix-0x80004005

[ralfschwalbe]

Zitat:

Zitat von cookie22 (Beitrag 1211713)

Es gibt keine Solid Zip-Archive. Das können Formate wie RAR, SQX oder 7Zip.

Oops, Du hast Recht! :oops: Als kleine Entschuldigung: Für mich ist heute "Montag". :roll:

[stahli]

Ich bleibe erst mal bei TZipFile, da ich nicht weiß, was Abbrevia genau besser macht (und da es so jetzt erst mal für mich reicht).

Wenn ich in Win7-Exporer Send an Zip ausführe, kann ich nachträglich etwas aus der Zip löschen.
Vielleicht expertet der Explorer da ja auch irgendwas hinein.

Die von TZipFile erzeugten Zips enthalten scheinbar keine Fehler (habe jedenfalls keine gefunden).

Der Fehler beim Packen verwendeter Files liegt am Aufruf von

Delphi-Quellcode:

LInStream := TFileStream.Create(FileName, fmOpenRead);

in TZipFile.Add.
Ich prüfe jetzt mit FileInUse und kopiere im "Erfolgsfall" die Datei und packe dann die freie Kopie ein.
Unter Win7 funktioniert das. Morgen will ich es unter XP im Netzwerk testen.

Hier nochmal die aktuelle Prozedur:

Delphi-Quellcode:

procedure DoZip(SourceDir: string; ZipFile: TZipFile; DestDir: string);
var
  FileName: String;

  function FileInUse(FileName: string): Boolean;
  var
    hFileRes: hFILE;
  begin
    Result := False;
    if not FileExists(FileName) then
      exit;
    hFileRes := CreateFile(PChar(FileName), GENERIC_READ or GENERIC_WRITE, 0, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
    Result := (hFileRes = INVALID_HANDLE_VALUE);
    if not Result then
      CloseHandle(hFileRes);
  end;

  procedure ZipFiles(RealDir, ZipDir: string);
  var
    E: Integer;
    sr: TSearchRec;
  begin
    ZipDir := StringReplace(RealDir, ZipDir, '', []);
    E := FindFirst(RealDir + '*.*', (faAnyFile and not faDirectory), sr);
    while E = 0 do
    begin
      if (sr.Attr and faDirectory) = 0 then
      begin
        FileName := sr.Name;
        if FileInUse(RealDir + FileName) then
        begin
          CopyFile(PWideChar(RealDir + FileName), PWideChar(DestDir + FileName), False);
          ZipFile.Add(DestDir + FileName, ZipDir + FileName);
          DeleteFile(PWideChar(DestDir + FileName));
        end
        else
          ZipFile.Add(RealDir + FileName, ZipDir + FileName);
      end;
      E := FindNext(sr);
    end;
    FindClose(sr);
  end;

  procedure ZipPath(RealDir, ZipDir: string);
  var
    E: Integer;
    sr: TSearchRec;
    F: Boolean;
  begin
    RealDir := RealDir + '\';
    if ZipDir = '' then
    begin
      ZipDir := RealDir;
      E := Length(ZipDir);
      F := True;
      while (E > 0) and ((Copy(ZipDir, E, 1) <> '\')) or (F) do
      begin
        Delete(ZipDir, E, 1);
        Dec(E);
        F := False;
      end;
    end;
    E := FindFirst(RealDir + '*.*', faDirectory, sr);
    while E = 0 do
    begin
      if (sr.Attr and faDirectory) = faDirectory then
      begin
        FileName := sr.Name;
        if (FileName <> '.') and (FileName <> '..') then
        begin
          ZipPath(RealDir + FileName, ZipDir);
        end;
      end;
      E := FindNext(sr);
    end;
    FindClose(sr);
    ZipFiles(RealDir, ZipDir);
  end;

begin
  ZipPath(SourceDir, '');
end;

[stahli]

Nochmal zwei Fragen zum TZipFile (unter FireMonkey):

1.) fmShareDenyNone

Ich habe jetzt einfach TZipFile überschreiben und fmShareDenyNone verwendet.

Delphi-Quellcode:

procedure TZipFile.Add(FileName: string; ArchiveFileName: string;
  Compression: TZipCompression);
var
  LInStream: TStream;
  LHeader: TZipHeader;
begin
  if not (FMode in [zmReadWrite, zmWrite]) then
    raise EZipException.CreateRes(@SZipNoWrite);

  if not FCompressionHandler.ContainsKey(Compression) then
    raise EZipException.CreateResFmt(@SZipNotSupported, [
      TZipCompressionToString(Compression) ]);

  // Setup Header
  FillChar(LHeader, sizeof(LHeader), 0);
  LHeader.Flag := 0;
  LInStream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyNone); // FIXED fmOpenRead);
  try
    LHeader.Flag := 0;
    LHeader.CompressionMethod := UInt16(Compression);
    LHeader.ModifiedDateTime := DateTimeToFileDate( tfile.GetLastWriteTime(FileName) );
    LHeader.UncompressedSize := LInStream.Size;
    LHeader.InternalAttributes := 0;
    LHeader.ExternalAttributes := 0;
    if ArchiveFileName = '' then
      ArchiveFileName := ExtractFileName(FileName);
    if FUTF8Support then
      LHeader.Flag := LHeader.Flag or (1 SHL 11); // Language encoding flag, UTF8
    LHeader.FileName := StringToTBytes(ArchiveFileName);
    LHeader.FileNameLength := Length(LHeader.FileName);

    LHeader.ExtraFieldLength := 0;
    Add(LInStream, LHeader);
  finally
    LInStream.Free;
  end;
end;

Auf den ersten Blick scheint das so alles zu funktionieren. Jedenfalls kann ich die laufende ProjektExe somit selbst packen.
Kennt jemand plausible Gründe, warum Emba das nicht entsprechend geregelt hat?


2.) Umlaute
Das Zippen von kompletten Ordnern funktioniert eigentlich gut. Ich habe aber ein Problem mit Umlauten in Dateinamen festgestellt (siehe Screenshot).
Weiß jemand Abhilfe?

[Union]

Also welche Kombination verwendest Du jetzt unter Firemonkey? Nur TZipFile mit dem überschriebenen Add oder auch das DoZip aus dem vorherigen Post?

[stahli]

Beides, aber aus dem DoZip habe ich die Prüfung FileInUse raus geworfen.
Mit DoZip werden die Ordner und Files ermittelt (*.tmp können ausgeklammert werden etc) und ZipFile.Add packt dann eine Datei.

[Union]

Sowas geht:

Delphi-Quellcode:

procedure TForm1.btnZipClick(Sender: TObject);
var
  BaseDir : string;
  ZipFile : TZipFile;
begin
  BaseDir := IncludeTrailingPathDelimiter(TPath.GetDirectoryName(Paramstr(0)));
  ZipFile := TZipFile.Create;
  ZipFile.Open(BaseDir+'ZipTest.zip', zmWrite);
  ZipFile.Add(BaseDir+'Hällö\Äin Faß vüll Tönte.txt' ,'Hällö\ZipTest\Äin Faß vüll Tönte.txt');
  ZipFile.Close;
  ZipFile.Free;
end;

Daher vermute ich dass Deine Dateisuche den falschen Stringtyp zurückgibt.

Wenn Du mit XEx und besonders FMX arbeitest, solltest Du das Find-Gedöns im eigenen Interesse durch TPath und TDirectory ersetzen. Auch die ganzen Abfragen auf "\" sowie "." sollten raus.

[stahli]

Hmm, ich habe Deinen Code getestet. Bei mir sind die Umlaute verfälscht in der Zip!?

[Union]

Schau ob das UTF Flag gesetzt ist. Sollte eigentlich im Constructor von TZipfile geschehen. Anonsten häng doch mal ein komplettes kleines Testprojekt hier rein sowie eine dadruch erzeugte Zipdatei. Vielleicht passiert der Fehler ja auch beim Entpacken.

[stahli]

Das UTF Flag ist gesetzt. Getestet auf Win7 32 + 64.
Anbei mal ein Testprojekt incl. erzeugter zip.
Offenbar noch etwas von Emba, das nix taugt.

Ich werde dann doch mal Abbrevia ansehen.

[Union]

Anbei ?

[stahli]

:oops: Oh, ganz klar ein Fall von zu viel versprochen...

[Union]

Ich habe das enthaltene Archiv ausgepackt - alles ok.

[Thom]

Windows-Explorer (Win7/64 Bit):

Code:

H+ñll+Â
H+ñll+Â in Fa+ƒ v++ll T+Ânte.txt

7Zip:

Code:

Hällö
Hällö in Faß vüll Tönte.txt

[Union]

Windows 8 (Integriert) - Ok
Windows XP (WinRar) - Nicht Ok
Windows 7 (WinRar) - Ok

Das Problem ist relativ simpel:

Die von der TZipFile-Klasse erzeugten Dateien haben zwar das UTF-Flag gesetzt, die Daten sind aber NICHT als UTF gespeichert sondern als Widechar. Einige Packer erkennen und korrigieren das, andere eben nicht.

Ein weiterer Fehler liegt in der Directory-Struktur. Die PathDelimiter werden nicht korrekt nach "/" umgesetzt, wie es in der ZIP-Spezifikation dokumentiert ist. Es liegt die Vermutung nahe, dass TZipFile irgendwo "abgeschrieben" wurde und notdürftig an Delphi angepasst. Der Ersteller hat dies zwar dokumentiert aber nicht implementiert.

[stahli]

Zitat:

Zitat von Union (Beitrag 1211698)

Benutze lieber Abbrevia o.ä.

:thumb:
Funktioniert perfekt und mindestens mit dem Win8-Explorer kann ich sogar etwas aus dem erstellten Zip löschen.


Den Zip-Versuch hätte Emba sich wieder sparen und noch mehr Arbeit in iOS stecken können. :wall:

[Union]

Und es werden Passwörter unterstützt.

[luisk]

Danke für den Zip-Tool Hinweis:
http://tpabbrevia.sourceforge.net/