AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Thema durchsuchen
Ansicht
Themen-Optionen

TZipFile + SubDirectory

Ein Thema von stahli · begonnen am 15. Apr 2013 · letzter Beitrag vom 29. Apr 2016
 
Benutzerbild von stahli
stahli

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

AW: TZipFile + SubDirectory

  Alt 17. Apr 2013, 23: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
 


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 07:38 Uhr.
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz