Wie synchroniziere ich mehrere Threads richtig

[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.