AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren

TZipFile + SubDirectory

Ein Thema von stahli · begonnen am 15. Apr 2013 · letzter Beitrag vom 29. Apr 2016
Antwort Antwort
Seite 1 von 3  1 23   
Benutzerbild von stahli
stahli

Registriert seit: 26. Nov 2003
Ort: Halle/Saale
4.343 Beiträge
 
Delphi 11 Alexandria
 
#1

TZipFile + SubDirectory

  Alt 15. Apr 2013, 23:56
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);
...
Stahli
http://www.StahliSoft.de
---
"Jetzt muss ich seh´n, dass ich kein Denkfehler mach...!?" Dittsche (2004)
  Mit Zitat antworten Zitat
Benutzerbild von cookie22
cookie22

Registriert seit: 28. Jun 2006
Ort: Düsseldorf
936 Beiträge
 
Delphi XE2 Professional
 
#2

AW: TZipFile + SubDirectory

  Alt 16. Apr 2013, 07:55
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.
Gruß
Cookie

Geändert von cookie22 (16. Apr 2013 um 08:21 Uhr)
  Mit Zitat antworten Zitat
Benutzerbild von stahli
stahli

Registriert seit: 26. Nov 2003
Ort: Halle/Saale
4.343 Beiträge
 
Delphi 11 Alexandria
 
#3

AW: TZipFile + SubDirectory

  Alt 16. Apr 2013, 22:21
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...
Miniaturansicht angehängter Grafiken
zip-win7explorer.png   zip-tzipfile.png   zip_error.png  
Stahli
http://www.StahliSoft.de
---
"Jetzt muss ich seh´n, dass ich kein Denkfehler mach...!?" Dittsche (2004)
  Mit Zitat antworten Zitat
Benutzerbild von Union
Union

Registriert seit: 18. Mär 2004
Ort: Luxembourg
3.492 Beiträge
 
Delphi 7 Enterprise
 
#4

AW: TZipFile + SubDirectory

  Alt 17. Apr 2013, 00:05
Benutze lieber Abbrevia o.ä.
Ibi fas ubi proxima merces
sudo /Developer/Library/uninstall-devtools --mode=all
  Mit Zitat antworten Zitat
Benutzerbild von ralfschwalbe
ralfschwalbe

Registriert seit: 19. Jul 2007
Ort: Lichtenstein/Sachsen
133 Beiträge
 
Delphi XE3 Professional
 
#5

AW: TZipFile + SubDirectory

  Alt 17. Apr 2013, 08:41
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...
Ralf Schwalbe
viele Grüße...
  Mit Zitat antworten Zitat
Benutzerbild von cookie22
cookie22

Registriert seit: 28. Jun 2006
Ort: Düsseldorf
936 Beiträge
 
Delphi XE2 Professional
 
#6

AW: TZipFile + SubDirectory

  Alt 17. Apr 2013, 08:59
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.
Gruß
Cookie

Geändert von cookie22 (17. Apr 2013 um 10:15 Uhr)
  Mit Zitat antworten Zitat
Benutzerbild von cookie22
cookie22

Registriert seit: 28. Jun 2006
Ort: Düsseldorf
936 Beiträge
 
Delphi XE2 Professional
 
#7

AW: TZipFile + SubDirectory

  Alt 17. Apr 2013, 09:03
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
Gruß
Cookie
  Mit Zitat antworten Zitat
Benutzerbild von ralfschwalbe
ralfschwalbe

Registriert seit: 19. Jul 2007
Ort: Lichtenstein/Sachsen
133 Beiträge
 
Delphi XE3 Professional
 
#8

AW: TZipFile + SubDirectory

  Alt 17. Apr 2013, 09:57
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".
Ralf Schwalbe
viele Grüße...
  Mit Zitat antworten Zitat
Benutzerbild von stahli
stahli

Registriert seit: 26. Nov 2003
Ort: Halle/Saale
4.343 Beiträge
 
Delphi 11 Alexandria
 
#9

AW: TZipFile + SubDirectory

  Alt 18. Apr 2013, 00:21
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
http://www.StahliSoft.de
---
"Jetzt muss ich seh´n, dass ich kein Denkfehler mach...!?" Dittsche (2004)
  Mit Zitat antworten Zitat
Benutzerbild von stahli
stahli

Registriert seit: 26. Nov 2003
Ort: Halle/Saale
4.343 Beiträge
 
Delphi 11 Alexandria
 
#10

AW: TZipFile + SubDirectory

  Alt 9. Jul 2013, 23:33
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?
Miniaturansicht angehängter Grafiken
zipjobumlaute.png  
Stahli
http://www.StahliSoft.de
---
"Jetzt muss ich seh´n, dass ich kein Denkfehler mach...!?" Dittsche (2004)
  Mit Zitat antworten Zitat
Antwort Antwort
Seite 1 von 3  1 23   

Themen-Optionen Thema durchsuchen
Thema durchsuchen:

Erweiterte Suche
Ansicht

Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 05:27 Uhr.
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz