delphi 通过线程实现Windows服务
2008-10-18 16:32
309 查看
Problem/Question/Abstract:
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.
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.
{*
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.
{*
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.
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.
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.
{*
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.
{*
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.
相关文章推荐
- delphi 通过线程实现Windows服务
- Delphi XE5通过DataSnap实现数据库三层应用
- 线程的实现(通过继承Thread类实现调用start())
- java多线程通过管道流实现不同线程之间的通信
- C语言通过线程实现回调机制
- 通过消息队列实现线程间通讯
- 多线程(一)——通过实现Runnable接口创建线程
- 简单的,通过线程实现三人卖票系统。
- 通过interface的Runnable实现线程合并(join),涉及setName,getName,sleep
- 在delphi线程中实现消息循环
- 在delphi线程中实现消息循环
- 用DELPHI通过写注册表来实现建立IIS的虚拟目录!
- 通过实现Runnable接口创建线程
- 线程的实现(通过实现Runnable接口启动线程)
- 通过模仿AsyncTask的封装方式,实现一个后台预读数据的线程,(使用AsyncTask有导致应用FC的风险)
- 通过Delphi 实现图象的缩放
- Delphi通过调用Http接口实现短信发送的功能
- Delphi通过开启远程线程注射DLL至目标进程
- Android 中通过Canvas 与线程结合实现动画效果
- C# 通过服务启动窗体(把窗体添加到服务里)实现用户交互的windows服务