[Last Call] Learn how to a build a cloud-first strategyRegister Now

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

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

0
alpires
Asked:
alpires
2 Solutions
 
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
 
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
VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

 
ThievingSixCommented:
You mean like this:

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

0
 
HypoCommented:
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

Featured Post

Free Tool: Port Scanner

Check which ports are open to the outside world. Helps make sure that your firewall rules are working as intended.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

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