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