TTask.WaitForAll hängt

[Smiley]

Ich habe jetzt mal eine Schoko-Version erstellt und angepasst nach der Vorgabe von Schokohase.
Das ganze funktioniert grob ganz gut mit der Ausnahme, dass die Dateien im ersten (ausgewählten) Verzeichnis nicht angezeigt werden.
Weiterhin wird im ListView nur der komplette Dateiname mit Pfad angezeigt und nicht einzeln, wie die ListView1Data Routine vermuten lässt.
Außerdem verstehe ich noch nicht was die ListView1Data Triggert und warum sie nicht nur, einen Eintrag, sondern alle aus FFiles in die ListView schreibt.
Um die Werte auch mal in eine TreeView anzeigen zu können müsste ich doch auch den Subdirectory Level haben, habe aber nur den HauptLevel in DirIndex, wie lässt sich das machen ?

Hier mal mein Code. Habe zwei Units daraus gemacht und möchte noch einiges mehr in die uDirlist auslagern.

Delphi-Quellcode:

unit uMain;

interface

uses
  Winapi.Windows,
  Winapi.Messages,
  System.SysUtils,
  System.Variants,
  System.Classes,
  Vcl.Graphics,
  Vcl.Controls,
  Vcl.Forms,
  Vcl.Dialogs,
  Vcl.ComCtrls,
  Vcl.StdCtrls,
  System.Generics.Collections,
  System.Types,
  System.Threading,
  System.IOUtils;

type
  TForm1 = class(TForm)
    TreeView1: TTreeView;
    Button1: TButton;
    ProgressBar1: TProgressBar;
    StatusBar1: TStatusBar;
    ListView1: TListView;
    ListBox1: TListBox;
    ListBox2: TListBox;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure PresentFiles(const Files: TStringDynArray;DirIndex:Integer);
    procedure ListView1Data(Sender: TObject; Item: TListItem);

  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;
  FSearchDirTask: ITask;
  FFiles: TList<string>;

implementation

{$R *.dfm}

uses uDirlist;

procedure TForm1.FormCreate(Sender: TObject);
begin
  FFiles := TList<string>.Create();
  ListView1.OwnerData := True;
  ListView1.ViewStyle:=vsList;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  if Assigned(FSearchDirTask) then
    FSearchDirTask.Cancel();
  FreeAndNil(FFiles);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  StartFolder, FilterMaske: string;
begin
  StartFolder := 'C:\xampp';
  FilterMaske := '*.*';

  StatusBar1.Panels[0].Text := 'suche Verzeichnisse';
  ListView1.Clear();
  ProgressBar1.Style := pbstMarquee;
  ProgressBar1.Position := 0;
  Button1.Enabled := False;

  FSearchDirTask := TDirectoryUtil.GetDirectoriesAsync(StartFolder, TSearchOption.soTopDirectoryOnly, nil,
    procedure(Directories: TStringDynArray; DirectoriesError: Exception)
    begin
      TThread.Synchronize(nil,
        procedure
        var
          dirIndex: Integer;
          filesCompletion: TProc<TStringDynArray, Exception>;
        begin
          if Assigned(DirectoriesError) then
            begin
              StatusBar1.Panels[0].Text := DirectoriesError.ToString();
              Button1.Enabled := True;
            end
          else
            begin
              ProgressBar1.Max := High(Directories) + 1;
              ProgressBar1.Style := pbstNormal;
              dirIndex := 0;
              filesCompletion := procedure(Files: TStringDynArray; FilesError: Exception)
                begin
                  TTask.CurrentTask.CheckCanceled();

                  TThread.Synchronize(nil,
                    procedure
                    begin
                      if Assigned(FilesError) then
                        begin
                          StatusBar1.Panels[1].Text:='Einlesefehler: '
                        end
                      else
                        begin
                          PresentFiles(Files,DirIndex);
                        end;
                      Inc(dirIndex);
                      ProgressBar1.Position := dirIndex;
                      if dirIndex <= High(Directories) then
                        begin
                          StatusBar1.Panels[0].Text := 'search in ' + Directories[dirIndex];
                          FSearchDirTask := TDirectoryUtil.GetFilesAsync(Directories[dirIndex], FilterMaske,
                            TSearchOption.soAllDirectories, filesCompletion);
                        end
                      else
                        begin
                          StatusBar1.Panels[0].Text := 'completed';
                          Button1.Enabled := True;
                          FSearchDirTask := nil;
                        end;
                    end);
                end;

              StatusBar1.Panels[0].Text := 'search in ' + Directories[dirIndex];
              FSearchDirTask := TDirectoryUtil.GetFilesAsync(Directories[dirIndex], FilterMaske,
                TSearchOption.soAllDirectories, filesCompletion);
            end;
        end);
    end);
end;

procedure TForm1.ListView1Data(Sender: TObject; Item: TListItem);
begin
  Item.Caption := FFiles[Item.Index];
  Item.SubItems.Add(TPath.GetDirectoryName(FFiles[Item.Index]));
  Item.SubItems.Add(TPath.GetFileName(FFiles[Item.Index]));
  Item.SubItems.Add('');
end;

procedure TForm1.PresentFiles(const Files: TStringDynArray;DirIndex:Integer);
 var
 i : integer;

begin
  FFiles.AddRange(Files);
  ListView1.Items.Count := FFiles.Count;
end;

end.

Delphi-Quellcode:

unit uDirlist;

interface
uses
  System.Generics.Collections,
  System.SysUtils,
  System.Variants,
  System.Classes,
  System.Threading,
  System.Types,
  Vcl.Graphics,
  Vcl.Controls,
  Vcl.StdCtrls,
  System.IOUtils,uMain;

  type
  TDirectoryUtil = record
  public
    class function GetDirectoriesAsync(const Path: string; const SearchOption: TSearchOption; const Predicate: TDirectory.TFilterPredicate;const Completion: TProc<TStringDynArray, Exception>): ITask; static;
    class function GetFilesAsync(const Path, SearchPattern: string; const SearchOption: TSearchOption; const Completion: TProc<TStringDynArray, Exception>): ITask; static;
  end;



implementation


{ TDirectoryUtil }

class function TDirectoryUtil.GetDirectoriesAsync(const Path: string; const SearchOption: TSearchOption; const Predicate: TDirectory.TFilterPredicate;
const Completion: TProc<TStringDynArray, Exception>): ITask;
begin
  if not Assigned(Completion) then
    raise EArgumentNilException.Create('Completion');

  Result := TTask.Run(
    procedure
    var
      res: TStringDynArray;
    begin
      res := default (TStringDynArray);
      try
        res := TDirectory.GetDirectories(Path, SearchOption, Predicate);
        Completion(res, nil);
      except
        on E: Exception do
        begin
          Completion(res, E);
          raise;
        end;
      end;
    end);
end;

class function TDirectoryUtil.GetFilesAsync(const Path, SearchPattern: string; const SearchOption: TSearchOption;
const Completion: TProc<TStringDynArray, Exception>): ITask;
begin
  if not Assigned(Completion) then
    raise EArgumentNilException.Create('Completion');

  Result := TTask.Run(
    procedure
    var
      res: TStringDynArray;
    begin
      res := default (TStringDynArray);
      try
        res := TDirectory.GetFiles(Path, SearchPattern, SearchOption);
        Completion(res, nil);
      except
        on E: Exception do
        begin
          Completion(res, E);
          raise;
        end
      end;
    end);
end;

end.