проблем със Service Application и Delphi6

Имам проблем със Service Application писано на Delphi 6?
Стартирам приложението (exe файла) но услугата не се стартира и Windows-a
прекратява процеса след около 15 сек.
Някой може ли да ми помогне с идея или работещ пример?

Ako startirash prilojenieto kato standartno Win App, nqma da se registrira kato Service. Ne poznavam Delphi, no Service prilojeniqta se puskat ot ServiceControlManager-a ( SCM ), a toi chete dannite ot HKLM\System\CurrentControlSet\Services. Ako tvoeto prilojenie ne e registrirano kato service ( CreateService(..) ), nikoi ne znae che to e service. Ima dostatychno primeri kak da se napishe service prilojenie v MSDN-a

Pri po-starite versii na Delphi service se instalirashe, kato se pusne ot command line s parameter

/install

i s parameter

/uninstall
se deinstalira (ako ne se lyja)

Opitai s tova i kaji rezultata. Interesno mi e kakvo e polojenieto

Pozdravi

опитах с опция /install : windows каза: "Service installed successfuly"
после стартирах приложението, но услугата не се стартира.

Отиваш в Administrative Tools->Services и си го стартираш от там

Целта оправдава средствата

1. Service-a ti w auto-start mode li e? (ako ne, triabwa rychno da go startirash)
2. Windows ima time-out pri startirane na service (by default 2 secs), taka che ako prawish niakakwi magarii wyw ServiceMain triabwa ili da uwelichish dwWaitHint (ne go preporychwam osobenno) ili periodichno da uwelichawash dwCheckPoint. Za poweche informacia pogledni QueryServiceStatus.

dimd00d

Na OnExecute na service-a trqbva da imash cikyl ot roda na

while not Terminated do
[all the stuff]

Ako imash nqkakvi HTTP servers, FTP servers slojeni, no nishto vyv OnExecute Service-a shte izleze. Moje tova da e problema?!?

Go on, prove me wrong. Destroy the fabric of the universe. See if I care.

ето примерен код, който би трябвало да работи, но при мен не ще:

C:\>pathtofile\service /install - инсталира се успешно
C:\>net start "Test service" - стартира се успешно, но не се изпълнява
процедурата Beep и не може да се спре услугата...

unit Unit1;
interface

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

type
TTestService = class(TService)
procedure ServiceStart(Sender: TService; var Started: Boolean);
procedure ServiceExecute(Sender: TService);
procedure ServiceBeforeInstall(Sender: TService);
procedure ServiceAfterInstall(Sender: TService);
procedure ServiceAfterUninstall(Sender: TService);
procedure ServiceBeforeUninstall(Sender: TService);
procedure ServiceStop(Sender: TService; var Stopped: Boolean);
procedure ServiceShutdown(Sender: TService);
procedure ServicePause(Sender: TService; var Paused: Boolean);
procedure ServiceContinue(Sender: TService; var Continued: Boolean);
private
{ Private declarations }
public
function GetServiceController: TServiceController; override;
{ Public declarations }
end;

var
TestService: TTestService;

implementation

{$R *.DFM}

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

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

procedure TTestService.ServiceStart(Sender: TService; var Started: Boolean);
begin
ShowMessage('OnStart');
Started := TRUE;
end;

procedure TTestService.ServiceExecute(Sender: TService);
begin
ShowMessage('OnExecute');
while not Terminated do
begin
Sleep(2000);
Beep;
end;
end;

procedure TTestService.ServiceBeforeInstall(Sender: TService);
begin
ShowMessage('BeforeInstall');
end;

procedure TTestService.ServiceAfterInstall(Sender: TService);
begin
ShowMessage('After Install');
end;

procedure TTestService.ServiceAfterUninstall(Sender: TService);
begin
ShowMessage('After Uninstall');
end;

procedure TTestService.ServiceBeforeUninstall(Sender: TService);
begin
ShowMessage('Before Uninstall');
end;

procedure TTestService.ServiceStop(Sender: TService; var Stopped: Boolean);
begin
ServiceThread.Terminate;
Stopped := TRUE;
ShowMessage('Stop');
end;

procedure TTestService.ServiceShutdown(Sender: TService);
begin
ShowMessage('Shutdown');
end;

procedure TTestService.ServicePause(Sender: TService; var Paused: Boolean);
begin
Paused := True;
ShowMessage('Pause');
end;

procedure TTestService.ServiceContinue(Sender: TService;
var Continued: Boolean);
begin
Continued := True;
ShowMessage('Continue');
end;

end.

1. Ako iskash da polzvash funkcii s izhod na ekrana (kato ShowMessage), trjabva da set-nesh propery Interactive na True. Po princip interaktivnite servizi sa glupava ideja i pochti njama da namerish takyv v praktikata. Az te syvetvam da mahnesh ShowMessage i da ostavish Interctive na False. Vmesto syobshtenija na ekrana, polzvaj Event Log-a na Windows crez metoda LogMessage na TService.

2. ServiceExecute trjabva da e neshto ot tipa na:

procedure TTestService.ServiceExecute(Sender: TService);
begin
while not Terminated do
begin
// ... do something ...
ServiceThread.ProcessRequests(False);
end;
end;

Obryshtam vnimanie na ProcessRequests !!

3. Mahni "ServiceThread.Terminate;" ot ServiceStop. "ServiceThread.Terminate;" mojesh da polzvash eventualno v tjaloto na ServiceExecute, no v ServiceStop ne ti trjabva - shte byde izvikano avtomatichno, ako vyrnesh True v Stopped.