I have a Delphi (Windows) application created using Delphi 10 that has some blocking calls that I would like to convert to using threads. Unfortunately for me, these are not procedures, but functions. (And information on how to return function results from threads appears to be much more limited.) I am trying to familiarize myself with the OmniThreadLibrary, since it seems to be the most flexible and best supported threading library for Delphi, but I'm having trouble with understanding how to do this.
I have been able to get the various OmniThreadLibrary routines to work well with procedures, but when I try to set up a function, I get an error about capturing the result. When I use OmniThreadLibrary's Future example as a starting point, I can get the function to work, but I can't figure out how to connect to the event monitor, how to send messages from the task, etc. So, it seems as if I'm overlooking something no matter which way I try to solve this problem.
Currently, my program does something like this:
If myPing(IPAddress) then
begin
//Do other things here…
end;
Because myPing is blocking, and I actually need it to wait until myPing returns true before processing further, the application gets sluggish during this process. I'd like to put the myPing call in a thread, which would solve the sluggishness problem, but I can't figure out how to do that in the form of a function using OmniThreadLibrary. (Unless I use a future, in which case I can't figure out how to connect to the Event Monitor.)
Edit 1: Since my original post, I have made a little progress. I was able to connect the Event Monitor to the Future by adding Parallel.TaskConfig.MonitorWith(Form1.OmniEventMonitor1) to my code, right after the function. However, I still can't figure out how to send messages to that event monitor from within the Future function.
Edit 2: I now have some sample code. My first attempt was similar to this:
function myPing(HostName: string): IOmniFuture<boolean>;
begin
Result := Parallel.Future<boolean>(function: boolean
begin
Result := False;
//Do actual ping here... Set Result := True if successful.
end
);
end;
The basic function worked, but did not allow me to send any messages to the TOmniEventMonitor. I was able to get that part working by changing the code to this:
function myPing(HostName: string): IOmniFuture<boolean>;
begin
Result := Parallel.Future<boolean>(function: boolean
begin
Result := False;
//Do actual ping here... Set Result := True if successful.
end,
Parallel.TaskConfig.MonitorWith(Form1.OmniEventMonitor1)
);
end;
Now, I can successfully monitor the OnTaskTerminated event, but I still can't send messages to the Event Monitor from the task. By changing my code once again, I can access the task itself and send messages using task.Comm.Send(), but the messages don't reach the EventMonitor:
function myPing(HostName: string): IOmniFuture<boolean>;
begin
Result := Parallel.Future<boolean>(function(const task: IOmniTask): boolean
begin
Result := False;
//Do actual ping here... Set Result := True if successful.
task.Comm.Send(0,'Test 1');
end,
Parallel.TaskConfig.MonitorWith(Form1.OmniEventMonitor1)
);
end;
Here's a simple example on how to retrieve the function result from the async call. It does not use an "OmniEventMonitor" but instead calls a function once the async call returns ("Ping" is defined in PingU.pas, but not of importance here):
unit MainFormU;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Menus;
type
TPingResultEvent = procedure (const bResult: Boolean) of object;
TOnTerminateTestForm = class(TForm)
LogMemo: TMemo;
MainMenu: TMainMenu;
PingMenu: TMenuItem;
procedure PingMenuClick(Sender: TObject);
private
procedure BackgroundPing (const sServer: String;
const OnResult: TPingResultEvent);
procedure PingResult (const bResult: Boolean);
public
{ Public declarations }
end;
var
OnTerminateTestForm: TOnTerminateTestForm;
implementation
{$R *.dfm}
uses PingU, OtlParallel, OtlTaskControl;
procedure TOnTerminateTestForm.PingMenuClick (Sender: TObject);
var
sServer : String;
begin
if (InputQuery ('Ping computer', 'Computer name:', sServer)) then
if (sServer <> '') then
begin
PingMenu.Enabled := false;
LogMemo.Lines.Add (Format ('Pinging %s',[sServer]));
BackgroundPing (sServer, PingResult);
end; { if }
end; { TOnTerminateTestForm.PingMenuClick }
procedure TOnTerminateTestForm.BackgroundPing (const sServer: String;
const OnResult: TPingResultEvent);
var
bResult : Boolean;
begin
Parallel.Async (
procedure
begin
bResult := Ping (sServer);
end,
Parallel.TaskConfig.OnTerminated(
procedure (const task: IOmniTaskControl)
begin
// executed in main thread after the async has finished
if Assigned (OnResult) then
OnResult (bResult);
end
)
);
end; { TOnTerminateTestForm.BackgroundPing }
procedure TOnTerminateTestForm.PingResult (const bResult: Boolean);
begin
PingMenu.Enabled := true;
LogMemo.Lines.Add ('Ping result = ' + BoolToStr (bResult, true));
end; { TOnTerminateTestForm.PingResult }
end.
Code source: Get a function result asynchronously in Delphi using Omni Thread Library
Related
My database is in a VPS and I should get some query from my tables
Because of getting query from server taking long time ( depending on Internet speed ! ) , I want to use threads to get queries
Now I create a thread and get query and then send result to my forms with sending and handling messages
I want to know is it possible to create and use a thread locally ?!?
My mean is :
procedure Requery;
var
...
begin
Create Thread;
...
Pass my Query Component to Thread
...
Getting Query in Thread;
...
Terminate and Free Thread
...
Do next jobs with Query;
...
end;
The main part is last part ( Do next jobs ... ) , I dont want to use query result in a message handler and I want to use them in the same procedure and after thread job
Is it possible ?!
I think this is not possible with Delphi TThread class and I should use other threading techniques ...
I`m using Delphi XE6
What you describe is not the best use of a thread. The calling code is blocked until the thread is finished. That negates the use of running code in parallel at all. You could just perform the query directly instead:
procedure Requery;
var
...
begin
...
// run query
// do next jobs with query
...
end;
That being said, since you are using XE6, you can create a "local" thread by using the TThread.CreateAnonymousThread() method, specifying an anonymous procedure that "captures" the variables you want it to work with, eg:
procedure Requery;
var
Event: TEvent;
H: THandle;
begin
Event := TEvent.Create;
try
TThread.CreateAnonymousThread(
procedure
begin
try
// run query in thread
finally
Event.SetEvent;
end;
end
).Start;
H := Event.Handle;
while MsgWaitForMultipleObjects(1, H, False, INFINITE, QS_ALLINPUT) = (WAIT_OBJECT_0+1) do
Application.ProcessMessages;
finally
Event.Free;
end;
// Do next jobs with query
...
end;
Alternatively:
procedure Requery;
var
Thread: TThread;
H: THandle;
begin
Thread := TThread.CreateAnonymousThread(
procedure
begin
// run query in thread
end
);
try
Thread.FreeOnTerminate := False;
H := Thread.Handle;
Thread.Start;
while MsgWaitForMultipleObjects(1, H, False, INFINITE, QS_ALLINPUT) = (WAIT_OBJECT_0+1) do
Application.ProcessMessages;
finally
Thread.Free;
end;
// Do next jobs with query
...
end;
However, threading is more useful when you let it run in the background while you do other things and then you act when the thread has finished its work. For example:
procedure TMyForm.Requery;
var
Thread: TThread;
begin
Thread := TThread.CreateAnonymousThread(
procedure
begin
// run query in thread
end
);
Thread.OnTerminate := QueryFinished;
Thread.Start;
end;
procedure TMyForm.QueryFinished(Sender: TObject);
begin
if TThread(Sender).FatalException <> nil then
begin
// something went wrong
Exit;
end;
// Do next jobs with query
end;
I think that using a thread this way isn't a good idea, but the answer is yes. You can do it.
procedure LocalThread;
var
LThread: TCustomThread; //Your thread class
LThreadResult: xxxxxxx//Your result type
begin
LThread := TCustomThread.Create(True);
try
//Assign your properties
LThread.Start;
//Option A: blocking
LThread.WaitFor;
//Option B: non blocking
while not LThread.Finished do
begin
Sleep(xx);
//Some progress here ??
end;
//Here query your thread for your result property
LThreadResult := LThread.MyResultProperty;
finally
LThread.Free;
end
//Do next jobs with LThreadResult
end;
Yes you can do that.
The way I would do it is to add an event-handler to your form.
You'll have to link the event-handler in code, but that's not that difficult.
Create a thread like so:
TMyEventHandler = procedure(Sender: TObject) of object;
type
TMyThread = class(TThread)
strict private
FDoneEvent: TMyEvent;
FDone: boolean;
FQuery: TFDQuery;
constructor Create(DoneEvent: TMyEventHandler; Query: TFDQuery);
procedure Execute; override;
function GetQuery: TFDQuery;
public
property Query read GetQuery;
end;
TForm1 = class(TForm)
FDQuery1: TFDQuery; //Do not connect the FDQuery1 to anything!
DataSource1: TDataSource;
DBGrid1: TDBGrid;
private
FOnThreadDone: TMyEventHandler;
FMyThread: TMyThread;
procedure DoThreadDone;
procedure ThreadDone;
public
property OnThreadDone: TMyEventHandler read FOnThreadDone write FOnThreadDone;
....
implementation
constructor TMyThread.Create(DoneEvent: TMyEvent; Query: TFDQuery);
begin
inherited Create(true);
FDoneEvent:= DoneEvent;
FQuery:= Query;
Start;
end;
procedure TMyThread.Execute;
begin
//Do whatever with the query
//when done do:
FDone:= true;
Synchonize(Form1.DoThreadDone);
end;
function TMyThread.GetQuery: TFDQuery;
begin
if not Done then Result:= nil else Result:= FQuery;
end;
procedure TForm1.DoThreadDone;
begin
if Assigned(FOnThreadDone) then FOnThreadDone(Self);
end;
procedure TForm1.ThreadDone(Sender: TObject);
begin
ShowMessage('Query is done');
//Now you can display the result of the query, by wiring it
//to a dataset.
MyDataSource1.Dataset:= FMyThread.Query;
FMyThread.Free;
end;
procedure TForm1.StartTheQuery;
begin
OnThreadDone:= Self.ThreadDone;
FMyThread:= TMyThread.Create(OnThreadDone, FDQuery1);
end;
Now the query will run in the background and signal your event handler when it is done. Meanwhile you can do all the mousing around and user interaction you want without having to worry. Note that you cannot use FDQuery1 at all whilst the thread is using it, and you cannot have FDQuery1 wired to a DataSource whilst it's the thread is running with it.
Leave it unwired and wire it in the ThreadDone event handler as shown.
I am trying to call a function from another unit/class which would take some time in performing the task and would return a string value. I couldn't find a good reference something similar to C# async-await like simple approach in Delphi. Using Omni Thread library seems a good idea for me.
A simple example will be a great start for me.
Sample approach:
procedure TForm1.button1Click(Sender: TObject);
begin
// notify before starting the task
memo1.Lines.Add('calling a asynchronous function..');
// call to the function that takes some time and returns a string value
memo1.Lines.Add(GetMagicString);
// notify that the task has been completed
memo1.Lines.Add('Results fetched successfully.');
end;
Here, the function GetMagicString should process the result asynchronously. Once the result is obtained, only then the program should notify that the task has been completed. By the way, I'm using Delphi-XE.
Edit1:
Here is what I tried. But I am still unable to figure out the proper way to make the job done. The problem is how to return the value.
.....
private
ResultValue: IOmniFuture<string>;
.........
.....
function TForm1.FutureGet: string;
begin
Sleep(3000);
Result := 'my sample magic string response ' + IntToStr(Random(9999));
end;
procedure TForm1.FutureGetTerminated;
begin
// This code fired when the task is completed
memo1.Lines.Add(ResultValue.Value);
end;
function TForm1.GetMagicString: string;
begin
ResultValue := Parallel.Future<string>(FutureGet,
Parallel.TaskConfig.OnTerminated(FutureGetTerminated));
end;
Here, using Result := ResultValue.Value feezes the UI.
Edit2
I made changes as per the answer provided.
MainForm Code:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Unit2;
type
TForm1 = class(TForm)
memo1: TMemo;
button1: TButton;
procedure button1Click(Sender: TObject);
private
FOnStringReceived: TMyEvent;
procedure StringReceived(const AValue: string);
property OnStringReceived: TMyEvent read FOnStringReceived write FOnStringReceived;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.button1Click(Sender: TObject);
var
MyObject: TMyClass;
begin
// notify before starting the task
memo1.Lines.Add('calling a asynchronous function..');
// call to the function that takes some time and returns a string value
MyObject := TMyClass.Create;
OnStringReceived := StringReceived;
try
MyObject.GetMagicStringInBackground(OnStringReceived);
finally
MyObject.Free;
end;
end;
procedure TForm1.StringReceived(const AValue: string);
begin
memo1.Lines.Add(AValue);
// notify that the task has been completed
memo1.Lines.Add('Results fetched successfully.');
end;
end.
Other Unit Code:
unit Unit2;
interface
uses SysUtils, OtlTask, OtlParallel, OtlTaskControl;
type
TMyEvent = procedure(const aValue: string) of object;
type
TMyClass = class
private
FOnStringReceived: TMyEvent;
function GetMagicString: string;
public
procedure GetMagicStringInBackground(AEvent: TMyEvent);
end;
implementation
{ TMyClass }
function TMyClass.GetMagicString: string;
begin
Sleep(3000);
Result := 'my sample magic string response ' + IntToStr(Random(9999));
end;
procedure TMyClass.GetMagicStringInBackground(AEvent: TMyEvent);
var
theFunctionResult: string;
begin
Parallel.Async(
procedure
begin
theFunctionResult := GetMagicString;
end,
Parallel.TaskConfig.OnTerminated(
procedure (const task: IOmniTaskControl)
begin
if Assigned(AEvent) then
AEvent(theFunctionResult);
end)
);
end;
end.
Yes, the code works as expected. I just want to know if this is the best way of doing what I really want to perform.
You would normally use a future in a case where you want something executed in the background but still need the result in the same execution path. It basically lets you do something in the background while doing another thing in the main thread and you can then use the result of the background thread.
What you need to use is the Async abstraction that TLama linked to:
In your case it would be:
procedure TForm1.DoSomething;
var
theFunctionResult: string;
begin
memo1.Lines.Add('calling a asynchronous function..');
Parallel.Async(
procedure
begin
// executed in background thread
theFunctionResult := GetMagicString;
end,
procedure
begin
// executed in main thread after the async has finished
memo1.Lines.Add(theFunctionResult);
// notify that the task has been completed
memo1.Lines.Add('Results fetched successfully.');
end
);
end;
This is a bit messy but you should get the idea. You need to make sure that your async code is completed before you destroy the form that owns this code (TForm1).
If you want to try and setup a system that will call an event when the code completes then you can do something like this:
type
TMyEvent = procedure(const aValue: string) of object;
procedure GetMagicStringInBackground(AEvent: TMyEvent);
var
theFunctionResult: string;
begin
Parallel.Async(
procedure
begin
// executed in background thread
theFunctionResult := GetMagicString;
end,
Parallel.TaskConfig.OnTerminated(
procedure (const task: IOmniTaskControl)
begin
// executed in main thread after the async has finished
if Assigned(AEvent) then
AEvent(theFunctionResult );
end
)
);
end;
You can then put the threaded code in the GetMagicString unit and just call the method above from your form passing in an event that will get called when it completes.
After reading this very interesting topic on stackoverflow --> How to wait for COM port receive event before sending more data in a loop
I've ran into many problems and i've tried many solutions ... nothing work well unfortunately !
Many serial port libraries are event-driven and i'm having a hard time understanding them.
I've tried with Asyncpro, Synaser and TComport.
Is it possible to have a function like this:
SerialSendandReply(tx string here,timeout) return rx string and if timeout send a error string
Response from the device are withing milliseconds a blocking way to do it would be better?
Like this:
Dosomething here
showmessage(SerialSendandReply('test',100 )); //100 ms timeout
dosomething else
With this code
TForm1 = class(TForm)
...
private
IOEvent : THandle; // used for IO events
IORx : string;
Comport : TapdComport;
...
procedure TForm1.ComportTriggerAvail(CP: TObject; Count: Word);
var i : integer;
begin
for i:=1 to Count do
IORx:=IORx+Comport.GetChar;
SetEvent(IOEvent);
end;
function TForm1.SerialSAWR(tx : string; TimeOut : integer) : boolean;
begin
Result := False;
try
IORx := ''; // your global var
ResetEvent(IOEvent);
Comport.PutString(tx);
Result := WaitForSingleObject(IOEvent, TimeOut) = WAIT_OBJECT_0;
except
on E : Exception do
// dosomething with exception
end;
end;
// constructor part
IOEvent := CreateEvent(nil, True, False, nil);
// destructor part
if IOEvent <> 0 then
CloseHandle(IOEvent);
Then i've tried to call this function :
if SerialSAWR('test'; 5000) then showmessage(IORx);
Sending is working great but doesn't return anything in the string.
Any advices?
Thank you very much!
Regards,
Laurent
I use TComPort and have created the following routine to do what you ask. TComPort monitors received characters in its monitoring thread and my routine waits for characters without calling Application.ProcessMessages. It may not be the most elegant code but it works fine.
function TArtTComPort.SerialPort_AwaitChars(AMinLength: integer;
ATerminator: char; AQtyAfterTerm: integer; ARaise: boolean): string;
var
fDueBy : TDateTime;
function IsEndOfReplyOrTimeout( var AStr : string ) : boolean;
var
I : integer;
begin
Result := False;
If ATerminator <> #0 then
begin
I := Length( AStr ) - AQtyAfterTerm;
If I > 0 then
Result := AStr[I] = ATerminator;
end;
If not Result then
Result := Length(AStr) >= AMinLength;
// Un-comment this next line to disable the timeout.
//Exit;
If not Result then
begin
Result := Now > fDueBy;
If Result then
If ARaise then
raise EArtTComPort.Create( 'Serial port reply timeout' )
else
AStr := '';
end;
end;
var
Events : TComEvents;
iCount : integer;
S : string;
begin
Assert( AMinLength > 0, 'Invalid minimum length' );
If not FComPort.Connected then
begin
Result := '';
Exit;
end;
fDueBy := Now + (FTimeoutMS * TDMSec );
Result := '';
Repeat
// Setup events to wait for:
Events := [evRxChar, evTxEmpty, evRxFlag, evRing, evBreak,
evCTS, evDSR, evError, evRLSD, evRx80Full];
// Wait until at least one event happens.
FComPort.WaitForEvent(
Events,
FStopEvent.Handle,
FTimeOutMS);
If Events = [] then // timeout
begin
If ARaise then
raise EArtTComPort.Create( 'Serial port reply timeout' )
end
else
begin
If evRxChar in Events then
begin
iCount := FComport.InputCount;
FComPort.ReadStr( S, iCount );
Result := Result + S;
end;
end;
until IsEndOfReplyOrTimeout( Result );
end;
I switched for nrComm Lib (v9.31)... very simple of use and well supported.
The only drawback is that isn't free and open source ... but it's worth it !
It's also thread-safe which is good too :).
Thank you very much everyone for the replies!
You are trying to do async I/O from the main thread. This will never play well with the GUI.
Doing complex async I/O is better suited in a separate thread. I have a blocking serial communication package (I think Synaser also has a blocking mode) and a function like this:
function TransmitReceive(const msg: AnsiString; var reply: AnsiString;
timeOut: Integer): Boolean;
Put the complex code logic inside a thread.execute and trig the start of the logic with an event signal.
Communicate results etc to the main thread through PostMessage calls for example.
I am using Delphi 2007 and threads.
My problem (sorry, i'll try to explain better):
1) I created a file "utilities.pas" where i have the function i use more.
2) I created a new program, in this program i have one thread
3) in the execute method of the thread i call one function in my file "utilities.pas".
this function connects to an ftp using clever components (tclftp). This components logs the server responce in a dedicated event. What i would like to do is to save the log in a stringlist and then send the stringlist back to the calling thread.
This is part of the file "utilities.pas":
// I created TEventHandlers because it's the only way to assign the event runtime
// without having a class
type
TEventHandlers = class
procedure clFtp1SendCommand(Sender: TObject; const AText: string);
end;
var EvHandler: TEventHandlers;
// this is the porcedure called from the thread. i want to send the stringlist
// back to it containing the ftp log
procedure Test(VAR slMain: tStringlist);
var cFTP: TclFtp;
begin
cFTP := TclFtp.Create(nil);
cFTP.Server := 'XXX';
cFTP.UserName := 'XXX';
cFTP.Password := 'XXX';
cFTP.OnSendCommand := EvHandler.clFtp1SendCommand;
// i connect to the ftp
cFTP.Open;
FreeAndNil(cFTP);
end;
procedure TEventHandlers.clFtp1SendCommand(Sender: TObject; const AText: string);
begin
// here the component (cftp) sends me back the answer from the server.
// i am logging it
// HERE IT'S THE PROBLEM:
// I can't reach slMain from here.....
slmain.add(Atext);
end;
this is the calling thread:
procedure TCalcThread.Execute;
var slMain: tstringlist;
begin
inherited;
slmain := tstringlist.create(nil);
Test(slmain);
if slMain.count > 0 then
slMain.savetofile('c:\a.txt');
// i won't free the list box now, but in the thread terminated.
end;
this is the main program:
procedure TfMain.ThreadTerminated(Sender: TObject);
Var ExThread: TCalcThread;
begin
ExThread := (Sender as TCalcThread);
if ExThread.slMain.Count > 0 then
ExThread.slMain.SaveToFile('LOG\Errori.log');
freeandnil(slMain);
end;
Please can anybody help me in solving this? I really don't know what to do.
I hope now it more clear.
p.s. thanks for all the answer..
Another approach would be to have your thread object have its own instance of the stringlist and its own cFTP. If you need to have one "master thread" that everything writes to (perhaps for a summary of what each thread accomplished), use this class:
TThreadStringList by Tilo Eckert
http://www.swissdelphicenter.ch/torry/showcode.php?id=2167
I think one (BAD) approach would be to create a pool of components in the main thread or at design time, and assign one to each thread. i.e. 5 instances of cFTP, 5 stringlists, 5 threads.
Update: Martin James points out why this is a terrible idea, and I agree. So don't do this. Post stays as a deterrent.
Intercept the event within the thread class, and fire an own typed event from within that handler. Synchronize this call! And try to prevent the global variable. All this as follows:
type
TFtpSendCommandEvent = procedure(Mail: TStrings; const AText: String) of object;
TMyThread = class(TThread)
private
FclFtp: TclFtp;
FslMail: TStrings;
FOnFtpSendCommand: TFtpSendCommandEvent;
FText: String;
procedure clFtpSendCommand(Sender: TObject; const AText: String);
procedure DoFtpSendCommand;
protected
procedure Execute; override;
public
// You could add this property as parameter to the constructor to prevent the
// need to assign it separately
property OnFtpSendCommand: TFtpSendCommandEvent read FOnFtpSendCommand
write FOnFtpSendCommand;
end;
// If you dont want to make this a property or private field of the thread class:
var
EvHandler: TFtpSendCommandEvent;
{ TMyThread }
procedure TMyThread.clFtpSendCommand(Sender: TObject; const AText: string);
begin
// Store the AText parameter temporarily in a private field: Synchronize only
// takes a parameterless method
FText := AText;
Synchronize(DoFtpSendCommand);
end;
procedure TMyThread.DoFtpSendCommand;
begin
if Assigned(FOnFtpSendCommand) then
FOnFtpSendCommand(FslMail, FText);
// Or, if you really like to use that global variable:
if Assigned(EvHandler) then
EvHandler(FslMail, FText);
end;
procedure TMyThread.Execute;
begin
...
FclFtp := TclFtp.Create(nil);
FslMail := TStringList.Create(nil);
try
FclFtp.Server := 'XXX';
FclFtp.UserName := 'XXX';
FclFtp.Password := 'XXX';
FclFtp.OnSendCommand := clFtpSendCommand;
FclFtp.Open;
finally
FreeAndNil(FclFtp);
FreeAndNil(FslMail);
end;
...
end;
This is my first post here - so be gentle :-)
I want to build a client/server application that uses datasnap for data transport.
This is a fairly simple task - and there are lots of examples to learn from.
BUT - Having a Datasnap server (build from Delphi XE wizard) I find myself running into a problem, and I hope someone can guide me into the right direction.
Server and Client run on same PC (that is the design for now).
Server is running Session lifecycle.
Server and Client shares a class (posted below)..
The Server provides a simple method - GetServerObject which uses the GetNewObject method.
The Server itself is a VCL application - main form is fmServer.
OnCreate instatiates the Servers FormObject property (FormObject := TMyDataObject.Create);
function TServerMethods2.GetNewObject: TMyDataObject;
begin
Result := TMyDataObject.Create;
end;
function TServerMethods2.GetServerObject: TMyDataObject;
begin
Result := GetNewObject;
if not Result.Assign(fmServer.FormObject) then
raise Exception.Create('Server error : Assign failed!');
end;
All this is pretty trivial - and my problem only appears if I twist my Client application into a multithreaded monster :-) (read - more than 1 thread).
So here is the Thread code for the client.
TDataThread = class(TThread)
private
DSConn: TSQLConnection;
protected
procedure Execute; override;
public
constructor Create(aConn: TSQLConnection); overload;
end;
constructor TDataThread.Create(aConn: TSQLConnection);
begin
inherited Create(False);
DSConn := aConn.CloneConnection;
FreeOnTerminate := true;
end;
procedure TDataThread.Execute;
var
DSMethod: TServerMethods2Client;
aDataObject : TMyDataObject;
begin
NameThreadForDebugging('Data');
{ Place thread code here }
DSMethod := nil;
try
while not terminated do
begin
sleep(10);
if DSConn.Connected then
begin
try
if DSMethod = nil then
DSMethod := TServerMethods2Client.Create(DSConn.DBXConnection,false);
if DSMethod <> nil then
try
aDataObject := DSMethod.GetserverObject;
finally
freeandnil(aDataObject);
end;
except
freeandnil(DSMethod);
DSConn.Connected := False;
end
end
else
begin
// connect
try
sleep(100);
DSConn.Open;
except
;
end;
end;
end;
finally
freeandnil(DSMethod);
DSConn.Close;
freeandnil(DSConn);
end;
When I create more than 1 of these threads - eventually I will get an error (being "cannot instatiate ... " or some "remote dbx error ..." .. and so on.
I simply cannot get this to work - so that I can spawn hundreds of threads/connections to a datasnap server.
I know this question is tricky - but my hope is that someone is smarter than me :-)
If I try the same client thread code - but accessing a more simple server method (lets say echostring from sample) then I can run it with hundreds of threads.
Perhaps Im answering myself here - but Im too blind to realize it :-)
unit uDataObject;
interface
uses
SysUtils;
Type
TMyDataObject = class(TObject)
private
fString: String;
fInteger: Integer;
public
constructor Create; virtual;
destructor Destroy; override;
function Assign(aSource: TMyDataObject): boolean;
property aString: String read fString write fString;
property aInteger: Integer read fInteger write fInteger;
end;
implementation
{ TMyDataObject }
function TMyDataObject.Assign(aSource: TMyDataObject): boolean;
begin
if aSource <> nil then
begin
try
fString := aSource.aString;
fInteger := aSource.aInteger;
Result := True;
except
Result := false;
end;
end
else
Result := false;
end;
constructor TMyDataObject.Create;
begin
inherited;
Randomize;
fString := 'The time of creation is : ' + FormatDateTime('ddmmyyyy hh:nn:ss:zzz', Now);
fInteger := Random(100);
end;
destructor TMyDataObject.Destroy;
begin
inherited;
end;
end.
All help is appreciated
This has mostly been answered in the comments and the bug report, but... The problem you are seeing is caused by a multithreading issue in XE's marshaller code. If two threads (or two clients) call a server server method which takes in or return user defined types (any type which will use the marshaller/unmarshaller) at the same time, then an exception could happen.
I am unaware of a perfect workaround for XE, but if it is possible to not use user-defined types, then you shouldn't see multithreading issues.
Mat
When the simple server method is working, i think your problem has to be found i somethin the "real" code is doing or using.
It could be in the connection (try changing your simpler code to use the connection)
Your problem can also be then CloneConnection. The Cloned connection is freed, when the connection it is cloned from is freed. See
http://docwiki.embarcadero.com/VCL/en/SqlExpr.TSQLConnection.CloneConnection