Wait for thread execution inside TIdHttpServer's OnCommandGet event handler - multithreading

My Delphi Berlin app uses TIdHttpServer to get some data from client via HTTP GET, process it and send it back.
All logic is performed within a single event handler: OnCommandGet. The identifier is received in a QueryString, then data will be transformed and returned back to client inside the same OnCommandGet event handler.
Data transformation is implemented in a separate thread which uses PostMessage to inform the main thread that the worker thread completes the execution and the data is ready to be sent back to client.
The data is sent in a AResponseInfo.ContentText property.
My question is:
How do I make OnCommandGet handler wait until the worker thread
does its job and sends the pointer to a transformed data, so I can get
the value and fire it back in a AResponseInfo.ContentText?
UPDATE
Here is the pseudo-code I want to execute:
type
TMyResponsesArray = array[0..5] of TMyObjectAttributes;
PMyResponsesArray = ^TMyResponsesArray;
{There will be 6 tasks run in parallel. Tasks' responses
will be stored in the below declared Responses array.}
var
Responses: TMyResponsesArray;
{Below is a Server handler, which takes the input parameter and calls
a proc which runs 6 threads in parallel. The result of each thread is
stored as an ordered array value. Only when the array is completely
populated, ServerCommandGet may send the response!}
procedure TMainForm.ServerCommandGet(AContext: TIdContext;
ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
var
ObjectId: string;
begin
ObjectId := ARequestInfo.Params.Values['oid'];
RunTasksInParallel(ObjectId);
end;
{Below is a procedure invoked by ServerCommandGet. It runs 6 tasks in
parallel. Each of the thread instantiates an object, sets its basic
parameter and fires the method. Each task runs queued. When each thread
completes the job, it sends a WM to the main thread (via ParentHandler
which must accept and process the response.}
procedure TMainForm.RunTasksInParallel(const ObjectId: string);
const
c: array[0..5] of Byte = (0, 1, 2, 3, 4, 5);
var
ParentHandle: HWND;
begin
{running 6 tasks in parallel}
TTask.Run(
procedure
begin
TParallel.For(Low(c), High(c),
procedure(index: Integer)
var
MyObj: TMyObject;
i: Byte;
begin
i := c[index];
MyObj := TMyObject.Create;
try
MyObj.SetMyParameter := Random(10);
Responses[i] := MyObj.CallMyMethd(ObjectId);
TThread.Queue(nil,
procedure
begin
SendMessage(ParentHandle,
UM_DATAPACKET, i, Integer(#Responses));
end);
finally
MyObj.Free;
end;
end);
end);
end;
{Now the WM handler. It decreases internal task counter and when
TaskCounter = 0, it means that all tasks finished execution and the
Responses array is fully populated. Then we somehow need to pass the
Response array to the ServerCommandGet and send it back to client...}
procedure TMainForm.OnDataPacket(var Msg: TMessage);
begin
i := Msg.WParam;
Responses := PMyResponsesArray(Msg.LParam)^;
{Skipped for for brevity:
When ALL tasks have finished execution, the Responses array is FULL.
Then all array values are wrapped into XML and sent back to initial
invoker ** ServerCommandGet ** which must send XML to client.}
end;

Your use of a global Responses array is not safe, unless you limit TIdHTTPServer to allow only 1 connected client at a time. Otherwise, you could potentially have multiple clients sending requests at the same time and overwriting each other's values in the array. Each invokation of ServerCommandGet() should use a local array instead.
TIdHTTPServer is not designed for the type of asynchronous processing you are attempting to do. ServerCommandGet() must block, as TIdHTTPServer sends a response to the client when the OnCommandGet handler exits, unless the handler sends a response first, which you are not doing. So, regarding your task thread management, I would suggest either:
getting rid of TTask.Run() and have RunTasksInParallel() call TParallel.For() directly.
or at least calling TTask.Wait() on the TTask object that is calling TParallel.For().
Either way will make RunTasksInParallel() block (and thus make ServerCommandGet() block) until all tasks have finished. Then you can send the response to the client immediately when RunTasksInParallel() exits. You don't need to wait for the tasks to post UM_DATAPACKET to the main thread and round-trip back into TIdHTTPServer. If you are using UM_DATAPACKET for other things, that's fine, but I do not recommend using it for your HTTP processing.
Try something more like this instead:
const
MaxResponses = 6;
type
TMyResponsesArray = array[0..MaxResponses-1] of TMyObjectAttributes;
{$POINTERMATH ON}
PMyResponsesArray = ^TMyResponsesArray;
{There will be 6 tasks run in parallel. Tasks' responses
will be stored in the below declared Responses array.}
procedure TMainForm.ServerCommandGet(AContext: TIdContext;
ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
var
ObjectId: string;
Responses: TMyResponsesArray;
begin
ObjectId := ARequestInfo.Params.Values['oid'];
RunTasksInParallel(ObjectId, #Responses);
{ALL tasks have finished execution, the Responses array is FULL.
Wrap all array values into XML and send it back to the client.}
end;
{Below is a procedure invoked by ServerCommandGet. It runs 6 tasks in
parallel. Each of the thread instantiates an object, sets its basic
parameter and fires the method.}
procedure TMainForm.RunTasksInParallel(const ObjectId: string; Responses: PMyResponsesArray);
begin
{running 6 tasks in parallel}
TParallel.For(0, MaxResponses-1,
procedure(index: Integer)
var
MyObj: TMyObject;
begin
MyObj := TMyObject.Create;
try
MyObj.SetMyParameter := Random(10);
Responses[index] := MyObj.CallMyMethd(ObjectId);
finally
MyObj.Free;
end;
end
);
end;
I would also not recommend doing the database updates in the main thread, either. If you can't update the database directly in ServerCommandGet(), or directly in the individual task threads, then I would suggest having a separate thread dedicated for database updates that you post to as needed. Stay out of the main thread as much as possible.

Related

Delphi - Asynchronous Datasnap Method Calls

I'm writing a Datasnap application with a TCP connection between client/server, with the server connected to an SQL server.
Server has a datamodule DM1 with all dataset queries and SQL connection. The DM1 also has REST request/client/response components.
DM1 has an exposed function PostDataAsync with ID param: to generate a json from a dataset, then HTTP post it to a RESTFul service. It returns the number of records failed to post in the callback arg.
The DSServer of this DM1 is “Invocation”.
The invocation server type should ensure that each server method call has its own DB connection, dataset, Rest components, which will not have multiple calls interfere with the data of each other (if added parallel threading).
procedure TServerMethods1.postCustOrderHistAsync(CustomerID: String; callback: TDBXcallback);
var
jsonObject: TJSONObject;
CallbackValue: TJsonValue;
errors: Integer;
begin
errors := postCustOrderHist(CustomerID); //takes time to post, returns num of failed records
jsonObject := TJSONObject.create;
jsonObject.AddPair(tjsonpair.create('errors', errors.ToString));
CallbackValue := callback.Execute(jsonObject);
end;
Client has a button which calls the server method PostDataAsync with ID param, and also a callback function “ShowNotification” (which uses windows notification center to show Post notification status).
For now, the application works as following: the client calls the server function synchronously, that means the main thread waits for the server function to finish the HTTP post and then runs the callback notification; the client hanging meanwhile.
TDSCallbackWithMethod = class(TDBXCallback)
private
FCallbackMethod: TDSCallbackMethod;
public
constructor Create(ACallbackMethod: TDSCallbackMethod);
function Execute(const Args: TJSONValue): TJSONValue; override; //executes FCallbackMethod
end;
procedure TMainForm.BtnPostOrderHistoryClick(Sender: TObject);
var
callback: TDBXCallback;
ServerMethods1Client: TServerMethods1Client;
begin
//Define Callback to show notification
callback := TDSCallbackWithMethod.Create(
function(const Args: TJSONValue): TJSONValue
var
errors: integer;
begin
errors := Args.GetValue<integer>('errors');
if errors = 0 then
showNotification(StrSentSuccessfully)
else
showNotification(StrSendingFailed + '(' + errors.ToString + ' not sent)');
result := TJsonTrue.Create;
end);
//Call Server Method
ServerMethods1Client := TServerMethods1Client.Create(DMServerConnection.SQLConnection1.DBXConnection);
try
ServerMethods1Client.postCustOrderHistAsync(EditCustomerId.Text, callback)
finally
ServerMethods1Client.Free;
end;
end;
How should the design be in order to call the server methods asynchronously, and let the server run the callback when done? Post function should be able to be called several times with the same user or multiple simultaneously.
Should the thread be on the server side or Client side? If anybody can help with this, I can send a demo of the application using the Northwind Database.
Note: I have tried running the client function call in a TTask, it works when the user runs the function once at a time. But when the server method is run several times simultaneously, I get a “DBXError…Read error…callback expecting X got Y”. It seems while the client waits for the response callback format from the first request, it gets confused with other tcp protocol packets initiated from the second request. I have tried running ttask at the server side, I get an exception "TOLEDBCommand.Destroy - interfaces not released"
Check out this example, it walks through the steps to create a callback. Basically you need a TDSClientCallbackChannelManager (component) and its RegisterCallback function to tell the datasnap client what method (of object inherited from TDBXCallback) to call on the client side when the callback is fired from the server. You will need to pass the clients session ID's to the server so it can call the correct client with the NotifyCallBack. Then from that callback method you can do what you need to, in a TThread.Queue for safety. You will probably need to create some sort of unique identifier (or maybe your CustomerID will work) in the JSON the sever returns so your client knows which call is the result of which.
For simplifying the client side server method call, I removed the Callback from the client, and just created parallel threads that wait for the response of the server. I still got the same error “DBXError…Read error…callback expecting X got Y”. So that's when I knew that the error wasn't a callback issue, it's an interference between the threads. It turned out that when I was creating the client's proxy methods, all the threads where using the same instance of DBXConnection. That will make the SQLconnection lost between different server calls/responses and get a parse error. I did a function "getNewSqlConnection" that will copy all the settings of the TSQLConnection into a new instance.
Now the client call method looks like this:
procedure TMainForm.BtnPostOrderHistoryClick(Sender: TObject);
begin
ttask.Run(
procedure
var
ServerMethods1Client: TServerMethods1Client;
SqlConnectionLocal: TSqlConnection;
errors: Integer;
begin
// Call Server Method
SqlConnectionLocal := DMServerConnection.getNewSqlConnection(Self);
ServerMethods1Client := TServerMethods1Client.Create(SqlConnectionLocal.DBXConnection);
try
errors := ServerMethods1Client.postCustOrderHist(EditCustomerId.Text);
if errors = 0 then
TThread.Synchronize(nil,
Procedure
begin
showNotification(StrSentSuccessfully)
end)
else
TThread.Synchronize(nil,
Procedure
begin
showNotification(StrSendingFailed + '(' + errors.ToString + ' not sent)')
end);
finally
ServerMethods1Client.Free;
SqlConnectionLocal.Free;
end;
end);
end;

Access VCL from other thread

I wrote a communication class based on TThread, which would send some data and receive a reply.
I want the method to:
sent the data (this is a non blocking procedure)
wait for a reply or timeout
show the data received in a vcl control
give back control to the caller
Here is how I try to do,
procedure TForm1.Button1Click(Sender: TObject);
begin
for i := 1 to 5 do // send 5 commands
mycomm.SendCommand();
end;
procedure TMyComm.ShowData();
begin
Form1.Memo1.Lines.Add('Frame received');
end;
procedure TMyComm.SendCommand();
begin
//build frame and put it on interface here
//...
event.WaitFor(3000);
//show received frame if no timeout in VCL
//...
end;
procedure TMyComm.Execute();
begin
while not Terminated do
begin
if receive() then //blocks until frame is received
begin
Synchronize(ShowData); //hangs :-(
event.SetEvent;
end;
end,
end;
Of course this will result in a deadlock, but how can I achieve that my VCL is updated immediately after each received frame?
You can use a anonymous thread, this will only execute the rest of the code after the thread has finished, change it to suite your needs.
You can find the AnonThread Unit in :
C:\Users\Public\Documents\RAD Studio\12.0\Samples\Delphi\RTL\CrossPlatform Utils
uses
AnonThread
var
GetFrame :TAnonymousThread<Boolean>;
begin
GetFrame := TAnonymousThread<Boolean>.Create(function : Boolean
begin
// Start your execution
end,
procedure (AResult : Boolean)
begin
// Wil only execute after the thread has run its course, also safe to do UI updates
end,
procedure (AException : Exception)
begin
ShowMessage('Error : ' + AException.Message);
end);

Delphi - OTL - Communicating between ThreadPool and Worker thread

I'm using XE8 and I'm trying to built an example of my real world application.
I need to communicate between the main "service thread" and the OTL thread pool.
The examples are all set with forms and Monitors. I don't need those, but I can't figure out a way to write a clean code. So far this is what I did:
TProcessWorker = Class( TOmniWorker )
strict private
FTaskID : int64;
FIndex : Integer;
FFolder : String;
protected
function Initialize: Boolean; override;
public
procedure WriteTask( var msg : TMessage); message _AM_WriteTask;
End;
{ TProcessWorker }
function TProcessWorker.Initialize: Boolean;
begin
FTaskID := Task.UniqueID;
FIndex := 0;
result := True;
FFolder := Format('%s/%d', [Task.Param['Folder'].AsString, FTaskID]);
ForceDirectories(FFolder);
end;
Implemented as:
procedure TProcessWorker.WriteTask(var msg: TMessage);
var
ps : PString;
L : TStringStream;
begin
Ps:= PString(msg.LParam);
L := TStringStream.Create( ps^ );
try
L.SaveToFile( format('%s\%d.txt',[FFolder, fIndex]) );
finally
l.Free;
inc(FIndex);
end;
end;
In the main thread, to create the pool, I'm calling:
FThreadPool := CreateThreadPool('Thread pool test');
and
var
lFolder : String;
Process : IOmniWorker;
begin
lFOlder := ExtractFilePath(ParamStr(0));
Process := TProcessWorker.Create;
CreateTask( Process, 'Task test').Unobserved.SetParameter('Folder',lFolder).Schedule(FThreadPool);
I don't know how to call correctly my worker thread. In my real application, several thread will be triggered and I need to be sure I using correctly the threadpool.
1) By calling CreateTask as I am, how am I making a correct use of threadpool? It's seems odd to me to call CreateTask for every Process I need.
2) The worker thread is never triggered. How should I make my Worker thread work! :)
Regards,
Clément
OmniThreadLibrary test 08_RegisterComm shows how to communicate directly between two threads.
Basically, you have to create an instance of IOmniTwoWayChannel and register its endpoint in the worker's Initialize method with Task.RegisterComm(<channel>).
You can then send messages in a 'normal' way with <channel>.Send(<message>, <data>) and they will be dispatched to other task's message method if you decorate it in a Delphi way:
procedure MessageHandler(var msg: TOmniMessage); message <message>;
check http://otl.17slon.com/book/doku.php?id=book:howto:connectionpool
my feeling is that OTL is based upon data containers, not threads.
so I think you need to make a queue of task requests that your "main thread" would inject tasks into.
the idea of pools is that they manage themselves! you should not communicate with a specific worker thread, you should just sent work requests into it, and then let the pool spawn/kill worker threads as it sees fit.
if you need feedback from every specific thread, I'd rather include TForm.Handle or maybe the TOmniMonitor pointer into the task request record, and make the worker thread to call back and communicate with the form, no the from with the thread

main application locks up using idPop3 to retrieve mail messages (even in a thread)

I am using a thread to access a pop3 account and retrieve messages. It works fine, but it locks up my application until it is complete. Cant move the window, shut down, click buttons, nothing.
It runs fine and allows me to access the main application up until the spot i commented out (or after the IdPOP31.Connect();)
//Getting the number of the messages that server has
then it locks up
procedure TPopThread.Pop;
var
vName, vEmail, vServerIn, vServerOut, vUserId, vPassword: String;
vPop3Port, vSMTPPort, vSSL: String; vHTML: TStringList;
MsgCount : Integer;
i,j : Integer;
FMailMessage : TIdMessage;
begin
with frmMain do
begin
RzMemo1.Lines.Clear;
vHTML:= TStringList.Create;
GetAccount(lbxMain.SelectedItem,vName, vEmail, vServerIn, vServerOut, vUserId, vPassword,
vPop3Port, vSMTPPort, vSSL, vHTML);
IdPOP31.Host := vServerIn;
IdPOP31.Username := vUserId;
IdPOP31.Password := vPassword;
IdPOP31.Port := StrToInt(vPop3Port);
try
Prepare(IdPOP31);
IdPOP31.Connect();
// {
// //Getting the number of the messages that server has.
// MsgCount := IdPOP31.CheckMessages;
// for i:= 0 to Pred(MsgCount) do
// begin
// try
// FMailMessage := TIdMessage.Create(nil);
// IdPOP31.Retrieve(i,FMailMessage);
// RzMemo1.Lines.Add('=================================================');
// RzMemo1.Lines.Add(FMailMessage.From.Address);
// RzMemo1.Lines.Add(FMailMessage.Recipients.EMailAddresses);
// RzMemo1.Lines.Add(FMailMessage.Subject);
// RzMemo1.Lines.Add(FMailMessage.Sender.Address);
// RzMemo1.Lines.Add(FMailMessage.Body.Text);
//
// for J := 0 to Pred( FMailMessage.MessageParts.Count ) do
// begin
// // if the part is an attachment
// if ( FMailMessage.MessageParts.Items[ J ] is TIdAttachment) then
// begin
// RzMemo1.Lines.Add('Attachment: ' + TIdAttachment(FMailMessage.MessageParts.Items[J]).Filename);
// end;
// end;
// RzMemo1.Lines.Add('=================================================');
// finally
// FMailMessage.Free;
// end;
// RzMemo1.Clear;
// end;
// }
finally
IdPOP31.Disconnect;
vHTML.Free;
end;
end;
end;
It actually did this before I added the thread, so it has something to do with that portion that is commented out and not the thread
What did i do wrong or didn't do?
here is my Execute
procedure TPopThread.Execute;
begin
try
Synchronize(Pop);
except
on Ex: Exception do
fExceptionMessage := Ex.Message;
end;
end;
here is how i call it
PopThread := TPopThread.Create(lbxMain.SelectedItem, frmMain.DonePopping);
You are locking up the application yourself, because you're synchronizing the call to the pop method.
Synchronize causes the call specified by AMethod to be executed using the main thread, thereby avoiding multithread conflicts.
The current thread is passed in the AThread parameter.
If you are unsure whether a method call is thread-safe, call it from within the Synchronize method to ensure it executes in the main thread.
Execution of the current thread is suspended while the method executes in the main thread.
So, for practical purposes, you're like you have no extra thread, since all your code is executed in the main thread.
An example of when you would want to use Synchronize is when you want to interact with a VCL component
On the other hand, because you're directly accessing a number of visual controls from your method, and the VCL is not thread safe, you have to execute your method in the main thread.
The best you can do is to make your thread independent from the VCL by not accessing any VCL component from the thread, but rather collecting all the input and output values in memory and setting/reading it from the main thread before the thread starts and after the thread finishes.
Or, if for any reason you don't want to do that, you can dissect your method to separate the parts that need access to the VCL and synchronize only that parts, for example:
type
TPopThread = class
private
FMailMessage : TIdMessage; //now the message belongs to the class itself
...
public
//all the values are passed via constructor or the thread is
//created in suspended state, configured and then started
property Host: string read FHost write FHost;
property UserName: string read FUserName write FUserName;
property Password: string read ...;
property Port: Integer read ...;
end;
procedure TPopThread.CopyMailToGUI;
var
J: Integer;
begin
frmMain.RzMemo1.Lines.Add('=================================================');
frmMain.RzMemo1.Lines.Add(FMailMessage.From.Address);
frmMain.RzMemo1.Lines.Add(FMailMessage.Recipients.EMailAddresses);
frmMain.RzMemo1.Lines.Add(FMailMessage.Subject);
frmMain.RzMemo1.Lines.Add(FMailMessage.Sender.Address);
frmMain.RzMemo1.Lines.Add(FMailMessage.Body.Text);
for J := 0 to Pred( FMailMessage.MessageParts.Count ) do
begin
// if the part is an attachment
if ( FMailMessage.MessageParts.Items[ J ] is TIdAttachment) then
begin
frmMain.RzMemo1.Lines.Add('Attachment: ' + TIdAttachment(FMailMessage.MessageParts.Items[J]).Filename);
end;
end;
frmMain.RzMemo1.Lines.Add('=================================================');
end;
procedure TPopThread.Pop;
var
MsgCount : Integer;
i,j : Integer;
Pop: TIdPOP3;
begin
Pop := TIdPOP3.Create(nil);
try
Pop.Host := FHost;
Pop.Username := FUserName;
Pop.Password := FPassword;
Pop.Port := FPort;
Prepare(Pop);
Pop.Connect();
//Getting the number of the messages that server has.
MsgCount := Pop.CheckMessages;
for I := 0 to Pred(MsgCount) do
begin
try
FMailMessage := TIdMessage.Create(nil);
try
IdPOP31.Retrieve(i,FMailMessage);
Synchronize(CopyMailToGUI);
finally
FMailMessage.Free;
end;
end;
finally
Pop.Free;
end;
end;
procedure TPopThread.Execute;
begin
//no need of a try/except, if an exception occurs, it
//is stored in the FatalException property
Pop;
end;
Now, your thread will ask the main thread to copy just the processed message to the VCL. During that copy your thread will block and your application will not respond to messages because the main thread is busy, but that will be for very shorts intervals, so even if it is not the ideal case, I think it will work for what you want.
You put all your logic inside a Synchronize call. Synchronize runs its function in the main VCL thread, so you've essentially nullified any benefits you might have gained from using a separate thread in the first place.
Remove the call to Synchronize so that Pop runs in the thread you created for it.
If you still need some operations to execute in the main thread, then put them in subroutines so that you can run only them in Synchronize. The parts I see in that code are the places where you add lines to a memo control.

Simple Thread Sample Delphi

I am new with this stuff of Threading in Delphi. so, I am trying to make a simple query aplication that make a bit call up for the database and take a bit of time, so I want to alert the user that there is a background process and have to be patient.
I tried many samples, but none of them work for me, Please, could somebody show me a simple sample that could work?
I know that I have to Declare a Type of TThread, with Create and Override Execute... etc.. but since that I am lost...
Using Delphi 7, SQL Server 2005 and ADO, Windows XP sp3.-
Thanks.
Yup, you declare a new type which inherits from TThread:
TMyWorkerThread = class(TThread)
end;
Then you add a function override for Execute():
TMyWorkerThread = class(TThread)
public
procedure Execute; override;
end;
That procedure will be called when you start your thread. It will be executed in parallel with your main program. Let's write it.
procedure TMyWorkerThread.Execute;
begin
//Here we do work
DoSomeWork();
DoMoreWork();
//When we exit the procedure, the thread ends.
//So we don't exit until we're done.
end;
How to use this? Let's say you want to start doing work when the user clicks button. You write an OnClick handler:
procedure TMainForm.Button1Click(Sender: TObject);
begin
TMyWorkerThread.Create(false);
end;
That's it. After the user clicks button, your thread starts and proceeds with doing whatever it is that you wrote in Execute. If the user clicks the button again, another thread will start, and then another - one every click. They will all run in parallel, each doing all what's written in Execute() and then ending.
Let's say you want to check if the work is over. For that, you'll have to store the reference to your thread somewhere:
TMainForm = class(TForm)
{...skipped...}
public
MyWorkerThread: TThread;
end;
procedure TMainForm.Button1Click(Sender: TObject);
begin
//This time we make sure only one thread can be started.
//If one thread have been started already, we don't start another.
if MyWorkerThread<>nil then
raise Exception.Create('One thread have already been started!');
MyWorkerThread := TMyWorkerThread.Create(false);
end;
procedure TMainForm.Button2Click(Sender: TObject);
begin
//If the work is not over yet, we display message informing the user we're still working
if (MyWorkerThread<>nil) and (WaitForSingleObject(MyWorkerThread.Handle, 0)<>WAIT_OBJECT_0) then
MessageBox(Self.Handle, pchar("The work is not yet done!"), pchar("Still running"), MB_OK);
end;
As you see, we're checking if a thread is still running by calling a Windows function called WaitForSingleObject. This function waits until the thread is done working, or the timeout is elapsed, and as we specify the timeout of 0, it just exists immediately if the thread is not over yet.
You can find many examples on the web of threads. The only special feature, if you are using ADO connections inside the Thread, is that you can't share the same connection.
Each thread must create its own connection, otherwise they are equal (should follow the same rules as any other thread.)
An sample that I have used is this:
TADOSQLThread = class(TThread)
private
FADOQ: TADOQuery; // Internal query
FSQL: string; // SQL To execute
FID: integer; // Internal ID
public
constructor Create(CreateSuspended:Boolean; AConnString:String;
ASQL:string; IDThread:integer);
destructor Destroy; override;
procedure Execute(); override;
property ID:integer read FID write FID;
property SQL:string read FSQL write FSQL;
property ADOQ:TADOQuery read FADOQ write FADOQ;
end;
The Create constructor is overrided, and look like this:
constructor TADOSQLThread.Create(CreateSuspended:Boolean; AConnString:String;
ASQL:string; IDThread:integer);
begin
inherited Create(CreateSuspended);
// ini
Self.FreeOnTerminate := False;
// Create the Query
FADOQ := TAdoquery.Create(nil);
// assign connections
FADOQ.ConnectionString := AConnString;
FADOQ.SQL.Add(ASQL);
Self.FID := IDThread;
Self.FSQL:= ASQL;
end;
And the execute method is very simple:
procedure TADOSQLThread.Execute();
begin
inherited;
try
// Ejecutar la consulta
Self.FADOQ.Open;
except
// Error al ejecutar
...Error treattement
end;
end;
To start and create a thread you can use code similar to this:
//crear el Thread
th := TADOSQLThread.Create(True, mmConnection.Lines.Text, ASQL, AId);
// internal for me (for controled the number of active threads and limete it)
inc(numThreads);
// evento finalizacion
th.OnTerminate := TerminateThread;
// Ejecutarlo
th.Resume;
I have create a TerminateThread method that receive the control of threads when they finish. The only different to other threads is the connection problem. You must create a new connection on every thread, It can't share the same ADOConnections with others.
I hope this example will be useful for you.
Regards

Resources