I have a thread defined THttpThread for downloading of a file. I would like to stop the download if modal form is closed or if Cancel button is pressed.
In the example from bellow I got Access Violation probably because of the way how I reuse the thread.
procedure Tform_update.button_downloadClick(Sender: TObject);
var
HttpThread: THttpThread;
begin
//download
if button_download.Tag = 0 then
begin
HttpThread:= THttpThread.Create(True);
//...
HttpThread.Start;
end
//cancel download
else
begin
HttpThread.StopDownload:= True;
end;
end;
I sow the answers from How stop (cancel) a download using TIdHTTP and some many others but I still don't get it how to update a property of a running thread.
I will give the answer found, using also the hints from users comments.
The access violation comes from the fact HttpThread was not assigned during cancellation. Reason why HttpThread: THttpThread must be defined under his form like:
Tform_update = class(TForm)
//...
private
HttpThread: THttpThread;
and then the code should be:
procedure Tform_update.button_downloadClick(Sender: TObject);
begin
//download
if button_download.Tag = 0 then
begin
HttpThread:= THttpThread.Create(True);
//...
HttpThread.Start
end
//cancel download
else
begin
if Assigned(HttpThread) then HttpThread.StopDownload:= True;
end;
end;
Same for form close
procedure Tform_update.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if Assigned(HttpThread) then HttpThread.StopDownload:= True;
end;
As some users ask for in some comments, there is no need for the code of thread.
Related
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
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);
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 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