Too many Threads Solution

[TheOriginalBytePlayer]

I was using your great component only to discover that it was creating a huge number of threads (200+) in our application which made debugging it basically impossible under Win64. I put together a simple -- read perhaps kludged solution -- that brings it down to 2 threads which I'm sure you could make more elegant and generic, if you desired.

Basically the way I did it was to create a centralized collector of components that want to receive messages, one which receives all the messages sent using an internal messaging channel, then feeds them back out to the registered components through an exterior messaging channel. This brings it down from one thread per IMessagingDispatcher to only two threads regardless as to how many components are registered.

I did some timing on it and 1600 calls took 6ms so I didn't bother trying to do any additional optimization though I'm sure it could be done.

There are two parts to this, the first is a component you can just drop on a form and it will automatically register the form with the messaging system.

The second is a SendMessage function that you can use with a generic messaging structure to pass most data.

unit VSoft.Messaging.Component.kjs;

interface

uses
  System.SysUtils, System.Classes, FMX.Forms, FMX.Types, FMX.Controls,
  System.Messaging,  VSoft.Messaging;

type

  TMessagingInitializer = class(TComponent)
  private
    { Private declarations }
    fEnabled:Boolean;
    procedure InitializeDispatcher;
  protected
    { Protected declarations }
  public
    { Public declarations }
    constructor Create(AOwner:TComponent); override;
    procedure SetEnabled(const Value:Boolean);
  published
    { Published declarations }
    property Enabled:Boolean read fENabled write SetEnabled;
  end;

   TGeneralPurposeMsg = record
      MsgID  : TMessageID;
      Filler : TMessageFiller;
      BinaryData:Pointer;
      StringData:String;
      ObjectData:TObject;
   end;


procedure Register;

procedure RegisterForMessageDispatcher(ForComponent:TComponent);
procedure UnRegisterForMessageDispatcher(ForComponent:TComponent);
procedure SendMessage(InMessageID:TMessageID;inStringData:String;
   InBinaryData:Pointer;InObjectData:TObject;SendDirectly:Boolean);

implementation
uses System.Contnrs, System.Diagnostics,  FMX.Dialogs;

type

   TInternalPurposeMsg= record
      MsgID  : TMessageID;
      Filler : TMessageFiller;
      PublicMsgID:TMessageID;
      BinaryData:Pointer;
      StringData:String;
      ObjectData:TObject;
   end;

const
   WM_USER             = $0400; //declaring here so we don't have to reference winapi.messages
   MSG_GENERAL_PURPOSE = WM_USER + $2000;

type
  TPooledMesageDispatcher = class(TComponent)
   strict private
     InternalMessageDispatcher:IMessageDispatcher;
     ComponentReceiverList:TObjectList;
   public
     ExternalMessageDispatcher:IMessageDispatcher;
     Procedure InternalMessage(var Msg:TInternalPurposeMsg); Message MSG_GENERAL_PURPOSE ;
     constructor Create(AOwner: TComponent); override;

     destructor Destroy; override;
     procedure Notification(AComponent: TComponent;  Operation: TOperation); override;
     procedure AddNotificationReceiver(InComponent:TComponent);
     procedure RemoveNotificationReceiver(InComponent:TComponent);
  end;


var
  ExternalMessageChannel:IMessageChannel;
  InternalMessageChannel:IMessageChannel;
  PooledMessageDispatcher:TPooledMesageDispatcher;

procedure SendMessage(InMessageID:TMessageID;inStringData:String;
   InBinaryData:Pointer;InObjectData:TObject;SendDirectly:Boolean);
begin
    var MsgToSend:TInternalPurposeMsg;
    MsgToSend.MsgID:=MSG_GENERAL_PURPOSE;
    MsgToSend.PublicMsgID:=inMessageID;
    MsgToSend.StringData:=InStringData;
    MsgToSend.BinaryData:=inBinaryData;
    MsgToSend.ObjectData:=inObjectData;
    if SendDirectly then
       PooledMessageDispatcher.InternalMessage(MsgToSend)
    else
       InternalMessageChannel.Queue.SendMessage(MsgToSend); //sync
end;

procedure RegisterForMessageDispatcher(ForComponent:TComponent);
begin
  PooledMessageDispatcher.AddNotificationReceiver(ForComponent);
end;

procedure UnRegisterForMessageDispatcher(ForComponent:TComponent);
begin
  PooledMessageDispatcher.RemoveNotificationReceiver(ForComponent);
end;


procedure Register;
begin
  RegisterComponents('FrameForge Custom Components', [TMessagingInitializer]);
end;

{ TMessagingInitializer }

procedure TMessagingInitializer.InitializeDispatcher;
begin
  var ParentForm:=Owner;
  while Assigned(ParentForm) and not (ParentForm is TCommonCustomForm) do
    ParentForm:=ParentForm.Owner;
  if assigned(ParentForm) and (ParentForm is TCommonCustomForm) then
   begin
      if Enabled then
         PooledMessageDispatcher.AddNotificationReceiver(ParentForm)
    else
         PooledMessageDispatcher.RemoveNotificationReceiver(ParentForm);
   end;
end;

constructor TMessagingInitializer.Create(AOwner: TComponent);
begin
  inherited;
  fEnabled:=True;
  InitializeDispatcher;
end;

procedure TMessagingInitializer.SetEnabled(const Value: Boolean);
begin
  if  not (csDestroying in ComponentState) and (value <> fEnabled) then
   begin
      fEnabled:=Value;
      InitializeDispatcher;
   end;
end;

{ TPooledMesageDispatcher }

procedure TPooledMesageDispatcher.AddNotificationReceiver(
  InComponent: TComponent);
begin
   if ComponentReceiverList.IndexOf(InComponent) =-1 then
   begin
      ComponentReceiverList.Add(InComponent);
      InComponent.FreeNotification(self);
   end;
end;

Procedure TPooledMesageDispatcher.InternalMessage(var Msg:TInternalPurposeMsg);
begin
   var GenPurposeMessage:TGeneralPurposeMsg;
    with GenPurposeMessage do
   begin
        MsgID := Msg.PublicMsgID;
        Filler := Msg.Filler;
         BinaryData:=Msg.BInaryData;
         StringData:=Msg.StringData;
         ObjectData:=Msg.ObjectData;
   end;
    for var ListenerIndex := 0 to ComponentReceiverList.Count-1 do
      begin
         ExternalMessageDispatcher.Target:=ComponentReceiverList[ListenerIndex];
         ExternalMessageChannel.Queue.SendMessage(GenPurposeMessage );
      end;
end;

constructor TPooledMesageDispatcher.Create(AOwner: TComponent);
begin
  inherited;
  ComponentReceiverList:=TObjectList.Create;
  ComponentReceiverList.OwnsObjects:=false;
  InternalMessageDispatcher:=TMessageDispatcherFactory.CreateUIDispatcher;
  InternalMessageDispatcher.Channel:=InternalMessageChannel;
  InternalMessageDispatcher.Target:=Self;
  ExternalMessageDispatcher:=TMessageDispatcherFactory.CreateUIDispatcher;
  ExternalMessageDispatcher.Channel:=ExternalMessageChannel;
  ExternalMessageDispatcher.Target:=Nil;
end;

destructor TPooledMesageDispatcher.Destroy;
   procedure FreeMessageDispatcher(var TheDispatcher:IMessageDispatcher);
   begin
       if TheDispatcher = Nil then
        exit;
       try
         TheDispatcher.Enabled:=False;
         TheDispatcher.Target:=Nil;
         TheDispatcher.Channel:=Nil;
         TheDispatcher:=Nil;
       except
         {$IFDEF DEBUG}
            on E:Exception do
              raise Exception.create('Exception Freeing Dispatcher: '+E.Message);
         {$ENDIF DEBUG}
       end;
   end;

begin
  ComponentReceiverList.Free;
  FreeMessageDispatcher(InternalMessageDispatcher);
  FreeMessageDispatcher(ExternalMessageDispatcher);
  inherited;
end;

procedure TPooledMesageDispatcher.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  if Operation = TOperation.opRemove then
     RemoveNotificationReceiver(AComponent);
  inherited;
end;

procedure TPooledMesageDispatcher.RemoveNotificationReceiver(
  InComponent: TComponent);
begin
    var IndexToDelete:=ComponentReceiverList.IndexOf(InComponent);
    if IndexToDelete >-1 then
      ComponentReceiverList.Delete(IndexToDelete);
end;

Initialization
  ExternalMessageChannel:=TMessageChannelFactory.CreateChannel;
  InternalMessageChannel:=TMessageChannelFactory.CreateChannel;
  PooledMessageDispatcher:=TPooledMesageDispatcher.Create(Nil);
finalization
  ExternalMessageChannel:=Nil;
  InternalMessageChannel:=Nil;
  PooledMessageDispatcher.Free;
end.

[vincentparrett]

Interesting idea. It does dumb things down somewhat by using a single message type.

My general advice when using this library in a UI is to limit the number of UI dispatchers as they would call sychronise too often otherwise.

When time permits I will see if I can come up with a better solution.

[TheOriginalBytePlayer]

Yeah, it was a quick fix and something more elegant could probably be done – such as registering which message types you wanted to receive so it could more intelligently filter/direct them… Or perhaps a better way of doing it would be to define a base MessageObject which could be subclassed to add specific data, something like type TReceiveMessageEvent = function (const MessageID:TMessageID; MessageData:TMessageObject; FreeOnRead:Boolean=False):integer of object; TMessageObject = class(TObject) StringData:String; IntegerData:Int64; FloatData:Double; End; TMessageReceiver = class(TComponent) Private fOnReceivedMessage:TReceiveMessageEvent; Function InternalReceiveMessage(const MessageID:TMessageID; MessageData:TMessageObject; FreeOnRead:Boolean=False):integer; public Procedure Loaded; override; Property OnReceivedMessage: TReceiveMessageEvent read fOnReceivedMessage write fOnReceivedMessage; End; RegisterWithMessageServer(ComponentToBeNotified:TComponent;ReceivedEvent:TReceivedMessageEvent;MessagesToReceive:Array of TMessageID); Procedure TMessageReceiver.Loaded; Begin ***@***.***,[wm_mymessage1,wm_mymessage2]); End; Function TMessageReceiver.InternalReceiveMessage(const MessageID:TMessageID; MessageData:TMessageObject; FreeOnRead:Boolean=False):integer; Begin If Assigned(fOnReceivedMessage) then Result:=(fOnReceivedMessage(MessageID,MessageData) If Result=S_OK) and FreeOnread and Assigned(messageData) then FreeANdNil(MessageData); End; From: Vincent Parrett ***@***.***> Sent: Wednesday, May 25, 2022 6:10 PM To: VSoftTechnologies/VSoft.Messaging ***@***.***> Cc: TheOriginalBytePlayer ***@***.***>; Author ***@***.***> Subject: Re: [VSoftTechnologies/VSoft.Messaging] Too many Threads Solution (Issue #2) Interesting idea. It does dumb things down somewhat by using a single message type. My general advice when using this library in a UI is to limit the number of UI dispatchers as they would call sychronise too often otherwise. When time permits I will see if I can come up with a better solution. — Reply to this email directly, view it on GitHub <#2 (comment)> , or unsubscribe <https://github.com/notifications/unsubscribe-auth/AEJYX4HRTBMUPEWSZNL2TVTVL2QLNANCNFSM5W4QXXRA> . You are receiving this because you authored the thread. <https://github.com/notifications/beacon/AEJYX4GO6AABGV3ELW5SWUDVL2QLNA5CNFSM5W4QXXRKYY3PNVWWK3TUL52HS4DFVREXG43VMVBW63LNMVXHJKTDN5WW2ZLOORPWSZGOIPJNXSQ.gif> Message ID: ***@***.*** ***@***.***> >