I am designing two components that asynchronously receive objects of a custom class (TMELogMessage) and store them in a thread-safe internal container. The first component is non visual (TMEFileLogger) and should write some info from these objects to a log file (non surprisingly). The second component (TMELogGrid) is a visual FMX.Grid descendant that should visualize some info from these objects in the UI. But what they do with these objects is, I think, irrelevant.
The problem I am facing is that these components do not actually know when these objects will be enqueued in their internal container, so they have to check the container themselves to see if there are any new objects that need processing, process them and remove them from the queue. Ideally I'd want this to be done when the application is not too busy, in a way similar to action updating, so as not to bog down the UI.
It is obviously wrong for a component to hook an event handler like Application.OnIdle... I could maybe subscribe to the TIdleMessage, but I'm not sure that is a good idea, as I've read that a some applications could never go idle. Using an internal timer seems a bit old-school. I could maybe use a low priority thread to poll the queue and then synchronize with the UI only when I find some object to process. I don't have other ideas though.
What is the proper way to do this in Delphi + multiplatform FireMonkey?
I don't like to answer my own questions, but I wanted this question to be answered, as it might be helpful to others. While Deltics' answer is useful, that is not the way I decided to go. I followed the advice in Remy's comment and encapsulated everything in a message handling class that components and forms can use. So both the TMEFileLogger and the TMELogGrid now use an instance of this new TMEMessageHandler class.
Here is some interface code to explain what I did. Keep in mind that this is to be a substitute and enhancement of the rtl System.Messaging unit. The problem with the rtl messaging system is that it provides only for sending synchronous messages. I wanted a richer interface. This is what my message manager looks like:
TMEMessageManager = Class
...
Public
...
Procedure PostDelayedEnvelope(Const Envelope: TMEMessageEnvelope; Const DelayMSec: Cardinal; Const ADispose: Boolean = True); Inline;
Procedure PostDelayedMessage(Const Sender: TObject; AMessage: TMessage; Const DelayMSec: Cardinal; Const ADispose: Boolean = True); Inline;
Procedure PostEnvelope(Const Envelope: TMEMessageEnvelope; Const ADispose: Boolean = True); Inline;
Procedure PostMessage(Const Sender: TObject; AMessage: TMessage; Const ADispose: Boolean = True); Inline;
Procedure SendEnvelope(Const Envelope: TMEMessageEnvelope; Const ADispose: Boolean = True); Inline;
Procedure SendMessage(Const Sender: TObject; AMessage: TMessage; Const ADispose: Boolean = True); Inline;
Function Subscribe(Const AMessageClass: TClass; Const AReceiver: IMEEnvelopeReceiver): Integer; Overload;
Function Subscribe(Const AMessageClass: TClass; Const AMethod: TMessageMethod): Integer; Overload; Deprecated 'Use TMEMessageManager.Subscribe(AMessageClass, AReceiver)';
Function Subscribe(Const AMessageClass: TClass; Const AProcedure: TMessageProcedure): Integer; Overload; Deprecated 'Use TMEMessageManager.Subscribe(AMessageClass, AReceiver)';
Procedure Unsubscribe(Const AMessageClass: TClass; ID: Integer; Const Immediate: Boolean = False); Overload;
Procedure Unsubscribe(Const AMessageClass: TClass; Const AReceiver: IMEEnvelopeReceiver; Const Immediate: Boolean = False); Overload;
Procedure Unsubscribe(Const AMessageClass: TClass; Const AMethod: TMessageMethod; Const Immediate: Boolean = False); Overload; Deprecated;
Procedure Unsubscribe(Const AMessageClass: TClass; Const AProcedure: TMessageProcedure; Const Immediate: Boolean = False); Overload; Deprecated;
...
End;
The TMEMessageEnvelope is a wrapper for messages, defined as:
Type
TMEMessageEnvelope = Class(TMEPersistent)
Public
...
Property Infos: TMEMessageInfos Read FInfos;
Property Sender: TObject Read FSender;
Property Msg: TMessage Read FMsg;
End;
Receivers that subscribe via an envelope receiver will receive both synchronous and asynchronous messages. This is the preferred subscription method. Receivers that subscribe via an object method or via a procedure will only receive synchronous messages. This is maintained for compatibility with the RTL messaging system, but is deprecated.
The problem is that RTL messages cannot be posted, as they are. The subscribed consumers just provide a procedure or an object method to consume the message, right away. To post the message so as it can be consumed later, asynchronously, it needs to be wrapped and enqueued. This way the sender is isolated from the receivers. So actually... messages are posted (immediately or delayed) by first wrapping them in envelopes.
Here are the base interfaces envolved in this messaging system:
Type
IMEClonableMessage = Interface(IInterface)
['{45B223E2-DCA8-4E42-9847-6A3FCC910891}']
Function Clone: TMessage;
End;
IMEMessageSender = Interface(IInterface)
['{99AFDC4A-CE30-41A3-9AA5-D49F2F1106BD}']
Procedure PostDelayedMessage(const M: TMessage; Const DelayMSec: Cardinal);
Procedure PostMessage(Const M: TMessage);
Procedure SendMessage(Const M: TMessage);
End;
IMEEnvelopeSender = Interface(IInterface)
['{C3AEC52C-A558-40AB-B07B-3000ECDB9C0C}']
Procedure PostDelayedEnvelope(Const Envelope: TMEMessageEnvelope; Const DelayMSec: Cardinal);
Procedure PostEnvelope(Const Envelope: TMEMessageEnvelope);
Procedure SendEnvelope(Const Envelope: TMEMessageEnvelope);
End;
IMEEnvelopeReceiver = Interface(IInterface)
['{7D464713-2F25-4666-AAF8-757AF07688C3}']
Procedure ClearEnvelopes;
Procedure ProcessEnvelope;
Procedure ProcessEnvelopes;
Function QueueEnvelope(Const Envelope: TMEMessageEnvelope): Integer;
Procedure ReceiveEnvelope(Const Envelope: TMEMessageEnvelope);
Procedure Subscribe(Const AMessageClass: TClass);
Procedure Unsubscribe(Const AMessageClass: TClass);
End;
The IMEClonableMessage interface is used to clone messages... asynchronous messages must be cloned... because if there are many subscribers to the same message, each will receive and consume the message in different times, so it is best that each has its own copy of the message.
The other interfaces are, I think, self explanatory.
And finally here is the TMEMessageHandler class:
TMEMessageHandler = Class(TMEPersistent, IMEMessageSender, IMEEnvelopeSender, IMEEnvelopeReceiver)
/// <summary>Basic thread-safe class that can send and receive synchronous and asynchronous messages and envelopes.</summary>
Private
FLock: TObject;
FMessageManager: TMEMessageManager;
FSubscriptions: TDictionary<TClass, Integer>;
FEnvelopes: TObjectList<TMEMessageEnvelope>;
FOnReceiveEnvelope: TReceiveEnvelopeEvent;
FAutoProcessEnvelopes: Boolean;
Procedure _Lock;
Procedure _Unlock;
Procedure ClearSubscriptions;
Function GetMessageManager: TMEMessageManager;
Procedure SetAutoProcessEnvelopes(Const Value: Boolean);
Procedure SetMessageManager(Const Value: TMEMessageManager);
Protected
Function QueryInterface(Const IID: TGuid; Out Obj): HResult; Stdcall;
Function _AddRef: Integer; Stdcall;
Function _Release: Integer; Stdcall;
Procedure DoReceiveEnvelope(Const Envelope: TMEMessageEnvelope);
Procedure PostDelayedEnvelope(Const Envelope: TMEMessageEnvelope; Const DelayMSec: Cardinal);
Procedure PostDelayedMessage(Const M: TMessage; Const DelayMSec: Cardinal);
Procedure PostEnvelope(Const Envelope: TMEMessageEnvelope);
Procedure PostMessage(Const M: TMessage);
Procedure SendEnvelope(Const Envelope: TMEMessageEnvelope);
Procedure SendMessage(Const M: TMessage);
Function QueueEnvelope(Const Envelope: TMEMessageEnvelope): Integer;
Procedure ReceiveEnvelope(Const Envelope: TMEMessageEnvelope);
Public
Constructor Create; Override;
Destructor Destroy; Override;
Procedure ClearEnvelopes;
Procedure ProcessEnvelope;
Procedure ProcessEnvelopes;
Procedure Subscribe(Const AMessageClass: TClass);
Procedure Unsubscribe(Const AMessageClass: TClass);
Property AutoProcessEnvelopes: Boolean Read FAutoProcessEnvelopes Write SetAutoProcessEnvelopes Default True;
Property MessageManager: TMEMessageManager Read GetMessageManager Write SetMessageManager;
Property OnReceiveEnvelope: TReceiveEnvelopeEvent Read FOnReceiveEnvelope Write FOnReceiveEnvelope;
End;
How all this works
The TMEMessageHandler immediately delegates to the MessageManager any Subscribe and Unsubscribe calls. It will always subscribe providing itself as an IMEEnvelopeReceiver. It keeps track of subscriptions in its internal dictionary so as to be more efficient when it unsubscribes.
It also immediately delegates any call to the Send, Post and PostDelayed methods. The TMEMessageManager:
Sends messages to subscribed procedures (as RTL)
Sends messages to subscribed object methods (as RTL)
Sends envelopes to subscribed receivers by calling their
ReceiveEnvelope method
Posts envelopes (and envelope wrapped messages) to subscribed
receivers by calling their QeueEnvelope method with a cloned copy of
the envelope
Posts delayed envelopes (and envelope wrapped messages) to subscribed
receivers by enqueing them first in an internal lightweight thread
(TMEDelayedEnvelopeDeliverer) which has the message manager itself
deliver them when the delay has passed
As a receiver, the TMEMessageHandler implements the ReceiveEnvelope by simply delegating to the OnReceiveEnvelope event-handler.
Posted envelopes are received by the QueueEnvelope method, which adds the envelope in its thread-safe queue and then, but only if AutoProcessEnvelopes is True, uses the main thread's Queue to call its own ProcessEnvelope method (as by Remy's suggestion):
Function TMEMessageHandler.QueueEnvelope(Const Envelope: TMEMessageEnvelope): Integer;
Begin
_Lock;
Try
FEnvelopes.Add(Envelope);
Result := FEnvelopes.Count;
Finally
_Unlock;
End;
If AutoProcessEnvelopes Then
TThread.Queue(Nil,
Procedure
Begin
ProcessEnvelope;
End);
End;
The ProcessEnvelope method extracts the envelope from the thread-safe queue, calls the ReceiveEnvelope method (same as called by the message manager for synchronous messages) and then Frees the envelope (remember that this was a cloned copy just for this receiver):
Procedure TMEMessageHandler.ProcessEnvelope;
Var
E: TMEMessageEnvelope;
Begin
If FEnvelopes.Count > 0 Then Begin
_Lock;
Try
E := FEnvelopes.Extract(FEnvelopes[0]);
Finally
_Unlock;
End;
E.UpdateInfo(mieReceived);
ReceiveEnvelope(E);
E.Free;
End;
End;
The ProcessEnvelopes method just calls the former as many times as necessary to empty the asynchronous message queue:
Procedure TMEMessageHandler.ProcessEnvelopes;
Begin
While FEnvelopes.Count > 0 Do
ProcessEnvelope;
End;
How is the TMEMessageHandler used
Having defined TMELogMessage as an IMEClonableMessage to handle information to log, a minimal implementation for TMEFileLogger and other components looks like this:
Type
TMEFileLogger = Class(TMEComponent)
Private
...
FMessageHandler: TMEMessagehandler;
Protected
...
Procedure ReceiveLogEnvelope(Const Envelope: TMEMessageEnvelope);
Property MessageHandler: TMEMessagehandler Read FMessageHandler;
Public
Constructor Create(AOwner: TComponent); Override;
Destructor Destroy; Override;
...
End;
Constructor TMEFileLogger.Create(AOwner: TComponent);
Begin
Inherited;
...
FMessageHandler := TMEMessagehandler.Create;
MessageHandler.OnReceiveEnvelope := ReceiveLogEnvelope;
MessageHandler.Subscribe(TMELogMessage);
End;
Destructor TMEFileLogger.Destroy;
Begin
MessageHandler.Unsubscribe(TMELogMessage);
MessageHandler.ProcessEnvelopes;
FreeAndNil(FMessageHandler);
...
Inherited;
End;
Procedure TMEFileLogger.ReceiveLogEnvelope(Const Envelope: TMEMessageEnvelope);
Begin
If Envelope.Msg Is TMELogMessage Then
With Envelope.Msg As TMELogMessage Do
... something useful ...
End;
Sorry for the long post, but I hope this can be useful to someone else.
Queue implementations typically implement an event (OS synchronization object, not a VCL 'event') which application code can wait on. The event is set/fired/triggered/however you want to think of it whenever an item is added to an empty queue (or, if multiple items are added in a "batch", after they have all been added. The precise pattern may vary). If the queue in your case is your own implementation then I would consider adding such a mechanism to your implementation.
To avoid blocking the UI the application code creates a lightweight thread with the sole purpose of waiting on that queue event, de-queuing items from the queue into a UI thread-safe container and then notifying the UI thread that there are items to be processed. The monitoring thread then resumes waiting for the event to signal that there are yet more items in the queue.
In a VCL application the mechanism by which the monitoring thread notifies the UI could be a naive Synchronized procedure or (I would recommend) a message based notification posted to some form responsible for the UI processing of the items.
NOTE: The queue monitoring thread is also typically responsible for handling the case where the application/UI no longer cares about processing items (e.g. is shutting down) and so also listens for a "cancel" or "terminate" event which signals the thread to de-queue items but discard them (or deal with them in whatever way suits the application needs at this time) and then terminate (that is, the monitoring thread exits).
Related
I am handling some specific TForm's event [CMControlListChanging],
and need to modify that (inserted) control, but thing gets bad, when I try to do so, because apparently it's not meant to do this in the middle of VCL operation.
So I need to defer that control modification, by queuing the code away from the [CMControlListChanging] handler, to be called at later time.
Sure, I can do PostMessage stuff, but I want more general approach.
System.Classes unit contains
class procedure Synchronize(ASyncRec: PSynchronizeRecord; QueueEvent: Boolean = False); overload;
which could do the trick, but it checks, whether
CurrentThread.ThreadID = MainThreadID
and if yes, then call method I try to queue immediately.
Is the any good approach to deferred calls, at least on the main thread?
Not sure if this is what you are looking for, but if you are on a recent Delphi version these Postpone methods may come in handy. They execute AProc in the main thread after applying an optional non-blocking delay.
uses
System.Threading,
System.Classes;
procedure Postpone(AProc: TThreadProcedure; ADelayMS: Cardinal = 0); overload;
begin
TTask.Run(
procedure
begin
if ADelayMS > 0 then begin
TThread.Sleep(ADelayMS);
end;
TThread.Queue(nil, AProc);
end);
end;
procedure Postpone(AProc: TThreadMethod; ADelayMS: Cardinal = 0); overload;
begin
TTask.Run(
procedure
begin
if ADelayMS > 0 then begin
TThread.Sleep(ADelayMS);
end;
TThread.Queue(nil, AProc);
end);
end;
How about this one? It doesn't create a new task, just a new HWND (to receive the message):
TYPE TDelayedProc = REFERENCE TO PROCEDURE;
TYPE
TPostponeClass = CLASS(TWinControl)
CONSTRUCTOR Create(P : TDelayedProc);
STRICT PRIVATE
Proc : TDelayedProc;
PROCEDURE Run(VAR M : TMessage); MESSAGE WM_USER;
END;
CONSTRUCTOR TPostponeClass.Create(P : TDelayedProc);
BEGIN
INHERITED Create(NIL);
Parent:=Application.MainForm;
Proc:=P;
PostMessage(Handle,WM_USER,0,0)
END;
PROCEDURE TPostponeClass.Run(VAR M : TMessage);
BEGIN
Proc;
Free
END;
PROCEDURE Postpone(Proc : TDelayedProc);
BEGIN
TPostponeClass.Create(Proc)
END;
It even works with anonymous methods, so you can postpone a part of execution of an event and still have access to the local variables (and the instance "Self").
Use it like this:
PROCEDURE WriteFile(CONST F : TFileName ; CONST STR : STRING);
VAR
TXT : TextFile;
BEGIN
AssignFile(TXT,F);
IF FileExists(F) THEN APPEND(TXT) ELSE REWRITE(TXT);
WRITELN(TXT,STR);
CloseFile(TXT)
END;
PROCEDURE TForm37.Button1Click(Sender: TObject);
CONST
N = 'LOGFILE.TXT';
VAR
LocalVar : INTEGER;
BEGIN
DeleteFile(N);
LocalVar:=20;
Postpone(PROCEDURE
BEGIN
WriteFile(N,'Postponed Code: '+Name+' ('+IntToStr(LocalVar)+')')
END);
WriteFile(N,'Last statement in event: '+Name)
END;
The LOGFILE.TXT file will contain the two lines:
Last statement in event: Form37
Postponed Code: Form37 (20)
to illustrate that the postponed event is only run at the end of the event, as well as access to local variables.
Caveat: Do you run Application.ProcessMessages between Postpone call and event exit - if you do, the postponed code will be run at that point.
Since Delphi 10.2 Tokyo, it is possible to defer a call from the main thread asynchronously using a method of TThread.
See TThread.ForceQueue:
class procedure ForceQueue(const AThread: TThread; const AMethod: TThreadMethod); overload; static;
class procedure ForceQueue(const AThread: TThread; const AThreadProc: TThreadProcedure); overload; static;
Queues the execution of a method call within the main thread.
Unlike Queue, the execution of the method call specified by AMethod is forced to be queued although it is called by the main thread.
AMethod associates the caller thread:
For static methods, you can associate the AMethod with any thread using the AThread parameter.
You can use nil/NULL as the AThread parameter if you do not need to know the information of the caller thread in the main thread.
RemoveQueuedEvents uses this thread information to find the proper queued method.
I offloaded all ADO hood in a separate Data Module, so a single module can be referred by several applications. All my applications basically need only two worker methonds to access data:
AdoQuery delivers a result set in a form of TADODataSet.
AdoExecute performs simple update/delete queries without fetching any results.
Here is the class structure:
type
TMyDataModule = class(TDataModule)
procedure DataModuleCreate(Sender: TObject);
procedure DataModuleDestroy(Sender: TObject);
private
procedure pvtAdoConnect;
procedure pvtAdoExecute(const sql: string);
function pvtAdoQuery(const sql: string): TADODataSet;
public
AdoConnection: TADOConnection;
end;
Then I added two publicly exposed wrappers to class methods. I used that to avoid long class references in the calls:
function AdoQuery(const sql: string): TADODataSet;
procedure AdoExecute(const sql: string);
implementation
function AdoQuery(const sql: string): TADODataSet;
begin
Result := MyDataModule.pvtAdoQuery(sql);
end;
Above are the worker function which I call from within all my forms.
AdoConnect runs only once on DataModuleCreate event. TDatModule derived from TPersistent, which allows to persist the single instance of connection throughout a runtime.
The only thing that annoys me so far - is a useless .DFM which I don't need at all.Is there any option to get rid of it?
I would handle this type of thing in one of two ways, with interfaces or with inheritance. I prefer not to expose classes to the outside world in these cases. The second one could almost be called an interface without interfaces :)
Interfaces
This version returns an interface that includes the required methods. The outside world only needs to use the interface. We keep the implementation details private. Our TMyDBClass implements the interface that we have exposed to the outside world and our global function GetDBInterface returns the single instance.
interface
uses
ADODB;
type
IMyDBInterface = interface
['{2D61FC80-B89E-4265-BB3D-93356BD613FA}']
function AdoQuery(const sql: string): TADODataSet;
procedure AdoExecute(const sql: string);
end;
function GetDBInterface: IMyDBInterface;
implementation
type
TMyDBClass = class(TInterfacedObject, IMyDBInterface)
strict private
FConnection: TADOConnection;
protected
procedure AfterConstruction; override;
procedure BeforeDestruction; override;
public
function AdoQuery(const sql: string): TADODataSet;
procedure AdoExecute(const sql: string);
end;
var
FMyDBInterface: IMyDBInterface;
procedure TMyDBClass.AdoExecute(const sql: string);
begin
// ...
end;
function TMyDBClass.AdoQuery(const sql: string): TADODataSet;
begin
// ...
end;
procedure TMyDBClass.AfterConstruction;
begin
inherited;
FConnection := TADOConnection.Create(nil);
end;
procedure TMyDBClass.BeforeDestruction;
begin
FConnection.Free;
inherited;
end;
// Our global function
function GetDBInterface: IMyDBInterface;
begin
if not Assigned(FMyDBInterface) then
FMyDBInterface := TMyDBClass.Create;
Result := FMyDBInterface;
end;
initialization
finalization
FMyDBInterface := nil;
end.
Inheritance
This version uses a base class that has the required methods. This is a bit easier for people to deal with because it excludes the interface which can be complex to people starting out. Again we hide the implementation details from the user and only expose a shell of a class that includes the two methods we want people to access. The implementation of these methods is performed by a class in the implementation that inherits from the exposed class. We also have a global function that returns the instance of this class. The big advantage that the interface approach has over this approach is that the user of this object can't free the object by accident.
interface
uses
ADODB;
type
TMyDBClass = class(TObject)
public
function AdoQuery(const sql: string): TADODataSet; virtual; abstract;
procedure AdoExecute(const sql: string); virtual; abstract;
end;
function GetDBClass: TMyDBClass;
implementation
type
TMyDBClassImplementation = class(TMyDBClass)
strict private
FConnection: TADOConnection;
protected
procedure AfterConstruction; override;
procedure BeforeDestruction; override;
public
function AdoQuery(const sql: string): TADODataSet; override;
procedure AdoExecute(const sql: string); override;
end;
var
FMyDBClass: TMyDBClassImplementation;
procedure TMyDBClassImplementation.AdoExecute(const sql: string);
begin
inherited;
// ...
end;
function TMyDBClassImplementation.AdoQuery(const sql: string): TADODataSet;
begin
inherited;
// ...
end;
procedure TMyDBClassImplementation.AfterConstruction;
begin
inherited;
FConnection := TADOConnection.Create(nil);
end;
procedure TMyDBClassImplementation.BeforeDestruction;
begin
FConnection.Free;
inherited;
end;
// Our global function
function GetDBClass: TMyDBClass;
begin
if not Assigned(FMyDBClass) then
FMyDBClass := TMyDBClassImplementation.Create;
Result := FMyDBClass;
end;
initialization
FMyDBClass := nil;
finalization
FMyDBClass.Free;
end.
Usage
Usage of these are really easy.
implementation
uses
MyDBAccess; // The name of the unit including the code
procedure TMyMainForm.DoSomething;
var
myDataSet: TADODataSet;
begin
myDataSet := GetDBInterface.AdoQuery('SELECT * FROM MyTable');
...
// Or, for the class version
myDataSet := GetDBClass.AdoQuery('SELECT * FROM MyTable');
...
end;
If you don't have any design-time non-visual components dropped onto your data module, and don't plan to ever do so, then you shouldn't need a data module at all. The whole purpose is for design-time components, and other implementations such as a Web Module or even a Windows Service Application. But not for wrapping pure code without design-time components.
Also, as mentioned in the comments, don't be confused about the meaning of TPersistent. This class is used entirely differently, and can be integrated into the IDE Object Inspector (as sub-properties within a component).
So the ideal thing for you to do is encapsulate everything in just a single class. For your purpose, a database connection...
type
TMyData = class(TObject)
private
FConnection: TADOConnection;
public
constructor Create;
destructor Destroy; override;
procedure pvtAdoConnect;
procedure pvtAdoExecute(const sql: string);
function pvtAdoQuery(const sql: string): TADODataSet;
...
end;
implementation
{ TMyData }
constructor TMyData.Create;
begin
FConnection:= TADOConnection.Create(nil);
end;
destructor TMyData.Destroy;
begin
FConnection.Connected:= False;
FConnection.Free;
inherited;
end;
As for the interpretation of being "persistent", you can create/destroy an instance of it in many ways. For example, you could use a unit's initialization and finalization sections (requiring CoInitialize) or you can have your main form initialize a global instance upon creation.
One common way of doing so is to add...
interface
function MyData: TMyData;
implementation
var
_MyData: TMyData;
function MyData: TMyData;
begin
if not Assigned(_MyData) then
_MyData:= TMyData.Create;
Result:= _MyData;
end;
initialization
_MyData:= nil;
finalization
_MyData.Free;
end.
The first time you call MyData from anywhere, a new global instance will be instantiated. Then, every further time it re-uses the same instance. This also solves the need of ActiveX and CoInitialize etc. because at this point, COM is expected to already be instantiated (which is required for ADO).
Usage of this unit would be extremely simple - use include it in the uses anywhere, and access its instance through the MyData function.
Notes
You should get out of the habit of global variables. This is asking for trouble down the road when trying to do later work. The example above shows how to accommodate for a global object instance. All other variables should be self-contained within that object, or in general one of scope / relevance. The whole control of your TADOConnection should be within here, including connecting/disconnecting, exception handling, assigning the connection string.
In case you might be interested in an alternative without DataModules alltogether, have a look at this:
https://github.com/stijnsanders/xxm/blob/master/Delphi/demo2/03%20Data%20ADO/xxmData.pas
Queries are stored in a single .sql file, which is handy to edit it in specific SQL editors or workbenches. Queries are separated with a line with --"QueryName", and loaded in a query-store on start-up. Assuming you query for smaller recordsets most of the time, the best lock and open style is read-only and static, which offers the best possible performance and least load on the database server. Getting field values uses the Collect call which also offers a little performance gain.
I have to develop plugin system for non-gui app that I'm developing. I envisioned this as core app that has basic set of features, and which is extendable with plugins.
Now, I figured out that probably best way to do this is to make plugins as DLLs, and to load them within host app. Plugins should be able to modify some parts of app core (access to certain methods/variables), and this is tricky part.
What I've thought is to make THost class, which implements IHost and IHostExposed interfaces. When host loads plugin, it will pass IHostExposed to plugin, and plugin could call methods/access to variables in that interface. Something like this:
Interface declarations:
unit uHostInterfaces;
interface
type
IHost = interface
['{BAFA98BC-271A-4847-80CE-969377C03966}']
procedure Start;
procedure Stop;
end;
// this intf will get exposed to plugin
IHostExposed = interface
['{1C59B1A9-EC7A-4D33-A574-96DF8F5A7857}']
function GetVar1: Integer;
function GetVar2: String;
procedure SetVar1(const AValue: Integer);
procedure SetVar2(const AValue: String);
property Var1: Integer read GetVar1 write SetVar1;
property Var2: String read GetVar2 write SetVar2;
end;
implementation
end.
Host class declaration:
unit uHost;
interface
uses
Winapi.Windows, Winapi.Messages,
uHostInterfaces, uInstanceController, uSettings;
type
THost = class(TInterfacedObject, IHost, IHostExposed)
private
FVar1 : Integer;
FVar2 : String;
FWindowHandle : HWND;
FInstanceController: TInstanceController;
FSettings : TSettings;
procedure WndProc(var AMessage: TMessage);
public
constructor Create;
destructor Destroy; override;
// methods from IHost
procedure Start;
procedure Stop;
// methods from IHostExposed, which get set Var1/Var2
function GetVar1: Integer;
function GetVar2: string;
procedure SetVar1(const AValue: Integer);
procedure SetVar2(const AValue: string);
end;
implementation
...
...and how i'd use it:
type
TRegisterPlugin = procedure(const AHostExposed: IHostExposed);
var
hdll : THandle;
RegisterPlugin: TRegisterPlugin;
host : IHost;
begin
host := THost.Create;
hdll := LoadLibrary('plugin.dll');
if hdll <> 0 then
begin
#RegisterPlugin := GetProcAddress(hdll, 'RegisterPlugin');
if Assigned(RegisterPlugin) then
begin
// call the plugin function and pass IHostExposed interface to it
// from there on, plugin can use this interface to interact with core app
RegisterPlugin(host as IHostExposed);
...
What I would like to hear is any suggestions about this approach, and if there are better solutions for what I'm trying to achieve?
Apparently you've worked with interfaces before, but you don't know the component registration features of COM? Use the new project wizard to start an ActiveX library with Automation Objects, have a look around the Type Library editor, and see what happens when the library runs and registers itself (it's all there in System.Win.ComServ.pas)
to write information on the processing state to the GUI inside a tcpserver.onexecute(..) function , i used the following command sequence
ExecuteDUMMYCommand(Global_Send_Record);
BitMap_PaintImageProcess;
TThread.Synchronize(nil, BitMap_PaintImageProcess);
The code is working well on some machines, but on a few it fails. The code execution stops atTThread.Synchronize command. I guess on these machines the function call is trapped inside a deadlock
Any chance to figure out the real problem behind ?
The procedure BitMap_PaintImageProcess , here I create a Bitmap and do a lot of painting stuff , but is seems that this code is never executed ?
I try to explain the very long code and reduce to the main points , the critical thread issues are hidden in processing the bitmap inside my Bitmapprocessingclass.
This class is accessed inside the GUIProcessing procedures of my ServerMainForm which also has the INDY TCP Server component.
{--------------- CLASS DEFINITION -----------------------------}
TBitMapProcessingClass = class()
FBitmap : TBitmap;
FList : TListOfSomething;
procedure ProcessTheBitmap(....);
......
(many many functions);
procedure Init;
procedure Free;
Procedure Create;
end;
TMainform = class(TForm)
MyServer : TIdTCPServer;
aBitMaoProcessingClass : TBitMaoProcessingClass;
procedure BitMap_PaintImageProcess;
procedure BitMap_ListProcess;
.....
end;
{------------------------- Implemantation ------------------------------}
procedure TMainform.IndyTCPServer.Onexecute()
begin
.......
ExecuteDUMMYCommand(Global_Send_Record);
BitMap_PaintImageProcess;
TThread.Synchronize(nil, BitMap_PaintImageProcess);
.......
end;
procedure TMainform.BitMap_PaintImageProcess;
begin
DoSomeServerVCLStuff(....);
aBitMapProcessingClass.ProcessTheBitmap;
DoSomeServerVCLStuff(....);
end;
Having no idea what BitMap_PaintImageProcess() does in fact, I have a few suppositions:
In the TThread.Synchronize call you try to read some data from the socket/idContext, but the data is not yet available. This will block the main thread until the data becomes available. But Indy's thread that is responsible for reading from the underlying socket buffer is currently blocked by your TThread.Synchronize call in the OnExecute event i.e. deadlock occurs;
In the TThread.Synchronize call you use Application.ProcessMessages (a common mistake);
In the OnExecute event you enter a critical section. Then during the TThread.Synchronize call you try to enter the same critical section again;
You modify the GUI in the onExecute event. Because onExecute is not thread safe, accessing VCL/FM from Indy's thread could lead to unpredictable results, including random deadlocks (hard to find).
I would suggest to use MadExcept / Eurekalog. They both have options to check if the main thread is "frozen". When that happens (during the deadlock) they will show you the current call stack. Having the call stack you can figure out which function is causing the deadlock.
Regarding the posted code:
procedure TMainform.IndyTCPServer.Onexecute()
begin
.......
ExecuteDUMMYCommand(Global_Send_Record);
BitMap_PaintImageProcess; //-> You do VCL stuff in the context of Indy's thread!
TThread.Synchronize(nil, BitMap_PaintImageProcess);
end;
In the BitMap_PaintImageProcess() you call DoSomeServerVCLStuff(....). Do not forget that OnExecute is fired from Indy's thread for the current context. I.e. you modify VCL from another thread (other from the Main Thread) which is not thread safe.
On your comment:
...but here my complex TBitmap processing Class must be alive the whole
time my Server is active...
If you have only one (global) instance for image processing, then what will happen if another client connects, while you are still processing the old connection (think Parallel :) )? Your image processing class should be instantiated separately for each new connection/context. For GUI updating you can use TIdNotify descendant.
A possible solution:
type
{ tIdNotify Stuff }
TVclProc= procedure(imgClass: tMyImageProcessingClass) of object;
tIdNotifyDescendant = (tIdNotify)
protected
fImgClass: tMyImageProcessingClass;
fProc: TVclProc;
procedure DoNotify; override;
public
class procedure updateVcl(imgClass: tMyImageProcessingClass; vclProc: TVclProc);
end;
procedure tIdNotifyDescendant.DoNotify;
begin
inherited DoNotify;
FProc(fImgClass);
end;
class procedure tIdNotifyDescendant.updateVcl(imgClass: tMyImageProcessingClass; vclProc: TVclProc);
begin
with Create do
begin
fImgClass := imgClass;
fProc := vclProc;
Notify;
end;
end;
{ Indy stuff & other logic }
procedure TForm1.IdTCPServer1Connect(AContext: TIdContext);
begin
// Create your instance when the client connects
AContext.Data := tMyImageProcessingClass.Create;
end;
procedure TForm1.IdTCPServer1Disconnect(AContext: TIdContext);
begin
// Do cleanup
if assinged(AContext.Data) then
(AContext.Data as tMyImageProcessingClass).Free // Casting just for clarity
end;
procedure TForm1.IdTCPServer1Execute(AContext: TIdContext);
var
imgProcClass: tMyImageProcessingClass;
begin
imgProcClass := acontext.Data as tMyImageProcessingClass;
// Do image processing
// Notify GUI for the progress:
tIdNotifyDescendant.updateVcl(AContext.data as tMyImageProcessingClass);
end;
Tip: If you do JPEG processing and you use Draw() method have in mind this: TJPEGImage.Draw() is not thread safe
I added a few more details on my BitmapProcessingclass and the idea of a thread safe extension of the existing class...
I need the existing class u nchanged in others apps ... I need a extension inside my app with the indy server.
ONly one client my connect to one server, or he has to query the state of the server
type TBmpNotify = class(TIdNotify)
protected
FBMP: MyImageProcessingClass;
procedure DoNotify; override;
public
constructor Create(aBMP: MyImageProcessingClass);
function SetImageView(LL, UR: TPoint): Boolean;
procedure PaintBitMap;
function InitBitMap(x, y: Integer;
PixelFormat: TPixelFormat = pf24bit): Boolean;
destructor free;
end;
implementation
{ TBmpNotify }
constructor TBmpNotify.Create(aBMP: MyImageProcessingClass);
begin
// indise this class I also create
// class.TBitmap
// class.TList
// much more stuff ....
FBmp := MyImageProcessingClass.Create;
end;
procedure TBmpNotify.DoNotify;
begin
inherited;
end;
destructor TBmpNotify.free;
begin
FBmp.Free;
inherited;
end;
function TBmpNotify.InitBitMap(x, y: Integer;
PixelFormat: TPixelFormat): Boolean;
begin
// Write values to the List
// also modify TBitmap
// execution time of this function ~ 5 min
FBmp.InitBitMap(x,y,PixelFormat)
end;
procedure TBmpNotify.PaintBitMap;
begin
// much TBitmap, bitmap.canvas .... is used
// execution time of this function ~ 1 min
FBmp.PaintBitMap;
end;
function TBmpNotify.SetImageView(LL, UR: TPoint): Boolean;
begin
// this function takes about 1 min
FBmp.SetImageView(LL, UR);
end;
end.
Since anonymous methods appeared in Delphi I wanted to use them in VCL components events. Obviously for backward compatibility the VCL wasn't updated, so I managed to make a simple implementation with a few caveats.
type
TNotifyEventDispatcher = class(TComponent)
protected
FClosure: TProc<TObject>;
procedure OnNotifyEvent(Sender: TObject);
public
class function Create(Owner: TComponent; const Closure: TProc<TObject>): TNotifyEvent; overload;
function Attach(const Closure: TProc<TObject>): TNotifyEvent;
end;
implementation
class function TNotifyEventDispatcher.Create(Owner: TComponent; const Closure: TProc<TObject>): TNotifyEvent;
begin
Result := TNotifyEventDispatcher.Create(Owner).Attach(Closure)
end;
function TNotifyEventDispatcher.Attach(const Closure: TProc<TObject>): TNotifyEvent;
begin
FClosure := Closure;
Result := Self.OnNotifyEvent
end;
procedure TNotifyEventDispatcher.OnNotifyEvent(Sender: TObject);
begin
if Assigned(FClosure) then
FClosure(Sender)
end;
end.
And this is how it's used for example:
procedure TForm1.FormCreate(Sender: TObject);
begin
Button1.OnClick := TNotifyEventDispatcher.Create(Self,
procedure (Sender: TObject)
begin
Self.Caption := 'DONE!'
end)
end;
Very simple I believe, there are two drawbacks:
I have to create a component to manage the lifetime of the anonymous method (I waste a bit more of memory, and it's a bit slower for the indirection, still I prefer more clear code in my applications)
I have to implement a new class (very simple) for every event signature. This one is a bit more complicated, still the VCL has very common event signatures, and for every special case when I create the class it's done forever.
What do you think of this implementation? Something to make it better?
You can take a look at my multicast event implementation in DSharp.
Then you can write code like this:
function NotifyEvent(Owner: TComponent; const Delegates: array of TProc<TObject>): TNotifyEvent; overload;
begin
Result := TEventHandler<TNotifyEvent>.Create<TProc<TObject>>(Owner, Delegates).Invoke;
end;
function NotifyEvent(Owner: TComponent; const Delegate: TProc<TObject>): TNotifyEvent; overload;
begin
Result := NotifyEvent(Owner, [Delegate]);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Button1.OnClick := NotifyEvent(Button1, [
procedure(Sender: TObject)
begin
Caption := 'Started';
end,
procedure(Sender: TObject)
begin
if MessageDlg('Continue?', mtConfirmation, mbYesNo, 0) <> mrYes then
begin
Caption := 'Canceled';
Abort;
end;
end,
procedure(Sender: TObject)
begin
Caption := 'Finished';
end]);
end;
You could make TNotifyEventDispatcher to be a subclass of TInterfacedObject so you do not need to care about freeing it.
But to be more pragmatic one would use traditional event assignment that takes less lines of code and is supported by the IDE.
Interesting approach.
(Disclaimer: haven't checked this, but it is something to investigate): You may have to be careful though about what goes on in capturing the state of the method that "assigns" the anonymous method to the event. Capturing can be an advantage but can also have side effects you do not want. If your anonymous method needs info about the form at the time it is fired, it may end up with info at the time of its assignment. Update: apparently this is not the case, see comment by Stefan Glienke.
You do not really need different classes. Using overloading you could create different class Create functions that each take a specific signature and return the corresponding event handler and the compiler will sort it out.
Managing lifetime could be simplified if you derived from TInterfacedObject instead of TComponent. Reference counting should then take care of destroying the instance when it is no longer used by the form. Update: this does require keeping a reference to the instance somewhere in the form, or refcounting won't help as the instance will be freed immediately after assigning the notify event. You could add an extra parameter on the class Create functions to which you pass a method that the instance can useto add itself to some list of the form.
Side note: All in all though I have to agree with David in his comment on the question: it does sound like a lot of work for the "sole purpose" of using anonymous methods...