Author: Kim Sandell
Delphi 5&6 has a template project for services, but it is incomplete. This example
builds on that template and completes the service. It also shows how to start a
thread that beeps every 2 seconds. You can use this as a base when developing
servers as services.
Answer:
This example shows how to use the service template in delphi, taking it a step
further and making a complete example. The source for this is included in the
ntservice.zip file.
Coded under D6, but works for D5 if you copy the source parts after creating a
template service.
Below are all the source files listed one by one.
To test the source, create a Service with Delphi, and pase these sources on top of
the automatically generated source.
1 program NTService;
2
3 uses
4 SvcMgr,
5 NTServiceMain in 'Units\NTServiceMain.pas' {ExampleService: TService},
6 NTServiceThread in 'Units\NTServiceThread.pas';
7
8 {$R *.RES}
9
10 begin
11 Application.Initialize;
12 Application.CreateForm(TExampleService, ExampleService);
13 Application.Run;
14 end.
15
16 {*
17 Windows Service Template
18 ========================
19
20 Author Kim Sandell
21 emali: kim.sandell@nsftele.com
22
23 Disclaimer Freeware. Use and abuse at your own risk.
24
25 Description A Windows NT Service skeleton with a thread.
26 Works in WinNT 4.0, Win 2K, and Win XP Pro
27
28 The NTServiceThread.pas contains the actual
29 thread that is started under the service.
30 When you want to code a service, put the code in
31 its Execute() method.
32
33 Example To test the service, install it into the SCM with
34 the InstallService.bat file. The go to the Service
35 Control Manager and start the service.
36
37 The Interval can be set to execute the Example Beeping
38 every x seconds. It depends on the application if it
39 needs a inerval or not.
40
41 Notes This example has the service startup options set to
42 MANUAL. If you want to make a service that starts
43 automatically with windows then you need to change this.
44 BE CAREFULT ! If your application hangs when running as a
45 service THERE IS NO WAY to terminate the application.
46
47 History Description
48 ========== ============================================================
49 24.09.2002 Initial version
50
51 *}
52 unit NTServiceMain;
53
54 interface
55
56 uses
57 Windows, Messages, SysUtils, Classes, SvcMgr,
58 NTServiceThread;
59
60 type
61 TExampleService = class(TService)
62 procedure ServiceExecute(Sender: TService);
63 procedure ServiceStart(Sender: TService; var Started: Boolean);
64 procedure ServiceStop(Sender: TService; var Stopped: Boolean);
65 procedure ServicePause(Sender: TService; var Paused: Boolean);
66 procedure ServiceContinue(Sender: TService; var Continued: Boolean);
67 procedure ServiceShutdown(Sender: TService);
68 private
69 { Private declarations }
70 fServicePri: Integer;
71 fThreadPri: Integer;
72
73 { Internal Start & Stop methods }
74 function _StartThread(ThreadPri: Integer): Boolean;
75 function _StopThread: Boolean;
76 public
77 { Public declarations }
78 NTServiceThread: TNTServiceThread;
79
80 function GetServiceController: TServiceController; override;
81 end;
82
83 var
84 ExampleService: TExampleService;
85
86 implementation
87
88 {$R *.DFM}
89
90 procedure ServiceController(CtrlCode: DWord); stdcall;
91 begin
92 ExampleService.Controller(CtrlCode);
93 end;
94
95 function TExampleService.GetServiceController: TServiceController;
96 begin
97 Result := ServiceController;
98 end;
99
100 procedure TExampleService.ServiceExecute(Sender: TService);
101 begin
102 { Loop while service is active in SCM }
103 while not Terminated do
104 begin
105 { Process Service Requests }
106 ServiceThread.ProcessRequests(False);
107 { Allow system some time }
108 Sleep(1);
109 end;
110 end;
111
112 procedure TExampleService.ServiceStart(Sender: TService; var Started: Boolean);
113 begin
114 { Default Values }
115 Started := False;
116 fServicePri := NORMAL_PRIORITY_CLASS;
117 fThreadPri := Integer(tpLower);
118
119 { Set the Service Priority }
120 case fServicePri of
121 0: SetPriorityClass(GetCurrentProcess, IDLE_PRIORITY_CLASS);
122 1: SetPriorityClass(GetCurrentProcess, NORMAL_PRIORITY_CLASS);
123 2: SetPriorityClass(GetCurrentProcess, HIGH_PRIORITY_CLASS);
124 3: SetPriorityClass(GetCurrentProcess, REALTIME_PRIORITY_CLASS);
125 end;
126
127 { Attempt to start the thread, if it fails free it }
128 if _StartThread(fThreadPri) then
129 begin
130 { Signal success back }
131 Started := True;
132 end
133 else
134 begin
135 { Signal Error back }
136 Started := False;
137 { Stop all activity }
138 _StopThread;
139 end;
140 end;
141
142 procedure TExampleService.ServiceStop(Sender: TService;
143 var Stopped: Boolean);
144 begin
145 { Try to stop the thread - signal results back }
146 Stopped := _StopThread;
147 end;
148
149 procedure TExampleService.ServicePause(Sender: TService; var Paused: Boolean);
150 begin
151 { Attempt to PAUSE the thread }
152 if Assigned(NTServiceThread) and (not NTServiceThread.Suspended) then
153 begin
154 { Suspend the thread }
155 NTServiceThread.Suspend;
156 { Return results }
157 Paused := (NTServiceThread.Suspended = True);
158 end
159 else
160 Paused := False;
161 end;
162
163 procedure TExampleService.ServiceContinue(Sender: TService;
164 var Continued: Boolean);
165 begin
166 { Attempt to RESUME the thread }
167 if Assigned(NTServiceThread) and (NTServiceThread.Suspended) then
168 begin
169 { Suspend the thread }
170 if NTServiceThread.Suspended then
171 NTServiceThread.Resume;
172 { Return results }
173 Continued := (NTServiceThread.Suspended = False);
174 end
175 else
176 Continued := False;
177 end;
178
179 procedure TExampleService.ServiceShutdown(Sender: TService);
180 begin
181 { Attempt to STOP (Terminate) the thread }
182 _StopThread;
183 end;
184
185 function TExampleService._StartThread(ThreadPri: Integer): Boolean;
186 begin
187 { Default result }
188 Result := False;
189 { Create Thread and Set Default Values }
190 if not Assigned(NTServiceThread) then
191 try
192 { Create the Thread object }
193 NTServiceThread := TNTServiceThread.Create(True);
194 { Set the Thread Priority }
195 case ThreadPri of
196 0: NTServiceThread.Priority := tpIdle;
197 1: NTServiceThread.Priority := tpLowest;
198 2: NTServiceThread.Priority := tpLower;
199 3: NTServiceThread.Priority := tpNormal;
200 4: NTServiceThread.Priority := tpHigher;
201 5: NTServiceThread.Priority := tpHighest;
202 end;
203 { Set the Execution Interval of the Thread }
204 NTServiceThread.Interval := 2;
205
206 { Start the Thread }
207 NTServiceThread.Resume;
208 { Return success }
209 if not NTServiceThread.Suspended then
210 Result := True;
211 except
212 on E: Exception do
213 ; // TODO: Exception Logging
214 end;
215 end;
216
217 function TExampleService._StopThread: Boolean;
218 begin
219 { Default result }
220 Result := False;
221 { Stop and Free Thread }
222 if Assigned(NTServiceThread) then
223 try
224 { Terminate thread }
225 NTServiceThread.Terminate;
226 { If it is suspended - Restart it }
227 if NTServiceThread.Suspended then
228 NTServiceThread.Resume;
229 { Wait for it to finish }
230 NTServiceThread.WaitFor;
231 { Free & NIL it }
232 NTServiceThread.Free;
233 NTServiceThread := nil;
234 { Return results }
235 Result := True;
236 except
237 on E: Exception do
238 ; // TODO: Exception Logging
239 end
240 else
241 begin
242 { Return success - Nothing was ever started ! }
243 Result := True;
244 end;
245 end;
246
247 end.
248
249 {*
250 A Windows NT Service Thread
251 ===========================
252
253 Author Kim Sandell
254 Email: kim.sandell@nsftele.com
255 *}
256 unit NTServiceThread;
257
258 interface
259
260 uses
261 Windows, Messages, SysUtils, Classes;
262
263 type
264 TNTServiceThread = class(TThread)
265 private
266 { Private declarations }
267 public
268 { Public declarations }
269 Interval: Integer;
270
271 procedure Execute; override;
272 published
273 { Published declarations }
274 end;
275
276 implementation
277
278 { TNTServiceThread }
279
280 procedure TNTServiceThread.Execute;
281 var
282 TimeOut: Integer;
283 begin
284 { Do NOT free on termination - The Serivce frees the Thread }
285 FreeOnTerminate := False;
286
287 { Set Interval }
288 TimeOut := Interval * 4;
289
290 { Main Loop }
291 try
292 while not Terminated do
293 begin
294 { Decrement timeout }
295 Dec(TimeOut);
296
297 if (TimeOut = 0) then
298 begin
299 { Reset timer }
300 TimeOut := Interval * 4;
301
302 { Beep once per x seconds }
303 Beep;
304 end;
305 { Wait 1/4th of a second }
306 Sleep(250);
307 end;
308 except
309 on E: Exception do
310 ; // TODO: Exception logging...
311 end;
312 { Terminate the Thread - This signals Terminated=True }
313 Terminate;
314 end;
315
316 end.
|
