i use this component for processing drag and drop files
http://melander.dk/delphi/dragdrop
unit DragThread;
interface
uses
Classes,DragDrop, DropTarget,DragDropFile,Dialogs,SysUtils;
type
TDragThread = class(TThread)
private
{ Private declarations }
ArraysLength : Integer;
DragComponent : TDropFileTarget;
DragArray,HashsArray : Array of string;
Procedure FDArray;
//Procedure FDHArray;
protected
procedure Execute; override;
Public
Constructor Create(Com: TDropFileTarget);
Destructor Destroy; Override;
end;
implementation
{ TDragThread }
Constructor TDragThread.Create(Com: TDropFileTarget);
begin
inherited Create(True);
DragComponent := Com;
end;
Destructor TDragThread.Destroy;
begin
//DragComponent.Free;
end;
Procedure TDragThread.FDArray;
var
A : Integer;
begin
SetLength(DragArray,DragComponent.Files.Count);
SetLength(HashsArray,DragComponent.Files.Count);
ShowMessage(IntToStr(DragComponent.Files.Count)); // just working in the first time !!
for A := 0 to DragComponent.Files.Count -1 do begin
DragArray[A] := DragComponent.Files[A];
//ShowMessage(DragComponent.Files[A]);
end;
ArraysLength := DragComponent.Files.Count-1;
//ShowMessage(DragComponent.Files[0]);
end;
procedure TDragThread.Execute;
begin
{ Place thread code here }
FDArray;
end;
end.
the strange thing that the Drop process working just one time then the DragComponent.Files.Count gives 0 for ever .!!
that's how i call it
procedure TForm1.DropFileDrop(Sender: TObject; ShiftState: TShiftState;
APoint: TPoint; var Effect: Integer);
var
DropThread : TDragThread;
begin
DropThread := TDragThread.Create(DropFile);
DropThread.Resume;
end;
i want to know why this happened and thanks in advance :) .
Don't operate VCL components from other threads.
There's no guarantee that the component's drop-event information will continue to be valid once the drop event has completed.
Copy all the information you need out of the component when you construct the thread (i.e., fully populate DragArray) and then use that cached data when executing the thread. Don't store a reference in DragComponent or you might be tempted to use it from the thread's Execute method, which you really shouldn't do.
Related
Hi I'm doing a code MessageDlgPos running five threads at the same time, the code is this:
type
TMyThread = class(TThread)
protected
procedure Execute; override;
public
text: string;
property ReturnValue;
end;
procedure TMyThread.Execute;
begin
if Terminated then
Exit;
MessageDlgPos(text, mtInformation, [mbOk], 0, 100, 200);
end;
procedure TForm1.btnTestClick(Sender: TObject);
var
LThread: TMyThread;
i: Integer;
begin
For i := 1 to 5 do
begin
LThread := TMyThread(Sender);
try
LThread.text := 'hi';
LThread.FreeOnTerminate := True;
except
LThread.Free;
raise;
end;
LThread.Resume;
end;
end;
The problem is that Delphi XE always returns the following error and does not execute anything:
First chance exception at $ 7524B727. Exception class EAccessViolation with message 'Access violation at address 00D0B9AB. Write of address 8CC38309 '. Process tester.exe (6300)
How do I fix this problem?
As David Heffernan pointed out, MessageDlgPos() cannot safely be called outside of the main UI thread, and you are not managing the thread correctly. Your code needs to look more like this instead:
type
TMyThread = class(TThread)
protected
procedure Execute; override;
public
text: string;
property ReturnValue;
end;
procedure TMyThread.Execute;
begin
// no need to check Terminated here, TThread already
// does that before calling Execute()...
TThread.Synchronize(nil,
procedure
begin
MessageDlgPos(text, mtInformation, [mbOk], 0, 100, 200);
end
);
end;
procedure TForm1.btnTestClick(Sender: TObject);
var
LThread: TMyThread;
i: Integer;
begin
For i := 1 to 5 do
begin
LThread := TMyThread.Create(True);
LThread.text := 'hi';
LThread.FreeOnTerminate := True;
LThread.Start;
end;
end;
I would suggest a slightly different variation:
type
TMyThread = class(TThread)
private
fText: string;
protected
procedure Execute; override;
public
constructor Create(const aText: string); reintroduce;
property ReturnValue;
end;
constructor TMyThread.Create(const aText: string);
begin
inherited Create(False);
FreeOnTerminate := True;
fText := aText;
end;
procedure TMyThread.Execute;
begin
// no need to check Terminated here, TThread already
// does that before calling Execute()...
TThread.Synchronize(nil,
procedure
begin
MessageDlgPos(fText, mtInformation, [mbOk], 0, 100, 200);
end
);
end;
procedure TForm1.btnTestClick(Sender: TObject);
var
i: Integer;
begin
For i := 1 to 5 do
begin
TMyThread.Create('hi');
end;
end;
But either way, if you don't like using TThread.Synchronize() to delegate to the main thread (thus only displaying 1 dialog at a time) then you cannot use MessageDlgPos() at all, since it is only safe to call in the main UI thread. You can use Windows.MessageBox() instead, which can be safely called in a worker thread without delegation (but then you lose the ability to specify its screen position, unless you access its HWND directly by using a thread-local hook via SetWindowsHookEx() to intercept the dialog's creation and discover its HWND):
procedure TMyThread.Execute;
begin
Windows.MessageBox(0, PChar(fText), PChar(Application.Title), MB_OK or MB_ICONINFORMATION);
);
end;
There are many problems. The biggest one is here:
LThread := TMyThread(Sender);
Sender is a button. Casting to a thread is simply wrong and the cause of your exception. Casting a button to a thread doesn't make it so. It's still a button.
You likely mean to create a thread instead.
LThread := TMyThread.Create(True);
You cannot show VCL UI outside the main thread. The call to MessageDlgPos breaks that rule. If you do need to show UI at that point, you'll need to use TThread.Synchronize to have the code execute in the main thread.
Your exception handler makes no sense to me. I think you should remove it.
Resume is deprecated. Use Start instead.
I am designing a thread pool with following features.
New thread should be spawned only when all other threads are running.
Maximum number of thread should be configurable.
When a thread is waiting, it should be able to handle new requests.
Each IO operation should call a callback on completion
Thread should have a way to manage request its serving and IO callbacks
Here is the code:
unit ThreadUtilities;
interface
uses
Windows, SysUtils, Classes;
type
EThreadStackFinalized = class(Exception);
TSimpleThread = class;
// Thread Safe Pointer Queue
TThreadQueue = class
private
FFinalized: Boolean;
FIOQueue: THandle;
public
constructor Create;
destructor Destroy; override;
procedure Finalize;
procedure Push(Data: Pointer);
function Pop(var Data: Pointer): Boolean;
property Finalized: Boolean read FFinalized;
end;
TThreadExecuteEvent = procedure (Thread: TThread) of object;
TSimpleThread = class(TThread)
private
FExecuteEvent: TThreadExecuteEvent;
protected
procedure Execute(); override;
public
constructor Create(CreateSuspended: Boolean; ExecuteEvent: TThreadExecuteEvent; AFreeOnTerminate: Boolean);
end;
TThreadPoolEvent = procedure (Data: Pointer; AThread: TThread) of Object;
TThreadPool = class(TObject)
private
FThreads: TList;
fis32MaxThreadCount : Integer;
FThreadQueue: TThreadQueue;
FHandlePoolEvent: TThreadPoolEvent;
procedure DoHandleThreadExecute(Thread: TThread);
procedure SetMaxThreadCount(const pis32MaxThreadCount : Integer);
function GetMaxThreadCount : Integer;
public
constructor Create( HandlePoolEvent: TThreadPoolEvent; MaxThreads: Integer = 1); virtual;
destructor Destroy; override;
procedure Add(const Data: Pointer);
property MaxThreadCount : Integer read GetMaxThreadCount write SetMaxThreadCount;
end;
implementation
constructor TThreadQueue.Create;
begin
//-- Create IO Completion Queue
FIOQueue := CreateIOCompletionPort(INVALID_HANDLE_VALUE, 0, 0, 0);
FFinalized := False;
end;
destructor TThreadQueue.Destroy;
begin
//-- Destroy Completion Queue
if (FIOQueue = 0) then
CloseHandle(FIOQueue);
inherited;
end;
procedure TThreadQueue.Finalize;
begin
//-- Post a finialize pointer on to the queue
PostQueuedCompletionStatus(FIOQueue, 0, 0, Pointer($FFFFFFFF));
FFinalized := True;
end;
function TThreadQueue.Pop(var Data: Pointer): Boolean;
var
A: Cardinal;
OL: POverLapped;
begin
Result := True;
if (not FFinalized) then
//-- Remove/Pop the first pointer from the queue or wait
GetQueuedCompletionStatus(FIOQueue, A, Cardinal(Data), OL, INFINITE);
//-- Check if we have finalized the queue for completion
if FFinalized or (OL = Pointer($FFFFFFFF)) then begin
Data := nil;
Result := False;
Finalize;
end;
end;
procedure TThreadQueue.Push(Data: Pointer);
begin
if FFinalized then
Raise EThreadStackFinalized.Create('Stack is finalized');
//-- Add/Push a pointer on to the end of the queue
PostQueuedCompletionStatus(FIOQueue, 0, Cardinal(Data), nil);
end;
{ TSimpleThread }
constructor TSimpleThread.Create(CreateSuspended: Boolean;
ExecuteEvent: TThreadExecuteEvent; AFreeOnTerminate: Boolean);
begin
FreeOnTerminate := AFreeOnTerminate;
FExecuteEvent := ExecuteEvent;
inherited Create(CreateSuspended);
end;
Changed the code as suggested by J... also added critical sections but the problem i am facing now is that when i am trying call multiple task only one thread is being used, Lets say if i added 5 threads in the pool then only one thread is being used which is thread 1. Please check my client code as well in the below section.
procedure TSimpleThread.Execute;
begin
// if Assigned(FExecuteEvent) then
// FExecuteEvent(Self);
while not self.Terminated do begin
try
// FGoEvent.WaitFor(INFINITE);
// FGoEvent.ResetEvent;
EnterCriticalSection(csCriticalSection);
if self.Terminated then break;
if Assigned(FExecuteEvent) then
FExecuteEvent(Self);
finally
LeaveCriticalSection(csCriticalSection);
// HandleException;
end;
end;
end;
In the Add method, how can I check if there is any thread which is not busy, if it is not busy then reuse it else create a new thread and add it in ThreadPool list?
{ TThreadPool }
procedure TThreadPool.Add(const Data: Pointer);
begin
FThreadQueue.Push(Data);
// if FThreads.Count < MaxThreadCount then
// begin
// FThreads.Add(TSimpleThread.Create(False, DoHandleThreadExecute, False));
// end;
end;
constructor TThreadPool.Create(HandlePoolEvent: TThreadPoolEvent;
MaxThreads: Integer);
begin
FHandlePoolEvent := HandlePoolEvent;
FThreadQueue := TThreadQueue.Create;
FThreads := TList.Create;
FThreads.Add(TSimpleThread.Create(False, DoHandleThreadExecute, False));
end;
destructor TThreadPool.Destroy;
var
t: Integer;
begin
FThreadQueue.Finalize;
for t := 0 to FThreads.Count-1 do
TThread(FThreads[t]).Terminate;
while (FThreads.Count = 0) do begin
TThread(FThreads[0]).WaitFor;
TThread(FThreads[0]).Free;
FThreads.Delete(0);
end;
FThreadQueue.Free;
FThreads.Free;
inherited;
end;
procedure TThreadPool.DoHandleThreadExecute(Thread: TThread);
var
Data: Pointer;
begin
while FThreadQueue.Pop(Data) and (not TSimpleThread(Thread).Terminated) do begin
try
FHandlePoolEvent(Data, Thread);
except
end;
end;
end;
function TThreadPool.GetMaxThreadCount: Integer;
begin
Result := fis32MaxThreadCount;
end;
procedure TThreadPool.SetMaxThreadCount(const pis32MaxThreadCount: Integer);
begin
fis32MaxThreadCount := pis32MaxThreadCount;
end;
end.
Client Code :
This the client i created to log the data in text file :
unit ThreadClient;
interface
uses Windows, SysUtils, Classes, ThreadUtilities;
type
PLogRequest = ^TLogRequest;
TLogRequest = record
LogText: String;
end;
TThreadFileLog = class(TObject)
private
FFileName: String;
FThreadPool: TThreadPool;
procedure HandleLogRequest(Data: Pointer; AThread: TThread);
public
constructor Create(const FileName: string);
destructor Destroy; override;
procedure Log(const LogText: string);
procedure SetMaxThreadCount(const pis32MaxThreadCnt : Integer);
end;
implementation
(* Simple reuse of a logtofile function for example *)
procedure LogToFile(const FileName, LogString: String);
var
F: TextFile;
begin
AssignFile(F, FileName);
if not FileExists(FileName) then
Rewrite(F)
else
Append(F);
try
Writeln(F, DateTimeToStr(Now) + ': ' + LogString);
finally
CloseFile(F);
end;
end;
constructor TThreadFileLog.Create(const FileName: string);
begin
FFileName := FileName;
//-- Pool of one thread to handle queue of logs
FThreadPool := TThreadPool.Create(HandleLogRequest, 5);
end;
destructor TThreadFileLog.Destroy;
begin
FThreadPool.Free;
inherited;
end;
procedure TThreadFileLog.HandleLogRequest(Data: Pointer; AThread: TThread);
var
Request: PLogRequest;
los32Idx : Integer;
begin
Request := Data;
try
for los32Idx := 0 to 100 do
begin
LogToFile(FFileName, IntToStr( AThread.ThreadID) + Request^.LogText);
end;
finally
Dispose(Request);
end;
end;
procedure TThreadFileLog.Log(const LogText: string);
var
Request: PLogRequest;
begin
New(Request);
Request^.LogText := LogText;
FThreadPool.Add(Request);
end;
procedure TThreadFileLog.SetMaxThreadCount(const pis32MaxThreadCnt: Integer);
begin
FThreadPool.MaxThreadCount := pis32MaxThreadCnt;
end;
end.
This is the form application where i added three buttons, each button click will write some value to the file with thread id and text msg. But the problem is thread id is always same
unit ThreadPool;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ThreadClient;
type
TForm5 = class(TForm)
Button1: TButton;
Button2: TButton;
Button3: TButton;
Edit1: TEdit;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Edit1Change(Sender: TObject);
private
{ Private declarations }
fiFileLog : TThreadFileLog;
public
{ Public declarations }
end;
var
Form5: TForm5;
implementation
{$R *.dfm}
procedure TForm5.Button1Click(Sender: TObject);
begin
fiFileLog.Log('Button one click');
end;
procedure TForm5.Button2Click(Sender: TObject);
begin
fiFileLog.Log('Button two click');
end;
procedure TForm5.Button3Click(Sender: TObject);
begin
fiFileLog.Log('Button three click');
end;
procedure TForm5.Edit1Change(Sender: TObject);
begin
fiFileLog.SetMaxThreadCount(StrToInt(Edit1.Text));
end;
procedure TForm5.FormCreate(Sender: TObject);
begin
fiFileLog := TThreadFileLog.Create('C:/test123.txt');
end;
end.
First, and probably most strongly advisable, you might consider using a library like OmniThread to implement a threadpool. The hard work is done for you and you will likely end up making a substandard and buggy product with a roll-your-own solution. Unless you have special requirements this is probably the fastest and easiest solution.
That said, if you want to try to do this...
What you might consider is to just make all of the threads in your pool at startup rather than on-demand. If the server is going to busy at any point then it will eventually end up with a pool of MaxThreadCount soon enough anyway.
In any case, if you want to keep a pool of threads alive and available for work then they would need to follow a slightly different model than what you have written.
Consider:
procedure TSimpleThread.Execute;
begin
if Assigned(FExecuteEvent) then
FExecuteEvent(Self);
end;
Here when you run your thread it will execute this callback and then terminate. This doesn't seem to be what you want. What you seem to want is to keep the thread alive but waiting for its next work package. I use a base thread class (for pools) with an execute method that looks something like this (this is somewhat simplified):
procedure TMyCustomThread.Execute;
begin
while not self.Terminated do begin
try
FGoEvent.WaitFor(INFINITE);
FGoEvent.ResetEvent;
if self.Terminated then break;
MainExecute;
except
HandleException;
end;
end;
end;
Here FGoEvent is a TEvent. The implementing class defines what the work package looks like in the abstract MainExecute method, but whatever it is the thread will perform its work and then return to waiting for the FGoEvent to signal that it has new work to do.
In your case, you need to keep track of which threads are waiting and which are working. You will probably want a manager class of some sort to keep track of these thread objects. Assigning something simple like a threadID to each one seems sensible. For each thread, just before launching it, make a record that it is currently busy. At the very end of your work package you can then post a message back to the manager class telling it that the work is done (and that it can flag the thread as available for work).
When you add work to the queue you can first check for available threads to run the work (or create a new one if you wish to follow the model you outlined). If there are threads then launch the task, if there are not then push the work onto the work queue. When worker threads report complete the manager can check the queue for outstanding work. If there is work it can immediately re-deploy the thread. If there isn't work it can flag the thread as available for work (here you might use a second queue for available workers).
A full implementation is too complex to document in a single answer here - this aims just to rough out some general ideas.
I have a Query and open it in my Thread. It works correctly and I don't want to use Synchronize, because Synchronize makes main Form don't response while the Query not complete fetch.
When close the Form blow error shown:
System Error. Code: 1400. Invalid window handle
type
TMyThread = class(TThread)
public
procedure Execute; override;
procedure doProc;
end; { type }
.
.
.
procedure TMyThread.doProc;
begin
Form1.Query1.Open;
end;
procedure TMyThread.Execute;
begin
inherited;
doProc;
end;
.
.
.
procedure TForm1.Button1Click(Sender: TObject);
begin
thrd := TMyThread.Create(True);
thrd.FreeOnTerminate := True;
thrd.Resume;
end;
Note : Query has a lot of record.
The problem is that the VCL is not thread safe.
In order to have the query execute in parallel to all other things going on you'll have to decouple it from the Form.
That means you'll have to create the Query at runtime using code:
type
TMyThread = class(TThread)
private
FQuery: TQuery;
FOnTerminate: TNotifyEvent;
public
constructor Create(AQuery: TQuery);
destructor Destroy; override;
procedure Execute; override;
procedure doProc;
//Add an event handler to do cleanup on termination.
property OnTerminate: TNotifyEvent read FOnTerminate write FOnTerminate;
end; { type }
constructor TMyThread.Create(AQuery: TQuery);
begin
inherited Create(True);
FQuery:= AQuery;
end;
procedure TMyThread.doProc;
begin
FQuery1.Open;
Synchronize(
//anonymous method, use a separate procedure in older Delphi versions
procedure
begin
Form1.Button1.Enabled:= true; //reenable the button when we're done.
end
);
end;
procedure TMyThread.Execute;
begin
inherited;
doProc;
end;
destructor TMyThread.Destroy;
begin
if Assigned(FOnterminate) then FOnTerminate(Self);
inherited;
end;
In the OnClick for Button1 you'll do the following:
type
TForm1 = class(TForm)
private
AQuery: TQuery;
...
end; {type}
procedure TForm1.Button1Click(Sender: TObject);
begin
Button1.Enabled:= false; //disable the button so it cannot be started twice.
thrd.Free;
AQuery:= TQuery.Create;
AQuery.SQL.Text:= .....
thrd := TMyThread.Create(AQuery);
thrd.OnTerminate:= MyTerminationHandler;
thrd.FreeOnTerminate:= False;
thrd.Resume;
end;
Finally assign cleanup code to the termination handler of the thread.
If you destroy the Query in the thread then you cannot use FreeOnTerminate:= true, but you'll have to Free the thread yourself.
procedure TForm1.MyTerminationHandler(Sender: TObject);
begin
FreeAndNil(AQuery);
end;
Warning
This code will only work if you start 1 thread.
If you want start this thread multiple times (i.e. run multiple queries at the same time), you'll have to create an array of threads e.g.:
TQueryThreads = record
MyThread: TMyThread;
MyQuery: TQuery;
constructor Create(SQL: string);
end; {record}
TForm1 = class(TForm)
private
Threads: array of TQueryThreads;
....
end; {TForm1}
Note that this code will not work in the BDE, because that library does not support multiple running queries at the same time
If you want to do that you'll have to use ZEOS or something like that.
As per TLama's suggestion:
I would suggest switching the BDE TQuery component to ADO, or downloading something like ZEOS components. The BDE is very outdated and has a lot of quirks that will never get fixed because it is no longer maintained.
The only issue that remains is cleaning up the connection if Form1 is closed.
If it's your main form it really does not matter because your whole application will go down.
If it's not your main form than you'll need to disable closing the form by filling the OnCanClose handler.
TForm1.CanClose(Sender: TObject; var CanClose: boolean);
begin
CanClose:= thrd.Finished;
end;
You should prevent any action (user and program) in the MainThread without blocking it. This can easily be done by a modal form, that cannot be closed by the user.
The thread can do anything as long as it takes and the final (synchronized) step is to close that modal form.
procedure OpenDataSetInBackground( ADataSet : TDataSet );
var
LWaitForm : TForm;
begin
LWaitForm := TForm.Create( nil );
try
LWaitForm.BorderIcons := []; // no close buttons
TThread.CreateAnonymousThread(
procedure
begin
try
ADataSet.Open;
finally
TThread.Synchronize( nil,
procedure
begin
LWaitForm.Close;
end );
end;
end );
try
LWaitForm.ShowModal;
finally
LWorkThread.Free;
end;
finally
LWaitForm.Free;
end;
end;
But you have to be careful with this and you should never try do start more than one parallel thread with this code unless you really know, what you are doing.
I'm new to multithreading, but not a complete novice. I need to perform a call to a webservice in a worker thread.
In the main thread I have a form (TForm) with a private data member (private string) that only the worker thread will write to (I pass the a pointer to it into the thread before it resumes). When the worker thread has finished its webservice call and written the resultant response xml to the private member on the form, the worker thread uses PostMessage to send a message to the form's handle (which I also passed into the thread before it resumed).
interface
const WM_WEBSERVCALL_COMPLETE = WM_USER + 1;
type
TWebServiceResponseXML = string;
PWebServiceResponseXML = ^TWebServiceResponseXML;
TMyForm = class(TForm)
...
private
...
fWorkerThreadID: Cardinal;
fWebServiceResponseXML: TWebServiceResponseXML;
public
...
procedure StartWorkerThread;
procedure OnWebServiceCallComplete(var Message: TMessage); Message WM_WEBSERVCALL_COMPLETE;
end;
TMyThread = class(TThread)
private
protected
procedure Execute; override;
public
SenderHandle: HWnd;
RequestXML: string;
ResponseXML: string;
IMyService: IService;
PResponseXML: PWebServiceResponseXML;
end;
implementation
procedure TMyForm.StartWorkerThread;
var
MyWorkerThread: TMyThread;
begin
MyWorkerThread := TMyThread.Create(True);
MyWorkerThread.FreeOnTerminate := True;
MyWorkerThread.SenderHandle := self.Handle;
MyWorkerThread.RequestXML := ComposeRequestXML;
MyWorkerThread.PResponseXML := ^fWebServiceResponseXML;
MyWorkerThread.Resume;
end;
procedure TMyForm.OnWebServiceCallComplete(var Message: TMessage);
begin
// Do what you want with the response xml string in fWebServiceResponseXML
end;
procedure TMyThread.Execute;
begin
inherited;
CoInitialize(nil);
try
IMyService := IService.GetMyService(URI);
ResponseXML := IMyService.Search(RequestXML);
PResponseXML := ResponseXML;
PostMessage(SenderHandle, WM_WEBSERVCALL_COMPLETE, 0, 0);
finally
CoUninitialize;
end;
end;
It works great, but now I want to do the same thing from a datamodule (which doesn't have a Handle)... so I would really appreciate some useful code to supplement the working model I have.
EDIT
What I really want is the code (if possible) that would allow me to replace the line
MyWorkerThread.SenderHandle := self.Handle;
with
MyWorkerThread.SenderHandle := GetHandleForThisSOAPDataModule;
I have used this technique before with some success: Sending messages to non-windowed applications
Basically, use a second thread as a message pump on a handle obtained via AllocateHWND. This is admittedly irritating, and you would be better off using a library to handle all the details. I prefer OmniThreadLibrary but there are others - see How Do I Choose Between the Various Ways to do Threading in Delphi? and Delphi - Threading frameworks.
You can allocate you own handle with AllocateHwnd and use that as a PostMessage target.
TTestThread = class(TThread)
private
FSignalShutdown: boolean;
// hidden window handle
FWinHandle: HWND;
protected
procedure Execute; override;
// our window procedure
procedure WndProc(var msg: TMessage);
public
constructor Create;
destructor Destroy; override;
procedure PrintMsg;
end;
constructor TTestThread.Create;
begin
FSignalShutdown := False;
// create the hidden window, store it's
// handle and change the default window
// procedure provided by Windows with our
// window procedure
FWinHandle := AllocateHWND(WndProc);
inherited Create(False);
end;
destructor TTestThread.Destroy;
begin
// destroy the hidden window and free up memory
DeallocateHWnd(FWinHandle);
inherited;
end;
procedure TTestThread.WndProc(var msg: TMessage);
begin
if Msg.Msg = WM_SHUTDOWN_THREADS then
// if the message id is WM_SHUTDOWN_THREADS
// do our own processing
FSignalShutdown := True
else
// for all other messages call
// the default window procedure
Msg.Result := DefWindowProc(FWinHandle, Msg.Msg,
Msg.wParam, Msg.lParam);
end;
You can apply this to anything not just threads. Just beware that AllocateHWND is NOT threade safe as indicated here.
Alternatives based on the use of an event:
Use OnTerminate of the thread (already present) in combination with a flag:
TMyDataModule = class(TDataModule)
private
procedure OnWebServiceCallComplete(Sender: TObject);
...
TMyThread = class(TThread)
public
property TerminateFlag: Integer ...
...
procedure TMyDataModule.StartWorkerThread;
...
MyWorkerThread.OnTerminate := <Self.>OnWebServiceCallComplete;
...
procedure TMyDataModule.OnWebServiceCallComplete(Sender: TObject);
begin
if MyWorkerThread.TerminateFlag = WEBCALL_COMPLETE then
...
end;
Set the TerminateFlag in the Execute routine. OnTerminate will automatically fire, even if FreeOnTerminate is True.
Add a new event property to the thread class in which you may provide the flag as a parameter to indicate termination/thread result. Something like shown here. Be sure to synchronize the event call. Or forget the parameter and just only call the event if execution completed gracefully (like you're doing now).
TThread's resume method is deprecated in D2010. So, I thought it should now work like this:
TMyThread = class (TThread)
protected
Execute; override;
public
constructor Create;
end;
...
TMyThread.Create;
begin
inherited Create (True);
...
Start;
end;
Unfortunately I get an exception "Cannot call start on a running or supsended thread"...which seems weird to me considering the fact that the documentation tells me that I should call Start on a thread created in suspended mode.
What am I missing here?
The reason is that a Thread is not supposed to start itself.
The thread never knows when initialization is complete. Construction is not the same as initialization (construction should always be short and exception free; further initialization is done after construction).
A similar situation is a TDataSet: no TDataSet constructor should ever call Open, or set Active := True.
See also this blog entry by Wings of Wind.
You should either:
Create the TMyThread suspended by calling Create(true) and perform the Start outside your TMyThread class
Create the TMyThread non-suspeneded, making sure the Create constructor does full initialization, and let TThread.AfterConstruction start the thread.
Explanation of TThread usage:
Basically, a thread should be just that: the encapsulation of the context on which code is executed.
The actual code (the business logic) that is executed should then be in other classes.
By decoupling those two, you gain a lot of flexibility, especially initiating your business logic from within multiple places (which is very convenient when writing unit tests!).
This is the kind of framework you could use for that:
unit DecoupledThreadUnit;
interface
uses
Classes;
type
TDecoupledThread = class(TThread)
strict protected
//1 called in the context of the thread
procedure DoExecute; virtual;
//1 Called in the context of the creating thread (before context of the new thread actualy lives)
procedure DoSetUp; virtual;
//1 called in the context of the thread right after OnTerminate, but before the thread actually dies
procedure DoTearDown; virtual;
protected
procedure DoTerminate; override;
procedure Execute; override;
public
constructor Create;
procedure AfterConstruction; override;
end;
implementation
constructor TDecoupledThread.Create;
begin
// create suspended, so that AfterConstruction can call DoSetup();
inherited Create(True);
end;
procedure TDecoupledThread.AfterConstruction;
begin
// DoSetUp() needs to be called without the new thread in suspended state
DoSetUp();
// this will unsuspend the underlying thread
inherited AfterConstruction;
end;
procedure TDecoupledThread.DoExecute;
begin
end;
procedure TDecoupledThread.DoSetUp;
begin
end;
procedure TDecoupledThread.DoTearDown;
begin
end;
procedure TDecoupledThread.DoTerminate;
begin
inherited DoTerminate();
// call DoTearDown on in the thread context right before it dies:
DoTearDown();
end;
procedure TDecoupledThread.Execute;
begin
// call DoExecute on in the thread context
DoExecute();
end;
end.
You could even make it event based by something like this:
unit EventedThreadUnit;
interface
uses
Classes,
DecoupledThreadUnit;
type
TCustomEventedThread = class(TDecoupledThread)
private
FOnExecute: TNotifyEvent;
FOnSetUp: TNotifyEvent;
FOnTearDown: TNotifyEvent;
strict protected
procedure DoExecute; override;
procedure DoSetUp; override;
procedure DoTearDown; override;
public
property OnExecute: TNotifyEvent read FOnExecute write FOnExecute;
property OnSetUp: TNotifyEvent read FOnSetUp write FOnSetUp;
property OnTearDown: TNotifyEvent read FOnTearDown write FOnTearDown;
end;
// in case you want to use RTTI
TEventedThread = class(TCustomEventedThread)
published
property OnExecute;
property OnSetUp;
property OnTearDown;
end;
implementation
{ TCustomEventedThread }
procedure TCustomEventedThread.DoExecute;
var
TheOnExecute: TNotifyEvent;
begin
inherited;
TheOnExecute := OnExecute;
if Assigned(TheOnExecute) then
TheOnExecute(Self);
end;
procedure TCustomEventedThread.DoSetUp;
var
TheOnSetUp: TNotifyEvent;
begin
inherited;
TheOnSetUp := OnSetUp;
if Assigned(TheOnSetUp) then
TheOnSetUp(Self);
end;
procedure TCustomEventedThread.DoTearDown;
var
TheOnTearDown: TNotifyEvent;
begin
inherited;
TheOnTearDown := OnTearDown;
if Assigned(TheOnTearDown) then
TheOnTearDown(Self);
end;
end.
Or adapt it for DUnit TTestCase descendants like this:
unit TestCaseThreadUnit;
interface
uses
DecoupledThreadUnit,
TestFramework;
type
TTestCaseRanEvent = procedure (Sender: TObject; const TestResult: TTestResult) of object;
TTestCaseThread = class(TDecoupledThread)
strict private
FTestCase: TTestCase;
strict protected
procedure DoTestCaseRan(const TestResult: TTestResult); virtual;
function GetTestCase: TTestCase; virtual;
procedure SetTestCase(const Value: TTestCase); virtual;
protected
procedure DoExecute; override;
procedure DoSetUp; override;
procedure DoTearDown; override;
public
constructor Create(const TestCase: TTestCase);
property TestCase: TTestCase read GetTestCase write SetTestCase;
end;
implementation
constructor TTestCaseThread.Create(const TestCase: TTestCase);
begin
inherited Create();
Self.TestCase := TestCase;
end;
procedure TTestCaseThread.DoExecute;
var
TestResult: TTestResult;
begin
if Assigned(TestCase) then
begin
// this will call SetUp and TearDown on the TestCase
TestResult := TestCase.Run();
try
DoTestCaseRan(TestResult);
finally
TestResult.Free;
end;
end
else
inherited DoExecute();
end;
procedure TTestCaseThread.DoTestCaseRan(const TestResult: TTestResult);
begin
end;
function TTestCaseThread.GetTestCase: TTestCase;
begin
Result := FTestCase;
end;
procedure TTestCaseThread.SetTestCase(const Value: TTestCase);
begin
FTestCase := Value;
end;
procedure TTestCaseThread.DoSetUp;
begin
if not Assigned(TestCase) then
inherited DoSetUp();
end;
procedure TTestCaseThread.DoTearDown;
begin
if not Assigned(TestCase) then
inherited DoTearDown();
end;
end.
--jeroen
Short answer: call inherited Create(false) and omitt the Start!
The actual Start of a non-create-suspended thread is done in AfterConstruction, which is called after all constructors have been called.