Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 1774
  • Last Modified:

Delphi Service, installed but shutdowns after startup

When I try to start the service, I receive this message and then the service stops.

The "Service" on Local Computer Started and then Stopped.  Some Services stop automatically if they have no work to do.

It's a simple service.  Basically I'm running a timer to execute a batch file.  here's the code, not much to it :-).  

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, SvcMgr, Dialogs,
  ExtCtrls;

type
  TCollectMail = class(TService)
    procedure ServiceExecute(Sender: TService);
    procedure ServiceStart(Sender: TService; var Started: Boolean);
  private
    { Private declarations }
    Timer: TTimer;
    procedure TimerOnTimer(Sender: TObject);
  public
    function GetServiceController: TServiceController; override;
    { Public declarations }
  end;

var
  CollectMail: TCollectMail;

implementation

{$R *.DFM}

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

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

procedure TCollectMail.TimeronTimer(Sender: TObject);
begin
  winExec('d:\mail\xa.cmd',SW_SHOWNORMAL);
end;

procedure TCollectMail.ServiceExecute(Sender: TService);
begin
  winExec('d:\mail\xa.cmd',SW_SHOWNORMAL);
end;

procedure TCollectMail.ServiceStart(Sender: TService;
  var Started: Boolean);
begin
    Timer:=TTimer.Create(nil);
    Timer.OnTimer:=TimeronTimer;
    timer.Interval := 60000;
    timer.Enabled := True;
end;

end.
0
looknow12
Asked:
looknow12
  • 7
  • 6
1 Solution
 
geobulCommented:
Hi,

Your Execute method just starts a cmd file and ends, so the service also terminates. Try something like:

procedure TCollectMail.ServiceExecute(Sender: TService);
begin
  winExec('d:\mail\xa.cmd',SW_SHOWNORMAL);
  while not Terminated do begin
    ServiceThread.ProcessRequests(False);
  end;
end;

Write OnStop event also:

procedure TCollectMail.ServiceStop(Sender: TService; var Stopped: Boolean);
begin
  Timer.Enabled := false; // disable the timer when terminated
  Timer.Free;
end;

Regards, Geo
0
 
looknow12Author Commented:
That worked, .  Do you see anywhere in the code why the timer event is not firing?
0
 
geobulCommented:
Hi,

Try this declaration:

type
  TCollectMail = class(TService)
    procedure ServiceExecute(Sender: TService);
    procedure ServiceStart(Sender: TService; var Started: Boolean);
    procedure TimerOnTimer(Sender: TObject); // <-- moved here
  private
    { Private declarations }
    Timer: TTimer;
  public
    function GetServiceController: TServiceController; override;
    { Public declarations }
  end;

One more thing: Is the cmd file being executed at least once from Execute method (from its first line)? If not then perhaps you'll have to try using SW_HIDE instead of SW_SHOWNORMAL.

Regards, Geo
0
Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

 
looknow12Author Commented:
It still does not seem to execute my CMD file.  Here's another shot of the code.  I don't think the event is firing.

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, SvcMgr, Dialogs,
  ExtCtrls;

type
  TCollectMail = class(TService)
    procedure ServiceExecute(Sender: TService);
    procedure ServiceStart(Sender: TService; var Started: Boolean);
    procedure ServiceStop(Sender: TService; var Stopped: Boolean);
    procedure TimerOnTimer(Sender: TObject);
  private
    { Private declarations }
    Timer: TTimer;
  public
    function GetServiceController: TServiceController; override;
    { Public declarations }
  end;

var
  CollectMail: TCollectMail;

implementation

{$R *.DFM}

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

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

procedure TCollectMail.TimeronTimer(Sender: TObject);
begin
  winExec('d:\mail\xa.cmd',SW_HIDE);
  showmessage('firing');
end;

procedure TCollectMail.ServiceExecute(Sender: TService);
begin
  winExec('d:\mail\xa.cmd',SW_SHOWNORMAL);
  while not Terminated do begin
    ServiceThread.ProcessRequests(False);
  end;
end;

procedure TCollectMail.ServiceStart(Sender: TService;
  var Started: Boolean);
begin
    Timer:=TTimer.Create(nil);
    Timer.OnTimer:=TimeronTimer;
    timer.Interval := 10000;
    timer.Enabled := True;
end;

procedure TCollectMail.ServiceStop(Sender: TService; var Stopped: Boolean);
begin
  Timer.Enabled := false; // disable the timer when terminated
  Timer.Free;

end;

end.
0
 
looknow12Author Commented:
Also, when I try to stop the service, I receive the error "Could not Stop Mail Service on Local Computer.  The Service did not return an error.  This could be an internal Windows error or an internal service error.
0
 
geobulCommented:
Hi,

Don't expect to see that message called from a service. I mean:

showmessage('firing');

Make your cmd to write to a log file instead. Then check that log.

BTW that cmd file should not be interractive, i.e. not to wait for any user input.

Regards, Geo
0
 
looknow12Author Commented:
The CMD file runs a command, dumps info to a txt file, and then has exit in it.  

The service does not seem to be running the CMD file.  On the flip side, I have a non service version of this that runs fine.  So I have the two problems.  A) it doesn't run on the timer event, b:) when I try to stop the service it bombs out and doesn't stop.

btw, I increased the points for this question.  No matter what happens geobul, you'll get some of the points for answering the first part.

Thanks
0
 
looknow12Author Commented:
Am I declaring the timer event correctly?
0
 
geobulCommented:
Hi,

In order to check whether the Timer works well:

1. Remove ShowMessage call from the OnTimer event.

2. Just to be sure your OnTimer event is being fired (I'm pretty sure it is) add writing to a log file in it with the date and time. Comment the WinExec call for the moment. Something like:

procedure TCollectMail.TimerOnTimer(Sender: TObject);
var
  FF: Text;
begin
//  winExec('d:\mail\xa.cmd',SW_HIDE);

  AssignFile(FF, 'c:\CollectMail.log');
  if FileExists(log) then begin
    Append(FF);
  end else begin
    Rewrite(FF);
  end;
  Writeln(FF, FormatDateTime('dd.mm.yyyy hh:nn', Now));
  CloseFile(FF);
end;

3. Comment WinExec call from Execute event

procedure TCollectMail.ServiceExecute(Sender: TService);
begin
//  winExec('d:\mail\xa.cmd',SW_SHOWNORMAL);
  while not Terminated do begin
    ServiceThread.ProcessRequests(False);
  end;
end;

and try the service. It should start and stop without problems. There should be one line every ten seconds in the log file (c:\CollectMail.log).

If the service doesn't stop correctly, the creation/freeing of the Timer could be moved to Create/Destroy events of the service respectively (without Start/Stop events):

procedure TCollectMail.ServiceCreate(Sender: TObject);
begin
    Timer:=TTimer.Create(nil);
    timer.Enabled := False;
    Timer.OnTimer:=TimerOnTimer;
    Timer.Interval := 10000;
end;

procedure TCollectMail.ServiceExecute(Sender: TService);
begin
//  winExec('d:\mail\xa.cmd',SW_SHOWNORMAL);
  Timer.Enabled := True;
  while not Terminated do begin
    ServiceThread.ProcessRequests(False);
  end;
  Timer.Enabled := False;
end;

procedure TCollectMail.ServiceDestroy(Sender: TObject);
begin
  Timer.Free;
end;

Now you should have a working service with a timer.

About calling the CMD file.

1. Does that file access some network resources? If so, change the account the service is logging on to your account, for instance, instead of the default Local System Account (which doesn't have network access permissions).

2. Create a CMD file which simply writes a line to a txt file (or something else very simple) and call it in the Execute and Timer events instead of 'd:\mail\xa.cmd'.

3. Install and run the service. See what happens. If it works well then the problem must be in your CMD file.

Regards, Geo
0
 
looknow12Author Commented:
Service stops properly, the log file runs correctly, but there must be something wrong with my winexec line or my CMD file.  Simply enough here it is.

d:\mail\xatrn -v -a 366 -p 366 -s domain.com othermailservice.com domain.com pass domain.com
print hello>xarun.txt
exit

XArun does not get a new time/date stamp either.
0
 
looknow12Author Commented:
I'm now calling that EXE directly from Delphi and it seems to work.  There must be something wrong with the WinEXEC command.  The CMD file appears to work fine in a foreground windows utility and at a command prompt.

Calling this from Delphi, is there any way to capture the screen information this utility would normally display?
0
 
geobulCommented:
Have you tried changing the Log On details (account) of the service? Your CMD file is trying to do something in your LAN or Internet, so perhaps you're having security issue.

Regards, Geo
0
 
geobulCommented:
You may also try starting that cmd file this way:

uses ShellApi;

ShellExecute(0, 'open', 'd:\mail\xa.cmd', nil, nil, SW_HIDE);

or using CreateProcess API directly.

Regards, Geo
0

Featured Post

Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

  • 7
  • 6
Tackle projects and never again get stuck behind a technical roadblock.
Join Now