[ThreadHelper] Hilfreiche Erweiterungen für TThread

[chaosben]

TThread.Exec

• Sinn: Mal schnell, ohne großen Aufwand, etwas in einem Extra-Thread ausführen
• Infos:
  • Über die globale Variable ThreadExecManager.MaxRunningThreads kann man bestimmen, wie viele Exec-Threads gleichzeitig laufen dürfen
  • Innerhalb der Thread-Funktion/Prozedur kann man über
    Delphi-Quellcode:

    MyExecThread

    den eigenen Thread referenzieren
• Beispiele:
  
  Delphi-Quellcode:

  //wartet 1 Sekunde und zeigt dann synchronized die Box an
  TThread.Exec(procedure begin Sleep(1000); end, 
               procedure begin ShowMessage('1 Sekunde gewartet'); end, 
               true);
  
  
  //Führt die Funktion "EineLangeBerechnung" threaded aus und gibt deren Resultat synchronized an "ZeigeResultat" weiter
  function EineLangeBerechnung: Int64;
  begin
    Result := 1;
  end;
  
  procedure ZeigeResultat(AResult : Int64);
  begin
    ShowMessage(IntToStr(AResult));
  end;
  
  procedure TForm1.Button1Click(Sender: TObject);
  begin
    TThread.Exec<Int64>(EineLangeBerechnung, ZeigeResultat, true);
  end;
  
  
  //Eine TNotify-Prozedur threaded aufrufen
  procedure TForm1.Button1Click(Sender: TObject);
  begin
    if GetCurrentThreadId = MainThreadID then
      ShowMessage('Click')
    else
      ShowMessage('Du altes Ferkel! Du greifst mit Thread ' + IntToStr(MyExecThread.ThreadID) + ' auf die VCL zu!');
  end;
  
  procedure TForm1.Button2Click(Sender: TObject);
  begin
    TThread.Exec(Button1Click, nil, procedure begin Caption := 'Klick erledigt'; end);
  end;
  
  
  //sucht rekursiv alle Dateien unterhalb eines Ordners, fügt die gefundenen Dateien in 
  //eine Listbox ein und zeigt die aktuelle Anzahl in der Caption des Forms and
  procedure CallBack(AList : TStringList);
  begin
    Form61.ListBox1.items.BeginUpdate;
    try
      Form61.ListBox1.items.AddStrings(AList);
    finally
      Form61.ListBox1.items.EndUpdate;
      AList.Free;
    end;
  
    Form61.Caption := IntToStr(Form61.ListBox1.Items.Count);
  end;
  
  function Search(ADir : String) : TStringList;
  var
    sr : TSearchRec;
    lst : TStringList;
  begin
    lst := TStringList.Create;
  
    if FindFirst(ADir + '\*.*', faAnyFile, sr) = 0 then
    begin
      repeat
        if (sr.Name <> '.') and (sr.Name <> '..')  then
        begin
          if faDirectory and sr.Attr = faDirectory then
          begin
            MyExecThread.Synchronize(MyExecThread, procedure begin CallBack(lst) end);
            lst := Search(ADir + '\' + sr.Name);
          end
          else
            lst.Add(ADir + '\' + sr.Name);
        end;
      until FindNext(sr) <> 0;
      FindClose(sr);
    end;
  
    Result := lst;
  end;
  
  procedure TForm61.Button4Click(Sender: TObject);
  begin
    tthread.Exec<TStringList>(function : TStringList 
                              begin 
                                Result := Search('c:\Program Files'); 
                              end, CallBack);
  end;
  
  
  //sucht rekursiv alle Dateien unterhalb eines Ordners wobei jeder Ordner von einem eigenen Thread durchsucht wird
  //zugegebenermaßen wird das Suchen durchs Multithreading nicht wirklich schneller ... aber man kanns ja mal versuchen :)
  procedure CallBack(AList : TStringList);
  begin
    //Dateiliste weiterverabeiten
  
    Alist.Free;
  end;
  
  function Search(ADir : String) : TFunc<TStringList>;
  begin
    Result := function : TStringList
              var
                sr : TSearchRec;
              begin
                Result := TStringList.Create;
                if FindFirst(ADir + '\*.*', faAnyFile, sr) = 0 then
                begin
                  repeat
                    if (sr.Name <> '.') and (sr.Name <> '..')  then
                    begin
                      if faDirectory and sr.Attr = faDirectory then
                        tthread.Exec<TStringList>(Search(ADir + '\' + sr.Name), CallBack)
                      else
                        Result.Add(ADir + '\' + sr.Name);
                    end;
                  until FindNext(sr) <> 0;
                  FindClose(sr);
                end;
              end;
  end;
  
  procedure TForm1.Button1Click(Sender: TObject);
  begin
    TThread.Exec<TStringList>(Search('c:\temp'), CallBack);
  end;

Entwickelt und getestet mit D2009. Weitere Ideen sind willkommen.

Download der aktuellesten Version