Zip erstellen über Shell API

[Bbommel]

Hach, tolles Thema hier, man kann es alle paar Tage/Wochen mal wieder aufwärmen.

Ich wollte die hier vorgestellte Lösung, um die Windows-Shell zum Erstellen von ZIPs zu benutzen, auch in ein Programm von mir einbauen. Kleine Besonderheit: Ich will nicht ein ganzes Verzeichnis packen, sondern nur ein paar bestimmte Dateien in diesem Verzeichnis. Setze ich hier in der Unit allerdings den Filter, dann zeigt Windows den Fortschritts-Dialog (zumindest bei mir) nicht mehr an, was ja irgendwie auch blöd ist. Also dachte ich mir: Macht ja nix, bastelst du dir halt selber etwas drumrum, das anzeigt welche Dateien gerade behandelt werden.

Die zentrale Prozedur sieht dann (erstmal) so aus:

Delphi-Quellcode:

procedure ZipFileList (aSrcDir: string; aFilter: string; aDstFile: string);

var myZip: TShellZip;
    formZip: TformZip;
    foundFiles: TStringList;
    findRec: TSearchRec;
    findResult: integer;
    newItem: TListItem;
  I: Integer;

begin
  foundFiles:=TStringList.Create;

  findResult:=FindFirst(aSrcDir+'\'+aFilter,0,findRec);
  while findResult=0 do begin
    foundFiles.Add(ExtractFileName(findRec.Name));
    findResult:=FindNext(findRec);
  end;

  formZip:=TformZip.Create(nil);
  for I := 0 to foundFiles.Count - 1 do begin
    newItem:=formZip.ListFileStatus.Items.Add;
    newItem.Caption:=foundFiles[i];
  end;
  formZip.Show;
  Application.ProcessMessages;

  myZip:=TShellZip.Create;
  myZip.Zipfile:=aDstFile;
  i:=0;
  while (i<=foundFiles.Count-1) and (not formZip.isCancelled) do begin
    formZip.ListFileStatus.Items[i].SubItems.Add('Läuft...');
    myZip.Filter:=foundFiles[i];
    myZip.ZipFolder(aSrcDir);
    formZip.ListFileStatus.Items[i].SubItems[0]:='OK';
    inc(i);
    Application.ProcessMessages;
  end;

  formZip.Free;
  myZip.Free;
  foundFiles.Free;
end;

(das Form hat ein ListView, um die Dateien anzuzeigen, die abgearbeitet werden, und einen Abbrechen-Button)

Läuft eigentlich auch alles total super, außer: Beim allerersten Aufruf von myZip.ZipFoler braucht diese Funktion unglaublich lange, um wieder zurückzukommen, obwohl die Datei schon längst zur Zip-Datei hinzugefügt wurde. Die Funktion hängt recht lange hier rum:

Delphi-Quellcode:

  // wait till all shell threads are terminated
  while NumProcessThreads <> numt do
  begin
    sleep(100);
  end;

Irgendwie braucht es total lange, bis gemerkt wird, dass der Thread beendet wurde. Aber: Nur beim allerersten Aufruf, bei den weiteren Aufrufen kommt die Funktion sofort nach getaner Arbeit zurück.

Hat irgendwer eine Idee, ob man noch etwas dagegen tun könnte?

Danke und bis denn
Bommel

[MarioL]

Hallo Bommel, vielleicht nicht die eleganteste Lösung, aber damit funktioniert es auch beim ersten Aufruf zügig :

Delphi-Quellcode:

procedure TShellZip.ZipFolder(const sourcefolder: WideString);
var
  srcfldr, destfldr: OleVariant;
  shellfldritems: Olevariant;
  numt: integer;
begin
  if not FileExists(zipfile) then
  begin
    CreateEmptyZip;
  end;

  numt := NumProcessThreads;

  if numt = 1 then numt := 2;
// (beim ersten Aufruf numt auf 2 setzen)

...

MfG MarioL

[Bbommel]

Hallo Mario,

bei mir hat das so leider nicht funktioniert. Im Gegenteil: numt wurde auf 2 gesetzt, aber NumProcessThreads ist bei mir eigentlich nie 2 geworden, so dass die Funktion am Ende in einer Endlosschleife festhing.

Aber dein Beitrag hat mich immerhin dazu motiviert, mir das Thema noch ein weiteres Mal näher anzuschauen. Dabei habe ich gesehen, dass auch schon die Befehle GetNameSpaceObj und GetNameSpaceObj_zipfile neue Threads erzeugen, die sich so schnell auch nicht beenden und wahrscheinlich Schuld daran sind, dass die Funktion beim ersten Durchlauf so lange braucht, um zu merken, dass sie fertig ist.

Was ich nun also gemacht habe, ist, die Abfrage numt := NumProcessThreads; soweit nach hinten zu setzen, dass sie erst unmittelbar vor dem CopyHere kommt.

Jetzt läuft es genauso, wie ich mir das erhofft habe, aber ob das nun auch immer unfallfrei passiert, da bin ich mir noch nicht ganz sicher. Ich könnte mir - allerdings ohne viel Ahnung davon zu haben, was da gerade so genau eigentlich passiert - vorstellen, dass sich die Threads, die von z.B. von GetNameSpaceObj erzeugt wurden, beenden, während das zippen noch läuft, wenn bspw. besonders große Dateien gezippt werden. Dann könnte es passieren, dass die Funktion schon zu früh oder auch gar nicht zurückkehrt.

Naja, für meine Zwecke wird es wahrscheinlich reichen...

Hier noch mal die Funktion in der kompletten Fassung:

Delphi-Quellcode:

procedure TShellZip.ZipFolder(const sourcefolder: WideString);
var
  srcfldr, destfldr: OleVariant;
  shellfldritems: Olevariant;
  numt: integer;
begin
  if not FileExists(zipfile) then
  begin
    CreateEmptyZip;
  end;

  shellobj := CreateOleObject('Shell.Application');

  srcfldr := GetNameSpaceObj(sourcefolder);
  if not IsValidDispatch(srcfldr) then
     raise EInvalidOperation.CreateFmt('<%s> invalid source', [sourcefolder]);

  destfldr := GetNameSpaceObj_zipfile;

  shellfldritems := srcfldr.Items;

  if (filter <> '') then
    shellfldritems.Filter(SHCONTF_INCLUDEHIDDEN or SHCONTF_NONFOLDERS or SHCONTF_FOLDERS,filter);

  numt := NumProcessThreads;

  destfldr.CopyHere(shellfldritems, 0);
  sleep(100);


  // wait till all shell threads are terminated
  while NumProcessThreads <> numt do
  begin
    sleep(100);
  end;
end;

Bis denn
Bommel

[MarioL]

Hallo Bommel, das ist auf jeden Fall die elegantere Lösung.

(bei mir erhalte ich als erstes und letztes Result von NumProcessThreads immer 2, egal mit welchen Dateien ich teste)

MfG MarioL

[peschai]

Ergänzende Frage hierzu
Was muss ich im Übergabeparameter "Filter" eingeben um nur eine einzelne Datei (z.b xyz.csv) unzippen.
Mit '*' gehen alle ...
wenn ich 'xyz.csv' angebe wird nichts extrahiert, obwohl die Datei im Archiv vorhanden ist...

Ergänzender Hinweis:
...,WideString('*')); funktioniert
...,WideString('*.csv')); funktioniert nicht

evt. war es etwas zu ungenau:
Mit WinZip erstellte pkzip2.0 kompatible ZIPDatei mit einem verzeichnis und zwei Dateien.
Eine Datei 'xyz.csv' möchte ich unzippen, aber die Filterungs geht nicht ...
...FolderItems.Filter(SHCONTF_NONFOLDERS,WideStrin g('')); FolderItems.Count dann incl Folder
...FolderItems.Filter(SHCONTF_NONFOLDERS,WideStrin g('*')); FolderItems.Count dann ohne Folder
...FolderItems.Filter(SHCONTF_NONFOLDERS,WideStrin g('*.*')); FolderItems.Count ist dann 0 ???????
...FolderItems.Filter(SHCONTF_NONFOLDERS,WideStrin g('*.csv')); FolderItems.Count ist dann 0 ???????
...FolderItems.Filter(SHCONTF_NONFOLDERS,WideStrin g('xyz.csv')); FolderItems.Count ist dann 0 ???????

[peschai]

Kann mir hier jemand helfen ?
Habe es och etwas genauer beschrieben Danke

[peschai]

Kann es ein, daß die Filterfunktion auf einzelne Dateien im Fall von ZIP Dateien nicht richtig funktioniert ?

Wenn ich die Dateien auspacke, und das Verzeichnis angebe anstelle deer ZipDatei dann funktioniert der FILTER wie erwartet.

Kann mir hier jemand helfen ?

[froschprinz]

Hallo,
ich würde gerne dieses Thema gerne noch einmal aufwärmen.

Leider funktioniert es bei mir nicht immer, durch die Anzahl der Threads (NumProcessThreads) das Ende zu erkennen. Manachmal bleibt ein Thread übrig und die Schleife läuft endlos oder es dauert unendlich lange.

Gibt es den keine andere Möglichkeit zu erkennen, ob die Datei schon fertig gezipt wurde????

[Bbommel]

Hallo froschprinz,

hast du meine Variante benutzt (Post #23) oder eine der vorigen Versionen? So, wie ich es hier gemacht habe, läuft es bei mir und meinen Kunden in geschätzten 98 % der Fälle problemlos unter den unterschiedlichsten Windows-Versionen.

Besser habe ich es nicht hinbekommen - CopyHere läuft halt nun mal leider los und gibt keine Rückmeldung mehr.

Wenn du also eine hundertprozentige Lösung brauchst, wirst du wohl um irgendwelche Komponenten nicht drumrum kommen...

Falls es doch noch eine bessere Lösung gibt, wäre ich auch dran interessiert - ich habe trotz langem Suchen und Testen nichts gefunden.

Bis denn
Bommel