Wie synchroniziere ich mehrere Threads richtig

[v2afrank]

Hallo, ich habe hier eine Anwendung, in der 12 Threads (muss leider so sein) unsere Hardware überwachen und eventuelle Fehlermeldungen am Hauptbildschirm überwachen. Wie es sich gehört, mache ich die Ausgabe über synchronize. Allerdings meldet mir Madexcept dann manchmal "Application seems to be froozen". Lasse ich synchronize weg passiert nichts. Ich habe das mal auf folgenden kleinen Test zusammengefasst.

Threadcode:

Delphi-Quellcode:

unit Unit9;

interface

uses
  Classes,windows,forms,sysutils;

type
  TTestThread = class(TThread)
  private
    { Private-Deklarationen }
    Myname:String;
  protected
    procedure Execute; override;
    procedure addmain;
    public
     constructor create(Name:String);
  end;

implementation
uses unit8;
{ Wichtig: Methoden und Eigenschaften von Objekten in visuellen Komponenten dürfen 
  nur in einer Methode namens Synchronize aufgerufen werden, z.B.

      Synchronize(UpdateCaption);

  und UpdateCaption könnte folgendermaßen aussehen:

    procedure TTestThread.UpdateCaption;
    begin
      Form1.Caption := 'Aktualisiert in einem Thread';
    end; }

{ TTestThread }

procedure TTestThread.addmain;
begin
 Form8.addstring(myName+'    '+inttostr(gettickcount));
end;

constructor TTestThread.create(Name: String);
begin
 Myname:=Name;
inherited create(false);
end;

procedure TTestThread.Execute;
begin
  { Thread-Code hier einfügen }
  while not Terminated do
   begin
//     Synchronize(addmain);  //  <==== Führt zum Freeze
     addmain;                 //  <==== Führt nicht zum Freeze
   end;
end;

end.

Im Hauptfenster ist folgendes:

Delphi-Quellcode:

unit Unit8;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs,unit9, StdCtrls;

type
  TForm8 = class(TForm)
    Memo1: TMemo;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
    threads:Array[1..50]of TTestThread;
    procedure addstring(str:String);
  end;

var
  Form8: TForm8;

implementation

{$R *.dfm}

{ TForm8 }

procedure TForm8.addstring(str: String);
begin
 try
  memo1.Lines.Add(str);
 except
  on exception do
   begin
     memo1.Lines.Delete(0);
     memo1.Lines.Delete(0);
     memo1.Lines.Delete(0);
     memo1.Lines.Delete(0);
     memo1.Lines.Delete(0);
   end;

 end;
end;

procedure TForm8.Button1Click(Sender: TObject);
var
  n: Integer;
begin
 for n := low(threads) to high(threads) do
  threads[n]:=TTestThread.create(inttostr(n));
 
end;

end.

Die Frage ist jetzt, was läuft hier falsch ? Warum kommt das "Application seems to be froozen" wenn ich synchronize benutze ?

[himitsu]

Syncronize ist voll OK ... dein Thread blockiert nur ständig den Hauptthread und läßt ihm keine Zeit für sich.

Delphi-Quellcode:

procedure TTestThread.Execute;
begin
  { Thread-Code hier einfügen }
  while not Terminated do
   begin
     Synchronize(addmain);
     Sleep(20);  <<<< freezet nicht
   end;
end;

kaum ist Synchronize fertig, wird es ja sofort wieder aufgerufen ... da bleibt halt kaum Zeit

oder bei kurzen Berechnungen nicht immer Synchronize ausühren

Delphi-Quellcode:

procedure TTestThread.Execute;
var i: integer;
begin
  { Thread-Code hier einfügen }
  while not Terminated do
   begin
     if i mod 20 = 0 then Synchronize(addmain);
     Inc(i);
     Sleep(2); 
   end;
end;

stell dir für das Sleep einfach längere/langsamere Berechnungen vor, welche dort gemacht würden oder sowas halt.

[v2afrank]

Leider doch.
Ich habe hier mal mein Testprojekt angehängt. Dort nutze ich ein sleep(Random(50)). Ich hatte jetzt gerade nach ca. 5-10 Minuten das freezen.

[himitsu]

das liegt dann wohl eher daran, daß wenn das Memo voller, es auch immer langsamer wird und somit wieder viel mehr Zeit wegen des Threads gewartet werden muß, als der Hauptthread für sich abbekommt.

versuch es mal so: :gruebel:

Delphi-Quellcode:

procedure TForm8.addstring(str: String);
begin
  memo1.Lines.Add(str);
  while memo1.Lines.Count > 1000 do memo1.Lines.Delete(0);
end;

[Blup]

Ein Thread der im Execute nichts anderes macht als dem Hauptthread per Synchronize alle Arbeit aufzuhalsen ist völlig sinnfrei.
Praktisch macht dieser Thread nichts anderes als in einer Schleife dem Hauptthread eine Nachricht zu schicken und darauf zu warten das diese beantwortet wird. Der Hauptthread bekommt die Nachricht das er "addmain" ausführen soll und dann passiert erst mal nichts anderes, bis diese Methode beendet wird.

Bitte Synchronize nur für kurze Aktionen verwenden, z.B. im Thread neu generierte Daten übergeben/anzeigen.

[v2afrank]

In Wirklichkeit macht der Thread ja schon noch etwas anderes. Ich habe hier nur versucht ein kurzes Demoprogramm zu erstellen, mit dem man den Fehler reproduzieren kann.

@himitsu Ich habe es gerade mal mit maximal 100 Einträgen versucht. Nach sehr kurzer Zeit kam der Fehler. Interessant finde ich, dass das Programm ohne synchronize stabiler läuft (Bauchgefühl) .

[WoGe]

Zitat:

Zitat von himitsu

Delphi-Quellcode:

procedure TForm8.addstring(str: String);
begin
  memo1.Lines.Add(str);
  while memo1.Lines.Count > 1000 do memo1.Lines.Delete(0);
end;

@Himitsu das funktioniert zwar ist aber anscheinend wenig performant.
Bei einer meiner Applicationen war es deutlich sinnvoller die Anzahl der Zeilen im Memo auf 100 zu begrenzen und, die dann alle mit Memo1.clear zu löschen.

Grüsse
wo

[v2afrank]

Bist Du sicher dass es funktioniert. Ich bekommen nach kurzer zeit wieder die Froozen Meldung

[Blup]

Ein Beispiel ohne Synchronize, statt dessen TCriticalSection:

Delphi-Quellcode:

unit TextPipeline;

interface

uses
  Messages, Classes, SyncObjs, Windows, SysUtils;

const
  WM_TEXTPIPEPLINE = WM_USER + 999;

type
  ITextPipeline = interface
    procedure SetObserver(AHandle: THandle);
    procedure Read(AList: TStrings);
    procedure Write(AValue: String);
  end;

  TTextPipeline = class(TInterfacedObject, ITextPipeline)
    constructor Create;
    destructor  Destroy; override;
  private
    FSection: TCriticalSection;
    FList: TStringList;
    FObserver: THandle;
  public
    procedure SetObserver(AHandle: THandle);
    procedure Read(AList: TStrings);
    procedure Write(AValue: String);
  end;

  TTestThread = class(TThread)
    constructor Create(AName: String; APipeline: ITextPipeline);
  private
    FName: String;
    FPipepline: ITextPipeline;
  protected
    procedure Execute; override;
  end;

implementation

constructor TTextPipeline.Create;
begin
  inherited Create;
  FSection  := TCriticalSection.Create;
  FList     := TStringList.Create;
end;

destructor TTextPipeline.Destroy;
begin
  FSection.Free;
  FList.Free;
  inherited;
end;

procedure TTextPipeline.SetObserver(AHandle: THandle);
begin
  FSection.Acquire;
  FObserver := AHandle;
  FSection.Release;
end;

procedure TTextPipeline.Read(AList: TStrings);
begin
  FSection.Acquire;
  AList.AddStrings(FList);
  FList.Clear;
  FSection.Release;
end;

procedure TTextPipeline.Write(AValue: String);
begin
  FSection.Acquire;
  FList.Add(AValue);
  if (FList.Count = 1) and (FObserver <> 0) then
    PostMessage(FObserver, WM_TEXTPIPEPLINE, 0, 0);
  FSection.Release;
end;

constructor TTestThread.Create(AName: String; APipeline: ITextPipeline);
begin
  inherited Create(False);
  FName      := AName;
  FPipepline := APipeline;
end;

procedure TTestThread.Execute;
begin
  while not Terminated do
  begin
    FPipepline.Write(IntToStr(GetTickCount) + ' ' + FName);
    Sleep(Random(50));
  end;
end;

end.

Delphi-Quellcode:

type
  TFTest = class(TForm)
{...}
    procedure BtnThreadsClick(Sender: TObject);
    procedure wmTextPipeline(var Msg: TMessage); message WM_TEXTPIPEPLINE;
  end;

procedure TFTest.BtnThreadsClick(Sender: TObject);
var
  i: Integer;
begin
  if Assigned(FPipeline) then
  begin
    FPipeline.SetObserver(0);
    FPipeline := nil;
    for i := 0 to Length(FThreads) - 1 do
    begin
      with FThreads[i] do
      begin
        FreeOnTerminate := True;
        Terminate;
      end;
    end;
    SetLength(FThreads, 0);
  end
  else
  begin
    FPipeline := TTextPipeline.Create;
    FPipeline.SetObserver(Handle);
    SetLength(FThreads, 50);
    for i := 0 to Length(FThreads) - 1 do
      FThreads[i] := TTestThread.Create('Thread Nr.' + IntToStr(i + 1), FPipeline);
  end;
end;

procedure TFTest.wmTextPipeline(var Msg: TMessage);
begin
  if Assigned(FPipeline) then
    FPipeline.Read(ListBox1.Items);
end;

Funktioniert bei mir problemlos, auch wenn nach ein par Minuten hunderttausende Eintragungen in der Listbox sind.

[v2afrank]

So, ich bin jetzt dazu gekommen Blups Code zu testen. Funktioniert auch bei mir problemlos, so dass ich Ihn in meiner eigentlichen Anwendung einbauen kann. Danke erst noch einmal.

Trotzdem möchte ich noch einmal auf meinen ursprünglichen Ansatz zurückkommen. Was ist denn daran falsch ?
Liegt es wirklich nur daran, dass das Memo zu voll wird und es nicht mehr abgearbeitert werden kann ?