my problem is the following:
I implemented a Windows Service with Delphi Tokyo but imho this is no version problem rather than a design problem.
I use the following code to pause my service and be responsive in that state.
procedure TMyService.ServiceExecute(Sender: TService);
begin
while not Terminated do
begin
MyProductiveFunction;
Delay(10000);
end;
end;
procedure TMyService.Delay(Milliseconds: integer);
var
Tick: DWord;
Event: THandle;
begin
LogOnLevel(clogger, CAS_LOGGER.Debug, '', ['Delay', 'ENTER', 'Delayed for ' + Milliseconds.ToString]);
Event := CreateEvent(nil, False, False, nil);
try
Tick := GetTickCount + DWord(Milliseconds);
while (Milliseconds > 0) and (MsgWaitForMultipleObjects(1, Event, False, Milliseconds, QS_ALLINPUT) <>
WAIT_TIMEOUT) do
begin
ServiceThread.ProcessRequests(False);
if Terminated then
exit;
Milliseconds := Tick - GetTickCount;
end;
finally
CloseHandle(Event);
end;
end;
The Function I run sometimes is very time consuming. When I try to Stop the Service while it is in the Delay procedure it stops and everything is fine. But when I try to stop the Service while running "MyProductiveFunction" it will say Service is not responding and after that there is no other way to terminate the Service than killing it by Taskmanager.
Is there a better way to implement that so the Service will be responding independently from its actual state?
You have to write MyProductiveFunction like you programmed your Delay function: periodically process requests and terminate the function if the service is asked to terminate.
Instead, you may also create another thread to execute MyProductiveFunction and from the ServiceExecute call ProcessRequest and check for termination. When termination is requested, you have to terminate the other thread. The best is to have this other thread check something shared such a TEvent for terminating, or ServiceExecute may kill/abort that thread.
Thanks for your Support.
I used the code skeleton from Remys post here:
Delphi Windows Service Design
Works great. Thx to that great community and thx to Remy
Related
At program start, in the OnActivate event handler, I need to do something which blocks the program for a few seconds. During this time the form's client area is still not completely painted, which looks ugly for the user. (During this blocked time I don't need the program to respond to clicks or other user actions, so there is no need to put the blocking operation into a thread - I just need the form to be completely painted). So I use TForm.Update and Application-ProcessMessages to update the form before the blocking operation which works very well:
procedure TForm1.FormActivate(Sender: TObject);
begin
Form1.Update;
Application.ProcessMessages;
Sleep(7000);
end;
However, I wonder whether there is not another more elegant solution for this problem. This could be for example a OnShown event implemented in a descendant of TForm which will be fired AFTER the form has been completely painted. How could such an event be implemented?
Your real problem is that you are blocking the UI thread. Simply put, you must never do that. Move the long running task onto a different thread and thus allow the UI to remain responsive.
If you are looking for event which is fired when application finishes loading/repainting you should use TApplication.OnIdle event
http://docwiki.embarcadero.com/Libraries/XE3/en/Vcl.Forms.TApplication.OnIdle
This event is fired once application is read to recieve users input. NOTE this event will be fired every time application becomes idle so you need to implement some controll variable which will tel you when OnIdle even was fired for the first time.
But as David already pointed out it is not good to block your UI (main thread). Why? When you block your main thread the application can't normally process its messages. This could lead to OS recognizing your application as being "Hanged". And aou definitly wanna avoid this becouse it could cause the users to go and forcefully kill your application whihc would probably lead to data loss. Also if you ever wanna design your application for any other platforms than Windows your application might fail the certification proces becouse of that.
In the past a simple PostMessage did the trick.
Essentially you fire it during DoShow of the base form:
procedure TBaseForm.DoShow;
begin
inherited;
PostMessage(Handle, APP_AFTERSHOW, 0, 0);
end;
then catch the msg and create an AfterShow event for all forms inherited from this base form.
But that no longer works, well not if you are skinning and have a good number of VCL controls.
My next trick was to spawn a simple thread in DoShow and check for IsWindowVisible(Handle) and IsWindowEnabled(Handle). That really sped things up it cut 250ms from load time since db opening and other stuff was already in the AfterShow event.
Then finally I thought of madHooks, easy enough to hook the API ShowWindow for my application and fire APP_AFTERSHOW from that.
function ShowWindowCB(hWnd: HWND; nCmdShow: Integer): BOOL; stdcall;
begin
Result := ShowWindowNext(hWnd, nCmdShow);
PostMessage(hWnd, APP_AFTERSHOW, 0, 0);
end;
procedure TBaseForm.Loaded;
begin
inherited;
if not Assigned(Application.MainForm) then // Must be Mainform it gets assigned after creation completes
HookAPI(user32, 'ShowWindow', #ShowWindowCB, #ShowWindowNext);
end;
To get the whole thing to completely paint before AfterShow it still needed a ProcessPaintMessages call
procedure TBaseForm.APPAFTERSHOW(var AMessage: TMessage);
begin
ProcessPaintMessages;
AfterShow;
end;
procedure ProcessPaintMessages; // << not tested, pulled out of code
var
msg: TMsg;
begin
while PeekMessage(msg, 0, WM_PAINT, WM_PAINT, PM_REMOVE) do
DispatchMessage(msg);
end;
My final test was to add a Sleep to the AfterShow event and see the Form fully painted with empty db containers since the AfterShow events had not yet completed.
procedure TMainForm.AfterShow;
begin
inherited;
Sleep(8*1000);
......
I just encountered a problem with a service I wrote some time ago. This service is meant to translate various programs by calling a multilizer application via CreateProcess. The problem is that once the checks of the given directories cleared and the actual translation method is called the cpu load will rise to about 15-20% and remain at this level even if all files have been processed. The OnStart-event of the service creates a non delayed thread which has an execute-method that looks like this:
procedure TTranslateThread.Execute;
var count : integer;
begin
sleep(ServiceObject.hInterval);
while not Terminated do
begin
Inc(Count);
if Count>= 10 then
begin
Count :=0;
if ServiceObject.CheckDirCount>0 then
begin
ServiceObject.TranslateService;
sleep(ServiceObject.hInterval);
end;
end;
end;
However I suppose the main cause of the problem lies in the way I have to call the multilizer. That is because the service has to wait for the multilizer to finish translating. I used WaitForSingleObject to wait for the multilizer to finish although I know it's kind of a bad idea. This is the method that calls the multilizer:
procedure WaitForML7(hName: string);
var
si: TStartupInfo;
pi: TProcessInformation;
hCreateOK: Boolean;
AParameterFinal,AFileName: String;
begin
AFileName := hMultilizerPath+'Ml7Build.exe';
AParameterFinal := 'b '+hName+'.exe.m7p';
FillChar(si,SizeOf(TStartupInfo),#0);
FillChar(pi,SizeOf(TProcessInformation),#0);
si.cb := SizeOf(TStartupInfo);
AParameterFinal := Format ('"%s" %s', [AFilename, TrimRight(AParameterFinal)]);
slog.Info('CreateProcess wird versucht');
hCReateOK := CreateProcess(nil,PChar(AParameterFinal), nil, nil, false, CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS, nil,
PChar(hMultilizerPath) ,si,pi);
if hCreateOK then
begin
slog.Error('Multilizeraufruf war erfolgreich für Prg: '+hName);
WaitForSingleObject(pi.hProcess,INFINITE);
end
else
begin
slog.Error('Aufruf war nicht erfolgreich -> keine Uebersetzung');
end;
CloseHandle(pi.hProcess);
CloseHandle(pi.hThread);
end;
I don't really understand why the processor load remains high even there is nothing more to do. Thanks in advance.
Your thread runs a busy loop.
while not Terminated do
begin
Inc(Count);
if Count>= 10 then
begin
Count :=0;
if ServiceObject.CheckDirCount>0 then
begin
ServiceObject.TranslateService;
sleep(ServiceObject.hInterval);
end;
end;
end;
Note that I've added the missing end from your code. I hope that's the only error you made, because obviously when you post code that is not the real code, it's plausible that the problem lies in the real code rather than the code you posted.
Anyway, suppose that CheckDirCount always evaluates to 0, then the loop looks like this:
while not Terminated do
begin
Inc(Count);
if Count>= 10 then
begin
Count :=0;
ServiceObject.CheckDirCount;
end;
end;
That is a busy loop. When you run a busy loop, the processor gets hot.
I don't really want to propose solutions to this because I don't know any of the details of what your program is doing. I'm just trying to answer the question of why your thread consumes CPU.
Your wait loop will run without waiting within a Sleep(), so will burn some CPU until Sleep() is reached. This is not a good implementation pattern.
A common solution is to use semaphores to notify the thread to wake up and handle the pending tasks. It won't use any CPU until the semaphore (e.g. TEvent) is triggered.
Take a look at TEvent documentation.
For more complex multi-thread content, consider using a dedicated library like OmniThreadLibrary. It features high-level lists and parallel processing, tuned and stable. Using such a library will save you plenty of time and money. Multi-threading programming can be very difficult to stabilize, so OmniThreadLibrary is worth a look.
In addition to David's answer:
your main execute block can be simplified, doing Sleep unconditionally to prevent a busy loop:
procedure TTranslateThread.Execute;
begin
while not Terminated do
begin
sleep(ServiceObject.hInterval);
if ServiceObject.CheckDirCount>0 then
ServiceObject.TranslateService;
end;
end;
Please note that you can avoid the sleep loop by using Shell notification events.
Can anyone help me with a coding example to close the associated process when I have the Process ID. I will be using Delphi 5 to perform this operation programmatically on a Windows 2003 server.
If you have a process id and want to force that process to terminate, you can use this code:
function TerminateProcessByID(ProcessID: Cardinal): Boolean;
var
hProcess : THandle;
begin
Result := False;
hProcess := OpenProcess(PROCESS_TERMINATE,False,ProcessID);
if hProcess > 0 then
try
Result := Win32Check(Windows.TerminateProcess(hProcess,0));
finally
CloseHandle(hProcess);
end;
end;
Use EnumWindows() and GetWindowProcessThreadId() to locate all windows that belong to the process, and then send them WM_CLOSE and/or WM_QUIT messages.
Along with the WM_CLOSE and WM_QUIT, you can make it really elegant and simply launch a second instance of the app with STOP as the parameter. Like this:
In the project main body...
if ((ParamCount >= 1) and (UpperCase(paramstr(1)) = 'STOP')) then
// send the WM_CLOSE, etc..
When the app launches and sees that it has a parameter of 'STOP', then hunt down the first instance and kill it. Then quit the second instance without creating your main form, etc.. This way, you don't have to have to write/deploy a second program just to kill the first one.
If you want to close a program properly without killing the process:
procedure TmyFRM.btn_closeClick(Sender: TObject);
var
h: HWND;
begin
h := FindWindow('Notepad', nil);
if h <> 0 then
PostMessage(h, WM_QUIT, 0, 0);
end;
and consider it sometimes you can use WM_Close instead of WM_Quit and you can work around SendMessage instead of PostMessage too. when you are trying to close a program properly without killing its process, so you are following the program routines and programs may respond diffrent to closing messages; for example, some programs will be Minimized to Tray after closing them and etc...
I created a class that opens a COM port and handles overlapped read and write operations. It contains two independent threads - one that reads and one that writes data. Both of them call OnXXX procedures (eg OnRead or OnWrite) notifying about finished read or write operation.
The following is a short example of the idea how the threads work:
TOnWrite = procedure (Text: string);
TWritingThread = class(TThread)
strict private
FOnWrite: TOnWrite;
FWriteQueue: array of string;
FSerialPort: TAsyncSerialPort;
protected
procedure Execute; override;
public
procedure Enqueue(Text: string);
{...}
end;
TAsyncSerialPort = class
private
FCommPort: THandle;
FWritingThread: TWritingThread;
FLock: TCriticalSection;
{...}
public
procedure Open();
procedure Write(Text: string);
procedure Close();
{...}
end;
var
AsyncSerialPort: TAsyncSerialPort;
implementation
{$R *.dfm}
procedure OnWrite(Text: string);
begin
{...}
if {...} then
AsyncSerialPort.Write('something');
{...}
end;
{ TAsyncSerialPort }
procedure TAsyncSerialPort.Close;
begin
FLock.Enter;
try
FWritingThread.Terminate;
if FWritingThread.Suspended then
FWritingThread.Resume;
FWritingThread.WaitFor;
FreeAndNil(FWritingThread);
CloseHandle(FCommPort);
FCommPort := 0;
finally
FLock.Leave;
end;
end;
procedure TAsyncSerialPort.Open;
begin
FLock.Enter;
try
{open comm port}
{create writing thread}
finally
FLock.Leave;
end;
end;
procedure TAsyncSerialPort.Write(Text: string);
begin
FLock.Enter;
try
{add Text to the FWritingThread's queue}
FWritingThread.Enqueue(Text);
finally
FLock.Leave;
end;
end;
{ TWritingThread }
procedure TWritingThread.Execute;
begin
while not Terminated do
begin
{GetMessage() - wait for a message informing about a new value in the queue}
{pop a value from the queue}
{write the value}
{call OnWrite method}
end;
end;
When you look at the Close() procedure, you will see that it enters the critical section, terminates the writing thread and then waits for it to finish.
Because of the fact that the writing thread can enqueue a new value to be written when it calls the OnWrite method, it will try to enter the same critical section when calling the Write() procedure of the TAsyncSerialPort class.
And here we've got a deadlock. The thread that called the Close() method entered the critical section and then waits for the writing thread to be closed, while at the same time that thread waits for the critical section to be freed.
I've been thinking for quite a long time and I didn't manage to find a solution to that problem. The thing is that I would like to be sure that no reading/writing thread is alive when the Close() method is left, which means that I cannot just set the Terminated flag of those threads and leave.
How can I solve the problem? Maybe I should change my approach to handling serial port asynchronously?
Thanks for your advice in advance.
Mariusz.
--------- EDIT ----------
How about such a solution?
procedure TAsyncSerialPort.Close;
var
lThread: TThread;
begin
FLock.Enter;
try
lThread := FWritingThread;
if Assigned(lThread) then
begin
lThread.Terminate;
if lThread.Suspended then
lThread.Resume;
FWritingThread := nil;
end;
if FCommPort <> 0 then
begin
CloseHandle(FCommPort);
FCommPort := 0;
end;
finally
FLock.Leave;
end;
if Assigned(lThread) then
begin
lThread.WaitFor;
lThread.Free;
end;
end;
If my thinking is correct, this should eliminate the deadlock problem. Unfortunately, however, I close the comm port handle before the writing thread is closed. This means that when it calls any method that takes the comm port handle as one of its arguments (eg Write, Read, WaitCommEvent) an exception should be raised in that thread. Can I be sure that if I catch that exception in that thread it will not affect the work of the whole application? This question may sound stupid, but I think some exceptions may cause the OS to close the application that caused it, right? Do I have to worry about that in this case?
Yes, you should probably reconsider your approach. Asynchronous operations are available exactly to eliminate the need for threads. If you use threads, then use synchronous (blocking) calls. If you use asynchronous operations, then handle everything in one thread - not necessarily the main thread, but it doesn't make sense IMO to do the sending and receiving in different threads.
There are of course ways around your synchronization problem, but I'd rather change the design.
You can take the lock out of the Close. By the time it returns from the WaitFor, the thread body has noticed it has been terminated, completed the last loop, and ended.
If you don't feel happy doing this, then you could move setting the lock just before the FreeAndNil. This explicitly lets the thread shutdown mechanisms work before you apply the lock (so it won't have to compete with anything for the lock)
EDIT:
(1) If you also want to close the comms handle do it after the loop in the Execute, or in the thread's destructor.
(2) Sorry, but your edited solution is a terrible mess. Terminate and Waitfor will do everything you need, perfectly safely.
The main problem seems to be that you place the entire content of Close in a critical section. I'm almost sure (but you'll have to check the docs) that TThread.Terminate and TThread.WaitFor are safe to call from outside the section. By pulling that part outside the critical section you will solve the deadlock.
There is a problem I am unable to solve. I created two service applications in Delphi and tried to post messages within them. Of course, there are no windows in such applications and PostMessage needs a window handle parameter to send a message.
Therefore, I created a window handle using the AllocateHWnd(MyMethod: TWndMethod) function and passed, as the 'MyMethod' parameter, a procedure I want to be called when a message is received. If it was a windowed application, PostMessage() called using the handle returned by the AllocateHWnd method would certainly send a message that would then be received by the 'MyMethod' procedure.
The situation, however, is different in my service applications. I do not understand why, but in one of them posting messages this way works fine, whereas in the second one it does not (the messages are not received at all). Only when the service is being stopped do I notice that two messages are received by 'MyMethod': WM_DESTROY and WM_NCDESTROY. The messages I send using PostMessage are never received by this procedure. On the other hand, the first service always receives all messages I send.
Could you please give me a clue that would help me find the reason of the second service not receiving my messages? I do not know in what way they can differ. I checked the settings of the services and they seem to be identical. Why then one of them works fine and the second one does not (as far as sending messages is concerned)?
Thanks for any advice.
Mariusz.
Without more information it will be difficult to help you debug this, especially why it works in one service but not in the other. However:
Instead of trying to fix the problem in your code you might want to remove the windows altogether, and use PostThreadMessage() instead of PostMessage(). For the posting of messages to work correctly you need a message loop, but not necessarily receiving windows.
Edit: I'm trying to reply to all your answers in one go.
First - if you want to make your life easy you should really check out OmniThreadLibrary by gabr. I don't know whether it does work in a Windows service application, I don't even know whether that has been tried yet. You could ask in the forum. It has however a lot of great features and is worth looking into, if only for the learning effect.
But of course you can also program this for yourself, and you will have to for Delphi versions prior to Delphi 2007. I will simply add some snippets from our internal library, which has evolved over the years and works in several dozen programs. I don't claim it to be bug-free though. You can compare it with your code, and if anything sticks out, feel free to ask and I'll try to clarify.
This is the simplified Execute() method of the worker thread base class:
procedure TCustomTestThread.Execute;
var
Msg: TMsg;
begin
try
while not Terminated do begin
if (integer(GetMessage(Msg, HWND(0), 0, 0)) = -1) or Terminated then
break;
TranslateMessage(Msg);
DispatchMessage(Msg);
if Msg.Message = WM_USER then begin
// handle differently according to wParam and lParam
// ...
end;
end;
except
on E: Exception do begin
...
end;
end;
end;
It is important to not let exceptions get unhandled, so there is a top-level exception handler around everything. What you do with the exception is your choice and depends on the application, but all exceptions have to be caught, otherwise the application will get terminated. In a service your only option is probably to log them.
There is a special method to initiate thread shutdown, because the thread needs to be woken up when it is inside of GetMessage():
procedure TCustomTestThread.Shutdown;
begin
Terminate;
Cancel; // internal method dealing with worker objects used in thread
DoSendMessage(WM_QUIT);
end;
procedure TCustomTestThread.DoSendMessage(AMessage: Cardinal;
AWParam: integer = 0; ALParam: integer = 0);
begin
PostThreadMessage(ThreadID, AMessage, AWParam, ALParam);
end;
Posting WM_QUIT will cause the message loop to exit. There is however the problem that code in descendant classes could rely on Windows messages being properly handled during shutdown of the thread, especially when COM interfaces are used. That's why instead of a simple WaitFor() the following code is used to free all running threads:
procedure TCustomTestController.BeforeDestruction;
var
i: integer;
ThreadHandle: THandle;
WaitRes: LongWord;
Msg: TMsg;
begin
inherited;
for i := Low(fPositionThreads) to High(fPositionThreads) do begin
if fPositionThreads[i] <> nil then try
ThreadHandle := fPositionThreads[i].Handle;
fPositionThreads[i].Shutdown;
while TRUE do begin
WaitRes := MsgWaitForMultipleObjects(1, ThreadHandle, FALSE, 30000,
QS_POSTMESSAGE or QS_SENDMESSAGE);
if WaitRes = WAIT_OBJECT_0 then begin
FreeAndNil(fPositionThreads[i]);
break;
end;
if WaitRes = WAIT_TIMEOUT then
break;
while PeekMessage(Msg, 0, 0, 0, PM_REMOVE) do begin
TranslateMessage(Msg);
DispatchMessage(Msg);
end;
end;
except
on E: Exception do
// ...
end;
fPositionThreads[i] := nil;
end;
end;
This is in the overridden BeforeDestruction() method because all threads need to be freed before the destructor of the descendant controller class begins to free any objects the threads might use.
I'd suggest you consider using named pipes for IPC. That is what they are designed to do:
Looking for an alternative to windows messages used in inter-process communication
As Mghie mentioned, you need a message processing loop. That's why PeekMessage returns the messages correctly. It's not that the messages aren't there, it's that you aren't processing them. In a standard application, Delphi creates a TApplication class and calls Application.Run. This IS the message processing loop for a normal app. It basically consists of:
repeat
try
HandleMessage;
except
HandleException(Self);
end;
until Terminated;
If you want your service application to handle messages, you'll need to perform the same kind of work.
There's an example of using a service and handling PostThreadMessage dispatches here. Keep in mind, as Mick mentioned, you cannot use message handling between applications of differing security contexts (particularly in Vista). You should use named pipes or similar. Microsoft discusses this here.
Edit:
Based on the code snippet that you posted, you may just be fighting a threading issue. AllocHWnd is not thread safe. See here for a really detailed explanation of the issue and a version that works correctly in threads.
Of course, this still leads us back to why you aren't using PostThreadMessage instead. The way your code sample is structured, it would be trivial to make the message handling a function of the thread and then pass it down into the class for disposition.
Thanks for all your answers. I think we can forget about the problem. I created a new service application and performed quick post message tests. The messages were delivered correctly, so I hope I can now state that normally everything works fine and something is wrong only with this one service I described. I know it is stupid, but I will just try to copy one fragment of code after another from the 'bad' service to a new one. Maybe this will help me find the reason of the problem.
I hope I can now consider the message-waiting loop unnecessary as long as everything works fine without it, can't I?
If it comes to the privileges, Microsoft says: "UAC uses WIM to block Windows messages from being sent between processes of different privilege levels.". My Vista's UAC is off and I did not set any privileges for those services I described. Apart from that I do not send messages between different processes. Messages are sent within one process.
To give you the idea of what I am doing, I'll show you a code snippet from a test service application.
uses ...;
type
TMyThread = class;
TMyClass = class
private
FThread: TMyThread;
procedure ReadMessage(var Msg: TMessage);
public
FHandle: HWND;
constructor Create;
destructor Destroy; override;
end;
TMyThread = class(TThread)
private
FMyClass: TMyClass;
protected
procedure Execute; override;
constructor Create(MyClass: TMyClass); reintroduce;
end;
implementation
{ TMyClass }
constructor TMyClass.Create;
begin
inherited Create;
FHandle := AllocateHWnd(ReadMessage);
FThread := TMyThread.Create(Self);
end;
destructor TMyClass.Destroy;
begin
FThread.Terminate;
FThread.WaitFor;
FThread.Free;
DeallocateHWnd(FHandle);
inherited Destroy;
end;
procedure TMyClass.ReadMessage(var Msg: TMessage);
begin
Log.Log('message read: ' + IntToStr(Msg.Msg));
end;
{ TMyThread }
constructor TMyThread.Create(MyClass: TMyClass);
begin
inherited Create(True);
FMyClass := MyClass;
Resume;
end;
procedure TMyThread.Execute;
begin
while not Terminated do
begin
//do some work and
//send a message when finished
if PostMessage(FMyClass.FHandle, WM_USER, 0, 0) then
Log.Log('message sent')
else
Log.Log('message not sent: ' + SysErrorMessage(GetLastError));
//do something else...
Sleep(1000);
end;
end;
This is only an example, but functioning of my real code bases on the same idea. When you create an object of this class, it will create a thread that will start sending messages to that class. Log.Log() saves data into a text file. When I use this code in a new service application, everything works fine. When i put it into the 'broken' service, it does not. Please note that I do not use any message-waiting loop to receive messages. I created a new service and just put the code above into it, then created an object of the class. That's all.
If I get to know why this does not work in the 'broken' service, I'll write about it.
Thanks for the time you devoted me.
Mariusz.
Here's what I would try:
Check the return value and GetLastError of PostMessage
Is this a Vista/2008 machine? If yes, check if the sending application have sufficient priviliges to do send the message.
I have to have more information to help you further.
I spent long hours trying to find the reason of the messages not being received. As I showed in my code snippet, the constructor of the class creates a window handle which I used to send messages to. As long as the class was constructed by the main thread, everything worked fine for the window handle (if I understand it correctly) existed in the context of the main thread which, by default, awaits messages. In the 'broken' service, as I called it by mistake, my class was created by another thread, so the handle must have existed in the context of that thread. Therefore, when I sent messages using this window handle, they were received by that thread, not by the main one. Because of the fact that this thread did not have any message-waiting loop, my messages were not received at all.
I just did not know it worked this way. To solve the problem in an easy way, I create and destroy the class in the main thread even though I use it in the second one.
Thanks for your time and all the information you gave me.
Mghie, I think you are absolutely right. I implemented a message waiting loop this way:
procedure TAsyncSerialPort.Execute;
var
Msg: tagMSG;
begin
while GetMessage(Msg, 0, 0, 0) do
begin
{thread message}
if Msg.hwnd = 0 then
begin
case Msg.message of
WM_DATA_READ: Log.Log('data read');
WM_READ_TIMEOUT: Log.Log('read timeout');
WM_DATA_WRITTEN: Log.Log('data written');
WM_COMM_ERROR: Log.Log('comm error');
else
DispatchMessage(Msg);
end;
end
else
DispatchMessage(Msg);
end;
end;
I'm doing it for the first time, so please, could you check the code whether it is correct? In fact, this is my real class code snippet (the logs will be substituted with a real code). It handles overlapped comm port. There are two threads that send thread messages to the thread above, informing it that they wrote or received some data from comm port, etc. When the thread gets such a message, it takes an action - it gets the received data from a queue, where the threads first put it and then calls an external method that, lets say, analyses the received data. I don't want to go into details for it is unimportant :). I send thread messages like this: PostThreadMessage(MyThreadId, WM_DATA_READ, 0, 0).
This code works properly as I checked, but I would like to be sure everything is correct, so I'm asking you about that. I would be grateful if you answered.
To free the thread I do the following:
destructor TAsyncSerialPort.Destroy;
begin
{send a quit message to the thread so that GetMessage returns false and the loop ends}
PostThreadMessage(ThreadID, WM_QUIT, 0, 0);
{terminate the thread but wait until it finishes before the following objects
(critical sections) are destroyed for the thread might use them before it quits}
Terminate;
if Suspended then
Resume;
WaitFor;
FreeAndNil(FLock);
FreeAndNil(FCallMethodsLock);
inherited Destroy;
end;
I hope this is the proper way to end the message loop.
Thank you very much for your help.
BTW, I hope my English language is understandable, isn't it? :) Sorry if you have difficulties understanding me.
There's one trick in message loops in threads. Windows won't create a message queue for a thread immediately so there will be some time when posting messages to a thread will fail. Details are here. In my msg loop thread I use the technique MS proposes:
constructor TMsgLoopThread.Create;
begin
inherited Create(True);
FEvMsgQueueReady := CreateEvent(nil, True, False, nil);
if FEvMsgQueueReady = 0 then
Error('CreateEvent: '+LastErrMsg);
end;
procedure TMsgLoopThread.Execute;
var
MsgRec: TMsg;
begin
// Call fake PeekMessage for OS to create message queue for the thread.
// When it finishes, signal the event. In the main app execution will wait
// for this event.
PeekMessage(MsgRec, 0, WM_USER, WM_USER, PM_NOREMOVE);
SetEvent(FEvMsgQueueReady);
...
end;
// Start the thread with waitinig for it to get ready
function TMsgLoopThread.Start(WaitInterval: DWORD): DWORD;
begin
inherited Start;
Result := WaitForSingleObject(FEvMsgQueueReady, WaitInterval);
end;
But in your case I'd strongly recommend using other means of IPC.