![]() |
TTask.WaitForAll hängt
Ich versuche mein Mainform beweglich zu halten, nachdem ich ein Programm starte, das sehr lange zum fertigstellen braucht.
Daher habe ich das Programm in einem TTask in den Hintergrund geschickt. Das Problem ist nur, dass ich abfragen muss, wann der Prozess beendet ist. Es wird immer wieder beschrieben, dass man mit WaitFoAll auf die Beendigung aller Tasks warten kann. Das funktioniert bei mir aber nicht, er bleibt in der WaitForAll Abfrage für immer stecken. Daher habe ich es mit einer separaten Variable gemacht um die Beendigung abzufragen, das funktioniert auch. Aber warum funktioniert das WaitForAll bzw. WaitForAny nicht, das ist dafür doch gedacht ??? Hier mein Code:
Delphi-Quellcode:
Wenn ich das WaitforAll rausnehme funktioniert alles wie gewünscht.
Verz: String;
j, AktLine: Integer; StartFolder, ProgPath: String; StartTime: TTime; LTaskRun: boolean; tasks: array of ITask; implementation {$R *.dfm} // ***************************************************************************** procedure TForm1.Button1Click(Sender: TObject); var lstatus: boolean; begin lStatus:=False; LTaskRun := true; Setlength(tasks, 1); tasks[0] := TTask.Create( procedure begin DirList; end); tasks[0].Start; lstatus := TTask.WaitForAll(tasks); ShowMessage('Nach WaitAll'); repeat application.ProcessMessages; until not LTaskRun; end; Einen 2ten Task aufmachen versuche ich erst wenn ich es mit einem vernüftig hinbekommen habe. Dann kommt auch noch das Sychronize mit rein. Ein Schritt nach dem anderen. Wärend im Hintergrund eine Liste in einem Grid eingfügt wird oder in eine DB, soll das Hauptfenster nicht "Programm ausgelastet" anzeigen und noch verschiebbar sein. |
AW: TTask.WaitForAll hängt
Ich kenne mich mit Tasks nicht so aus, aber wenn der Task so wie so schon im Hintergrund läuft, wozu die Schleife mit dem ProcessMessages?
|
AW: TTask.WaitForAll hängt
Weil ich wissen will wann der Task beendet ist.
Besser wäre es natürlich ich bekäme einen event der mir sagt, dass der Task fertig ist. Das ist aber erst der nächste Schritt. wie das geht habe ich noch nicht gefunden. |
AW: TTask.WaitForAll hängt
So ganz konkret kann ich jetzt nicht helfen, aber hier mal 3 Videos zu Threads & Co:
![]() ![]() ![]() Im ersten sind Tasks explizit mit als Thema aufgeführt. (Werde ich mir auch gleich nochmal anschauen. Ich war sowieso gerade auf der Suche nach interessanten Programmier-Videos. :-) ) |
AW: TTask.WaitForAll hängt
Also Wait heißt übersetzt Warten und genau das passiert.
Der Aufruf WaitForAll oder WaitForAny ist blockierend. Diese Repeat Schleife kannst du ersatzlos streichen, denn wenn du da hin kommst dann ist schon alles vorbei. |
AW: TTask.WaitForAll hängt
Das ist schon klar Schokohase, dafür war es auch gedacht, das Repeat habe ich lediglich nicht gelöscht, aber dorthin komme ich ja nie, genau das ist ja das Problem.
Das WaitForAll wartet eben unendlich, auch wenn der Task lange abgelaufen ist, zum Reppeat komme ich ja gar nicht. Danke Stahli für die Links, das erste Video von Bernd Ua kannte ich noch nicht, das ist ganz gut. Das von Daniel war auch gut beschäftigt sich aber hauptsächlich nur mit dem Deadlock und Synchronize, bei Bernd Ua ist etwas mehr Code zu sehen. |
AW: TTask.WaitForAll hängt
Zitat:
|
AW: TTask.WaitForAll hängt
Zum showmessage komme ich nicht, da er ja in waitforall hängen bleibt.
Man könnte hier zu beginn von der Clickroutine den Butto auf disabled stellen und nach waitforall auf enabled, dann erkennt man einen Sinn in der Abfrage |
AW: TTask.WaitForAll hängt
procedure TForm1.Button1Click(Sender: TObject);
var lstatus: boolean; begin lStatus:=False; LTaskRun := true; Setlength(tasks, 1); Button1.enabled:=False; tasks[0] := TTask.Create( procedure begin DirList; // Hier ist das Prgramm das lange braucht und im Hintergrund läuft end); tasks[0].Start; lstatus := TTask.WaitForAll(tasks); // Hier kommt man nie hin. Button1.enabled:=True; end; |
AW: TTask.WaitForAll hängt
Habe mir jetzt alle Videos angesehen,
Das zeite Video von Olaf Monien ![]() Das dritte von Daniel Wolf ist auch sehr gut (kannte ich schon) beschreibt aber mehr nur die Problematik Synchronisierung und der Deadlock vermeidung. Danke Stahli für die Links Ich weiß zwar noch nicht warum das mit dem WaitforAll nicht funktioniert, vermute aber dass es an einer anderen Stelle eingesetzt wird und normalerweis so auch nicht benutzt wird. Davon ist in den Videos auch nicht die Rede. |
AW: TTask.WaitForAll hängt
Bleibt eventuell DirList hängen? Wie sieht der Code dazu aus?
|
AW: TTask.WaitForAll hängt
Nein, wenn ich das WaitForAll weglasse funktioniert alles problemlos.
|
AW: TTask.WaitForAll hängt
Hallo,
wenn ich es richtig gelesen habe wird ja auch nur ein Task gestartet. |
AW: TTask.WaitForAll hängt
Ohne den Code von
Delphi-Quellcode:
zu kennen, können wir nur mutmassen.
DirList
Es könnte sich hier um einen DeadLock handeln, der durch das Blockierende Verhalten
Delphi-Quellcode:
zum Tragen kommt und es dann funktioniert wenn das Besagte eben entfernt wird.
TTask.WaitForAll
Wird irgendwo von
Delphi-Quellcode:
ein
DirList
Delphi-Quellcode:
aufgerufen? Dann ist das die Ursache für den DeadLock.
TThread.Synchronize
Zitat:
|
AW: TTask.WaitForAll hängt
[QUOTE=Schokohase;1443023]Ohne den Code von
Delphi-Quellcode:
zu kennen, können wir nur mutmassen.
DirList
wie geschrieben, falsch gelesen. Gruß |
AW: TTask.WaitForAll hängt
Zitat:
Zitat:
Du hast also richtig gelesen. Aber wo soll da das Problem sein? |
AW: TTask.WaitForAll hängt
Zitat:
Oder meinst Du, daß die Oberfläche nicht einfriert und irgendwann die gewünschten Daten zur Verfügung stehen? Da ich TTask nicht kenne kann ich nur beschreiben wie ich das mit TTHread gelöst hätte. Da wird als letzte Aktion vor dem selbstmord des Threads eine "Endmessage" gesandt. dann weiß das Programm, daß ein Thread beendet wurde und gut ist. Gruß K-H |
AW: TTask.WaitForAll hängt
Hier die DirList Routine.
Wenn nur ein Task läuft, wo soll dann ein Deadlock eintreten ??? Das WaitForAll wird in dem Beispiel von Embarcadero verwendet und ich wollte es benutzen um nicht mit einem eigene Flag arbeiten zu müssen. Kann ich dann mal ein Beispiel mit EndMessage sehen ?
Delphi-Quellcode:
// *****************************************************************************
procedure TForm1.DirList; var // SearchResult MainVerz: TStringDynArray; SearchResult: TStringDynArray; FilterMaske: String; I: Integer; begin StartFolder := '\\SCHLUPP\Praktikant\Delphi\Tutorial\'; // Filter für *.pdf, *.docx,... FilterMaske := '*.*'; // Grid.StartUpdate; GridInit; AktLine := 1; ListBox1.clear; // Uses IOUtils für GetDir..und System.Types für DynArray hinzufügen // Alle Hauptverzeichnisse einlesen und dann pro Verz. eine Suche ausführen in eigenem Thrad StartTime := Now(); MainVerz := TDirectory.GetDirectories(StartFolder, TSearchOption.soTopDirectoryOnly, nil); Form1.ProgressBar1.Max := high(MainVerz); qV.Open; for j := 0 to High(MainVerz) do begin ListBox1.Items.Add(MainVerz[j]); try Begin // Einlesen der Dateien ab dem Verz[j] SearchResult := TDirectory.GetFiles(MainVerz[j], FilterMaske, TSearchOption.soAllDirectories); for I := 0 to High(SearchResult) do begin if SearchResult[I] <> '' then begin // grid.Cells[1, AktLine] := ExtractFilename(SearchResult[I]); // grid.Cells[2, AktLine] := ExtractFilePath(SearchResult[I]); qV.append; qV.FieldByName('Verzeichnis').AsString := ExtractFilePath(SearchResult[I]); qV.FieldByName('Datei').AsString := ExtractFileName(SearchResult[I]); qV.FieldByName('Kategorie').AsString := ''; qV.Post; inc(AktLine); end; end; ListBox1.Items.Add('Task ' + IntToStr(j) + ' Zeit: ' + FormatDateTime('hh:nn:ss:zzz', Now - StartTime)); StartTime := Now(); ListBox1.Refresh; End; except // Catch the possible exceptions MessageDlg('Incorrect path or search mask', mtError, [mbOK], 0); Exit; end; Form1.ProgressBar1.Position := j; end; LTaskRun := false; end; |
AW: TTask.WaitForAll hängt
Ein Task, der in einem Thread läuft und der MainThread sind bei mir zwei Threads.
Aber du weißt das anscheinend besser und da kann ich natürlich nicht helfen. Entschuldige die Störung. |
AW: TTask.WaitForAll hängt
Moin...8-)
Zitat:
Zitat:
Delphi-Quellcode:
Jetzt rächt sich wieder einmal RAD. Jede procedure kennt alle Units / Controls. :wink:
for j := 0 to High(MainVerz) do
begin ListBox1.Items.Add(MainVerz[j]); // ListBox: niemals aus einem Thread auf das Control zugreifen. Nur mit Synchronize über ein Event! try Begin // Einlesen der Dateien ab dem Verz[j] SearchResult := TDirectory.GetFiles(MainVerz[j], FilterMaske, TSearchOption.soAllDirectories); for I := 0 to High(SearchResult) do begin if SearchResult[I] <> '' then begin // grid.Cells[1, AktLine] := ExtractFilename(SearchResult[I]); // grid.Cells[2, AktLine] := ExtractFilePath(SearchResult[I]); qV.append; qV.FieldByName('Verzeichnis').AsString := ExtractFilePath(SearchResult[I]); qV.FieldByName('Datei').AsString := ExtractFileName(SearchResult[I]); qV.FieldByName('Kategorie').AsString := ''; qV.Post; inc(AktLine); end; end; ListBox1.Items.Add('Task ' + IntToStr(j) + ' Zeit: ' + FormatDateTime('hh:nn:ss:zzz', Now - StartTime)); / // ListBox: niemals aus einem Thread auf das Control zugreifen. Nur mit Synchronize über ein Event! StartTime := Now(); ListBox1.Refresh; End; except // Catch the possible exceptions MessageDlg('Incorrect path or search mask', mtError, [mbOK], 0); Exit; end; Form1.ProgressBar1.Position := j; // Form: niemals aus einem Thread auf die Form zugreifen. Nur mit Synchronize über ein Event! end; LTaskRun := false; end; |
AW: TTask.WaitForAll hängt
Zitat:
Zitat:
Zitat:
Delphi-Quellcode:
NICHT aufgerufen wird).
TThread.Synchronize
Aber vielleicht habe ich ja auch von deutscher Sprache einfach keine Ahnung. Dann entschuldige ich mich auch hier für die Störung. |
AW: TTask.WaitForAll hängt
Zitat:
|
AW: TTask.WaitForAll hängt
Hmm....
Zitat:
Und da haben wir deinen DEADLOCK... Es wird in DirList auf eine 'visuelle' Komponente zugegriffen, welche 'Messages' generiert und auf dessen Ausführung wartet! Die Komponente ist die ListBox1 (sowie auch der ProgressBar1)! (beim Clear und bei jedem Add werden Messages generiert, auf dessen Result die ListBox 'wartet' (per SendMessage)) Da dessen Messages im MainThread (Ersteller der ListBox) verarbeitet werden, dieser jedoch mit WaitForAll wartet und keine Messages bearbeiten kann, bleibt die App in einem Deadlock hängen!!! Baue deine Procedure DirList so um, dass die Sammlung der Informationen (Dateinamen..) in einer eigenen 'nicht visuellen' Liste (z.B. TObjectList mit je einem eigenen Objekt je Dateinamen) gesammelt werden und erst nach dem Durchlauf und außerhalb des Tasks visualisiert wird.. |
AW: TTask.WaitForAll hängt
Hmm..
Ach ja, und wenn Du es umbaust, dass verwende eventuell ein TThread, nicht TTask.. Ein TThread hat ein 'OnTerminate' Event, welches bereits mit dem MainThread synchronisiert aufgerufen wird. Wenn diese (abgeleitete) TThread eine Property mit der Objektliste deiner Dateieinträge hat, kannst Du dann darauf zugreifen und deine ListBox füllen. Der TThread hat auch ein WaitFor, welches Du dann aber nicht brauchst.. |
AW: TTask.WaitForAll hängt
Zitat:
Delphi-Quellcode:
TTask.Run(
procedure begin DirList; TThread.Queue(nil, procedure begin // tue was, nachdem DirList beendet wurde end; end); Das löst aber natürlich nicht das Problem mit den Zugriffen auf VCL-Objekte innerhalb DirList. Da steckt vermutlich noch der größte Aufwand bevor das threadsicher wird. |
AW: TTask.WaitForAll hängt
Zitat:
Gruß K-H |
AW: TTask.WaitForAll hängt
Zitat:
Es sind aber ja nicht nur die GUI-Objekte ListBox1 und ProgressBar1 (diese Namen :stupid:), die aus dem Thread angesprochen werden. Neben des DataSet qV sind da auf den ersten Blick noch StartFolder, GridInit, AktLine und StartTime - das LTaskRun sollte mit dem Ansatz eigentlich obsolet sein. Die ganze Routine ist sowas von thread-untauglich, daß ich gar nicht weiß, wo ich anfangen soll. Solange hier nicht ein tieferes Verständnis bezüglich Thread-Sicherheit von Code aufgebaut wird, würde ich von solchen Threading-Abenteuern absehen. |
AW: TTask.WaitForAll hängt
Wow, Du hast wirklich besser gelesen als ich (qv ist mir vollständig durch die Lappen gegangen).
Hättest Du denn eine Quelle für das notwendige Wissen? (Auch ich würde mein zusammen gestoppeltes Wissen gerne abrunden) Gruß K-H |
AW: TTask.WaitForAll hängt
Zitat:
|
AW: TTask.WaitForAll hängt
Zitat:
(Ernst gemeinte Frage, ich weiß das wirklich nicht, ich habe TTask noch nie verwendet.) |
AW: TTask.WaitForAll hängt
Zitat:
Delphi-Quellcode:
zu tun!
TTask
Jeder Task wird von einem Thread ausgeführt und darum gelten die gleichen Spielregeln wie bei einem Thread. Man muss hier allerdings folgendes beachten:
Delphi-Quellcode:
fügt den Code in eine Warteschlange, die erst dann abgearbeitet wird, wenn es zu einer Synchronisation mit dem MainThread kommt.
TThread.Queue
Wenn man also im MainThread auf einen oder mehrere Threads wartet, dann passiert bei
Delphi-Quellcode:
erstmal gar nichts. Erst wenn der/die Thread/s beendet sind (auf den/die da gewartet wurde) dann erfolgt das was man per
TThread.Queue
Delphi-Quellcode:
machen wollte.
TThread.Queue
Am besten ist es wenn man im MainThread NIEMALS auf einen Thread wartet. Die Ausnahmen von dieser Regel sollten sehr spärlich sein, sonst drohen eben DeadLocks oder seltsame Verhalten. Und das es anders geht zeige ich mal mit einem kleinen Beispiel.
Delphi-Quellcode:
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. |
AW: TTask.WaitForAll hängt
Zitat:
|
AW: TTask.WaitForAll hängt
Danke für die Erklärung Schokhase.
Aber muss das unbedingt in GROSSBUCHSTABEN und rot sein? Ich habe dann immer das Gefühl, Du willst allen zeigen, wie dumm ich doch bin. Das wissen die aber doch alle schon! |
AW: TTask.WaitForAll hängt
Zitat:
Es ist also ein Service. |
AW: TTask.WaitForAll hängt
Bitte sachlich und beim Thema bleiben.
|
AW: TTask.WaitForAll hängt
Ich hatte heute Morgen meinen Code noch mit Synchronize abgesichert und es lief auch ganz gut, dann musste ich weg.
Jetzt schaue ich hier ins Forum und sehe das Beispiel von Schokohase (unit AsyncWithTasks.MainForm). Die einzelnen Verzeichnisse in Striglisten zu speichern und dann an den MainThread weiterzugeben hatte ich für später auch schon geplant, wollte aber erst mal klein anfangen, was, wie man sieht, nicht sinnvoll ist. Im Schokohasen Beispiel ist ja schon ziemlich alles drin was ich insgesamt erreichen wollte. Höchstens nochmal versuchen ob Pooling (task.Queue) noch was bringt. Wenn ich das richtig verstehe, wird ein FSearchDirTask := TDirectoryUtil.GetDirectoriesAsync aufgemacht der dann rekursiv durch die Verzeichnisse geht und pro Verzeichnist dann eine Stringliste an den Mainthread übergibt (PresentFiles(Files)). Das "filesCompletion: TProc<TStringDynArray, Exception>;" muss ich mir noch genauer ansehen um das errorhandling zu verstehen und wie ich das verarbeite. Ist "FFiles: TList<string>;" eine TStringlist ? Diese Schreibweise kenne ich noch nicht. Dann fange ich am besten nochmal von vorne an, indem ich den SchokohasenThread als Vorlage benutze. Danke Schokohase für den kompletten benutzbaren Code. Ein Beispiel sagt mir mehr als viele Diskussionen. Melde mich wieder, wenn ich es umgesetzt habe. |
AW: TTask.WaitForAll hängt
Das "FFiles: TList<string>;" habe ich mir mal nachgeschlagen, ist eine TList Klasse, damit habe ich bisher nicht gearbeitet, scheint sehr nützlich zu sein.
Ist das von der Geschwindigkeit nur unbedeutend langsamer als eine Striglist oder DynArray ? Wenn ich es richtig verstehe wird mit jedem Verzeichnis die TList erweitert und enthält am Ende alle Files mit Verzeichnisname ? In "PresentFiles" wird dem Treview immer wieder die,zu diesem Zeitpunkt, gesamte Liste zugewiesen, ist das richtig ? |
AW: TTask.WaitForAll hängt
Zitat:
Womöglich sowas wie Aufteilung einer Aufgabe in mehrere Threads, und dann warten bis alle Fertig sind. Ich würde aber auch dafür eigentlich nicht im MainUI darauf warten wollen. Oder hast Du dafür ein besonderes Beispiel, wo man im UT Thread warten MUSS ? P.S. rot und fett finde ich gut. Weiter so, damit der Blick beim Wesentlichen bleibt :thumb: |
AW: TTask.WaitForAll hängt
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. |
AW: TTask.WaitForAll hängt
Die Antwort auf meine Frage TTask.WaitForAll wird in dem Kurs von Olaf Monien sehr gut erklärt:
Delphi CE Bootcamp 2018 Week 7 - Threading and Performance Tuning with Olaf Monien Part 3 etwa bei 40 bis 47 Minuten dort wird auch der Sinn dieses Befehls erklärt, in bestimmten Situationen. Das war die Antwort die ich finden wollte. |
Alle Zeitangaben in WEZ +1. Es ist jetzt 21:38 Uhr. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz