Windows - criando servicos no NT, 2000 e xp

Top Previous Next

program NTService;

uses

SvcMgr,

NTServiceMain in 'Units\\NTServiceMain.pas' {ExampleService: TService},

NTServiceThread in 'Units\\NTServiceThread.pas';

{$R *.RES}

begin

Application.Initialize;

Application.CreateForm(TExampleService, ExampleService);

Application.Run;

end.

------- CUT-CUT-CUT-CUT -------------------------------------------------

Windows Service Template

========================

Author Kim Sandell

emali: kim.sandell@nsftele.com

Disclaimer Freeware. Use and abuse at your own risk.

Description A Windows NT Service skeleton with a thread.

Works in WinNT 4.0, Win 2K, and Win XP Pro

The NTServiceThread.pas contains the actual

thread that is started under the service.

When you want to code a service, put the code in

its Execute() method.

Example To test the service, install it into the SCM with

the InstallService.bat file. The go to the Service

Control Manager and start the service.

The Interval can be set to execute the Example Beeping

every x seconds. It depends on the application if it

needs a inerval or not.

Notes This example has the service startup options set to

MANUAL. If you want to make a service that starts

automatically with windows then you need to change this.

BE CAREFULT ! If your application hangs when running as a

service THERE IS NO WAY to terminate the application.

History Description

========== ============================================================

24.09.2002 Initial version

unit NTServiceMain;

interface

uses

Windows, Messages, SysUtils, Classes, SvcMgr,

NTServiceThread;

type

TExampleService = class(TService)

procedure ServiceExecute(Sender: TService);

procedure ServiceStart(Sender: TService; var Started: Boolean);

procedure ServiceStop(Sender: TService; var Stopped: Boolean);

procedure ServicePause(Sender: TService; var Paused: Boolean);

procedure ServiceContinue(Sender: TService; var Continued: Boolean);

procedure ServiceShutdown(Sender: TService);

private

{ Private declarations }

fServicePri : Integer;

fThreadPri : Integer;

{ Internal Start & Stop methods }

Function _StartThread( ThreadPri:Integer ): Boolean;

Function _StopThread: Boolean;

public

{ Public declarations }

NTServiceThread : TNTServiceThread;

function GetServiceController: TServiceController; override;

end;

var

ExampleService: TExampleService;

implementation

{$R *.DFM}

procedure ServiceController(CtrlCode: DWord); stdcall;

begin

ExampleService.Controller(CtrlCode);

end;

function TExampleService.GetServiceController: TServiceController;

begin

Result := ServiceController;

end;

procedure TExampleService.ServiceExecute(Sender: TService);

begin

{ Loop while service is active in SCM }

While NOT Terminated do

Begin

{ Process Service Requests }

ServiceThread.ProcessRequests( False );

{ Allow system some time }

Sleep(1);

End;

end;

procedure TExampleService.ServiceStart(Sender: TService; var Started: Boolean);

begin

{ Default Values }

Started := False;

fServicePri := NORMAL_PRIORITY_CLASS;

fThreadPri := Integer(tpLower);

{ Set the Service Priority }

Case fServicePri of

0 : SetPriorityClass( GetCurrentProcess, IDLE_PRIORITY_CLASS );

1 : SetPriorityClass( GetCurrentProcess, NORMAL_PRIORITY_CLASS );

2 : SetPriorityClass( GetCurrentProcess, HIGH_PRIORITY_CLASS );

3 : SetPriorityClass( GetCurrentProcess, REALTIME_PRIORITY_CLASS );

End;

{ Attempt to start the thread, if it fails free it }

If _StartThread( fThreadPri ) then

Begin

{ Signal success back }

Started := True;

End Else

Begin

{ Signal Error back }

Started := False;

{ Stop all activity }

_StopThread;

End;

end;

procedure TExampleService.ServiceStop(Sender: TService;

var Stopped: Boolean);

begin

{ Try to stop the thread - signal results back }

Stopped := _StopThread;

end;

procedure TExampleService.ServicePause(Sender: TService; var Paused: Boolean);

begin

{ Attempt to PAUSE the thread }

If Assigned(NTServiceThread) AND (NOT NTServiceThread.Suspended) then

Begin

{ Suspend the thread }

NTServiceThread.Suspend;

{ Return results }

Paused := (NTServiceThread.Suspended = True);

End Else Paused := False;

end;

procedure TExampleService.ServiceContinue(Sender: TService;

var Continued: Boolean);

begin

{ Attempt to RESUME the thread }

If Assigned(NTServiceThread) AND (NTServiceThread.Suspended) then

BEGIN

{ Suspend the thread }

If NTServiceThread.Suspended then NTServiceThread.Resume;

{ Return results }

Continued := (NTServiceThread.Suspended = False);

END Else Continued := False;

end;

procedure TExampleService.ServiceShutdown(Sender: TService);

begin

{ Attempt to STOP (Terminate) the thread }

_StopThread;

end;

function TExampleService._StartThread( ThreadPri: Integer ): Boolean;

begin

{ Default result }

Result := False;

{ Create Thread and Set Default Values }

If NOT Assigned(NTServiceThread) then

Try

{ Create the Thread object }

NTServiceThread := TNTServiceThread.Create( True );

{ Set the Thread Priority }

Case ThreadPri of

0 : NTServiceThread.Priority := tpIdle;

1 : NTServiceThread.Priority := tpLowest;

2 : NTServiceThread.Priority := tpLower;

3 : NTServiceThread.Priority := tpNormal;

4 : NTServiceThread.Priority := tpHigher;

5 : NTServiceThread.Priority := tpHighest;

End;

{ Set the Execution Interval of the Thread }

NTServiceThread.Interval := 2;

{ Start the Thread }

NTServiceThread.Resume;

{ Return success }

If NOT NTServiceThread.Suspended then Result := True;

Except

On E:Exception do ; // TODO: Exception Logging

End;

end;

function TExampleService._StopThread: Boolean;

begin

{ Default result }

Result := False;

{ Stop and Free Thread }

If Assigned(NTServiceThread) then

Try

{ Terminate thread }

NTServiceThread.Terminate;

{ If it is suspended - Restart it }

If NTServiceThread.Suspended then NTServiceThread.Resume;

{ Wait for it to finish }

NTServiceThread.WaitFor;

{ Free & NIL it }

NTServiceThread.Free;

NTServiceThread := NIL;

{ Return results }

Result := True;

Except

On E:Exception do ; // TODO: Exception Logging

End Else

Begin

{ Return success - Nothing was ever started ! }

Result := True;

End;

end;

end.

------- CUT-CUT-CUT-CUT -------------------------------------------------

A Windows NT Service Thread

===========================

Author Kim Sandell

Email: kim.sandell@nsftele.com

unit NTServiceThread;

interface

uses

Windows, Messages, SysUtils, Classes;

type

TNTServiceThread = Class(TThread)

private

{ Private declarations }

Public

{ Public declarations }

Interval : Integer;

Procedure Execute; Override;

Published

{ Published declarations }

End;

implementation

{ TNTServiceThread }

procedure TNTServiceThread.Execute;

Var

TimeOut : Integer;

begin

{ Do NOT free on termination - The Serivce frees the Thread }

FreeOnTerminate := False;

{ Set Interval }

TimeOut := Interval * 4;

{ Main Loop }

Try

While Not Terminated do

Begin

{ Decrement timeout }

Dec( TimeOut );

If (TimeOut=0) then

Begin

{ Reset timer }

TimeOut := Interval * 4;

{ Beep once per x seconds }

Beep;

End;

{ Wait 1/4th of a second }

Sleep(250);

End;

Except

On E:Exception do ; // TODO: Exception logging...

End;

{ Terminate the Thread - This signals Terminated=True }

Terminate;

end;

end.