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 von cookie22:

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

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

[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 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?