TTask.WaitForAll hängt

[Benmik]

Zitat von Uwe Raabe:

WaitForAll blockiert und blockieren ist nie gut. Dann kann ich den Thread-Code auch gleich im Hauptthread ausführen...

Wer so wie ich Jahre später hier vorbeikommt, auf der Suche nach der Lösung eben jenen Problems, dann sollte man sich auch das kleine Gefecht zwischen Remy Lebeau und David Heffernan auf Stackoverflow anschauen. Tatsächlich ist WaitForAll nicht zwingend blockend, da es eine Überladung mit Timeout-Parameter gibt.

Ich lese in meinem Programm JPG-Dateien ein und lese die EXIF-Daten aus. Das kann bei mehreren Tausend Dateien dauern, weswegen ich jetzt schaue, ob das nicht multithreaded geht. Wie immer ist das Problem die Anzeige des Fortschritts im GUI. Ich habe mir daher einen Versuchsaufbau gebastelt, bei dem ich von 100 größeren Dateien die MD5-Prüfsumme errechne, was meine Kerne für ca. 10 Sekunden gut auslastet, und ich schaue, ob die Fortschrittsanzeige trotzdem funktioniert.

Dabei verstehe ich die damals von Schokohase apodiktisch aufgestellte Behauptung nicht, dass im Mainthread auf TThread.Queue hin nichts passieren soll, wenn man auf Hintergrundthreads wartet. Die Paralleltasks werkeln vor sich hin, der Hauptthread hat nichts zu tun, warum sollte er keine Nachrichten verarbeiten? Das wird er nicht tun, wenn er lahmgelegt ist, aber warum sollte er das sein?

Angeleitet von Dalija Prasnikar habe ich TMessageManager.DefaultManager.SubscribeToMessage entdeckt und daher Folgendes implementiert:

Delphi-Quellcode:

  FProgressID := TMessageManager.DefaultManager.SubscribeToMessage(TProgressMessage,
    procedure(const Sender: TObject; const M: TMessage)
    begin
      FS.Position        := TProgressMessage(M).Percent;
      LabFS.Caption      := TProgressMessage(M).Description;
      LabKopiert.Caption := FormatiereDateigröße(BytesVerarbeitet);
    end);

Das wird bedient von der Methode

Delphi-Quellcode:

procedure   TForm1.SendProgress(APercent: Integer; const ADescription: string);
begin
  TThread.Queue(nil,
    procedure
    begin
      TMessageManager.DefaultManager.SendMessage(nil, TProgressMessage.Create(APercent, ADescription));
    end);
end;

Die Dateien werden aufgelistet und sofort verarbeitet. Die Prozedur BerechneMD5Async spare ich mir hier, sie errechnet MD5 und ruft dabei laufend SendProgress auf, über sie läuft auch das Abbrechen. Angezeigt wird alle Sekunde.

Delphi-Quellcode:

procedure ZeigeMD5Fortschritt(BytesMD5:integer;var Abbruch:Boolean);
begin
  Abbruch := Abbrechen;
  TInterlocked.Exchange(BytesVerarbeitet,BytesVerarbeitet + BytesMD5);
  Form1.LabGesamt.Caption    := FormatiereDateigröße(DatGröße);
  If BytesVerarbeitet = Datgröße then begin
    Form1.SendStopProgress;
  end else if GetTickCount > GTC + 1000 then begin
    GTC := GetTickCount;
    Form1.SendProgress(Round((BytesVerarbeitet / DatGröße) * 100),Format('Bisher %2.0f %% berechnet', [(BytesVerarbeitet / DatGröße) * 100]));
  end;
end;

Das funktioniert absolut.

Delphi-Quellcode:

procedure TForm1.BerechneMD5ATask;
var
  AnzDat:integer;
  Hnd:THandle;
  Data:TWIN32FINDDATAW;
  DatnameMV:string;
const FIND_FIRST_EX_LARGE_FETCH = 2;
  Verz = 'L:\';
begin
  BytesVerarbeitet := 0;
  AnzDat           := 0;
  SetLength(ATasks,16);
  SendStartProgress;
  Hnd := THandle(FindFirstFileExW(PWideChar(Verz + '*'), FindExInfoBasic, @Data, FindExSearchNameMatch, nil, FIND_FIRST_EX_LARGE_FETCH));
  If Hnd <> INVALID_HANDLE_VALUE then begin
    Try
      Repeat
        If (Hnd <> INVALID_HANDLE_VALUE) and (Data.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY <> FILE_ATTRIBUTE_DIRECTORY) then begin
          DatnameMV := TPath.Combine(Verz,string(Data.cFileName));
          Inc(AnzDat);
          If AnzDat > Length(ATasks)
            then SetLength(ATasks,Length(ATasks) * 2);
          ATasks[AnzDat - 1] := TTask.Create(
            procedure begin
              BerechneMD5Async(DatnameMV);
            end);
          ATasks[AnzDat - 1].Start;
        end;
      Until FindNextFile(Hnd, Data) = False;
      While TTask.WaitForAll(ATasks,50) do
        CheckSynchronize(0);
      Form1.SendStopProgress;
    Finally
      SetLength(ATasks,0);
      Winapi.Windows.FindClose(Hnd);
    end;
  end;
end;

Hier kam allerdings jetzt eine Überraschung. Denn das TTask.WaitForAll war bereits nach 1,5 Sekunden passiert, die tatsächliche Verarbeitung dauerte aber noch 8 Sekunden länger. Habe ich nicht verstanden, und auch der Blick in den Quellcode brachte mich nicht weiter.
Bis zur Erleuchtung habe ich daher einfach auf DoWaitForAll verzichtet und stelle das Ende der Operation durch Auswertung der globalen Variablen BytesVerarbeitet und Datgröße fest.

Delphi-Quellcode:

procedure TForm1.BerechneMD5Task;
var
  Hnd:THandle;
  Data:TWIN32FINDDATAW;
  DatnameMV:string;
const FIND_FIRST_EX_LARGE_FETCH = 2;
  Verz = 'L:\';
begin
  DatGröße         := 0;
  BytesVerarbeitet := 0;
  AnzDateien       := 0;
  SetLength(ATasks,100);
  SendStartProgress;
  Hnd := THandle(FindFirstFileExW(PWideChar(Verz + '*'), FindExInfoBasic, @Data, FindExSearchNameMatch, nil, FIND_FIRST_EX_LARGE_FETCH));
  If Hnd <> INVALID_HANDLE_VALUE then begin
    Try
      Repeat
        If (Hnd <> INVALID_HANDLE_VALUE) and (Data.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY <> FILE_ATTRIBUTE_DIRECTORY) then begin
          DatnameMV := TPath.Combine(Verz,string(Data.cFileName));
          TTask.Run(procedure begin
            TInterlocked.Increment(AnzDateien);
            TInterlocked.Exchange(DatGröße,ErmittleDateiGröße(DatnameMV) + DatGröße);
            BerechneMD5Async(DatnameMV);
          end);
        end;
      Until FindNextFile(Hnd, Data) = False;
    Finally
      SetLength(ATasks,0);
      Winapi.Windows.FindClose(Hnd);
    end;
  end;
end;

So, das wird jetzt die alten Hasen hier schwerlich vom Hocker reißen, aber wer weiß, wer in den nächsten vier Jahren hier noch vorbeikommt. Ich jedenfalls war schon unzählige Male für solche Anregungen dankbar.