Delphi. How to know if TEvent is Signaled or not? - delphi

please tell me: how to know if TEvent is Signaled or not?
Click on STOP-button = SetEvent(Events[1]);
I am trying to unzip an archive and if STOP-button is pressed then a tread must be terminated and Unzippping must be aborted.
My code:
procedure TForm2.ZipForge1OverallProgress(Sender: TObject; Progress: Double;
Operation: TZFProcessOperation; ProgressPhase: TZFProgressPhase;
var Cancel: Boolean);
begin
if Events[1]<>null then
begin
ThreadUpdating.Terminate;
Abort;
end else
form2.Update_ProgressBar.Position := Trunc(Progress);
end;
But if I press STOP-button(SetEvent(Events[1])) nothing happens.
PS: I am using WaitForMultipleObjects(Event[1],Event[2]) in a thread. Event [1] is being used as a signal of STOP in two parts: in ZipForge1OverallProgress and WaitForMultipleObjects.

Call WaitForMultipleObjects, but do it properly. You haven't shown that code, and the code you have shown doesn't look right anyway.
First, it looks like you're trying to check whether the Events[1] element is a null pointer. Null pointers in Delphi are spelled nil, not null; the latter is a function that returns a null Variant value (but since Variant is convertible to lots of other types, the compiler probably doesn't alert you that your code is wrong). Next, it looks as though the event you're handling has a Cancel parameter that you can set to notify the caller that it should stop what it's doing, but instead of just setting that, you're throwing an EAbort exception.
If the progress event you show here is really running in a separate thread, then it must not modify property of VCL objects like TProgressBar. You need to use Synchronize to make sure VCL operations only occur in the VCL thread.
As I said, you need to call WaitForMultipleObjects property. That means passing it four parameters, for one thing. You appear to have an array with at least two handles in it, so call it like this:
var
Ret: DWord;
Ret := WaitForMultipleObjects(2, #Events[1], False, Timeout);
case Ret of
Wait_Object_0: begin
// Events[1] is signaled
end;
Wait_Object_0 + 1: begin
// Events[2] is signaled
end;
Wait_Timeout: begin
// Neither is signaled. Do some more work, or go back to waiting.
end;
Wait_Failed: begin
RaiseLastOSError;
end;
end;
If all you want to do is check whether the handle is signaled, but you don't want to wait for it to become signaled if it isn't already, then use a timeout value of zero.

'if Events[1]<>null then begin' is this pseudocode? Doesn't lok like it - looks more like real Delphi to me:) If so, you are just checking to see if the Event object is assigned, rather than signaled.
If you want to poll the stop event in your OverallProgress handler, you need to call WaitForSingleObject() with a timeout of 0.
Can you not just check a 'stop' boolean in your handler? This would be much quicker than a kernel call. You may need the Event as well so that the WFMO call at the top of the thread gets signaled when an abort/terminate is needed or you might get away with signaling some other event in the WFMO array by always checking for stop:
TmyThread = class(TThread)
..
public
stopRequested:boolean;
procedure stop;
..
end;
procedure TmyThread.stop;
begin
stopRequested:=true;
someEventInWFMOarray.signal;
end;
procedure TmyThread.execute;
begin;
while true do
begin
waitForMultipeObjects();
if stopRequested then exit;
work;
end;
end;
TForm2.ZipForge1OverallProgress(sender:TObject,......)
begin
cancel:=TmyThread(Sender).stopRequested;
if cancel then exit;
doStuff;
end;

Related

Accessing TObject instance when it is locked by TMonitor.Enter in the calling thread

What will happen if a thread tries to access the same object locked by another thread? I know it can be handled by TMonitor.Wait(), but what if there is no handling codes to check if it is locked? Will there be an error?
In the example below, Thread1Process locks the object and Thread2Process attempts to assign a value to the object's property. Will the Thread2Process automatically wait before Thread1Process releases the lock to execute the next line var x: Integer := 1; or will it stop and throw an exception?
procedure Thread1Process(const AObject: TObjectDescendant);
begin
TMonitor.Enter(AObject);
try
// lengthy process here...
finally
TMonitor.Exit(AObject);
end;
end;
procedure Thread2Process(const AObject: TObjectDescendant);
begin
AObject.StringProperty := 'Any value';
var x: Integer := 1;
end;
We are using Delphi 11 Alexandria.
TMonitor is just a synchronization lock, nothing more. Much like TMutex, TSemaphore, etc.
It doesn't do anything to the object itself. If one thread decides to enter the lock, and a second thread doesn't, the second thread will not be blocked in any way, and no exception will be raised 1, but there is no guarantee to the stability of the object or its members. Race conditions occur due to lack of proper synchronization by all involved threads cooperating with each other.
1: unless the object itself decides to raise an exception, or a system exception is raised, like from accessing invalid memory, etc.
On a side note, your call to TMonitor.Enter() needs to be outside the try block, eg:
procedure Thread1Process(const AObject: TObjectDescendant);
begin
TMonitor.Enter(AObject);
try
// lengthy process here...
finally
TMonitor.Exit(AObject);
end;
end;

Using Abort to improve/simplify code in some situations

I had a discussion the other day: https://stackoverflow.com/a/42156860/937125
where I didn't quite understand why an Abort was better than calling Exit in that situation. I tend not to use it in my code flow. I consider it a bad practice and bad for code flow.
but #David's statement in the comments made me wonder if maybe I was missing something:
Without a silent exception, how would you abort an operation when deep
down the call stack. For instance how would you abort a file copy
operation with a 10 deep call stack? Isn't that exactly what
exceptions are designed for? Sure you can code it without exceptions
but it is much more verbose and error prone.
I can't imagine such situation. Can someone give me an example of such code/scenario, and convince me that Abort in the above case is really a good thing and "much more verbose and error prone". (3-4 deep call stack is enough to illustrate)
The simplest scenario that illustrates my point is like so:
procedure MethodA;
begin
MethodB;
MethodC;
end;
procedure MethodB;
begin
// ... do stuff
end;
procedure MethodC;
begin
// ... do stuff
end;
That's fine as it is. Now suppose that MethodB asks the user for some input, and if the user presses the Cancel button, that no further work should be carried out. You could implement that like this:
procedure MethodA;
begin
if MethodB then
MethodC;
end;
function MethodB: Boolean;
begin
Result := MessageDlg(...)=mrOK;
if not Result then
exit;
// ... do stuff
end;
procedure MethodC;
begin
// ... do stuff
end;
That works fine, but imagine that you in the real world code, there was deeper nesting. The boolean returned by MethodB might need to be passed on up a great many levels. This would become cumbersome.
Or consider what happens if MethodB needs to return a value to its caller. In that scenario the original code might be like so:
procedure MethodA;
begin
MethodC(MethodB);
end;
function MethodB: string;
begin
Result := ...;
end;
procedure MethodC(Value: string);
begin
// ... do stuff with Value
end;
Now once more consider what happens if the user gets a chance to cancel. How can we return both a boolean and a string from MethodB? Using an out parameter for one of the return values? Using a compound structure like a record to wrap both values. The latter obviously involves lots of boilerplate so let us explore the former.
procedure MethodA;
var
Value: string;
begin
if MethodB(Value) then
MethodC(Value);
end;
function MethodB(out Value: string): Boolean;
begin
Result := MessageDlg(...)=mrOK;
if not Result then
exit;
Value := ...;
end;
procedure MethodC(Value: string);
begin
// ... do stuff with Value
end;
For sure you can do this, but this is beginning to look like the sort of code that exceptions were designed to simplify. And at this point, let us consider the existence of a silent exception, EAbort, raised by calling Abort, that does not result in a message being shown by the top level exception handler. That last point is what is meant by silent.
Now the code becomes:
procedure MethodA;
begin
MethodC(MethodB);
end;
function MethodB: string;
begin
if MessageDlg(...)<>mrOK then
Abort;
Result := ...;
end;
procedure MethodC(Value: string);
begin
// ... do stuff with Value
end;
The advantage is that MethodA does not need to worry about cancellation. And if the call stack was deeper, none of the methods between MethodA at the top, and MethodB at the point of user input, would need to know anything about cancellation.
A further benefit is that MethodB can retain its natural signature. It returns a string. In case of failure, either from a more traditional exception, or from user cancellation, an exception is thrown.
This very simple example isn't that much more compelling than the previous one that does not use Abort. But imagine what the code would look like if MethodB were 4 or 5 deep in the call stack?
I am absolutely not saying that Abort should always be used in place of exit. My belief is that both have their place. Where Abort shines is when the user opts to cancel an operation and you don't want any more processing to take place in the current event handler. Furthermore, since the user expressly opted to cancel, no further UI needs to be presented to them. You don't need a message box telling the user that they cancelled, they already know that.
Assume your program is doing a lengthy operation either in a separate thread or (even though it's frowned upon) calling Application.ProcessMessages. Now, you want the user to be able to abort that operation in a safe manner (that is: All resources are cleaned up, the data is in a consistent state etc.). So, the UI sets a flag somewhere and in your code you periodically check for that flag. If it is set, you call Abort or explicitly raise EAbort. This will cause all your carefully crafted try / except / finally blocks to be execute and making sure aborting the operation is safe.
// in the main thread:
procedure TMyProgressDialog.b_AbortClick(Sender: TObject);
begin
if AskUserIfHeIsSure then begin
gblAbortedFlag := true;
b_Abort.Enabled := false;
b_Abort.Caption := _('Aborting');
end;
end;
// call this repeatedly during the lenghty operation:
procecdure CheckAborted;
begin
// If you are in the main thread, you might want to call
// Application.ProcessMessages;
// here. If not, definitely don't.
if gblAbortedFlag then
Abort;
end;
Of course this could be done with a different exception, but I can't think of any other way to safely exit from a deep call stack without having to program lots of ifs and exits.

Delphi stack overflow due to a cycle in event handling

I am working on the application which has two listboxes.I load the two listboxes with values and when i keep on clicking the items from the list box i get the following error while debugging.
Running the exe causes the application to close.Sometimes i get the "Access Violation" message.
so what should I do to get rid of this error from my aaplication?
EDIT
..
The main form has timer that refresh all the controls
timer_RefreshCOntrol (intervali 1).
whenver the editBox_one is modified(value)
this function is called
Procedure TStringSetting.SetValue (const AValue : String);
Begin
...
If FValueControl <> Nil then
Begin
FValueControl.OnChange := VoidNotifyEvent;
FValueControl.Text := NewValue;
FValueControl.OnChange := EditChange; //<--here the stackoverflow error comes....
end;
end;
Procedure EditChange (Sender: TObject);
Begin
Value := FValueControl.Text;
If Not EditIsValid then FValueControl.Font.Color := clRed
else If Dirty then FValueControl.Font.Color := clBlue
else FValueControl.Font.Color := clWindowText;
If #OldCustomEditChange <> Nil then OldCustomEditChange(Sender);
end;`
the EditChange (Sender: TObject); <--keeps geting called and the stackoverflow error comes
EditChange is assigned to the editbox on FormCreate
EDIT2
I am not the original developer.I just handled code sometimes back, major refactoring is not possible.
edit 3
The call stack value but what is the "???"
EDIT 4
after going through #Cosmin Prund and #david
i got the place where the infinity call start
Procedure TFloatSetting.EditChange (Sender: TObject);
Begin
SkipNextOnChange := True;
Inherited EditChange(Sender);
IfValidThenStore(FValueControl.Text);
Inherited EditChange(Sender); {<-------This is where it start}
end;
Procedure TStringSetting.EditChange (Sender: TObject);
Begin
Value := FValueControl.Text;
If Not EditIsValid then FValueControl.Font.Color := clRed
else If Dirty then FValueControl.Font.Color := clBlue
else FValueControl.Font.Color := clWindowText;
If #OldCustomEditChange <> Nil then OldCustomEditChange(Sender); {<---this keeps calling Procedure TFloatSetting.EditChange (Sender: TObject);}
end;
Based in the posted call stack it's obvious why the error is happening: TStringSetting.EditChange triggers TFloatSetting.EditChange and that in turn triggers TStringSetting.EditChange. The loop goes on like this until all stack space is exhausted.
Here are some tips on why that might happen, and tips on how to debug and fix it:
Maybe the controls involved trigger the OnChange event handler when the Value is changed progrmatically. If the two editors are supposed to display the same data in two formats and you're using the respective OnChange event handlers to keep them in sync, this might be the cause.
Maybe you're directly calling one event handler from the other.
Ways to debug this:
You should first try the breakpoint solution, as suggested by paulsm4. If the stack overflow happens every time one of the OnChange handlers is called, this solution would easily work.
Comment-out the code for one of the event handlers. Run the program, the error should no longer appear. Un-comment the code in tiny (but logical) amounts, test and repeat. When the error shows up again, you know you fund the line that's causing the error. If you can't figure it out yourself, edit the question, add the code and mark the line that you just found out it's giving you trouble.
If the controls you're using are triggering the OnChange event handler when there value is changed programatically, you should make your event handlers non-reentrant: that would stop the infinite recursive loop for sure. I almost always assume controls trigger OnChange or equivalent events when properties are changed from code and always protect myself from re-entry using something like this:
// Somewhere in the private section of your form's class:
FProcessingEventHandler: Boolean;
// This goes in your event handler
procedure TYourForm.EventHandler(Sender:TObject);
begin
if FProcessingEventHandler then Exit; // makes code non-reentrant
FProcessingEventHandler := True;
try
// old code goes here ...
finally FProcessingEventHandler := False;
end;
end;
Suggestions:
Set a breakpoint in EditChange and OldCustomEditChange to see who's calling them. Each invocation. Clearly, only EditChange should ever call OldCustomEditChange.
Look in your .dfm to make sure EditChange is only assigned to one event (not multiple events) and OldCustomEditChange isn't assigned at all.
You report a non-terminating recursive call sequence to EditChange. Looking at the code of EditChange there are two candidates for a recursive call:
OldCustomEditChange being equal to EditChange, or calling a function that in turn calls EditChange.
An event handler that responds to changes to FValueControl.Font by calling EditChange.
These are the only opportunities for the code in EditChange to call itself.
It is easy to see how both of these possibilities leads to the non-terminating recursive function call and eventually the stack overflow. Of the two candidates my bet is number 1. I would study carefully what happens when OldCustomEditChange is called.
To debug a stack overflow of this nature simply open the call stack window and look at the long sequence of calls. You will typically see a pattern with one function calling itself, possibly via one or more intermediate functions.

how to pause while some process going in loopss(delphi)

how can i pause and resume in application while working with loops
i can put some sleep(xxx) at begininsg of my loop to pause ,but i want pause when ever i want and resume when i ever i need
any ideas ?
thanks in advance
ok here is alittle more explanation
for i:=0 to 100 do
begin
if button1.clicked then pause //stop the operation and wait for resume button
if button2.clicked then resume //resume the operations
end;
edit2 :
ok guys i will tell an example well take any checker for suppose proxy checker ,i have a bunch of proxies loaded in my tlistviwe i am checking them all ,by using lop for i:=0 to listview.items.count do ......
i want to pause my checking operation when ever i want and resume when ever i need
am i clear or still i have to explain some ? :S
regards
You need a boolean flag that will indicate whether it's safe to continue looping. If something happens that makes it so you need to pause, it should set the variable to false. This means that, unless you're working with multiple threads, whatever sets this flag will have to be checked inside the loop somewhere. Then at the top (or the bottom) of your loop, check to see if this variable is true and pause otherwise.
Here's the basic idea, in the context of your explanation:
procedure TForm1.DoLoop;
begin
FCanContinue := true;
for i:=0 to 100 do
begin
//do whatever
Application.ProcessMessages; //allow the UI to respond to button clicks
if not FCanContinue then Pause;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
FCanContinue := false;
end;
procedure TForm2.Button1Click(Sender: TObject);
begin
FCanContinue := true;
Resume;
end;
This is a very simplistic implementation. What you really should do if you have a long-running task that you need to be able to pause and resume on command is put this in a separate thread and take a look at the TEvent class in SyncObjs.
OK, I don't understand what you are trying to do, but here is some pseudo code:
for i:=0 to 100 do
begin
if button1.clicked then
begin
while not button2.clicked do
sleep(50);
end;
end;
Check if a key is pressed?

Deadlock when closing thread

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.

Resources