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
Related
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.
I have one external program which doesn't support proxy to access internet and but I need proxy.
As a solution, I've written one simple Delphi Application using Indy 10.6.0.5040 and its TIdMappedPortTCP component. How it works simply, external application connects to IdMappedPortTCP locally and IdMappedPortTCP connects to real server using my proxy settings.
To do my proxy setting, I handled OnConnect event of IdMappedPortTCP like below:
procedure TForm1.IdMappedPortTCP1Connect(AContext: TIdContext);
var
io: TIdIOHandlerStack;
proxy: TIdConnectThroughHttpProxy;
begin
if Assigned(TIdMappedPortContext(AContext).OutboundClient) then
begin
io := TIdIOHandlerStack.Create(TIdMappedPortContext(AContext).OutboundClient);
proxy := TIdConnectThroughHttpProxy.Create(io);
proxy.Enabled := False;
proxy.Host := FSettings.ProxyAddress;
proxy.Port := FSettings.ProxyPort;
proxy.Username := FSettings.ProxyUserName;
proxy.Password := FSettings.ProxyPassword;
If (proxy.Username <> '') or (proxy.Password <> '') then proxy.AuthorizationRequired(True);
proxy.Enabled := True;
io.DefaultPort := FSettings.DestinationPort[0];
io.Port := FSettings.DestinationPort[0];
io.Destination := FSettings.DestinationHostAddress[0];
io.Host := FSettings.DestinationHostAddress[0];
io.TransparentProxy := proxy;
io.OnStatus := StackStatus;
TIdMappedPortContext(AContext).OutboundClient.IOHandler := io;
end;
Log(Format('Listener connected at %s:%d', [TIdMappedPortContext(AContext).Server.MappedHost, TIdMappedPortContext(AContext).Server.MappedPort]));
end;
{ TIdConnectThroughHttpProxyHelper }
procedure TIdConnectThroughHttpProxyHelper.AuthorizationRequired(const val: boolean);
begin
Self.FAuthorizationRequired := val;
end;
procedure TForm1.Log(const s: string);
begin
Memo1.Lines.Add(Format('(%s) %s', [FormatDateTime('hh:nn:ss:zzz', Now), s]));
end;
procedure TForm1.IdMappedPortTCP1Disconnect(AContext: TIdContext);
begin
// Log(Format('Listener disconnected at %s:%d', [TIdMappedPortContext(AContext).Server.MappedHost, TIdMappedPortContext(AContext).Server.MappedPort]));
end;
procedure TForm1.IdMappedPortTCP1Exception(AContext: TIdContext;
AException: Exception);
begin
Log(Format('Exception: %s (%s:%d)', [AException.Message,TIdMappedPortContext(AContext).Server.MappedHost, TIdMappedPortContext(AContext).Server.MappedPort]));
end;
procedure TForm1.IdMappedPortTCP1ListenException(AThread: TIdListenerThread;
AException: Exception);
begin
Log(Format('Listener Exception: %s', [AException.Message]));
end;
procedure TForm1.IdMappedPortTCP1OutboundConnect(AContext: TIdContext);
begin
Log('MappedPort Destination connected.');
end;
procedure TForm1.IdMappedPortTCP1OutboundDisconnect(AContext: TIdContext);
begin
Log('MappedPort Destination disconnected.');
end;
procedure TForm1.StackStatus(ASender: TObject;
const AStatus: TIdStatus; const AStatusText: string);
begin
Log(Format('Stack Status: %s', [AStatusText]));
end;
I have many active connections and all work flawlessly. My problem is that, if I try to deactivate IdMappedPortTCP using "IdMappedPortTCP.Active := false;" while there are active traffics, connections, it hangs there and I had to terminate delphi application using task manager.
Is there anything that I need to do manually before setting Active to false?
Thanks.
Indy servers are multi-threaded. Their events (like OnConnect, OnDisconnect, OnExecute, OnException, and OnListenException) are triggered in the context of worker threads, not the context of the main UI thread. As such, you must sync with the main thread, such as with the TThread.Synchronize() or TThread.Queue() methods, or Indy's TIdSync or TIdNotify classes, in order to access UI components safely.
If the main thread is busy deactivating the server, it cannot process sync requests, so an asynchronous approach (TThread.Queue() or
TIdNotify) is preferred over a synchronous one (TThread.Synchronize() or TIdSync) to avoid a deadlock. Alternatively, deactivate the server in a worker thread so the main thread is free to process sync requests.
I created a new Windows Service project using wizard, putted some code, compiled it, run it with /INSTALL and then I tried to start it using net start myservice but I've got an service name not found error; then I went to the Control Panel in Services and when I try to start clicking the 'Start' link the dialog windows that shows up freezes at 50% of the progress bar indefinitely.
This is my first try to make a service to update the main system I am developing, and for a test I put a Timer to tell the time every one minute. Can anyone notice what is wrong and why it is behaving like that?
The DPR file with:
{...}
begin
if not Application.DelayInitialize or Application.Installing then
begin
Application.Initialize;
end;
Application.CreateForm(TZeusUpdateSevice, ZeusUpdateSevice);
Application.Run;
end.
and the PAS file with:
{...}
procedure ServiceController(CtrlCode: DWord); stdcall;
begin
ZeusUpdateSevice.Controller(CtrlCode);
end;
function TZeusUpdateSevice.GetServiceController: TServiceController;
begin
Result := ServiceController;
end;
procedure TZeusUpdateSevice.ServiceAfterInstall(Sender: TService);
var
regEdit : TRegistry;
begin
regEdit := TRegistry.Create(KEY_READ or KEY_WRITE);
try
regEdit.RootKey := HKEY_LOCAL_MACHINE;
if regEdit.OpenKey('\SYSTEM\CurrentControlSet\Services\' + Name,False) then
begin
regEdit.WriteString('Description','Mantém atualizados os arquivos e as credenciais da Plataforma Zeus.');
regEdit.CloseKey;
end;
finally
FreeAndNil(regEdit);
end;
end;
procedure TZeusUpdateSevice.ServiceStart(Sender: TService; var Started: Boolean);
begin
{ executa os processos solicitados pelo sistema }
Timer1.Enabled := True;
while not Terminated do ServiceThread.ProcessRequests(True);
Timer1.Enabled := False;
end;
procedure TZeusUpdateSevice.Timer1Timer(Sender: TObject);
begin
ShowMessage('Now, time is: ' + TimeToStr(Now));
end;
There are a couple of obvious problems:
You have an infinite loop in the OnStart event. This event allows you to perform one time actions when the service starts. That code belongs in OnExecute.
Services cannot show UI and so ShowMessage cannot work. You'll need to use a non-visual mechanism to give feedback.
Because your OnStart doesn't return, the SCM regards your service as not having started. So I guess that item 1 above is the explanation as to why your service won't start.
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;
I've built a few services in Delphi 7 and did not have this problem. Now that I started a new service app in XE2, it won't stop properly. I don't know if it's something I'm doing wrong or if it might be a bug in the XE2 services.
The execute procedure looks like this:
procedure TMySvc.ServiceExecute(Sender: TService);
begin
try
CoInitialize(nil);
Startup;
try
while not Terminated do begin
DoSomething; //Problem persists even when nothing's here
end;
finally
Cleanup;
CoUninitialize;
end;
except
on e: exception do begin
PostLog('EXCEPTION in Execute: '+e.Message);
end;
end;
end;
I never have an exception, as you can see I log any exception. PostLog saves to an INI file, which works fine. Now I do use ADO components, so I use CoInitialize() and CoUninitialize. It does connect to the DB and do its job properly. The problem only happens when I stop this service. Windows gives me the following message:
Then the service continues. I have to stop it a second time. The second time it does stop, but with the following message:
The log file indicates that the service did successfully free (OnDestroy event was logged) but it never successfully stopped (OnStop was never logged).
In my above code, I have two procedures Startup and Cleanup. These simply create/destroy and initialize/uninitialize my necessary things...
procedure TMySvc.Startup;
begin
FUpdateThread:= TMyUpdateThread.Create;
FUpdateThread.OnLog:= LogUpdate;
FUpdateThread.Resume;
end;
procedure TMySvc.Cleanup;
begin
FUpdateThread.Terminate;
end;
As you can see, I have a secondary thread running. This service actually has numerous threads running like this, and the main service thread is only logging the events from each thread. Each thread has different responsibilities. The threads are reporting properly, and they are also being terminated properly.
What could be causing this stop failure? If my posted code doesn't expose anything, then I can post more code later - just have to 'convert' it because of internal naming, etc.
EDIT
I just started NEW service project in Delphi XE2, and have the same issue. This is all my code below:
unit JDSvc;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes, JDSvcMgr;
type
TJDService = class(TService)
procedure ServiceExecute(Sender: TService);
private
FAfterInstall: TServiceEvent;
public
function GetServiceController: TServiceController; override;
end;
var
JDService: TJDService;
implementation
{$R *.DFM}
procedure ServiceController(CtrlCode: DWord); stdcall;
begin
JDService.Controller(CtrlCode);
end;
function TJDService.GetServiceController: TServiceController;
begin
Result := ServiceController;
end;
procedure TJDService.ServiceExecute(Sender: TService);
begin
while not Terminated do begin
end;
end;
end.
look at the source code for the Execute method:
procedure TServiceThread.Execute;
var
msg: TMsg;
Started: Boolean;
begin
PeekMessage(msg, 0, WM_USER, WM_USER, PM_NOREMOVE); { Create message queue }
try
// Allow initialization of the Application object after
// StartServiceCtrlDispatcher to prevent conflicts under
// Windows 2003 Server when registering a class object with OLE.
if Application.DelayInitialize then
Application.Initialize;
FService.Status := csStartPending;
Started := True;
if Assigned(FService.OnStart) then FService.OnStart(FService, Started);
if not Started then Exit;
try
FService.Status := csRunning;
if Assigned(FService.OnExecute) then
FService.OnExecute(FService)
else
ProcessRequests(True);
ProcessRequests(False);
except
on E: Exception do
FService.LogMessage(Format(SServiceFailed,[SExecute, E.Message]));
end;
except
on E: Exception do
FService.LogMessage(Format(SServiceFailed,[SStart, E.Message]));
end;
end;
as you can see if you don't assign a OnExecute method, Delphi will process SCM requests (Service Start, Stop, ...) until the service is stopped.
When you make an loop in the Service.Execute you must to process SCM requests yourself by calling ProcessRequests(False). A good habit is not to use Service.execute and start your workerthread in the Service.OnStart event and terminating/freeing it in the Service.OnStop event.
As told in the comments, another problem lies in the FUpdateThread.Terminate part.
David Heffernan was spot on with the Free/WaitFor comment.
Make sure you end your thread in correct fashion using synchronisation objects.