delphi and TService

Hi Experts

I'm trying to create a service in delphi, but is not working. I am using delphi 7 and windows xp professional.

What's wrong with this code

Alexandre
unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, SvcMgr, Dialogs,
  ExtCtrls;
 
type
  TService1 = class(TService)
    Timer1: TTimer;
    procedure ServiceExecute(Sender: TService);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
  public
    function GetServiceController: TServiceController; override;
    { Public declarations }
  end;
 
var
  Service1: TService1;
 
implementation
 
{$R *.DFM}
 
procedure ServiceController(CtrlCode: DWord); stdcall;
begin
  Service1.Controller(CtrlCode);
end;
 
function TService1.GetServiceController: TServiceController;
begin
  Result := ServiceController;
end;
 
procedure TService1.ServiceExecute(Sender: TService);
begin
  Timer1.Enabled := True;
  while not Terminated do
  ServiceThread.ProcessRequests(True);
  Timer1.Enabled := False;
end;
 
procedure TService1.Timer1Timer(Sender: TObject);
const
  FileName = 'c:\logdate.txt';
var
  F: TextFile;
begin
  AssignFile(f,FileName);
  if FileExists(FileName) then Append(f)
  else
  Rewrite(f);
  writeln(f,DateTimeToStr(Now));
  ShowMessage(DateTimeToStr(Now));
  CloseFile(f);
end;
 
end.

Open in new window

alpiresAsked:
Who is Participating?
 
ThievingSixConnect With a Mentor Commented:
You mean like this:

ShellExecute(0,'open','C:\myservice.exe','/install','',SW_SHOWNORMAL);

0
 
Geert GruwezOracle dbaCommented:
how are you trying to run this ?

you need to run it from the cmd prompt

service.exe /install
0
 
alpiresAuthor Commented:
Yes I'm doing this, but still not working
0
The new generation of project management tools

With monday.com’s project management tool, you can see what everyone on your team is working in a single glance. Its intuitive dashboards are customizable, so you can create systems that work for you.

 
alpiresAuthor Commented:
Well, Now I made these changes and worked:

procedure TService1.ServiceExecute(Sender: TService);
begin
  Timer1.Enabled := True;
  while not self.Terminated do
  self.ServiceThread.ProcessRequests(true);
  Timer1.Enabled := False;
end;

But now i have some questions:

1- How star the service by another delphi
0
 
HypoConnect With a Mentor Commented:
To start and stop services programatically, you have to use the ServiceControlManager. You can read all about it in the Win32 SDK help. What you do is that you allocate a handle to the ServiceControlManager, from which you can then request a handle to the service you want to start, by calling OpenService and providing the service name as a parameter. When you have a handle to the service, you can call the function StartService to Start; or ControlService with parameter SERVICE_CONTROL_STOP to stop the service. The service needs to be installed on your computer for this to work.

The example I've provided below uses the default service database on the local computer, which is where I assume your service will exist, but you can also connect to other databases or other computers by submitting the correct parameters to the OpenSCManager call.

Create an application with two buttons and a TEdit, and then add the code I've provided below. Button1 will start the service named by Edit1, and Button2 will stop the service.

regards
Hypo
Procedure StartService(ServiceName : AnsiString; Const Args : Array of String);
var i : Integer;
    sArgs : String;
    sFirst : PAnsiChar;
    aServiceControl : SC_Handle;
    aService : SC_Handle;
begin
  aService := 0;
  // Get a handle to the service manager...
  aServiceControl := WinSVC.OpenSCManager(nil, nil, SC_MANAGER_CONNECT);
  if aServiceControl = 0 then RaiseLastOSError;
  try
    // Get a handle to the service...
    aService := WinSVC.OpenService(aServiceControl, PAnsiChar(ServiceName), SERVICE_START);
    if aService = 0 then RaiseLastOSError;
    // Build sArgs string by concatenating the Args elemtents, separated by #0
    for i := 0 to Length(Args)-1
      do sArgs := sArgs + Args[i] + #0;
    // Point to the first String...
    if Length(sArgs) > 0
      then sFirst := Addr(sArgs[1])
      else sFirst := nil;
    // try Starting the service...
    if not WinSVC.StartService(aService, Length(Args), sFirst)
      then RaiseLastOSError;
  finally
    if aService <> 0 then WinSVC.CloseServiceHandle(aService);
    if aServiceControl <> 0 then WinSVC.CloseServiceHandle(aServiceControl)
  end;
End;
 
Procedure StopService(ServiceName : AnsiString);
var aServiceControl : SC_Handle;
    aService : SC_Handle;
    aStatus : TServiceStatus;
begin
  aService := 0;
  // Get a handle to the service manager...
  aServiceControl := WinSVC.OpenSCManager(nil, nil, SC_MANAGER_CONNECT);
  if aServiceControl = 0 then RaiseLastOSError;
  try
    // Get a handle to the service...
    aService := WinSVC.OpenService(aServiceControl, PAnsiChar(ServiceName), SERVICE_STOP);
    if aService = 0 then RaiseLastOSError;
    // try Stopping the service...
    if not WinSVC.ControlService(aService, SERVICE_CONTROL_STOP, aStatus)
      then RaiseLastOSError;
  finally
    if aService <> 0 then WinSVC.CloseServiceHandle(aService);
    if aServiceControl <> 0 then WinSVC.CloseServiceHandle(aServiceControl)
  end;
End;
 
procedure TForm1.Button1Click(Sender: TObject);
begin
  // You can pass runparameters to the service here...
  // Ex: StartService(Edit1.Text, ['MyRunParam1', 'MyRunParam2']);
  StartService(Edit1.Text, []);
end;
 
procedure TForm1.Button2Click(Sender: TObject);
begin
  StopService(Edit1.Text);
end;

Open in new window

0
 
Geert GruwezOracle dbaCommented:
to start it from the Delphi Ide :

Add "/Install" to the Parameters Edit in Menu Run / Parameters / Tab Local

And hit Run (F9)

0
All Courses

From novice to tech pro — start learning today.