Cancel an ADO Connection's attempt to connect? - delphi

I have a TADOConnection inside a thread. In the event that it fails to connect to the database (timeout), when closing the app, the thread is held up and it takes time until the attempt is finished before my app is able to close. I don't want to reduce the connection timeout of the connection, this isn't the issue. Is there any way I can forcefully abort the attempt to connect?
The TADOConnection connects at the beginning of the thread execution and automatically reconnects repeatedly until success. Then, upon closing the app, if the database is failing to connect, the thread hangs until the connection attempt is finished (timed out).
EDIT
This is a sample of how the thread works:
procedure TMyThread.Init;
begin
CoInitialize(nil);
FDB:= TADOConnection.Create(nil);
FDB.LoginPrompt:= False;
FDB.ConnectionTimeout:= 5;
FDB.ConnectOptions:= coAsyncConnect;
end;
procedure TMyThread.Uninit;
begin
if FDB.Connected then
FDB.Connected:= False;
FDB.Free;
CoUninitialize;
end;
function TMyThread.Reconnect: Boolean;
begin
Result:= False;
if FDB.Connected then
FDB.Connected:= False;
FDB.ConnectionString:= FConnectionString;
try
FDB.Connected:= True; //How to abort?
Result:= True;
except
on e: exception do begin
//MessageDlg(e.Message, mtError, [mbOK], 0);
FDB.Connected:= False;
Result:= False;
end;
end;
end;
procedure TMyThread.Process;
begin
if Reconnect then begin //Once connected, keep alive in loop
while FActive do begin
if Terminated then Break;
if not Connected then Break;
//Do Some Database Work
end;
end else begin
//Log connection failure
end;
end;
procedure TMyThread.Execute;
begin
while not Terminated do begin
if FActive then begin
Init; //CoInitialize, create DB, etc.
try
while (FActive) and (not Terminated) do begin
try
Process; //Actual processing procedure
except
on e: exception do begin
//Record error to log
end;
end;
end;
finally
Uninit; //CoUninitialize, destroy DB, etc.
end;
end;
end;
end;
(Tried to include just relevant things to the question)

First thing that comes to mind is to reduce connection's timeout. Why do you not want that? And why do you want to establish a connection when closing the application? Especially when you prefer to abort it when it takes more time than expected, why connect at all? Sounds like we could know more background info.
In the special case that you really need it on the condition that it connects quickly, ánd when this issue only applies to application's destruction, then I suggest not to wait for the thread to finish. Just do not free it, terminate the application, and let Windows kill the process including all its threads.
In the case that the connection does succeed, then this approach could backfire, so signal your main thread when the thread dóes connect, and postpone its termination by yet waiting for the thread. You may need another timeout for that again.
Edit:
I suppose the OnWillConnect event will occur every time the attempt to connect is made. Try returning EventStatus := esCancel within its handler.

Related

How to excecute code in parallel with Indy.Post

I want to send a Post to a server that is slow. The server won't answer for 20 minutes (or more) and the whole application freezes.
I would like to unfreeze the GUI and at the same time, while waiting for the Post response to process the data from previous Post commands.
Here is how I send the Post command:
{ POST }
procedure TJob.SendToServer;
begin
...
lHTTP := TIdHTTP.Create(NIL);
TRY
TRY
Server.Rspns:= lHTTP.Post(ApiServer, MegaSeqFileName); { This won't freeze the GUI anymore because now TJob.SendToServer function is called in a TPostThread thread }
EXCEPT
on E: Exception DO { Catch Internet connection problems }
begin
Application.ProcessMessages;
Status:= jsNotSubmited;
ParentTask.Log.AddError(E.Message);
EXIT;
end;
END;
FINALLY
FreeAndNil(lHTTP);
END;
This is the Thread code:
TYPE
TPostThread= class(TThread)
public
Job: TJob;
procedure Execute; override;
procedure Done;
end;
procedure TPostThread.Done;
begin
Job.ThreadDone:= TRUE;
end;
procedure TPostThread.Execute;
begin
Job.SendToServer; { Send job and collect results }
Synchronize(Done);
end;
and this is how I start the thread
Job.ThreadDone:= FALSE;
Thread:= TPostThread.Create(TRUE);
Thread.Job:= Job;
Thread.FreeOnTerminate:= FALSE;
Thread.Start; {This calls: Job.SendToServer }
REPEAT
DelayEx(2000);
if Aborted then
begin
MesajInfo('Task aborted.');
Thread.Terminate;
FreeAndNil(Thread); <----freezes here!
EXIT(FALSE);
end;
//todo: run other tasks here (more exactly get results from previous Posts and send them to a different web server)
UNTIL Job.ThreadDone;
FreeAndNil(Thread);
The problem is that when I set Aborted = True, the thread won't exit. It freezes on FreeAndNil(Thread)... which is natural, because I don't check the Terminated in Thread.Execute.
I have this temporary solution, without threads, based on an idea from #RemyLebeau:
procedure TJob.OnHTTPProgress(ASender: TObject; AWorkMode: TWorkMode; AWorkCount: Int64);
begin
if UserAborted=true then TIdHTTP(ASender).Disconnect;
Application.ProcessMessages;
end;
I know THIS IS NOT the good answer, only a dirty hack (this is why I will never mark this answer as accepted), but it made my program work, and I badly need to make it work in the next 1-2 weeks. It allows me to do both things: stop the program (during upload) and prevent the GUI from freezing.
I can return later to fix this nastyty.

What is the proper way to free and terminate a thread which uses the TIdTCPClient component?

I'm using Delphi 10 Seattle to build a simple Client/Server application using the TIdTCPClientand TIdTCPServer components.
For read the data arrived from the server application (TIdTCPServer) I'm using a Thread in the Client Application.
This is the Execute method
procedure TClientReadThread.Execute;
begin
while not Terminated do
begin
try
if FClient.Connected() then //FClient is TIdTCPClient
begin
if not FClient.IOHandler.InputBufferIsEmpty then
begin
AResponse := FClient.IOHandler.ReadLn();
Synchronize(NotifyReadln);
end
else
FClient.IOHandler.CheckForDataOnSource(10);
end;
except
on E: Exception do
begin
// Send the exception message to the logger
FE:=E;
Synchronize(LogException);
end;
end;
end;
end;
Under normal circumstances all is working fine, but now I'm doing some tests to restore the connection on the client application in case which the server or the network is down. So I shutdown the server App to simulate a issue when the comm fails.
When that happens the client application detects which the server is gone using the TIdTCPClient.OnStatus event.
After that I try to terminate the reading thread using this code
if Assigned(FClientReadThr) then
begin
FClientReadThr.Terminate;
FClientReadThr.WaitFor; // This never returns.
FreeAndNil(FClientReadThr);
end;
But the WaitFor function never returns.
SO the question is , there is something wrong on my execute procedure which is preventing the finalization of the thread?
Exist a better way to terminate the thread?
First, you should not be using Connected() in this manner. Just call ReadLn() unconditionally and let it raise an exception if an error/disconnect occurs:
procedure TClientReadThread.Execute;
begin
while not Terminated do
begin
try
AResponse := FClient.IOHandler.ReadLn();
Synchronize(NotifyReadln);
except
// ...
end;
end;
end;
If you want to poll the socket for data manually, it should look more like this:
procedure TClientReadThread.Execute;
begin
while not Terminated do
begin
try
if FClient.IOHandler.InputBufferIsEmpty then
begin
FClient.IOHandler.CheckForDataOnSource(10);
FClient.IOHandler.CheckForDisconnect;
if FClient.IOHandler.InputBufferIsEmpty then Continue;
end;
AResponse := FClient.IOHandler.ReadLn();
Synchronize(NotifyReadln);
except
// ...
end;
end;
end;
DO NOT use the TIdTCPClient.OnStatus event to detect a disconnect in this situation. You are deadlocking your code if you are terminating the thread directly in the OnStatus event handler. That event will be called in the context of the thread, since the thread is the one reading the connection and detecting the disconnect. So your thread ends up waiting on itself, that is why WaitFor() does not exit.
I would suggest an alternative approach. DON'T terminate the thread at all. To recover the connection, add another level of looping to the thread and let it detect the disconnect and reconnect automatically:
procedure TClientReadThread.Execute;
var
I: Integer;
begin
while not Terminated do
begin
try
// don't call Connect() in the main thread anymore, do it here instead
FClient.Connect;
except
// Send the exception message to the logger
// you should wait a few seconds before attempting to reconnect,
// don't flood the network with connection requests...
for I := 1 to 5 do
begin
if Terminated then Exit;
Sleep(1000);
end;
Continue;
end;
try
try
while not Terminated do
begin
AResponse := FClient.IOHandler.ReadLn();
Synchronize(NotifyReadln);
end;
except
// Send the exception message to the logger
end;
finally
FClient.Disconnect;
end;
end;
end;
You can then Terminate() and WaitFor() the thread normally when you want to stop using your socket I/O.

Delphi XE Service won't start: Error 1053

I have a service made in Delphi XE that will not start when prompted from the service manager in Windows 7, I get
Error 1053: The service did not respond to the start or control reqquest in a timely fashion
I have the service hooked up with an AfterInstall and an OnExecute event, here is my code for the events:
procedure TAarhusRunner.ServiceAfterInstall(Sender: TService);
var
Reg: TRegistry;
begin
Reg := TRegistry.Create(KEY_READ or KEY_WRITE);
try
Reg.RootKey := HKEY_LOCAL_MACHINE;
if Reg.OpenKey('\SYSTEM\CurrentControlSet\Services\' + Name, false) then
begin
Reg.WriteString('Description', 'Worker Service for Inversion Job Distribution');
Reg.CloseKey;
end;
finally
Reg.Free;
end;
end;
procedure TAarhusRunner.ServiceExecute(Sender: TService);
begin
try
Self.Status := csRunning;
//start the loop
MainTimer.Interval := 5000; //MainTimer is declared in the .dfm
MainTimer.Enabled := True;
RecheckAndApplyTimer.Enabled := False;
while not Terminated do
begin
ServiceThread.ProcessRequests(true);
MainTimer.Enabled := False;
end;
except
on e: Exception do begin
MessageDlg(E.Message,mterror,[mbok],0);
exit;
end;
end;
end;
Can anyone tell me what I am doing wrong?
you use
ServiceThread.ProcessRequests(True);
in your service loop with WaitForMessage set to True.
This will block your loop since it will wait indefinitely for a service message.
To solve your problem, simply change your line to:
ServiceThread.ProcessRequests(False);
Some general advice:
Do not implement the OnExecute handler of a service but spawn a thread in the OnStart eventhandler instead. Terminate this thread from the OnStop Eventhandler.
More details can be found here.
Using a TTimer from a non GUI thread (like the service thread in your case) is tricky, it is not impossible however (David Heffernan has a topic on this subject here on SO).
(Solved)
It turned out to be a unit error that prevented the service from responding. I copied the relevant .bpl package to the service folder and that seemed to solve the error.
Thank you all for taking the time to add your input

Delphi-XE4 understanding threads count

Since my iOS app terminates (if running in debugger, the app simply freezes without any errors) after some minutes of intensive use, I started looking into possible reasons why the app would simply suddenly close down. (But always first do so after some time.)
I create lots of shortlived threads that are set to terminate when done. (I use FreeOnTerminate := True in constructor.) However, in Delphi IDE | Thread status the threads seem to live on after execute has run.
So in debug window, I have e.g. 100 threads with State=none and Status=unknown. Am I correct in assuming that means the threads are not completely freed/gone?
For reference, demo code:
constructor TMyOnlineThread.Create(...) ;
begin
inherited Create(False);
//--
//...
//--
FreeOnTerminate := True;
end;
destructor TMyOnlineThread.Destroy;
begin
//...
inherited;
end;
procedure TMyOnlineThread.Execute;
begin
//--
// Single task. No while loop or anything like that.
//--
if (...) then
begin
if Assigned(FOnDone) then
Synchronize(MyCallBack)
;
end
;
end;
procedure someothercode;
begin
TMyOnlineThread.Create(...);
end;

Indy, TidNotify and closing TidTCPServer

I have a TidTCPServer which use database manipulating inside onExcecute event (by using TidNotify). Everything works very good instead of possibility closing application.
During closing application I do not know whether everything Notify instances finished their work or not and usually I get Runtime Error 216 (I think I close database before "notify" work end).
Is any way to check - are there waiting old Notify posts or not to be sure I can close application.
Other question is how to protect TidTCPServer from accepting new connection during closing server process.
I use code like below but I obtain the error still.
type
TShutdownThread = class(TThread)
protected
procedure Execute; override;
end;
procedure TShutdownThread.Execute;
begin
IdTCPServer.Active := false;
end;
//closing...
if IdTCPServer.Active then
begin
with TShutdownThread.Create(false) do
try
WaitFor; // internally processes sync requests...
finally
Free;
end;
end;
Is any way to check - are there
waiting old Notify posts or not to be sure I can close
application.
TIdNotify is asynchronous, it posts requests to the main thread message queue for later execution. It is possible that pending requests are still in the queue after TShutdownThread.WaitFor() has exited. You can call the RTL's CheckSynchronize() function to process any remaining requests, eg:
if IdTCPServer.Active then
begin
with TShutdownThread.Create(false) do
try
WaitFor;
finally
Free;
end;
CheckSynchronize;
end;
how to protect TidTCPServer from accepting new connection during closing server process.
While TIdTCPServer is being deactivated, it closes its listening port(s) for you. However, there is a very small window of opportunity when new clients could be accepted before the server closes the port(s). The server will close those connections as part of its shutdown, but if you do not want the OnExecute event to be called for those connections then you can set a flag somewhere in your code before deactivating the server, then check for that flag in the OnConnect event, and if it is set then disconnect the client immediately, eg:
var
ShuttingDown: boolean = False;
procedure TForm1.IdTCPServer1Connect(AContext: TIdContext);
begin
if ShuttingDown then
begin
AContext.Connection.Disconnect;
Exit;
end;
...
end;
...
if IdTCPServer.Active then
begin
ShuttingDown := True;
try
with TShutdownThread.Create(false) do
try
WaitFor;
finally
Free;
end;
CheckSynchronize;
finally
ShuttingDown := False;
end;
end;

Resources