I create a Kernel-Mode driver and do something in that.
And I have an User-Mode app written in Delphi called MyApp, for communication with the driver and MyApp.
I have to use Event sharing method between Driver and MyApp.
I am using a thread for doing this work. In the constructor of my thread I create a User-Mode event using CreateEvent:
...
var xxx:THandle;
....
xxx:=CreateEvent(nil, False, False, nil);
And pass it to my driver and validate that.
But when this event is being created the handle of that is not valid, and when I try to use that nothing happens even any error or exception:
procedure TMyThread.Execute;
begin
while Active do
begin
if WaitForSingleObject(xxx, INFINITE) <> WAIT_FAILED then
begin
Synchronize(DoSomething)
end
else
begin
RaiseLastOSError;
Break;
end;
Sleep(1);
end;
end;
The driver create an event and pass that by the handle of this User-Mode event handle (xxx) to MyApp.
But when I create this event in main thread:
For example:
procedure TfrmMain.FormCreate(Sender: TObject);
Var
xxx::THandle;
begin
xxx:=CreateEvent(nil, False, False, nil);
end;
The handle of event (xxx) is a valid handle !!!
Edit:
When I use Delphi 7 the xxx handle is valid! Only in XE+ it is not valid.
Edit my code!
Notice that I have to use threading and I have to create event in MyThread.
Any idea?
(Excuse me if my English is bad)
Related
I am using TOmniBlockingCollection from a "Server Thread".
In this thread, I am hosting a Single-Threaded Apartment COM object to a DataProvider (CoInitialize() and CoUninitialize() are called).
Then additionally, I am using multiple worker threads to write to an ADO Dataset (TADOCommand), which also needs CoInitialize()/CoUninitialize().
Only when I catch an error from inside the WorkerFunction and try to terminate the "Server Thread", I am waiting (infinitely?) on the CoUninitialize() in the "Server Thread" (inherited from TThread) that started the WorkerFunction.
Callstack:
:774546bc ntdll.ZwWaitForAlertByThreadId + 0xc
.... some other system functions
:771e8069 combase.CoUninitialize + 0xf9
UTServerThread.TServerThread.Execute (calls CoUninitialize)
How do I avoid the wait in the Server Thread when I catch an error ... it seems to be something COM-related in multi-threading.
Pseudo Code:
procedure CreateIOmniWorkers;
begin
for Each IOmniWorker in OmniWorkerArry
begin
IOmniWorker := CreateTask("WorkerFunction" as TOmniTaskMethod, Description)
.SetParameter('Input', InputCollection)
.WithLock(TSynchroObject.Create) // The Used Logger inside Worker Funtion needs a Lock
.OnTerminated(ErrorHandler);
end;
end;
procedure ErrorHandler(const task: IOmniTaskControl);
var
eException: Exception;
begin
if Assigned(task.FatalException) then
begin
eException := task.DetachException;
try
Logger.Error(
'TOTLBlockingListWorker', eException.ClassName,
Format(rsScriptErrorDataBlock,[eException.Message, eException.StackTrace]));
finally
FreeAndNil(eException);
end;
end;
end;
procedure WorkerFunction(const task: IOmniTask; var SyncData: TSyncOutputValueHolder);
begin
CoInitialize(nil);
try
CreateConnection(SyncData);
// Somewhere here a Exception happens
WriteSQLStyle(task, SyncData);
finally
CoUninitialize; // is called
end;
end;
procedure UTServerThread.TServerThread.Execute
begin
CoInitialize(nil);
try
while not Terminated
begin
CreateIOmniWorkers;
with TOTLBlockingCollection do
while DataAvailable
TOTLBlockingCollection.Add(Datapackage);
TOTLBlockingCollection.CompleteAdding;
while not TOTLBlockingCollection.IsFinalized
Sleep(250);
end;
finally
CoUninitialize; // Here the (infinite?) Wait happens.
end;
end;
I had also some Other Problem with the BlockingList.
if a Exception occured Inside the TryTake until False Loop of the Blocking List Interfaced objects would not be freed.
So i did deperately update my OTL Source to the current Version (3.07.8 was 07.6).
The Problem with CoInitialize and Unitialize is gone... But... i must have still a bug in the Composition.
In place of the OnTerminadted Handler i attached A Monitor to my CreateIOmniWorkers, but i dont receive Events there. The OnTerminated Handler also does not Fire. So it works... But i am not confident that i did it right.
repeat
if not BlockingList.TryTake(Params) then
break; // simplified
InterfacedObject := TInferfacedObject.Create as ISomething
try
raise Exception while having a TInterfacedObject here ...
Finally
InterfaceObject := nil; // if this finally is here in case of Error the Interface would not be freed.
end;
until false
I'm fairly new to IPC(interprocess communication). Doing my research, I decided on the Named pipes.
My application consists of 2 parts: a monitoring app, and a UI dashboard. The dashboard receives updates from the monitor constantly and shows stats, the user should be able to change certain parameters of the monitor through the dashboard (refresh rate, restart process,scheduled task...) so it has to be a bidirectional communication. The Monitor would later become a service application, but that's a plan for later.
Getting to the point, I used the Pipes unit by Overbyte(Francois Piette) v1.01
and followed the example made on their website. When connecting the pipes on the main thread, it functions normally. But due to my monitor needing a separate thread to (monitor-send message-sleep-loop...), when I try to connect on the other thread, I get an error "The notify window and the component window do not exist in the same thread!"
What I need to know is, can named pipes communicate using a separate thread? (Judging by the error msg, I feel it may be fetching the window handle on the main UI and would not work on a different thread)
Is there a better way to implement my application? or named pipes better than Overbyte?
Sample of my code:
TThreadMonitor = Class(TThread)
private
PipeClient1: TPipeClient;
listOfProcesses: Array of String;
protected
procedure Execute; override;
public
constructor Create(CreateSuspended: Boolean);
procedure ConnectPipe;
procedure SendMessage(const Msg: String);
End;
var
t: TThreadMonitor;
procedure TClientFormMain.BtnDifferentThreadClick(Sender: TObject);
begin
t := TThreadMonitor.Create(TRUE);
t.FreeOnTerminate := TRUE;
t.Start;
end;
procedure TThreadMonitor.ConnectPipe;
begin
if not PipeClient1.Connect(2000, TRUE) then
LogThis('Pipe connection failed', LogFilePath, TRUE)
else
LogThis('Pipe connected', LogFilePath, TRUE);
end;
procedure TThreadMonitor.Execute;
begin
inherited;
ConnectPipe; //<---throws exception here although getting "Pipe Connected"
while not Terminated do
begin
for i := 0 to Length(listOfProcesses) - 1 do
begin
...
MonitorProcess(listOfProcesses[i]);
...
end;
sleep(2000);
end;
end;
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);
When my main application (Delphi 2009) terminates, I want it to signal my threads (timers, TDataModules with ADO Connections, SMTP etc) to dispose gracefully.
In my main application, I have the following:
try
PostThreadMessage(bpvccMAILER.ThreadID, WM_SYSTEM_CLOSE, self.Handle, 0);
returnMessage := (SysErrorMessage(GetLastError)); //Returns 'The operation completed successfully'
while TRUE do
begin
sleep(1000);
if not (Assigned(bpvccMAILER)) then
begin
bpvccACTIVITY_LOGGER.Write('SHUTDOWN','TBPVCommunicatorGUI.FormClose - All Threads have shut down');
break;
end;
locWaited := locWaited + 10;
end;
except
end;
finally
FreeAndNil(bpvccACTIVITY_LOGGER);
FreeAndNil(bpvccMAILER);
end;
Thread class:
TBPVMailer = class(TThread)
protected
SMTP : TIdSMTP;
interval : Integer;
fMain : Integer;
fMainIsSvc : Boolean;
fTerminated: Boolean;
function SendEmail(AEmail: TEmailObj) : TBPVEmailSendResult;
function doSleep : Boolean;
procedure Write(AStatus, AMessage : String);
procedure FlushQueue();
procedure HandleMessage(var Message : TMessage); message WM_SYSTEM_CLOSE;
public
constructor Create(AServer : String; APort : Integer; AUser, APass : String; AInterval : Integer; StartSuspended : Boolean); overload;
procedure Execute; override;
procedure QueueEmail(AEmail: TEmailObj; EmailType : TBPVEmailType; AssociatedID : String);
destructor Destroy; override;
end;
procedure TBPVMailer.HandleMessage(var Message: TMessage);
var
msg : tagMSG;
begin
PeekMessage(&msg, 0, 0, 0, PM_NOREMOVE);
fMain := Message.WParam;
fMainIsSvc := Message.LParam = 1;
fTerminated := TRUE;
end;
Problem is, Assigned(bpvccMAILER) always returns true even after calling PostThreadMessage. Also, bpvccMAILER.fTerminated is always FALSE, which means the TBPVMailer.HandleMessage is never executed because that is were the value is set to TRUE. What am I doing wrong, it appears that my threads arent receiving the messages?
The obvious explanation is that you don't have a message pump in your thread. You post the message, but the thread does not pump its queue.
The code is needlessly complex though. There seems to be no need for messages at all. Call the Terminate method of the thread and then use its WaitFor method to wait until it stops. Or even simpler, just call Free on the thread.
Your code does contain a number of oddities:
Why do you call PeekMessage? That serves no purpose that I can discern.
Waiting with Sleep should be avoided. You can almost always use dedicated wait functions.
It's odd the you wait until bpvccMAILER is nil, but then use FreeAndNil(bpvccMAILER).
You must only call GetLastError when it is well-defined. Typically that is only when the preceeded API call has failed. And failure is indicated by the value returned by the API call.
The Sleep loop in the main thread is not OK since it blocks processing messages.
Just call the PostThreadMessage and return, without any Sleep loop afterwards.
If you need to wait until bpvccMAILER finishes, add code that on completion send a PostMessage to your main thread. So, the main thread will handle this message and will be aware that the auxiliary thread has finished. It may not be easy to change your application this way straight from the start, but little by little you will be designing applications in such a way that always does correct thread handling.
Besides that, if you use PostThreadMessage, then your Thread.Execute loop must have MsgWaitForMultipleObjects.
Here is an example on how the Thread.Execute loop have to be:
<skipped>
repeat
<skipped>
R := MsgWaitForMultipleObjects(EventCount, EventArray, False, INFINITE, QS_ALLINPUT);
<skipped>
if R = WAIT_OBJECT_0 + EventCount then
begin
while PeekMessage(M, 0, 0, 0, PM_REMOVE) do
begin
if M.Message = WM_QUIT then
Break;
TranslateMessage(M);
DispatchMessage(M);
end;
if M.Message = WM_QUIT then
Break;
end;
<skipped>
until Terminated;
<skipped>
If your application will eventually need to exit while the tread is running (assume your thread object is in T variable), do the following:
T.Terminate;
SetEvent([one of the event of the EventArray]); // we should call it AFTER terminate for the Terminated property would already be True when the tread exits from MsgWaitForMultipleObjects
T.WaitFor;
T.Free; // "Free" calls "WaitFor" anyway, but Remy Lebeau suggests to explicitly call "WaitFor" before "Free".
T := nil;
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