unit AsyncWithTasks.MainForm;
interface
uses
Winapi.Windows,
Winapi.Messages,
System.Generics.Collections,
System.SysUtils,
System.Variants,
System.Classes,
System.Threading,
System.Types,
Vcl.Graphics,
Vcl.Controls,
Vcl.Forms,
Vcl.Dialogs,
Vcl.ExtCtrls,
Vcl.ComCtrls,
Vcl.StdCtrls;
type
TForm1 =
class(TForm)
Button1: TButton;
ProgressBar1: TProgressBar;
Label1: TLabel;
ListView1: TListView;
Panel1: TPanel;
procedure FormDestroy(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure ListView1Data(Sender: TObject; Item: TListItem);
private
{ Private-Deklarationen }
FSearchDirTask: ITask;
FFiles: TList<
string>;
procedure PresentFiles(
const Files: TStringDynArray);
public
{ Public-Deklarationen }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
uses
System.IOUtils;
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;
procedure TForm1.FormDestroy(Sender: TObject);
begin
if Assigned(FSearchDirTask)
then
FSearchDirTask.Cancel();
FreeAndNil(FFiles);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
FFiles := TList<
string>.Create();
end;
procedure TForm1.Button1Click(Sender: TObject);
var
StartFolder, FilterMaske:
string;
begin
StartFolder := '
Z:\Dokumente';
FilterMaske := '
*.*';
Label1.Caption := '
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
Label1.Caption := 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
end
else
begin
PresentFiles(Files);
end;
Inc(dirIndex);
ProgressBar1.Position := dirIndex;
if dirIndex <= High(Directories)
then
begin
Label1.Caption := '
search in ' + Directories[dirIndex];
FSearchDirTask := TDirectoryUtil.GetFilesAsync(Directories[dirIndex], FilterMaske, TSearchOption.soAllDirectories, filesCompletion);
end
else
begin
Label1.Caption := '
completed';
Button1.Enabled := True;
FSearchDirTask :=
nil;
end;
end);
end;
Label1.Caption := '
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);
begin
FFiles.AddRange(Files);
ListView1.Items.Count := FFiles.Count;
end;
{ 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.