Verständnisfrage zur Thread-Synchronisation

[EdAdvokat]

Hallo zusammen,
ich beschäftige mich vermutlich mit mäßigem Erfolg mit Threads und habe dazu ein Beispiel hier aus dem Forum ausgewählt, dass unlängst hier diskutiert wurde.
https://www.delphipraxis.net/210313-...d-starten.html
Ich habe also das von #Sinspin gepostete Beispiel für mich zum Verständnis ausgewählt.
Da wird also ein Haupt-Thread erzeugt, in dem eine Schleife bis 100 zählt und diese dann an ein Counter.Label sendet.
Als weiterer Thread wird ein Activityindicator erzeugt. Beide Threads laufen parallel.
Nun wollte ich das Beispiel erweitern und einen weiteren Hintergrund-Thread hinzufügen und erhalte folgenden Effekt:
Der 2. Thread mit einem weiteren Activityindicator und einer Schleife, die bis 70 zählt wird sofort ausgeführt (zählt bis 70 und 2. Activityindicator wird angezeigt).
Ebenfalls parallel wird der 1. Activityindicator ausgeführt.
Erst wenn die 70-ger-Schleife (2.Thread) abgearbeitet wurde startet die Schleife bis 100 (Haupt-Thread) und beide Activityindicatoren werden parallel angezeigt.
Ist das so richtig?
Wie muß man ein Konstrukt mit einem Haupt-Thread und zwei weiteren Threads bauen? Ich bin da so völlig unbedarft und taste mich an die ominösen Threads erst heran.
Die hier oft diskutierten Beispiele sind mir oft zu kompliziert um nur das Wesen der Threads zu begreifen und natürlich auch deren Synchronisation.
Nun noch mein Erweiterungs-Konstruckt auf 2 Threads neben dem Haupt-Thread:

Delphi-Quellcode:

unit Unit1;

interface
uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Threading,
  System.Classes, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls,
  Vcl.WinXCtrls, Vcl.ExtCtrls;

type
  TheThread = class(TThread)
  private
    procedure DoIt;
  public
    procedure Execute; override;
  end;

type
  TheThread2 = class(TThread)
  private
    procedure DoIt2;
  public
    procedure Execute; override;
  end;

type
  TForm1 = class(TForm)
  actvtyndctr1: TActivityIndicator;
  CounterLabel: TLabel;
  StartThreadBtn: TButton;
  btnclose: TButton;
    lblDoit2: TLabel;
    actvtyndctr2: TActivityIndicator;
    lblThread2: TLabel;
    lblThread1: TLabel;
    bvl1: TBevel;
    lblHauptThread: TLabel;
  procedure StartThreadBtnClick(Sender: TObject);
  procedure btncloseClick(Sender: TObject);
  private
    { Private-Deklarationen }

  public
    { Public-Deklarationen }

  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{ TheTread1 }

procedure TheThread.DoIt;
begin
  Form1.actvtyndctr1.Animate := true;
end;

procedure TheThread.Execute;
begin
  Synchronize(DoIt);
end;

{ TheTread2 }

procedure TheThread2.DoIt2;
var i: int32;
begin
  Form1.actvtyndctr2.Animate:= True;

  for i := 0 to 70 do
  begin
      Form1.lblDoIt2.Caption := I.tostring;
      Application.ProcessMessages;
      Sleep(30);
    end;

end;

procedure TheThread2.execute;
begin
  inherited;
  Synchronize(DoIt2);
end;

procedure TForm1.btncloseClick(Sender: TObject);
begin
  Close;
end;

procedure TForm1.StartThreadBtnClick(Sender: TObject);
var
  Thread: TheThread;
  Thread2: TheThread2;
  I: integer;
begin
  try
    // Thread starten
    Thread := TheThread.Create(True);
    Thread.FreeOnTerminate := true;
    Thread.Start;

    Thread2:=TheThread2.Create(True);
    thread2.FreeOnTerminate:=True;
    thread2.Start;

    //  Hauptthread Zählt bis 100 u. gibt Ergebnis aus
    for I := 0 to 100 do
    begin
      Form1.CounterLabel.Caption := I.tostring;
      Application.ProcessMessages;
      Sleep(50);
    end;
    Form1.actvtyndctr1.Animate := false;
    Form1.actvtyndctr2.Animate := false;
  except
    on E:Exception do
    begin
      Form1.actvtyndctr1.Animate := false;
      Form1.actvtyndctr2.Animate := false;
    end;
  end;
end;
end.

Anbei das Beispielprogramm

[DieDolly]

Zitat:

Erst wenn die 70-ger-Schleife (2.Thread) abgearbeitet wurde startet die Schleife bis 100 (Haupt-Thread) und beide Activityindicatoren werden parallel angezeigt.
Ist das so richtig?

Eigentlich sollte die Schleife bis 100 sofort loslegen wenn der 2. Thread gestartet wurde.
Wenn das so funktionieren soll, wie du oben beschreibst, dann braucht man ja keinen Thread und kann alles nacheinander abarbeiten.

Außerdem würde ich

Delphi-Quellcode:

Form1.actvtyndctr2.Animate := false;

nicht da stehen lassen wo es steht.
Das soll da aufgerufen werden, wo auch der Thread seine Arbeit erledigt hat. Also im Thread selber und nicht außerhalb.

Dein Beispiel ist nicht gut, ich würde das wegschmeißen und was Vernünftiges suchen.

[BerndS]

Was dir anschließend noch nicht klar ist:
1. Im Execute macht man das,was zu tun ist.
Also for... Slepp usw.
2. Per synchronise erfolt der Zugriff auf die Vcl und hier kein Sleep!
3. Application.ProcessMessages sollte bzw. darf weder im Excecute noch in den per
Synchronise abgerufenen Methoden verwendet werden.
4. Eine Exception Behandlung muss im Execute erfolgen.

Ich bin grade an Tablett und kann daher kein Beispiel machen, wie es sinnvoll wäre.

[Phoenix]

Dazu ist ein klein wenig wichtig zu wissen, wie sich Windows verhält wenn man Threads startet.

Ein Thread der erzeugt wird wird, wenn man ihn Starten möchte, nicht sofort gestartet. Die Windows-API sagt dem Thread lediglich, dass er jetzt loslaufen kann, und der Windows-Scheduler kann ihn dann (muss ihn aber nicht sofort) beim nächsten mal wenn er arbeitet berücksichtigen und auf die CPU legen.

Das passiert frühestens(!) wenn der Haupt-Thread Deiner Anwendung yielded (das bedeutet: Rechenzeit abgibt). Warum das passiert (seine Zeitscheibe / Quantum ist abgelaufen, er blockiert wegen I/O, er gibt mit Sleep freiwillig Rechenzeit ab) ist dabei egal, aber der zweite Thread kommt eben frühestens das erste mal auf die CPU wenn der Hauptthread frei macht.

Auch danach kannst Du bei mehreren Threads nicht sicher sein, dass die wirklich Zeitgleich laufen. Es kann passieren, dass der Windows-Scheduler die Threads alle schön nacheinander ausführt.

Auch wichtig: Nur der UI-Thread kann das UI aktualisieren. Wenn der gerade nicht läuft wenn die anderen beiden Threads werkeln, bekommt das UI das nicht mit. Und da Du den im Prinzip mehr schlafen legst als das er Rechnet (Sleep-Aufrufe) kann der nicht viel machen.

Noch ein Wort zu den Quantums: Eine Zeitscheibe auf der CPU sind bei Windows aktuell vermutlich irgendwas zwischen 20 und 60 Millisekunden ( siehe auch: https://medium.com/@dikrek/processor...x-fb5ab02828e2 ). Nehmen wir mal Beispielhaft 30 an. Wenn der Thread jetzt z.B. nur eine Millisekunde rechnet und Du dann Sleep aufrufst, verwirfst Du den kompletten Rest Deiner Zeitscheibe. Das bedeutet der Scheduler nimmt den von der CPU runter und er kommt frühestens nach 29 Millisekunden wieder dran. Auch wenn Du nur 5ms Schlafen willst.

Will heissen: Mit Deinen extrem kurzen Cyclen (einfache Schleifen) und aus CPU-Sicht extrem vielen und langen Wartezeiten ärgerst Du gerade mehr den Windows-Scheduler als rauszufinden was wirklich passiert ;)

[Phoenix]

Zitat:

Zitat von BerndS (Beitrag 1504495)

4. Eine Exception Behandlung muss im Execute erfolgen.

Oh, auch hier vielleicht wichtig als Hintergrundinfo: Ein "Feature" von Windows ist es, bei einer unbehandelten(!) Exception in einem Sub-Thread immer gleich den kompletten Prozess zu terminieren. Und zwar sofort. Throw -> alle Fenster weg. Du kannst in dem Moment nicht mehr reagieren. Noch nichtmal loggen. Deswegen ist es sauwichtig das jeder von Dir erzeugte Thread entweder ganz sicher keine Exception werfen kann oder idealerweise die komplette Ausführung in einer try/catch - Anweisung läuft. Sonst: Plopp :lol:

[shebang]

Zitat:

Zitat von Phoenix (Beitrag 1504501)

Wenn der Thread jetzt z.B. nur eine Millisekunde rechnet und Du dann Sleep aufrufst, verwirfst Du den kompletten Rest Deiner Zeitscheibe. Das bedeutet der Scheduler nimmt den von der CPU runter und er kommt frühestens nach 29 Millisekunden wieder dran. Auch wenn Du nur 5ms Schlafen willst.

Auf aktuellen Multikernprozessoren stimmt das höchstens dann, wenn alle Kerne komplett ausgelastet sind und die Threads um Prozessorzeit konkurrieren. Ansonsten, wenn du einen Thread 5 ms schlafen legst, dann ist er nach 5-6 ms wieder wach und arbeitet weiter.

[Stevie]

Zitat:

Zitat von Phoenix (Beitrag 1504502)

Oh, auch hier vielleicht wichtig als Hintergrundinfo: Ein "Feature" von Windows ist es, bei einer unbehandelten(!) Exception in einem Sub-Thread immer gleich den kompletten Prozess zu terminieren. Und zwar sofort. Throw -> alle Fenster weg. Du kannst in dem Moment nicht mehr reagieren. Noch nichtmal loggen. Deswegen ist es sauwichtig das jeder von Dir erzeugte Thread entweder ganz sicher keine Exception werfen kann oder idealerweise die komplette Ausführung in einer try/catch - Anweisung läuft. Sonst: Plopp :lol:

Wie gut, dass der Code in der RTL das schon übernimmt und jegliche Exception aus dem Thread Execute abfängt und an die Eigenschaft FatalException hängt, so dass das nicht passieren kann. ;)

[EdAdvokat]

zunächst erst einmal Dank für die konstruktiven Hinweise.
Doch so richtig weitergekommen bin ich noch nicht.
Gibt es denn nicht ein wirklich einfaches Beispiel für Hauptprogramm und ggf. 2 Threads, die synchronisiert werden ohne viel Schnick und Schnack.
Leider habe ich bisher nur mit div. Problemen überfrachtete Beispiele gefunden, die mir als Anfänger in dieser Sache nicht so richtig weiter helfen.
Den vorliegenden Code habe ich dahingehend verändert, dass nun im 2. Thread keine Schleife (bis 70) mehr enthalten ist sondern nur noch ein Activityindicator
mit anderem Aussehen. Also im Hauptprogramm wird eine Schleife bis 100 hoch gezählt und in den beiden Threads laufen die jeweils verschiedenen Activityindicatoren.
Diese laufen erkennbar beide gleichzeitig und wohl auch synchronisiert. Ist das also als Beispiel für ein Hauptprogramm mit 2 Threads tauglich?
Kennt jemand ein gutes Beispiel für meine Vorstellungen?

[KodeZwerg]

ich weiß nicht ob es hilft aber so erstelle ich threads meist über die API, hier nur grob dargestellt

Delphi-Quellcode:

var
  ThreadHandle,
  ThreadId: TThreadID


procedure ThreadProc;
begin
  // mach was, auch GUI könnte man hier updaten etc...

  // thread wird beendet
  ExitThread(0);
end;

procedure foobar;
begin
  // einen thread wartend initialisieren
  ThreadHandle := CreateThread(nil, LongWord(0), @ThreadProc, nil, CREATE_SUSPENDED, ThreadId);
  // priorität festlegen
  SetThreadPriority(ThreadHandle, THREAD_PRIORITY_ABOVE_NORMAL);

  // thread starten
  ResumeThread(ThreadHandle);


  // einen thread abschießen
  if ((ThreadHandle <> 0) and (ThreadHandle <> INVALID_HANDLE_VALUE)) then
  begin
    TerminateThread(ThreadHandle, 0);
    WaitForSingleObject(ThreadHandle, 50);
    if ((ThreadHandle <> 0) and (ThreadHandle <> INVALID_HANDLE_VALUE)) then
      CloseHandle(ThreadHandle);
  end;
end;

[Renate Schaaf]

There used to be an example in old versions of Delphi, which helped me to get started with threads. Apparently it is still available from here:
https://gist.github.com/jpluimers/8a...2ce7aaa8d4a2ea

Is ja die deutsche Seite :). Also obiges Beispiel hat mir geholfen, als ich mit Threads angefangen habe.

[Blup]

Auf jeden Fall sollte dir erst mal klar sein was Synchronize() überhaupt macht:
- der aufrufende Thread wird angehalten
- Wenn der Hauptthread irgendwann mal nichts zu tun hat wird die übergebene Methode vom Hautpthread aufgerufen und abgearbeitet. Während der Abarbeitung der Methode kann der Hauptthread natürlich nichts anderes machen.
- nachdem der Hauptthread die Methode beendet hat, wird auch der aufrufende Thread fortgesetzt

[Benmik]

Die Frage ist doch auch, ob du dich in Threads einarbeiten und sie verstehen oder ob du ein Problem lösen möchtest, sprich: eine konkrete Aufgabe mit Threads schneller abarbeiten möchtest. Im zweiten Fall könntest du dir einfach die OTL (OmniThreadLibrary von Primož Gabrijelčič) anschauen. Auch sonst erfährst du in seinem Online-Buch und in den Beispielen auch einiges über die Architektur von Threads.

[Stevie]

Zitat:

Zitat von Blup (Beitrag 1504522)

Auf jeden Fall sollte dir erst mal klar sein was Synchronize() überhaupt macht:
- der aufrufende Thread wird angehalten
- Wenn der Hauptthread irgendwann mal nichts zu tun hat wird die übergebene Methode vom Hautpthread aufgerufen und abgearbeitet. Während der Abarbeitung der Methode kann der Hauptthread natürlich nichts anderes machen.
- nachdem der Hauptthread die Methode beendet hat, wird auch der aufrufende Thread fortgesetzt

Ich bin mit deiner Formulierung etwas unglücklich - genauer gesagt die Wortwahl "wird angehalten" und "wird fortgesetzt". Das könnte missverstanden werden.
Der aufrufende Thread blockiert, bis der Hauptthread die Methode abgearbeitet hat und das signalisiert.

[EdAdvokat]

#Benmik: Es ist eher das erste. Ich will mich in das spannende Thema "Threads" einarbeiten und habe aktuell kein zu lösendes Problem, wofür ich Threads einsetzen sollte.
Es ist die Spannung, die entstehen soll, wenn eine "neue Tür" aufgestoßen wird und Erbauung erwartet wird. Noch klemmt bei mir diese Tür, doch ich werde die Beiträge
und meine bisherigen Versuche nochmals durchgehen, in der Hoffnung auf Eingebung.
Ich danke euch für die Hinweise.

[stahli]

Also dann eine übersichtliche Aufgabe:

Zähle in einem Thread Zähler1 von 0 - 1Mio.
Dann erhöhe einen zweiten Zähler Zähler2 um eins und setze Zähler1 auf null zurück.
Gib den aktuellen Stand von Zähler2 in einem Label auf einem Formular aus (synchronisiert).
Beende den Thread vor dem Beenden der Anwendung.

Verwende keinen Timer, kein Sleep und kein Processmessage!

Setze im Formular ein paar Controls ein, mit denen Du irgendetwas tun kannst.
Verschiebe das Formular und ändere die Größe, um zu sehen, ob das flüssig läuft.

Die Zwischenstände kannst Du ja hier als Zip hochladen, so dass man mal schauen kann, wo es evtl. nicht passt...

[EdAdvokat]

Hallo Strahli, hier mein Versuch Deine Aufgabenstgellung zu lösen. Sicher nicht das Gelbe vom Osterei.

Delphi-Quellcode:

unit Unit1;

interface
uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  System.Classes, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls,
  Vcl.WinXCtrls, Vcl.ExtCtrls;

type
  TheThread = class(TThread)
  private
    procedure DoIt;
  public
    procedure Execute; override;
  end;


type
  TForm1 = class(TForm)
  CounterLabel: TLabel;
  StartThreadBtn: TButton;
  btnclose: TButton;
  procedure btncloseClick(Sender: TObject);
    procedure StartThreadBtnClick(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TheThread.DoIt;
var Zaehler1, Zaehler2, erg1: Integer;
begin
  for Zaehler1 := 0 to 1000000 do
  erg1:=Zaehler1;

  Zaehler2:=1;
  Zaehler2 := Zaehler2 + 1;
  Zaehler1:=0;

  begin
    Form1.counterlabel.Caption := Zaehler2.tostring;
  end;
end;

procedure TheThread.Execute;
begin
  Synchronize(DoIt);
end;

procedure TForm1.btncloseClick(Sender: TObject);
begin
  Close;
end;

procedure TForm1.StartThreadBtnClick(Sender: TObject);
var
  Thread: TheThread;
  I: integer;
begin
  try
    Thread := TheThread.Create(True);
    Thread.FreeOnTerminate := true;
    Thread.Start;
    Thread.ShutdownThread;
  except
    on E:Exception do
    begin
       MessageDlg(E.Message, mtError, [mbOK], -1);
    end;
  end;

end;

end.

[haentschman]

Moin...8-)

1. Dein Thread macht im Exeute, außer Sync aufrufen, nichts.
2. Sync arbeitet nur im HauptTread

Fazit:
Der Thread ist nutzlos.

Versuche mal an die Aufgabenstellung erst mal anders ranzugehen.

1. Das EXCECUTE macht die Arbeit im HINTERGUND. :thumb:

Wenn das fertig ist, dann über die Rückmeldung an den Haupthread nachdenken. (Form mit Labels etc.)
Hinweis: z.B. bei einer Million Durchläufen braucht man die Oberfläche nicht permanent updaten. 1% MAX Menge reicht. Heißt: Sync nur 1% auslösen.

:wink:

[EdAdvokat]

ich glaube, es ist besser, ich lasse es mit dem Erkundungsprojekt "Threads", denn ich habe überhaupt kein Plan, wie ich diese Aufgabenstellung umsetzen soll.
Ich bin wie vernagelt und kann tatsächlich nichts Sinnvolles beitragen.
Wäre es zuviel verlangt, mir eine Lösung zu zeigen, wie man mit einem oder gar zwei ganz einfachen Threads sinnvoll arbeiten kann?

[stahli]

Aus Zeitgründen mal ins Unreine und zum rantasten...

DoIt brauchst Du nicht.
Im Create kannst Du ein Label übergeben und in fLabel speichern (Constructor entsprechend überschreiben).
Execute kann ungefähr so aussehen:

Delphi-Quellcode:

  procedure TMyThread.Execute;
  var
    I1, I2: Cardinal;
  begin
    I1 := 0;
    I2 := 0;
    try
      while (not Terminated) do
        begin
          Inc(I1);
          if (I1 >= 1000000) then 
            begin
              Inc(I2);
              Synchronize(
                procedure
                  begin
                    fLabel.Caption := I2.ToString;
                  end);
              I1 := 0;
            end;
        end;
    except
      raise;
//    on e: exception do begin
//      mache hier irgendetwas mit dem Fehler.
    end;
  end;

Der Thread läuft also dauernd durch und berechnet etwas. In Abständen wird ein Zwischenwert in dem Label ausgegeben.
Synchronize wartet dafür, bis die VCL bereit ist, dem Thread eine Änderung zu ermöglichen. So lange steht die Schleife still.
Während der Synchronisierung steht die VCL still (was man aber nicht merkt, da die Synchronisierung nur kurze Zeit braucht. Wenn die aber eine Minute brauen würde, würde die VCL eine Minute hängen.
Nach der Synchronisierung arbeitet der Thread wieder weiter.

[EdAdvokat]

vielen Dank für eure Geduld #Stahli und #hentschman. Ihr habt mir zurückliegend schon öfter mal geholfen.
Aktuell gebe ich auf, denn ich verstehe es einfach nicht.
Nun habe ich vor kurzer Zeit das aktuelle Buch von Marcu Cantu für mich übersetzt, gelesen und doch wohl wieder kaum was dazugelernt. Jedenfalls zeigt
es mir die aktuelle Praxis.
Ich bin so was von gefrustet wegen meiner Stümperei und werde wohl Delphi für einige Zeit oder auch länger in die Ecke werfen.

[stahli]

Das wird schon. :-)

Im MyThread.Execute muss in einem einzelnen Schritt oder in einer Schleife ein Problem gelöst werden.
Wenn Execute verlassen wird, ist der Thread fertig.

Währenddessen können andere Threads oder eben auch die VCL ihre eigenständigen Aufgaben erledigen.
Im Grunde ist jeder Thread ein eigenständiges Programm.

Die VCL-Anwendung ist das, was der Nutzer sieht. Da läuft auch eine Dauer-Schleife:
- FormularZeichnen,
- TastaturPrüfen,
- MausPrüfen,
- EreignisseAbarbeiten,
- GuckenObEinThreadEtwasTunMöchte, // dann dessen Code dazwischen schieben
- WennNichtProgrammendeSchleifeVonVorn

Man darf nicht zwischen verschiedenen Threads (auch die VCL ist ein Thread) untereinander auf Daten zugreifen. Deshalb müssen die Threads sich gegenseitig abstimmen und den eigenen Ablauf ggf. anhalten. Für die VCL funktioniert das mit Synchronize.

Ich würde da noch nicht aufgeben an Deiner Stelle. Ist normal, dass man etwas Zeit braucht.

[EdAdvokat]

#stahli Was meinst Du mit Deinem Hinweis "Im Create kannst Du ein Label übergeben und in fLabel speichern (Constructor entsprechend überschreiben)."
Damit kann ich nichts anfangen.

Setze ich den ganzen Prozess so wie bei mir geschrieben mit

Delphi-Quellcode:

procedure TForm1.StartThreadBtnClick(Sender: TObject);
var
  Thread: TheThread;
  I: integer;
begin
  try
    Thread := TheThread.Create(True);
    Thread.FreeOnTerminate := true;
    Thread.Start;
    Thread.ShutdownThread;
  except
    on E:Exception do
    begin
       MessageDlg(E.Message, mtError, [mbOK], -1);
    end;
  end;
end;

in Gang?

Schreibe ich die Thread-Class um in:

Delphi-Quellcode:

type
  TheThread = class(TThread)
  private
    fLabel : TLabel;
  public
    procedure Execute; override;
    property Labelcount : TLabel read FLabel write FLabel;
  end;

Ich bin weiterhin ratlos.
Das mit der Synchronisierung der einzelnen Threads glaube ich verstanden zu haben, doch wie es nun praktisch realisiert wird, da scheitert es.

[Phoenix]

Zitat:

Zitat von stahli (Beitrag 1504580)

Das wird schon. :-)

Man darf nicht zwischen verschiedenen Threads (auch die VCL ist ein Thread) untereinander auf Daten zugreifen. Deshalb müssen die Threads sich gegenseitig abstimmen und den eigenen Ablauf ggf. anhalten. Für die VCL funktioniert das mit Synchronize.

Das ist, denke ich, der wichtigste Punkt. Das Problem ist u.a. vereinfacht folgendes:

Thread 1 liest aus einem Speicherbereich Daten aus (z.B. ein Array das in einem Objekt steckt), während Thread 2 gerade in genau diesem Array hinten Daten drin ändert und dort reinschreibt.
Am Ende hat Thread 1 halb alte und halb neue Daten gelesen, die in sich halt nicht zusammenpassen, und hat damit dann natürlich Rotz gelesen.

Wenn gerade kein anderer Thread in die Daten schreibt, dürfen aber natürlich beliebig viele Threads gleichzeitig lesen, denn die stören sich untereinander ja nicht.

Für diese Zugriffe gibt es (grundsätzlich, das hat erstmal nichts speziell mit Delphi zu tun) einige Methoden damit sich die Programmteile nicht in die Quere kommen. Das sind zum einen Locks, Mutexe, Semaphore und Monitore.

Für das obige Szenario kann z.B. ein Reader/Writer-Lock verwendet werden. Jeder Thread der gerade Lesen will, holt sich einen Reader-Lock, liest die Daten, und gibt den Reader-Lock wieder frei.
Reader-Locks können beliebig oft gehalten werden.
Ein Thread der Schreiben will, versucht sich einen Writer-Lock zu holen. Das geht nicht, weil es noch Reader-Locks gibt die gehalten werden. Der Thread der das probiert blockiert nun an dieser Stelle bis er den Writer-Lock erhalten kann. Das hat insbesondere zur Folge, das weitere Threads keinen neuen Reader-Lock mehr holen können und hier auch blockieren, bis das wieder geht.
Wenn alle Threads die gerade lesen ihre Reader-Locks zurück gegeben haben, dann gibt das Betriebssytem den Writer-Lock frei und der schreibende Thread darf weiterlaufen. Der bekommt also den Writer-Lock, jetzt ist sichergestellt das gerade keiner mehr liest, und darf seine Daten schreiben. Danach gibt er den Writer-Lock wieder frei. Das erlaubt im Umkehrschluss wieder allen anderen Threads die lesen wollen, ihren gewünschten Reader-Lock jetzt endlich bekommen zu können, und diese können auch weiterlaufen.

Wenn Du Dich mit Thread-Synchronisation auseinandersetzen willst, solltest Du vielleicht ein paar Artikel zu den Konzepten, insbesondere Mutex, Lock und Sempahor (beinhaltet meist schon Monitor) lesen (Wikipedia ist schon ganz okay-ish), und dann von dort aus weiter arbeiten.

Eine noch ganz wichtige Sache in Windows (bzw. nahezu jeder anderen UI-Technologie) ist, das nur genau ein einziger Thread auserkoren ist, UI-Elemente (Forms, Controls etc.) zu aktualisieren. Damit müssen dann andere Threads eben die Daten mittels mindestens einer der oben genannten Synchronisationsmethoden wohin schreiben, wo der UI-Thread dann lesen darf und am besten auch mitbekommt, das er diese Daten jetzt irgendwie anzeigen muss.

Das Synchronize in dem oben genannten Beispiel schreibt den Code (Update das Label mit diesem neuen Text) sozusagen als Daten auf den UI-Thread (im Prinzip schiebt er einen Zeiger auf den Code dorthin) und blockiert dann, bis der UI-Thread beim abarbeiten seiner Nachrichten diesen Zeiger liest, und den Code auf den der Zeiger zeigt selber ausführt (also das Label aktualisiert). Wenn der UI-Thread das gemacht hat, wird dem anderen Thread der auf das abarbeiten des Synchronize-Blcos wartet gesagt: Lauf weiter. Intern arbeitet das Synchronize auch mit nichts anderem als die oben genannten Mechanismen. Ist alles keine Magie ;) Sobald Du die Konzepte verstanden hast macht das auf einmal alles Sinn ;)

[stahli]

Geht noch einfacher... :-)

Delphi-Quellcode:

type
  TheThread = class(TThread)
  private
    fLabel : TLabel;
  public
    constructor Create(aLabel: TLabel); overload;
    procedure Execute; override;
  end;

...

  constructor TTheThread.Create(aLabel: TLabel);
  begin
    fLabel := aLabel;
    inherited Create(False);
  end;

[EdAdvokat]

und wie bekomme ich den Prozess zum Laufen und zur Anzeige des Hochzählens bzw. der Synchronisation?
muß ich ggf. mit dem FormCreate arbeiten und das Label zur Anzeige bringen oder mit dem StartButton?
Noch passiert überhaupt nichts.
folgender Quelltext liegt nun vor:

Delphi-Quellcode:

type
  TheThread = class(TThread)
  private
    fLabel : TLabel;
  public
    constructor Create(aLabel: TLabel); overload;
    procedure Execute; override;
  end;


type
  TForm1 = class(TForm)
  CounterLabel: TLabel;   
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}


constructor TheThread.Create(aLabel: TLabel);
begin
  fLabel := aLabel;
    inherited Create(False);
end;

procedure TheThread.Execute;
 var
    I1, I2: Cardinal;
  begin
    I1 := 0;
    I2 := 0;
    try
      while (not Terminated) do
        begin
          Inc(I1);
          if (I1 >= 1000000) then
            begin
              Inc(I2);
              Synchronize(
                procedure
                  begin
                    FLabel.caption := I2.ToString;
                  end);
              I1 := 0;
            end;
        end;
    except
      raise;
// on e: exception do begin
// mache hier irgendetwas mit dem Fehler.
    end;
  end;

end.

[stahli]

Jetzt musst Du in Deinem Formular noch eine Variable vom Typ Deines Threads anlegen und dem Dein Label übergeben, wo er seine Ergebnisse darstellen soll.

Im Formular im Private-Abschnitt:
- fTheThread: TTheThread;

Im OnCreate:
- fTheThread := TTheThread.Create(CounterLabel);

Im OnClose:
- fTheThread.Terminate;

(Bei der Freigabe kann es sein, dass man erst noch auf die tatsächliche Beendigung warten muss und es sonst zu Konflikten kommen kann.)

[EdAdvokat]

so sieht das Ergebnis nun aus:

Delphi-Quellcode:

unit Unit1;

interface
uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  System.Classes, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls,
  Vcl.WinXCtrls, System.UITypes, Vcl.ExtCtrls;

type
  TTheThread = class(TThread)
  private
    fLabel : TLabel;
  public
    constructor Create(aLabel: TLabel); overload;
    procedure Execute; override;
  end;


type
  TForm1 = class(TForm)
  CounterLabel: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private-Deklarationen }
    fTheThread: TTheThread;
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}


constructor TTheThread.Create(aLabel: TLabel);
  begin
    fLabel := aLabel;
    inherited Create(False);
  end;

procedure TTheThread.Execute;
 var
    I1, I2: Cardinal;
  begin
    I1 := 0;
    I2 := 0;
    try
      while (not Terminated) do
        begin
          Inc(I1);
          if (I1 >= 1000) then
            begin
              Inc(I2);
              Synchronize(
                procedure
                  begin
                    FLabel.caption := I2.ToString;
                  end);
              I1 := 0;
            end;
        end;
    except
      raise;
// on e: exception do begin
// mache hier irgendetwas mit dem Fehler.
    end;
  end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
   fTheThread.Terminate;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  fTheThread := TTheThread.Create(CounterLabel);
end;
end.

Ich sehe also auf dem Formular das stets unterbrochene Hochzählen (also die Synchronisation zwischen I1 und I2)
Vielen vielen Dank für die Ausdauer mit mir Plinse.
Ich denke das war es also.

[stahli]

Freut mich! :)

[haentschman]

Moin...8-)

Zitat:

Im Create kannst Du ein Label übergeben

...keine gute Idee die Oberfläche mit Businesslogic zu mischen. Der Thread sollte die VCL nicht kennen! :warn:
Was passiert wenn das Label nicht mehr existiert? Bumm. :zwinker:

Damit ist auch gemeint, daß der Thread in eine separate Unit gehört und nicht in die Form Unit. :zwinker:

PS: Zum Testen/Lernen ist es OK. :zwinker:

Besser:
Der Thread hat ein Event. Dieses Event ist in der Oberfläche an einen Eventhandler gebunden. Der Thread gibt den Wert (was auch immer) über das Event an den Eventhander der Oberfläche weiter. :thumb:

Delphi-Quellcode:

type
  TOnChangeEvent = procedure(Sender: TObject; MaxValue: Integer; CurrentValue: Integer) of object;

  TTheThread = class(TThread)
  private
    FOnChange: TOnChangeEvent;
  public
    property OnChange: TOnChangeEvent read FOnChange write FOnChange;
    procedure Execute; override;
  end;

...
if (I1 >= 1000) then
begin
  Inc(I2);
  Synchronize(
    procedure
    begin
      if Assigned(FOnChange) then
      begin
        FOnChange(Self, I1, I2); //Beispiel 
      end;
    end);
  I1 := 0;
end;
...
procedure TForm1.FormCreate(Sender: TObject);
begin
  FTheThread := TThread.Create;
  FTheThread.OnChange := DoOnChange;
end;
...
procedure TForm1.DoOnChange(Sender: TObject; MaxValue: Integer; CurrentValue: Integer);
begin
  CounterLabel.Caption := CurrentValue.ToString;
end;

[EdAdvokat]

Danke auch an #haentschman. Ich habe Deine früheren strengen Hinweise noch immer im Ohr - Trennung von Businesslogic und Form; nimm immer klar bezeichnete Variablen und
bennenne sie möglichst englisch usw. Habe Deine Hinweise stets befolgt.
Diese nun in zwei units aufgeteilte Modellanwendung funktioniert ebenso wie die von gestern. Vielen Dank für die Hilfe.
Noch eine kurze Frage habe ich: Wie würde man die Threads bezeichnen (Was ist der Hauptthread und was die Sub-Threads) oder ist das uniteressant?
Grüsse nach Seifhennersdorf - war unlängst in Johnsdorf und frohes Osterfest an alle hier!

[KodeZwerg]

ich habe mir anhand des coolen beispiels von haentschman was gebastelt und frage mich nun warum es nicht so funktioniert wie erwünscht
bei mir blockiert der main thread....
was ich tat war alten code von luckie ausbuddeln und dann als thread verpackt arbeiten lassen.

hier die threaded unit

Delphi-Quellcode:

unit kzProc;

interface

uses
  Winapi.Windows, Winapi.Messages, Winapi.PsAPI, Winapi.TlHelp32,
  System.Classes, System.SysUtils;

type
  TPIDList = array of DWORD;

  TProcessInfo = packed record
    PID: Cardinal;
    Parent: Cardinal;
    Filename: string;
    Filepath: string;
    Owner: string;
    ClassName: string;
    Threads: Cardinal;
    Modules: Cardinal;
    Priority: Cardinal;
    Memory: SIZE_T;
    Version: string;
  end;

  TProcesses = array of TProcessInfo;

  TGetProcessesEvent = procedure(Sender: TObject; Processes: TProcesses) of object;
  TGetProcesses = class(TThread)
  private
    FOnChange: TGetProcessesEvent;
  public
    property OnChange: TGetProcessesEvent read FOnChange write FOnChange;
    procedure Execute; override;
  end;

  TkzProcessEvent = procedure(Sender: TObject) of object;
  TkzProcess = class(TPersistent)
    strict private
      FPreviousDebugState: Boolean;
      FProcesses: TProcesses;
      FHasProcesses: Boolean;
      FIsBusy: Boolean;
      FGetProcessThread: TGetProcesses;
    protected
      procedure DoOnGetProcesses(Sender: TObject; Processes: TProcesses);
    private
      FOnChange: TkzProcessEvent;
    public
      constructor Create;
      destructor Destroy; override;
      procedure Refresh;
      function KillProcess(PID: DWORD; Wait: DWORD): Boolean;
    public
      property OnGetProcesses: TkzProcessEvent read FOnChange write FOnChange;
      property IsBusy: Boolean read FIsBusy;
      property Processes: TProcesses read FProcesses;
      property HasProcesses: Boolean read FHasProcesses;
  end;

// Get ProcessID By ProgramName (Include Path or Not Include)
function GetPIDByProgramName(const APName: string): THandle;

// Get Window Handle By ProgramName (Include Path or Not Include)
function GetHWndByProgramName(const APName: string): THandle;

// Get Window Handle By ProcessID
function GetHWndByPID(const hPID: THandle): THandle;

// Get ProcessID By Window Handle
function GetPIDByHWnd(const hWnd: THandle): THandle;

// Get Process Handle By Window Handle
function GetProcessHndByHWnd(const hWnd: THandle): THandle;

// Get Process Handle By Process ID
function GetProcessHndByPID(const hAPID: THandle): THandle;

implementation

// Get Window Handle By ProgramName (Include Path or Not Include)
function GetHWndByProgramName(const APName: string): THandle;
begin
   Result := GetHWndByPID(GetPIDByProgramName(APName));
end;

// Get Process Handle By Window Handle
function GetProcessHndByHWnd(const hWnd: THandle): THandle;
var
   PID: DWORD;
   AhProcess: THandle;
begin
   if hWnd <> 0 then
   begin
      GetWindowThreadProcessID(hWnd, @PID);
      AhProcess := OpenProcess(PROCESS_ALL_ACCESS, false, PID);
      Result := AhProcess;
      CloseHandle(AhProcess);
   end
   else
      Result := 0;
end;

// Get Process Handle By Process ID
function GetProcessHndByPID(const hAPID: THandle): THandle;
var
   AhProcess: THandle;
begin
   if hAPID <> 0 then
   begin
      AhProcess := OpenProcess(PROCESS_ALL_ACCESS, false, hAPID);
      Result := AhProcess;
      CloseHandle(AhProcess);
   end
   else
      Result := 0;
end;

// Get Window Handle By ProcessID
function GetPIDByHWnd(const hWnd: THandle): THandle;
var
   PID: DWORD;
begin
   if hWnd <> 0 then
   begin
      GetWindowThreadProcessID(hWnd, @PID);
      Result := PID;
   end
   else
      Result := 0;
end;

// Get Window Handle By ProcessID
function GetHWndByPID(const hPID: THandle): THandle;
  type
   PEnumInfo = ^TEnumInfo;
   TEnumInfo = record
      ProcessID: DWORD;
      HWND: THandle;
   end;

   function EnumWindowsProc(Wnd: DWORD; var EI: TEnumInfo): BOOL; stdcall;
   var
      PID: DWORD;
   begin
      GetWindowThreadProcessID(Wnd, @PID);
      Result := (PID <> EI.ProcessID) or (not IsWindowVisible(WND)) or (not IsWindowEnabled(WND));
      if not Result then
        EI.HWND := WND; //break on return FALSE
   end;

   function FindMainWindow(PID: DWORD): DWORD;
   var
      EI: TEnumInfo;
   begin
      EI.ProcessID := PID;
      EI.HWND := 0;
//      EnumWindows(@EnumWindowsProc, Integer(@EI));
      EnumWindows(@EnumWindowsProc, LPARAM(@EI));
      Result := EI.HWND;
   end;

begin
   if hPID <> 0 then
      Result := FindMainWindow(hPID)
   else
      Result := 0;
end;

// Get ProcessID By ProgramName (Include Path or Not Include)
function GetPIDByProgramName(const APName: string): THandle;
var
   isFound: boolean;
   AHandle, AhProcess: THandle;
   ProcessEntry32: TProcessEntry32;
   APath: array[0..MAX_PATH] of char;
begin
   Result := 0;
   AHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
   try
      ProcessEntry32.dwSize := Sizeof(ProcessEntry32);
      isFound := Process32First(AHandle, ProcessEntry32);
      while isFound do
      begin
         AhProcess := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ,
            false, ProcessEntry32.th32ProcessID);
         GetModuleFileNameEx(AhProcess, 0, @APath[0], sizeof(APath));
         if (UpperCase(StrPas(APath)) = UpperCase(APName)) or
            (UpperCase(StrPas(ProcessEntry32.szExeFile)) = UpperCase(APName)) then
         begin
            Result := ProcessEntry32.th32ProcessID;
            break;
         end;
         isFound := Process32Next(AHandle, ProcessEntry32);
         CloseHandle(AhProcess);
      end;
   finally
      CloseHandle(AHandle);
   end;
end;

function GetSecurityInfo(handle: THandle; ObjectType: DWord; SecurityInfo: SECURITY_INFORMATION; ppsidOwner: PSID; ppsidGroup: PSID; ppDacl: PACL; ppSacl: PACL; ppSecurityDescriptor: PSECURITY_DESCRIPTOR): DWORD; stdcall; external 'advapi32.dll';
//function ConvertSidToStringSid(SID: PSID; var StringSid: PWideChar): Boolean; stdcall; external 'advapi32.dll' name 'ConvertSidToStringSidW';
//function ConvertStringSidToSid(StringSid: PWideChar; var Sid: PSID): Boolean; stdcall; external 'advapi32.dll' name 'ConvertStringSidToSidW';

function SidToString(ASID: PSID): WideString;
var
  sDummy            : PWideChar;
begin
  ConvertSidToStringSid(ASID, sDummy);
  Result := string(sDummy);
end;

function StrSIDToName(const StrSID: Widestring; var Name: WideString; var SIDType: DWORD): Boolean;
var
  SID               : PSID;
  Buffer, Temp      : PWideChar;
  NameLen, TempLen  : Cardinal;
  succes            : Boolean;
begin
  SID := nil;
  succes := ConvertStringSIDToSID(PWideChar(StrSID), SID);
  if succes then
  begin
    NameLen := 0;
    TempLen := 0;
    LookupAccountSidW(nil, SID, nil, NameLen, nil, TempLen, SIDType);
    if NameLen > 0 then
    begin
      GetMem(Buffer, NameLen * sizeOf(WideChar));
      GetMem(Temp, TempLen * sizeof(WideChar));
      try
        succes := LookupAccountSidW(nil, SID, Buffer, NameLen, Temp, TempLen, SIDType);
        if succes then
        begin
          Name := WideString(Buffer);
        end;
      finally
        FreeMem(Buffer);
        FreeMem(Temp);
      end;
    end;
    LocalFree(Cardinal(SID));
  end;
  result := succes;
end;

function EnablePrivilege(const Privilege: string; fEnable: Boolean; out PreviousState: Boolean): Boolean;
var
  ok                : Boolean;
  Token             : THandle;
  NewState          : TTokenPrivileges;
  Luid              : TLargeInteger;
  PrevState         : TTokenPrivileges;
  Return            : DWORD;
begin
  PreviousState := True;
  if (GetVersion() > $80000000) then // Win9x
    Result := True
  else // WinNT
  begin
    ok := OpenProcessToken(GetCurrentProcess(), MAXIMUM_ALLOWED, Token);
    if ok then
    begin
      try
        ok := LookupPrivilegeValue(nil, PChar(Privilege), Luid);
        if ok then
        begin
          NewState.PrivilegeCount := 1;
          NewState.Privileges[0].Luid := Luid;
          if fEnable then
            NewState.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED
          else
            NewState.Privileges[0].Attributes := 0;
          ok := AdjustTokenPrivileges(Token, False, NewState, SizeOf(TTokenPrivileges), PrevState, Return);
          if ok then
          begin
            PreviousState := (PrevState.Privileges[0].Attributes and SE_PRIVILEGE_ENABLED <> 0);
          end;
        end;
      finally
        CloseHandle(Token);
      end;
    end;
    Result := ok;
  end;
end;

procedure TGetProcesses.Execute;
  function _GetClassName(const AValue: string): string;
  var
    ClassName: string;
    LhWnd: THandle;
  begin
    LhWnd := GetHWndByProgramName(AValue);
    SetLength(ClassName, 255);
    //get the class name and reset the
    //memory area to the size of the name
    SetLength(ClassName, GetClassName(LhWnd, PChar(className), Length(className)));
    Result := ClassName;
    if Result = '' then
      Result := Integer(LhWnd).ToString;
  end;
  function GetMemory(const APID: DWORD): SIZE_T;
  var
    hProcess: THandle;
    PMC: PPROCESS_MEMORY_COUNTERS;
    cb: DWORD;
  begin
    Result := 0;
    cb := SizeOf(_PROCESS_MEMORY_COUNTERS);
    GetMem(PMC, cb);
    try
      PMC^.cb := cb;
      hProcess := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, False, APID);
      begin
        if ( hProcess = 0 ) then
          Exit;
        if ( GetProcessMemoryInfo(hProcess, PMC, SizeOf(PMC^)) ) then
          Result := (PMC^.WorkingSetSize Div 1024)
        else
          Result := 0;
      end;
    finally
      CloseHandle(hProcess);
      FreeMem(PMC, SizeOf(_PROCESS_MEMORY_COUNTERS));
    end;
  end;
  function GetPriority(const APID: DWORD): DWORD;
  var
    hProcess          : THandle;
  begin
    hProcess := OpenProcess(PROCESS_QUERY_INFORMATION or GENERIC_READ, False, APID);
    if (hProcess <> 0) then
    begin
      Result := GetPriorityClass(hProcess);
      CloseHandle(hProcess);
    end
    else
      Result := 0;
  end;
  function GetParentPID(const APID: DWORD): DWORD;
  const
    BufferSize = 4096;
  var
    HandleSnapShot  : THandle;
    EntryParentProc : TProcessEntry32;
    HandleParentProc: THandle;
    ParentProcessId : DWORD;
    ParentProcessFound  : Boolean;
    ParentProcPath      : String;
  begin
    Result := 0;
    ParentProcessFound := False;
    HandleSnapShot := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);   //enumerate the process
    if HandleSnapShot <> INVALID_HANDLE_VALUE then
    begin
      EntryParentProc.dwSize := SizeOf(EntryParentProc);
      if Process32First(HandleSnapShot, EntryParentProc) then    //find the first process
      begin
        repeat
          if EntryParentProc.th32ProcessID = APID then
          begin
            ParentProcessId := EntryParentProc.th32ParentProcessID; //get the id of the parent process
            HandleParentProc := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, False, ParentProcessId);
            if HandleParentProc <> 0 then
            begin
              ParentProcessFound := True;
              CloseHandle(HandleParentProc);
            end;
            Break;
          end;
        until not Process32Next(HandleSnapShot, EntryParentProc);
      end;
      CloseHandle(HandleSnapShot);
    end;
    if ParentProcessFound then
      Result := ParentProcessId
    else
      Result := 0;
  end;

  function GetVersion(const Filename: string): string;
  type
    PDWORDArr = ^DWORDArr;
    DWORDArr = array[0..0] of DWORD;
  var
    VerInfoSize       : DWORD;
    VerInfo           : Pointer;
    VerValueSize      : DWORD;
    VerValue          : PVSFixedFileInfo;
    LangID            : DWORD;
  begin
    result := '';
    VerInfoSize := GetFileVersionInfoSizeW(PWideChar(Filename), LangID);
    if VerInfoSize <> 0 then
    begin
      VerInfo := Pointer(GlobalAlloc(GPTR, VerInfoSize * 2));
      if Assigned(VerInfo) then
      try
        if GetFileVersionInfoW(PWideChar(Filename), 0, VerInfoSize, VerInfo) then
        begin
          if VerQueryValueW(VerInfo, '\', Pointer(VerValue), VerValueSize) then
         begin
            with VerValue^ do
            begin
              result := Format('%d.%d.%d.%d', [dwFileVersionMS shr 16, dwFileVersionMS and $FFFF,
                dwFileVersionLS shr 16, dwFileVersionLS and $FFFF]);
            end;
          end
          else
            result := '';
        end;
      finally
        GlobalFree(THandle(VerInfo));
      end;
    end;
  end;
  function GetThreads(const APID: DWORD): DWORD;
  var
    hSnapShot         : Thandle;
    pe32              : TProcessEntry32W;
  begin
    Result := 0;
    hSnapShot := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
    if hSnapShot <> INVALID_HANDLE_VALUE then
    begin
      pe32.dwSize := SizeOf(TProcessEntry32W);
      if not Process32FirstW(hSnapShot, pe32) then
      begin
        CloseHandle(hSnapShot);
      end
      else
      repeat
        if APID = pe32.th32ProcessID then
        begin
          Result := pe32.cntThreads;
          Break;
        end;
      until not Process32NextW(hSnapShot, pe32);
      CloseHandle(hSnapShot);
    end;
  end;
  function GetModulePath(const APID: DWORD): string;
  var
    hSnapShot         : Thandle;
    hModuleSnapShot   : THandle;
    pe32              : TProcessEntry32W;
    me32              : TModuleEntry32W;
  begin
    hSnapShot := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, APID);
    if hSnapShot <> INVALID_HANDLE_VALUE then
    begin
      pe32.dwSize := SizeOf(TProcessEntry32W);
      if not Process32FirstW(hSnapShot, pe32) then
      begin
        CloseHandle(hSnapShot);
      end
      else
      begin
        if APID <> 0 then // Process 0 is no real process!
        begin
          hModuleSnapShot := CreateToolhelp32Snapshot(TH32CS_SNAPMODULE, APID);
          if hModuleSnapShot <> INVALID_HANDLE_VALUE then
          begin
            me32.dwSize := SizeOf(TModuleEntry32W);
            if Module32FirstW(hModuleSnapShot, me32) then
            begin
              Result := me32.szExePath;
            end
            else
            begin
              Result := '';
              CloseHandle(hModuleSnapShot);
            end;
            CloseHandle(hModuleSnapShot);
          end
          else
            Result := '';
        end;
      end;
      CloseHandle(hSnapShot);
    end;
  end;
  function GetModules(const APID: DWORD): DWORD;
  var
    hProcess          : THandle;
    ModuleList        : array[0..1024] of DWORD;
    cbNeeded          : DWORD;
  begin
    cbNeeded := 0;
    hProcess := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, False, APID);
    if hProcess <> 0 then
    begin
      if EnumProcessModules(hProcess, @ModuleList, SizeOf(ModuleList), cbNeeded) then
      begin
        Result := cbNeeded div SizeOf(DWORD);
      end
      else
      begin
        Result := 0;
      end;
      CloseHandle(hProcess);
    end
    else
    begin
      Result := 0;
    end;
  end;
  function GetOwnerName(const APID: DWORD): string;
  var
    hProcess          : THandle;
    ppsidOwner        : PSID;
    SecDescriptor     : PSECURITY_DESCRIPTOR;
    err               : DWord;
    s                 : string;
    SIDType           : DWORD;
    Owner             : WideString;
  const
    SE_UNKNOWN_OBJECT_TYPE: DWord = 0;
    SE_FILE_OBJECT    : DWord = 1;
    SE_SERVICE        : DWord = 2;
    SE_PRINTER        : DWord = 3;
    SE_REGISTRY_KEY   : DWord = 4;
    SE_LMSHARE        : DWord = 5;
    SE_KERNEL_OBJECT  : DWord = 6;
    SE_WINDOW_OBJECT  : DWord = 7;
  begin
    Owner := '';
    hProcess := OpenProcess(PROCESS_QUERY_INFORMATION or GENERIC_READ, False, APID);
    if (hProcess <> 0) then
    begin
      err := GetSecurityInfo(hProcess, SE_KERNEL_OBJECT, OWNER_SECURITY_INFORMATION, @ppsidOwner, nil, nil, nil, @SecDescriptor);
      if (err = 0) then
      begin
        s := SidToString(ppsidOwner);
        StrSIDToName(s, Owner, SIDType);
        LocalFree(Cardinal(SecDescriptor));
      end;
      CloseHandle(hProcess);
    end;
    Result := Owner;
  end;
  function GetProcessName(PID: DWORD; var ProcessName: string): DWORD;
  var
    dwReturn     : DWORD;
    hProc        : Cardinal;
    buffer       : array[0..MAX_PATH - 1] of Char;
  begin
    dwReturn := 0;
    Zeromemory(@buffer, sizeof(buffer));
    hProc := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, FALSE, PID);
    if hProc <> 0 then
    begin
      GetModulebaseName(hProc, 0, buffer, sizeof(buffer));
      ProcessName := (string(buffer));
      CloseHandle(hProc);
    end
    else
      dwReturn := GetLastError;
    result := dwReturn;
  end;


var
 ProcessList: TPIDList;
 PidProcess: PDWORD;
 cb: DWORD;
 cbNeeded: DWORD;
 BufferSize: Cardinal;
 dwReturn: DWORD;
 cntProcesses: Cardinal;
 PidWork: PDWORD;
 i: Cardinal;
 ProcessName: string;
 LPID: DWORD;
 LProcesses: TProcesses;
 LPreviousDebugState: Boolean;
begin
  EnablePrivilege('SeDebugPrivilege', True, LPreviousDebugState);
  cbNeeded := 0;
  BufferSize := 1024;
  GetMem(PidProcess, BufferSize);
  // make sure memory is allocated
  if Assigned(PidProcess) then
  begin
    try
      // enumerate the processes
      if EnumProcesses(PidProcess, BufferSize, cbNeeded) then
      begin
        dwReturn := 0;
        cntProcesses := cbNeeded div sizeof(DWORD) - 1;
        PidWork := PidProcess;
        SetLength(ProcessList, cntProcesses);
        // walk the processes
        for i := 0 to cntProcesses - 1 do
        begin
          ProcessList[i] := PidWork^;
          Inc(PidWork);
        end;
      end
      else // EnumProcesses = False
        dwReturn := GetLastError;
      finally
        // clean up no matter what happend
        FreeMem(PidProcess, BufferSize);
      end;
  end
  else // GetMem = nil
    dwReturn := GetLastError;

  SetLength(LProcesses, Length(ProcessList));
  for i := 0 to Length(ProcessList) - 1 do
  begin
    LPID := ProcessList[i];
    LProcesses[i].PID := LPID;
    if (GetProcessName(LPID, ProcessName) <> 0) then
      ProcessName := 'Unknown';
    LProcesses[i].Parent := GetParentPID(LPID);
    LProcesses[i].Filename := ProcessName;
    LProcesses[i].Owner := GetOwnerName(LPID);
//    LProcesses[i].ClassName := _GetClassName(LPID);
//    LProcesses[i].ClassName := _GetClassName(ProcessName);

    LProcesses[i].Modules := GetModules(LPID);
    LProcesses[i].Filepath := GetModulePath(LPID);
    if (Length(LProcesses[i].Filepath) > 0) then
      LProcesses[i].Version := GetVersion(LProcesses[i].Filepath);
    LProcesses[i].Threads := GetThreads(LPID);
    LProcesses[i].Priority := GetPriority(LPID);
  end;
  SetLength(ProcessList, 0);
  Synchronize(
    procedure
      begin
        if Assigned(FOnChange) then
          FOnChange(Self, LProcesses);
      end);
  SetLength(LProcesses, 0);
  EnablePrivilege('SeDebugPrivilege', LPreviousDebugState, LPreviousDebugState);
end;


constructor TkzProcess.Create;
begin
  inherited Create;
  EnablePrivilege('SeDebugPrivilege', True, FPreviousDebugState);
  Self.Refresh;
  Self.Refresh;
end;

destructor TkzProcess.Destroy;
begin
  inherited Destroy;
  EnablePrivilege('SeDebugPrivilege', FPreviousDebugState, FPreviousDebugState);
end;

procedure TkzProcess.DoOnGetProcesses(Sender: TObject; Processes: TProcesses);
begin
  FProcesses := Processes;
  FHasProcesses := (Length(FProcesses) > 0);
  FIsBusy := False;
  if Assigned(FOnChange) then
    FOnChange(Self);
end;

procedure TkzProcess.Refresh;
begin
  FGetProcessThread := TGetProcesses.Create(False);
  try
    FIsBusy := True;
    FHasProcesses := False;
    FGetProcessThread.OnChange := Self.DoOnGetProcesses;
    FGetProcessThread.FreeOnTerminate := True;
    FGetProcessThread.Execute;
  finally
    FGetProcessThread.Terminate;
  end;
end;

function TkzProcess.KillProcess(PID: DWORD; Wait: DWORD): Boolean;
var
  hProcess: THandle;
  wfso: DWORD;
begin
  hProcess := OpenProcess(SYNCHRONIZE or PROCESS_TERMINATE, False, PID);
  if (hProcess <> 0) then
  begin
    if TerminateProcess(hProcess, 1) then
    begin
      // TerminateProcess returns immediately, verify if we have killed the process
      wfso := WaitForSingleObject(hProcess, Wait);
      Result := (not wfso = WAIT_FAILED);
    end
    else
      Result := False;
  end
  else
    Result := False;
end;

end.

und so wende ich es an

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.ExtCtrls, Vcl.StdCtrls,
  uListView,
  kzProc;

type
  TfrmMain = class(TForm)
    pnlMain: TPanel;
    lvProcesses: TListView;
    pnlButtons: TPanel;
    btnRefresh: TButton;
    Panel1: TPanel;
    cbUnknown: TCheckBox;
    cbUniques: TCheckBox;
    btnKill: TButton;
    procedure btnRefreshClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormActivate(Sender: TObject);
    procedure lvProcessesMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure lvProcessesDblClick(Sender: TObject);
    procedure cbUnknownClick(Sender: TObject);
    procedure btnKillClick(Sender: TObject);
  protected
      procedure DoOnProcesses(Sender: TObject);
  strict private
    // current mouseclick positions
    FX: Integer;
    FY: Integer;
    // copy of everything
    FProcOriginal: TProcesses;
    // local hitinfo
    FHitInfo: THitInfo;
  private
    // the class
    FkzProc: TkzProcess;
    // local display copy
    FProc: TProcesses;
  private
    procedure DisplayIt;
  public
  end;

var
  frmMain: TfrmMain;

implementation

{$R *.dfm}

procedure TfrmMain.DisplayIt;
var
  i: Integer;
  li: TListItem;
begin
  if Length(Self.FProc) > 0 then
  begin
    Self.lvProcesses.Items.BeginUpdate;
    Self.lvProcesses.Items.Clear;
    for i := 0 to Pred(Length(Self.FProc)) do
    begin
      li := lvProcesses.Items.Add;
      // PID
      li.Caption := Self.FProc[i].PID.ToString;
      // Parent
      li.SubItems.Add(Self.FProc[i].Parent.ToString);
      // Filename
      li.SubItems.Add(Self.FProc[i].Filename);
      // Filepath
      li.SubItems.Add(Self.FProc[i].Filepath);
      // Owner
      li.SubItems.Add(Self.FProc[i].Owner);
      // ClassName
      li.SubItems.Add(Self.FProc[i].ClassName);
      // Threads
      li.SubItems.Add(Self.FProc[i].Threads.ToString);
      // Modules
      li.SubItems.Add(Self.FProc[i].Modules.ToString);
      // Priority
      li.SubItems.Add(Self.FProc[i].Priority.ToString);
      // Memory
      li.SubItems.Add(Self.FProc[i].Memory.ToString);
      // FileVersion
      li.SubItems.Add(Self.FProc[i].Version);
    end;
    Self.lvProcesses.Items.EndUpdate;
  end;
end;

procedure TfrmMain.cbUnknownClick(Sender: TObject);
  function AddToRecord(const AValue: TProcessInfo): TProcesses;
  var
    i: Integer;
  begin
    i := Length(Result);
    SetLength(Result, i + 1);
    Result[i].Filename := AValue.Filename;
    Result[i].Filepath := AValue.Filepath;
    Result[i].Memory := AValue.Memory;
    Result[i].Modules := AValue.Modules;
    Result[i].Owner := AValue.Owner;
    Result[i].Parent := AValue.Parent;
    Result[i].Priority := AValue.Priority;
    Result[i].Threads := AValue.Threads;
    Result[i].Version := AValue.Version;
    Result[i].PID := AValue.PID;
  end;
var
  i: Integer;
  NewRec: TProcessInfo;
begin
  SetLength(Self.FProc, 0);
  for i := 0 to Pred(Length(Self.FProcOriginal)) do
  begin
    NewRec.Filename := Self.FProcOriginal[i].Filename;
    NewRec.Filepath := Self.FProcOriginal[i].Filepath;
    NewRec.Memory := Self.FProcOriginal[i].Memory;
    NewRec.Modules := Self.FProcOriginal[i].Modules;
    NewRec.Owner := Self.FProcOriginal[i].Owner;
    NewRec.ClassName := Self.FProcOriginal[i].ClassName;
    NewRec.Parent := Self.FProcOriginal[i].Parent;
    NewRec.Priority := Self.FProcOriginal[i].Priority;
    NewRec.Threads := Self.FProcOriginal[i].Threads;
    NewRec.Version := Self.FProcOriginal[i].Version;
    NewRec.PID := Self.FProcOriginal[i].PID;
    if ((Self.cbUnknown.Checked) and (NewRec.Filename <> 'Unknown')) then
      Self.FProc := AddToRecord(NewRec)
      else
      if (not Self.cbUnknown.Checked) then
        Self.FProc := AddToRecord(NewRec);
  end;
  Self.DisplayIt;
end;

procedure TfrmMain.DoOnProcesses(Sender: TObject);
begin
  Self.FProc := Self.FkzProc.Processes;
  Self.FProcOriginal := Self.FkzProc.Processes;
  Self.DisplayIt;
end;

procedure TfrmMain.btnKillClick(Sender: TObject);
begin
  // precheck if retrieved data can be used
  if ((FHitInfo.Row >= 0) and (FHitInfo.Column >= 0)) then
  begin
    Self.btnKill.Enabled := (not Self.FkzProc.KillProcess(StrToInt64(GetHitTestInfoValueAt(Self.lvProcesses, FHitInfo.Row, 0)), 500));
  end;
end;

procedure TfrmMain.btnRefreshClick(Sender: TObject);
begin
  // update everything
  Self.FkzProc.Refresh;
end;

procedure TfrmMain.FormActivate(Sender: TObject);
begin
  // initiate the class
  Self.FkzProc := TkzProcess.Create;
  // and assign event handler
  Self.FkzProc.OnGetProcesses := Self.DoOnProcesses;
end;

procedure TfrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  // free the class
  Self.FkzProc.Free;
end;

procedure TfrmMain.FormCreate(Sender: TObject);
begin
  // do nothing
  Application.ProcessMessages;
end;

procedure TfrmMain.lvProcessesDblClick(Sender: TObject);
var
  LV: TListView;
  Index: Integer;
begin
  // make method generic usable, no "ListView1.foo.bar"
  LV := (Sender as TListView);
  // precheck if retrieved data can be used
  if ((FHitInfo.Row >= 0) and (FHitInfo.Column >= 0) and (FHitInfo.Row < LV.Items.Count) and (FHitInfo.Column < LV.Columns.Count)) then
  begin
    // for testing set caption to clicked item
    Self.Caption := 'Row: ' + FHitInfo.Row.ToString + ' - Column: ' + FHitInfo.Column.ToString + ' = ' + GetHitTestInfoValueAt(LV, FHitInfo.Row, FHitInfo.Column);
    // react if column 1 was clicked
    if (FHitInfo.Column = 1) then
    begin
      // retrieve needed index to jump to, by searching for a value match
      Index := GetIndexFrom(LV, GetHitTestInfoValueAt(LV, FHitInfo.Row, FHitInfo.Column), 0);
      if ((Index >= 0) and (Index < LV.Items.Count)) then
      begin
        // bring item in visible range
        LV.Items[Index].MakeVisible(False);
        // select item
        LV.Items[Index].Selected := True;
      end;
    end;
  end;
end;

procedure TfrmMain.lvProcessesMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  LV: TListView;
begin
  // save local a copy of xy position
  FX := X;
  FY := Y;
  // make method generic usable, no "ListView1.foo.bar"
  LV := (Sender as TListView);
  // retrieve row and column of clicked item
  FHitInfo := GetSubItemHitTestInfoAt(LV.Handle, FX, FY);
  // if a line is selected, enable kill button
  Self.btnKill.Enabled := ((Sender as TListView).Selected <> nil);
end;

end.

worin liegt mein denkfehler?

[DieDolly]

Zitat:

Versuche mal an die Aufgabenstellung erst mal anders ranzugehen.

Ich würde auch diesen Quatsch mit DoIt weglassen. Geb den Dingern entweder richtige Namen oder lass die besser jetzt erstmal komplett weg.

[juergen]

Hallo zusammen,

ich habe mich seit gestern mal tiefer mit Threads beschäftigt und da kam das Beispiel von Stahli hier genau richtig.:-D

Nun habe ich mal eine "Demo" erstellt, mit den 2 verschiedenen Varianten von Stahli und Haentschmann.
In meiner VM-Entwickler-Maschine laufen beide Thread-Varianten so wie erwartet. Man sieht wie das Label refresht wird und das Hochzählen der Zahlen anzeigt.
Auf meinem Haupt-PC läuft es nicht so wie ich es erwarten würde. Das Programm wird blockiert (evtl. selbes Problem wie bei KodeZwerg?), sobald das Programm den Fokus hat oder man mit der Maus nur über das Programm drüber gleitet. Wenn man ein anderes Programm in den Vordergrund holt, zeigt das Label wieder das Hochzählen an und die Blockade ist weg.
Ich hoffe, ich konnte ausdrücken was das Problem ist.

Hier die Hauptunit:

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.StdCtrls, Vcl.ExtCtrls;

TYPE
  TOnChangeEvent = PROCEDURE( Sender: TObject; MaxValue: Integer; CurrentValue: Integer ) OF OBJECT; { mein Event-Hanlder für den 2. Thread }

  Tfrm_Main = CLASS( TForm )
    Btn_Start_Thread1: TButton;
    CounterLabel1: TLabel;
    Btn_End_Thread1: TButton;
    Label1: TLabel;
    Bevel1: TBevel;
    Btn_Start_Thread2: TButton;
    Btn_End_Thread2: TButton;
    Counterlabel2: TLabel;
    PROCEDURE FormClose( Sender: TObject; VAR Action: TCloseAction );
    PROCEDURE Btn_Start_Thread1Click( Sender: TObject );
    PROCEDURE Btn_End_Thread1Click( Sender: TObject );
    PROCEDURE DoOnChange( Sender: TObject; MaxValue: Integer; CurrentValue: Integer );
    PROCEDURE Btn_Start_Thread2Click( Sender: TObject );
    PROCEDURE Btn_End_Thread2Click( Sender: TObject );
    PROCEDURE FormCreate( Sender: TObject );

  PRIVATE
    { Private-Deklarationen }

  PUBLIC
    { Public-Deklarationen }
  VAR
    gb_ist_Thread1_aktiv, gb_ist_Thread2_aktiv: Boolean;

  END;

VAR
  frm_Main: Tfrm_Main;

IMPLEMENTATION

{$R *.dfm}


USES
  uThread_mit_Erzeugung_Controls_fuer_Zugriff_auf_VCL_im_Hauptthread, uThread_mit_Businesslogic_kennt_somit_nicht_den_HauptThread;


{ mein Event-Handler von dem 2. Thread }
PROCEDURE Tfrm_Main.DoOnChange( Sender: TObject; MaxValue: Integer; CurrentValue: Integer );
BEGIN
  frm_Main.CounterLabel2.Caption := CurrentValue.ToString;
END;

PROCEDURE Tfrm_Main.FormCreate( Sender: TObject );
BEGIN
  gb_ist_Thread1_aktiv := False;
  gb_ist_Thread2_aktiv := False;
END;

PROCEDURE Tfrm_Main.Btn_Start_Thread1Click( Sender: TObject );
BEGIN
  Btn_Start_Thread1.Enabled := False;
  Btn_Start_Thread2.Enabled := False;
  Btn_End_Thread2.Enabled := False;

  FMy_Thread1 := TTheThread.Create( CounterLabel1 );
END;

PROCEDURE Tfrm_Main.Btn_End_Thread1Click( Sender: TObject );
BEGIN
  IF frm_Main.gb_ist_Thread1_aktiv THEN FMy_Thread1.Terminate;
  Btn_Start_Thread1.Enabled := True;
  Btn_End_Thread1.Enabled := True;
  Btn_Start_Thread2.Enabled := True;
  Btn_End_Thread2.Enabled := True;
END;

PROCEDURE Tfrm_Main.Btn_Start_Thread2Click( Sender: TObject );
BEGIN
  Btn_Start_Thread1.Enabled := False;
  Btn_End_Thread1.Enabled := False;
  Btn_Start_Thread2.Enabled := False;

  FMy_Thread2 := TTheThread2.Create;
  FMy_Thread2.OnChange := DoOnChange; { ! }
END;

PROCEDURE Tfrm_Main.Btn_End_Thread2Click( Sender: TObject );
BEGIN
  IF frm_Main.gb_ist_Thread2_aktiv THEN FMy_Thread2.Terminate;
  Btn_Start_Thread1.Enabled := True;
  Btn_End_Thread1.Enabled := True;
  Btn_Start_Thread2.Enabled := True;
  Btn_End_Thread2.Enabled := True;
END;

PROCEDURE Tfrm_Main.FormClose( Sender: TObject; VAR Action: TCloseAction );
BEGIN
  IF frm_Main.gb_ist_Thread1_aktiv THEN FMy_Thread1.Terminate;
  IF frm_Main.gb_ist_Thread2_aktiv THEN FMy_Thread2.Terminate;
END;

END.

Und hier die Unit eines der beiden Thread-Beispiele:

Delphi-Quellcode:

UNIT uThread_mit_Businesslogic_kennt_somit_nicht_den_HauptThread;

INTERFACE

USES
  Winapi.Windows, Winapi.Messages, System.Classes, System.SysUtils, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, uMain;

TYPE

  TTheThread2 = CLASS( TThread )
  PRIVATE
    FOnChange: TOnChangeEvent; { Event-Handler in uMain }
  PUBLIC
    PROPERTY OnChange: TOnChangeEvent READ FOnChange WRITE FOnChange;
    PROCEDURE Execute; OVERRIDE;
  END;

VAR
  FMy_Thread2: TTheThread2;

IMPLEMENTATION

PROCEDURE TTheThread2.Execute;
VAR
  I1, I2: Cardinal;
BEGIN
  I1 := 0;
  I2 := 0;
  TRY
    frm_Main.gb_ist_Thread2_aktiv := True;
    TRY
      WHILE ( NOT Terminated ) DO
      BEGIN
        Inc( I1 );
        IF ( I1 >= 1000 ) THEN
        BEGIN
          Inc( I2 );

          Synchronize(
            PROCEDURE
            BEGIN
              IF Assigned( FOnChange ) THEN
              BEGIN
                FOnChange( Self, I1, I2 ); // Beispiel
              END;
            END );

          I1 := 0;
          IF I2 > 4200000000 THEN I2 := 0; // wegen Gefahr eines Überlaufs wenn jemand mal den Thread laufen lässt...

          // =================================  !!! um Fehler zu testen im(!) Thread  ===============================
          // I2 := I2 DIV I1;
        END;
      END;
    FINALLY
      frm_Main.gb_ist_Thread2_aktiv := False;
    END;
  EXCEPT
    /// Wird benötigt, weil eine Exception im(!) Thread diesen Thread beendet und eine Exception im Hauptthread nicht "angezeigt" werden kann
    ON E: Exception DO
    BEGIN
      Queue(
        PROCEDURE
        BEGIN
          MessageBox( Application.MainFormHandle, PChar( Exception.Classname + ' : ' + E.Message ), 'Thread-Error!', MB_OK OR MB_ICONERROR );
        END );
    END;
  END;
END;

END.

Ich würde mich freuen wenn dieses Mysterium aufgeklärt werden könnte.
Vielen Dank schon mal vorab!

[juergen]

Also wenn ich TThread.Sleep(2) vor Synchronize() setze, dann funktioniert alles.

Delphi-Quellcode:

  IF ( I1 >= 1000 ) THEN
        BEGIN
          TThread.sleep(2);
          Inc( I2 );

          Synchronize(

Muss man das so machen, dass das Synchronize() genug Zeit bekommt?

[KodeZwerg]

Bei mir ist es halt lediglich 1x synchronize und zwar wenn der thread mit seiner Arbeit durch ist.

Also, MainThread erzeugt eine Klasse mit einem OnEvent für den MainThread, die Klasse erzeugt einen Thread mit einem OnEvent für die Klasse, das Klassen-Event gibt dem MainThread Event bescheid wenn es fertig ist.
Von der Logik her denke ich das es so korrekt ist.

Mit WinAPI Threads habe ich dieses Phänomen nicht, da wird nicht der MainThread blockiert obwohl es von der Sache her der gleiche ablauf ist (nur halt per PostMessage als ersatz für OnEvent).

Da ich wirklich nur 1x sync mache denke ich das dies bei mir nicht der Fehler ist, aber ich werde es später gerne mal testen.

[Uwe Raabe]

Ich denke hier liegt das Problem:

Delphi-Quellcode:

  FMy_Thread2 := TTheThread2.Create;
  FMy_Thread2.OnChange := DoOnChange; { ! }

Der Thread wird erzeugt und läuft gleich los, aber das OnChange ist noch nicht gesetzt.

Versuch mal dies:

Delphi-Quellcode:

  FMy_Thread2 := TTheThread2.Create(False);
  FMy_Thread2.OnChange := DoOnChange; { ! }
  FMy_Thread2.Start;

BTW, die Zugriffe aus dem Thread auf frm_Main halte ich für gefährlich, während die Zugriffe auf frm_Main in den Methoden von Tfrm_Main lediglich kontraproduktiv sind.

[himitsu]

DoOnChange als Parameter ans Create übergeben?

Kann OnChange zur Laufzeit des Threads sich ändern? (theoretisch ja, da public Property ohne abgesicherten Setter)
Und wenn, passiert das dann auch definitif immer nur im Hauptthreads?

Wenn es sich nicht ändern kann/soll, dann darf das nicht als Property ungesichert öffentlich zugänglich sein.

Und wenn es sich nie während der Threadlaufzeit ändern kann, dann IF-Assigned vor das Synchronize, da bei NIL sonst immer sinnlos Synchronize ausgeführt wird und bremst.

Delphi-Quellcode:

        IF Assigned( FOnChange ) THEN
          Synchronize(
            PROCEDURE
            BEGIN
              FOnChange( Self, I1, I2 ); // Beispiel
            END );

[Blup]

Das "IF Assigned(FOnChange)" vor dem Synchronize kann man zwar zusätzlich prüfen.
Verlassen kann man sich darauf allein aber nur, wenn FOnChange nicht von außen durch den Haupthread verändert werden kann.
Also kein Property dafür existiert, sondern der Wert z.B. als Parameter dem Constructor übergeben wurde.

Der Hauptthread führt die synchronisierte Prozedur erst beim nächsten Processmessages() aus.
Inzwischen könnte FOnChange aber durch den Hauptthread auf nil gesetzt worden sein, was dann zur Zugriffsverletzung führt.
Deshalb würde ich solche Property immer auch in der synchronisierten Prozedur prüfen und den Zugriff mit einer CriticalSection absichern.

Wurde zwar eigentlich bereits gesagt, aber ist leicht zu überlesen.

[BerndS]

Auch wenn das dann irgendwie doppelt ist würde das dann helfen:

Delphi-Quellcode:

 
IF Assigned( FOnChange ) THEN
  Synchronize(
    PROCEDURE
    BEGIN
      if Assigned( FOnChange ) then
        FOnChange( Self, I1, I2 ); // Beispiel
    END );

[Edelfix]

Dein TTheThread2 hat uMain in den Uses.

Das ist nicht so gut. Sollte auch ohne gehen. Dann ist der Thread wirklich für sich.

Sonst könntest du Synchronize ganz weg lassen da du ja auch frm_Main.gb_ist_Thread2_aktiv := True; machst.

Könntest auch frm_Main.CounterLabel2.Caption := CurrentValue.ToString; direkt im tread machen.