multithreadingdelphieventstthread

TThread behavior on TEvent.SetEvent


I am facing strange behavior when using TThread and TEvent to start a work done by the thread. Since suspend/resume are deprecated, I was looking for using TEvent, so here is just a simplified code I have, but still it won't perform as expected. I have TSampleThread class with FThreadStartEvent. For example I create 3 instances of TSampleThread but when I start one thread by setting FThreadStartEvent in it, somehow all of the instances get executed.

enter image description here

What is the issue? Thanks everyone.

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, System.Contnrs, System.SyncObjs,
  Vcl.StdCtrls;


type
  TSampleThread = class;
  TTaskProc = procedure(const SampleThread:TSampleThread) of object;

 TSampleThread = class (TTHread)
  public
   FId:String;
   FThreadStartEvent: TEvent;
   FOnThreadExecute:TTaskProc;
   constructor Create;
   destructor Destroy; override;
   procedure  Execute; override;
   procedure  Start;
 end;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private

    { Private declarations }
  public
    task1, task2, task3:TSampleThread;
    procedure onTask(const SampleThread: TSampleThread);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}


procedure TSampleThread.Execute;
begin
 repeat
  FThreadStartEvent.WaitFor(INFINITE);
  FThreadStartEvent.ResetEvent;
  if Assigned(TMethod(FOnThreadExecute).Code) then FOnThreadExecute(Self);
 until terminated;

end;


procedure TSampleThread.Start;
begin
 FThreadStartEvent.SetEvent;
end;

constructor TSampleThread.Create;
begin
  FreeOnTerminate:= False;
  FOnThreadExecute:= nil;
  FThreadStartEvent:= TEvent.Create(nil, true, false, 'ThreadStartEvent');
  inherited Create(false);

end;

destructor TSampleThread.Destroy;
begin
   FThreadStartEvent.SetEvent;
   FThreadStartEvent.Free;
   inherited;
end;

{ TForm1 }

procedure TForm1.Button1Click(Sender: TObject);
begin
 task1.Start;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin

  task1:= TSampleThread.Create;
  task1.FId:= 'Task 1' ;
  task1.FOnThreadExecute:= onTask;


  task2:= TSampleThread.Create;
  task2.FId:= 'Task 2' ;
  task2.FOnThreadExecute:= onTask;

  task3:= TSampleThread.Create;
  task3.FId:= 'Task 3' ;
  task3.FOnThreadExecute:= onTask;


end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
 task1.Free;
 task2.Free;
 task3.Free;
end;

procedure TForm1.onTask(const SampleThread: TSampleThread);
begin
  SampleThread.Synchronize(nil,
  procedure
  begin
    Memo1.Lines.Add(SampleThread.FId);
  end);
end;




end.

Solution

  • DO NOT assign a name to your TEvent objects in this situation:

    https://docwiki.embarcadero.com/Libraries/en/System.SyncObjs.TEvent.Create

    Set Name to provide a name for a new event object or to specify an existing named event object. If no other thread or process will need to access the event object to wait for its signal, Name can be left blank. Name can be a string of up to 260 characters, not including the backslash character (). If Name is used to specify an existing event object, the value must match the name of the existing event in a case-sensitive comparison. If Name matches the name of an existing semaphore, mutex, or file-mapping object, the TEvent object will be created with Handle set to 0 and all method calls will fail.

    All of your TEvent objects have the same name assigned, so that is causing all of your threads to share a single named event object in the Windows kernel, thus signaling any of your threads will satisfy the wait in all of your threads.

    Also, naming the event opens up your app to outside interference, if a thread in another app decides to access the same named event object.

    You need to change this:

    FThreadStartEvent:= TEvent.Create(nil, true, false, 'ThreadStartEvent');

    To this instead:

    FThreadStartEvent := TEvent.Create(nil, true, false, '');

    Or simpler:

    FThreadStartEvent := TEvent.Create;


    Note: you did not say which version of Delphi you are using. Your code is using Unit Scope names in the uses clause, so it must be at least XE2. But, prior to XE8, there was a bug in the TEvent constructor that caused it to still create a named event object even when the Name parameter is blank. This was fixed in XE8. For earlier versions, use the Win32 CreateEvent() function directly instead.