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