Watch, Follow, &
Connect with Us

For forums, blogs and more please visit our
Developer Tools Community.


Welcome, Guest
Guest Settings
Help

Thread: TService can't stop


This question is answered. Helpful answers available: 2. Correct answers available: 1.


Permlink Replies: 12 - Last Post: Jan 29, 2016 2:52 AM Last Post By: Michael Eriksen
Michael Eriksen

Posts: 27
Registered: 6/12/11
TService can't stop  
Click to report abuse...   Click to reply to this thread Reply
  Posted: Jan 25, 2016 12:05 PM
Hey all

I hope this is the most appropriate group to write my question in.

I have problems with stopping my new service application. It starts successfully - but when I try to stop it, it can't stop!
I guess that I have missed something - but I don't know what :-(

My code looks like the following:
procedure ServiceController(CtrlCode: DWord); stdcall;
begin
SMSService.Controller(CtrlCode);
end;

function TSMSService.GetServiceController: TServiceController;
begin
Result := ServiceController;
end;

procedure TSMSService.ServiceCreate(Sender: TObject);
begin
//
end;

procedure TSMSService.ServiceExecute(Sender: TService);
var
Stop: Boolean;
begin
while not Terminated do begin
try
Stop := False;
while not Stop do begin
// servicecode here
end;
except

end;
end;
end;

procedure TSMSService.ServiceStart(Sender: TService; var Started: Boolean);
begin
//
end;

procedure TSMSService.ServiceStop(Sender: TService; var Stopped: Boolean);
begin
//
end;

end.

Thanks in advance for any help
Michael Eriksen
Remy Lebeau (Te...


Posts: 9,447
Registered: 12/23/01
Re: TService can't stop  
Click to report abuse...   Click to reply to this thread Reply
  Posted: Jan 25, 2016 2:30 PM   in response to: Michael Eriksen in response to: Michael Eriksen
Michael wrote:

I hope this is the most appropriate group to write my question in.

This group is fine.

I have problems with stopping my new service application. It starts
successfully - but when I try to stop it, it can't stop!

Your TService.OnExecute event handler is not processing SCM messages, so
the service will not respond to stop requests and the SCM will timeout.
When you use the TService.OnExecute event, you MUST call the TService.ServiceThread.ProcessRequests()
method periodically, eg:

procedure TSMSService.ServiceExecute(Sender: TService);
var
  Stop: Boolean;
begin
  while not Terminated do begin
    try
      Stop := False;
      while not Stop do begin
        // servicecode here
        ServiceThread.ProcessRequests(False);
      end;
    except
    end;
  end;
end;


I highly recommend you NEVER use the TService.OnExecute event! For exactly
the reason that you have to call ProcessRequests() manually, and most people
get that wrong. If you do not assign any OnExecute handler at all, TService
calls ProcessRequests() automatically for you, and the service is responsive
to SCM messages.

The best way to use TService is to move your service logic to its own worker
thread that is started in the TService.OnStart event and terminated on the
TService.OnStop/OnShutdown events, eg:

type
  TMyThread = class(TThread)
  protected
    procedure Execute; override;
  end;
 
procedure TMyThread.Execute;
begin
  while not Terminated do begin
    try
      // service code here
    except
    end;
  end;
end;
 
var
  MyThread: TMyThread = nil;
 
procedure TSMSService.ServiceStart(Sender: TService; var Started: Boolean);
begin
  MyThread := TMyThread.Create(False);
  Started := True;
end;
 
procedure TSMSService.ServiceStop(Sender: TService; var Stopped: Boolean);
begin
  ServiceShutdown(Sender);
  Stopped := True;
end;
 
procedure TSMSService.ServiceShutdown(Sender: TService);
begin
  if MyThread <> nil then
  begin
    MyThread.Terminate;
    while WaitForSingleObject(MyThread.Handle, WaitHint-100) = WAIT_TIMEOUT 
do
      ReportStatus;
    FreeAndNil(MyThread);
  end;
end;


--
Remy Lebeau (TeamB)
Michael Eriksen

Posts: 27
Registered: 6/12/11
Re: TService can't stop  
Click to report abuse...   Click to reply to this thread Reply
  Posted: Jan 26, 2016 8:50 AM   in response to: Remy Lebeau (Te... in response to: Remy Lebeau (Te...
Hello again
I have now tested it.

But I can't start the service with my thread - I can build it but not start it.

Maybe I have a further problem:
From my thread: How to call cmponents on my servicemodule? What is the best way to do it?

Thanks in advance
Michael Eriksen
Remy Lebeau (Te...


Posts: 9,447
Registered: 12/23/01
Re: TService can't stop  
Click to report abuse...   Click to reply to this thread Reply
  Posted: Jan 26, 2016 9:51 AM   in response to: Michael Eriksen in response to: Michael Eriksen
Michael wrote:

I have now tested it.
But I can't start the service with my thread - I can build it but not
start it.

You are not supposed to "start" the service manually. That is handled automatically
by TService. All you have to do is start your thread when your service asks
you to start it. If your thread itself is not working correctly then you
are doing something wrong with it. Please show your updated code.

From my thread: How to call cmponents on my servicemodule?

The same way you always have. All you need is to a pointer to the service
object. You can either:

1. use the global pointer that is automatically declared for your service
class (the same pointer that is being used in ServiceController()):

procedure TMyThread.Execute;
begin
  while not Terminated do begin
    try
      // use global SMSService pointer as needed
    except
    end;
  end;
end;


2. you can pass the Self pointer as a variable to your thread before starting
it running.

type
  TMyThread = class(TThread)
  protected
    procedure Execute; override;
  private
    fService: TSMSService;
  public
    constructor Create(AService: TSMSService); reintroduce;
  end;
 
constructor TMyThread.Create(AService: TSMSService);
begin
  inherited Create(False);
  fService := AService;
end;
 
procedure TMyThread.Execute;
begin
  while not Terminated do begin
    try
      // use fService as needed...
    except
    end;
  end;
end;
 
procedure TSMSService.ServiceStart(Sender: TService; var Started: Boolean);
begin
  MyThread := TMyThread.Create(Self);
  Started := True;
end;


--
Remy Lebeau (TeamB)
Michael Eriksen

Posts: 27
Registered: 6/12/11
Re: TService can't stop  
Click to report abuse...   Click to reply to this thread Reply
  Posted: Jan 26, 2016 11:20 AM   in response to: Remy Lebeau (Te... in response to: Remy Lebeau (Te...
Thanks for your quick reply

My service code - which can't start in sservicemanager - looks like the following:
Thanks for any help to my service application.

unit dmMainU;

interface

uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.SvcMgr, Vcl.Dialogs, Data.DB, DBAccess;

type
TSMSService = class(TService)
IBCConnection1: TIBCConnection;
procedure ServiceStart(Sender: TService; var Started: Boolean);
procedure ServiceStop(Sender: TService; var Stopped: Boolean);
procedure ServiceShutdown(Sender: TService);
private
{ Private declarations }
public
function GetServiceController: TServiceController; override;
{ Public declarations }
end;

var
SMSService: TSMSService;

implementation

{$R *.dfm}

type
TSmsSvcThread = class(TThread)
private
fService: TSMSService;
protected
procedure Execute; override;
public
constructor Create(AService: TSMSService); reintroduce;
end;

constructor TSmsSvcThread.Create(AService: TSMSService);
begin
inherited Create(False);
fService := AService;
end;

procedure TSmsSvcThread.Execute;
begin
while not Terminated do begin
try
// Servicecode here ...
except
end;
end;
end;

var
SmsSvcThread: TSmsSvcThread = nil;

procedure ServiceController(CtrlCode: DWord); stdcall;
begin
SMSService.Controller(CtrlCode);
end;

function TSMSService.GetServiceController: TServiceController;
begin
Result := ServiceController;
end;

procedure TSMSService.ServiceShutdown(Sender: TService);
begin
if SmsSvcThread <> nil then
begin
SmsSvcThread.Terminate;
while WaitForSingleObject(SmsSvcThread.Handle, WaitHint-100) = WAIT_TIMEOUT do
ReportStatus;
FreeAndNil(SmsSvcThread);
end;
end;

procedure TSMSService.ServiceStart(Sender: TService; var Started: Boolean);
begin
smsSvcThread := TSmsSvcThread.Create(Self);
Started := True;
end;

procedure TSMSService.ServiceStop(Sender: TService; var Stopped: Boolean);
begin
ServiceShutdown(Sender);
Stopped := True;
end;

end.

Best regards,
Michael Eriksen
Michael Eriksen

Posts: 27
Registered: 6/12/11
Re: TService can't stop  
Click to report abuse...   Click to reply to this thread Reply
  Posted: Jan 26, 2016 11:25 AM   in response to: Remy Lebeau (Te... in response to: Remy Lebeau (Te...
Hello all

Thanks for your quick reply - but I still can't get it to work :-(
The service can't start in servicemanager.
My code looks like the following:

unit dmMainU;

interface

uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.SvcMgr, Vcl.Dialogs, Data.DB, DBAccess;

type
TSMSService = class(TService)
IBCConnection1: TIBCConnection;
procedure ServiceStart(Sender: TService; var Started: Boolean);
procedure ServiceStop(Sender: TService; var Stopped: Boolean);
procedure ServiceShutdown(Sender: TService);
private
{ Private declarations }
public
function GetServiceController: TServiceController; override;
{ Public declarations }
end;

var
SMSService: TSMSService;

implementation

{$R *.dfm}

type
TSmsSvcThread = class(TThread)
private
fService: TSMSService;
protected
procedure Execute; override;
public
constructor Create(AService: TSMSService); reintroduce;
end;

constructor TSmsSvcThread.Create(AService: TSMSService);
begin
inherited Create(False);
fService := AService;
end;

procedure TSmsSvcThread.Execute;
begin
while not Terminated do begin
try
// Servicecode here ...
except
end;
end;
end;

var
SmsSvcThread: TSmsSvcThread = nil;

procedure ServiceController(CtrlCode: DWord); stdcall;
begin
SMSService.Controller(CtrlCode);
end;

function TSMSService.GetServiceController: TServiceController;
begin
Result := ServiceController;
end;

procedure TSMSService.ServiceShutdown(Sender: TService);
begin
if SmsSvcThread <> nil then
begin
SmsSvcThread.Terminate;
while WaitForSingleObject(SmsSvcThread.Handle, WaitHint-100) = WAIT_TIMEOUT do
ReportStatus;
FreeAndNil(SmsSvcThread);
end;
end;

procedure TSMSService.ServiceStart(Sender: TService; var Started: Boolean);
begin
smsSvcThread := TSmsSvcThread.Create(Self);
Started := True;
end;

procedure TSMSService.ServiceStop(Sender: TService; var Stopped: Boolean);
begin
ServiceShutdown(Sender);
Stopped := True;
end;

end.

Thanks in advance for any help,
Michael Eriksen

Remy Lebeau (Te...


Posts: 9,447
Registered: 12/23/01
Re: TService can't stop  
Click to report abuse...   Click to reply to this thread Reply
  Posted: Jan 26, 2016 1:42 PM   in response to: Michael Eriksen in response to: Michael Eriksen
Michael wrote:

Thanks for your quick reply - but I still can't get it to work :-(
The service can't start in servicemanager.

Is this everything in your actual code? If so, your thread Execute() method
is not actually doing anything except running a tight unyielding loop. You
are going to eat up CPU cycles and prevent other threads from running correctly.
Threads have to yield periodically. So either:

1. make your thread actually do something, so the OS can schedule it properly

procedure TSmsSvcThread.Execute;
begin
  while not Terminated do begin
    try
      // REAL service code here ...
    except
    end;
  end;
end;


2. else put a Sleep() inside the loop so it yields, unltil you figure out
what you want the thread to do:

procedure TSmsSvcThread.Execute;
begin
  while not Terminated do begin
    try
      Sleep(1000);
    except
    end;
  end;
end;


--
Remy Lebeau (TeamB)
Michael Eriksen

Posts: 27
Registered: 6/12/11
Re: TService can't stop  
Click to report abuse...   Click to reply to this thread Reply
  Posted: Jan 27, 2016 6:10 AM   in response to: Remy Lebeau (Te... in response to: Remy Lebeau (Te...
Hello again,

Thanks for your quick reply.
I have now tested it and it works now with threads in startup via the servicemanager - Excellent :-)
But again - I'm so sorry - I can't stop my service. Further information: I have deactivated all db-code to prevent any problems with that.

My code looks like the following:

unit dmMainU;

interface

uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.SvcMgr, Vcl.Dialogs, Data.DB, DBAccess, IBC, stdIBC,
Settings, IdHTTP, inifiles, CompanySettings, System.Win.Registry;

type
TSMSService = class(TService)
IBCConnection1: TIBCConnection;
procedure ServiceStart(Sender: TService; var Started: Boolean);
procedure ServiceStop(Sender: TService; var Stopped: Boolean);
procedure ServiceShutdown(Sender: TService);
procedure ServiceAfterInstall(Sender: TService);
private
{ Private declarations }
public
function GetServiceController: TServiceController; override;
{ Public declarations }
end;

var
SMSService: TSMSService;

implementation

{$R *.dfm}

type
TSmsSvcThread = class(TThread)
private
fService: TSMSService;
protected
procedure Execute; override;
public
constructor Create(AService: TSMSService); reintroduce;
end;

constructor TSmsSvcThread.Create(AService: TSMSService);
begin
inherited Create(False);
fService := AService;
end;

procedure TSmsSvcThread.Execute;
var
Stop: Boolean;
h, m, s, n: Word;
begin
while not Terminated do begin
try
Stop := False;
while not Stop do begin
DecodeTime(Time, h, m, s, n);
if m in [0, 15, 30, 45] then begin
// my service code here with db management
Sleep(65000);
end;
end;
Sleep(1000);
except
end;
end;
end;

var
SmsSvcThread: TSmsSvcThread = nil;

procedure ServiceController(CtrlCode: DWord); stdcall;
begin
SMSService.Controller(CtrlCode);
end;

function TSMSService.GetServiceController: TServiceController;
begin
Result := ServiceController;
end;

procedure TSMSService.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', 'My description');
Reg.CloseKey;
end;
finally
FreeAndNil(Reg);
end;
end;

procedure TSMSService.ServiceShutdown(Sender: TService);
begin
if SmsSvcThread <> nil then
begin
SmsSvcThread.Terminate;
while WaitForSingleObject(SmsSvcThread.Handle, WaitHint-100) = WAIT_TIMEOUT do
ReportStatus;
FreeAndNil(SmsSvcThread);
end;
end;

procedure TSMSService.ServiceStart(Sender: TService; var Started: Boolean);
begin
smsSvcThread := TSmsSvcThread.Create(Self);
Started := True;
end;

procedure TSMSService.ServiceStop(Sender: TService; var Stopped: Boolean);
begin
ServiceShutdown(Sender);
Stopped := True;
end;

end.

Thanks in advance,
Michael Eriksen
Remy Lebeau (Te...


Posts: 9,447
Registered: 12/23/01
Re: TService can't stop  
Click to report abuse...   Click to reply to this thread Reply
  Posted: Jan 27, 2016 10:57 AM   in response to: Michael Eriksen in response to: Michael Eriksen
Michael Eriksen wrote:
But again - I'm so sorry - I can't stop my service. Further
information: I have deactivated all db-code to prevent any
problems with that.

You are not terminating your worker thread correctly, so your OnStop/Shutdown handler waits forever.

I keep taking out your useless Stop flag, and you keep putting it back in. Please pay attention to the example I give you. You are never setting Stop to True, so your thread keeps looping forever. Get rid of that flag and just use the TThread.Terminated property, like I keep showing you.

procedure TSmsSvcThread.Execute;
var
  h, m, s, n: Word;
begin
  while not Terminated do begin
    try
      while not Terminated do begin
        ...
      end;
    except
    end;
  end;
end;


Also, your thread is sleeping WAY too long without waking up. If the minutes of the current time is a multiple of 15, you are sleeping for over 1 minute. If you try to stop the service during that time, the SCM will eventually time out. If you are going to sleep that long, you need to do it in smaller increments so you can check the Terminated property more often:

procedure TSmsSvcThread.Execute;
var
  h, m, s, n: Word;
begin
  while not Terminated do begin
    try
      while not Terminated do begin
        DecodeTime(Time, h, m, s, n);
        if m in [0, 15, 30, 45] then begin
          // my service code here with db management
          for I := 1 to 26 do
            Sleep(2500);
        end else
          Sleep(1000);
      end;
    except
    end;
  end;
end;


Otherwise, use a TEvent for the sleep so you can wake it up immediately:

type
  TSmsSvcThread = class(TThread)
  private
    fService: TSMSService;
    fTermEvent: TEvent;
  protected
    procedure Execute; override;
    procedure TerminatedSet; override;
  public
    constructor Create(AService: TSMSService); reintroduce;
    destructor Destroy; override;
  end;
 
constructor TSmsSvcThread.Create(AService: TSMSService);
begin
  inherited Create(False);
  fService := AService;
  fTermEvent := TEvent.Create(nil, True, False, '');
end;
 
destructor TSmsSvcThread.Destroy;
begin
  fTermEvent.Free;
  inherited;
end;
 
procedure TSmsSvcThread.TerminatedSet;
begin
  fTermEvent.SetEvent;
end;
 
procedure TSmsSvcThread.Execute;
var
  h, m, s, n: Word;
begin
  while not Terminated do begin
    try
      while not Terminated do begin
        DecodeTime(Time, h, m, s, n);
        if m in [0, 15, 30, 45] then begin
          // my service code here with db management
          fTermEvent.WaitFor(65000);
        end else
          Sleep(1000);
      end;
    except
    end;
  end;
end;


Do make sure that when you put in your REAL db code, that your thread remains responsive to the Terminated property. If you do a lot of db operations, check the Terminated property in between them. If any single db operations take a long time to perform, check the Terminated property before and after performing them.

Now, with all of that said, you should consider using a waitable timer instead of polling the clock every few seconds:

Waitable Timer Objects
https://msdn.microsoft.com/en-us/library/windows/desktop/ms687012.aspx

That way, you can wait on the timer and the terminate event at the same time, using WaitForMultipleObjects(), and then act accordingly based on which one gets signaled.

procedure TSMSService.ServiceAfterInstall(Sender: TService);

You should not be writing to the Registry directly to create a description. Use the SERVICE_CONFIG_DESCRIPTION option of ChangeServiceConfig2() instead:

https://msdn.microsoft.com/en-us/library/windows/desktop/ms681988.aspx

--
Remy Lebeau (TeamB)
Michael Eriksen

Posts: 27
Registered: 6/12/11
Re: TService can't stop  
Click to report abuse...   Click to reply to this thread Reply
  Posted: Jan 28, 2016 4:53 AM   in response to: Remy Lebeau (Te... in response to: Remy Lebeau (Te...
Helloo again,

Thanks for taking your time to help me.

It is now possible to stop my service - thanks for any help with my issue.
But when my time is a multiple of 15 minutes - and I want to stop my service, it takes very long time for the SCM to stop it.
Is there a way out of that without a waitable timer?

Also, your thread is sleeping WAY too long without waking up. If the minutes of the current time is a multiple of 15, you are sleeping for over 1 minute. If you try to stop the service during that time, the SCM will eventually time out. If you are going to sleep that long, you need to do it in smaller increments so you can check the Terminated property more often:

Thanks in advance,
Michael Eriksen

Remy Lebeau (Te...


Posts: 9,447
Registered: 12/23/01
Re: TService can't stop  
Click to report abuse...   Click to reply to this thread Reply
  Posted: Jan 28, 2016 6:23 PM   in response to: Michael Eriksen in response to: Michael Eriksen
Michael wrote:

But when my time is a multiple of 15 minutes - and I want to stop
my service, it takes very long time for the SCM to stop it.

Which technique are you using for simulating the "db management" time - a
Sleep() loop or a TEvent? I did just notice a bug in the Sleep() loop I
showed you, there is a missing Break when the Terminated property is set
to true.

--
Remy Lebeau (TeamB)
Michael Eriksen

Posts: 27
Registered: 6/12/11
Re: TService can't stop  
Click to report abuse...   Click to reply to this thread Reply
  Posted: Jan 29, 2016 2:52 AM   in response to: Remy Lebeau (Te... in response to: Remy Lebeau (Te...
Hello again

Thanks again for taking your time to help me.
Everything seems to work now - excellent :-)

Best regards
Michael Eriksen
Remy Lebeau (Te...


Posts: 9,447
Registered: 12/23/01
Re: TService can't stop  
Click to report abuse...   Click to reply to this thread Reply
  Posted: Jan 28, 2016 6:17 PM   in response to: Remy Lebeau (Te... in response to: Remy Lebeau (Te...
Remy wrote:

for I := 1 to 26 do
Sleep(2500);

Sorry, that should be this instead:

for I := 1 to 26 do
begin
  if Terminated then Break; // <-- add this
  Sleep(2500);
end;


--
Remy Lebeau (TeamB)
Legend
Helpful Answer (5 pts)
Correct Answer (10 pts)

Server Response from: ETNAJIVE02