用Delphi编写Windows服务程序.docx
- 文档编号:5189165
- 上传时间:2022-12-13
- 格式:DOCX
- 页数:17
- 大小:22.97KB
用Delphi编写Windows服务程序.docx
《用Delphi编写Windows服务程序.docx》由会员分享,可在线阅读,更多相关《用Delphi编写Windows服务程序.docx(17页珍藏版)》请在冰豆网上搜索。
用Delphi编写Windows服务程序
一、Windows服务简介
服务程序(ServiceApplication)是一种运行于WinNT的后台程序,每个服务程序(ServiceApplication)中可能包含若干个服务(Service),每个服务就是其中的一个线程(该服务也可以创建多个子线程)。
采用服务,应用程序可以获得特殊的权限,而且不会被用户通过Win2000的任务管理器直接结束程序,所以服务常常用来实现一些特殊的目标。
通过Win2000控制面板中的服务管理工具,我们可以设置/查看服务的特性:
(1)服务名称;
(2)显示名称;(3)描述;(4)启动类型;(5)依赖关系;
其中,服务名称是标识给服务的。
以Win2000的C:
\WINNT\System32\程序为例子,该Exe文件对应一个ServiceApplication,是该服务程序的可见实体;该exe中包含多个服务(Service),例如Alerter,Dhcp(DHCPClient),Messenger等。
当我们结束一个服务的时候,该服务所在的ServiceApplication中的其他服务并没有被终止。
在Delphi中,Borland的工程师为我们提供了TServiceApplication,TService,TServiceThread等类,封装了大量细节,简化了服务程序的。
二、TServiceApplication
在Delphi中,类TServiceApplication就对应上述的ServiceApplication。
利用Delphi的开发环境,我们新建一个ServiceApplicationProject,同时就创建了一个继承自TService的类。
项目文件中的Application对象就是一个TServiceApplication实例。
每个TServiceApplication包含若干个TService对象,正好对应上述的服务程序和服务之间的数量关系。
通过阅读TServiceApplication和TService类的定义,可以得知,TServiceApplication从TComponent类继承而来,TService从类TDataModule基础而来,Application对象负责各个TService对象的Create和Destroy。
跟踪下列代码
(TService1,Service1);
可以发现创建的TService对象的Owner都是Application对象;在VCLFrameWork中Owner总是负责Destroy各个Component对象(VCL的TComponent类采用了Composite模式),所以TServiceApplication也将Destroy各个TService对象。
下面跟踪的代码,可以发现TServiceApplication首先解析运行参数,实现了服务的Install和Uninstall。
然后,初始化一个ServiceStartTable数组,该数组包含了各个service对象的服务名称和运行入口;最后创建一个TServiceStartThread对象,该对象是一个线程对象,从线程调用API:
StartServiceCtrlDispatcher来启动ServiceStartTable中指定的若干个服务;而ServiceApplication主线程就不断循环,处理消息,比如接收请求来停止/暂停某个服务。
三、TService
TService类继承自类TDataModule,这意味着我们可以加入大量的VCL控件,实现丰富的功能。
此外,我们还可以处理OnStart,OnPause,OnStop,OnContinue,OnCreate,OnShutDown等事件。
其中需要说明的是:
OnStop表示该服务被停止;而OnShutDown表示该ServiceApplication停止运行,这意味着其他服务也被终止了;两者含义是不一样的。
前面讲过,ServiceApplication通过调用StartServiceCtrlDispatcher来启动各个服务。
StartServiceCtrlDispatcher启动TService的入口,该入库就是。
首先注册该服务,然后调用。
创建一个内部TServiceThread成员对象,这是一个线程对象;考察可以得知,当我们处理的TService1.OnExecute,那么TService会把所有的请求委托给该TServiceThread成员对象处理,该对象以默认的方式处理所有的请求。
TService.ServiceExecute是TService的主体内容。
一个服务要正常运行,除了需要处理它要关注的目标(比如监听某个端口、执行某个任务等)外,还要响应外部命令/请求:
比如终止、暂停、恢复该服务。
因此可以考虑创建一个专门的线程来完成该任务,而在ServiceExecute中处理外面命令/请求。
因此代码如下:
whilenotTerminateddobegin
(False);
end;
当然,也可以在OnExecute中处理某些任务,如监听某个端口,但是这常常会导致该Service不能及时响应Stop/Pause等请求。
当OnExecute执行完了,该服务实际上就完成了任务要结束了(terminate)。
Windows的服务是一个比较实用的功能,你的程序可以在Windows未进行登录的时候就开始运行,不受用户注销的影响,也不容易被用户误关闭。
但是编写服务也许不是一件容易的事情,幸好Delphi给我们提供了一个模板,可以很容易的编写一个标准的Windows服务程序。
首先,在Delphi内新建一个ServiceApplication。
此时,Delphi已经给我们建好了一个Service程序的框架,我们只需要把我们的代码加到合适的位置就行了。
一般情况下,Service内需要一个线程来不断的工作,也许定时器也可以,但线程工作起来更好。
Delphi会生成一个可视化的Service容器,你可以一些必要的控件在它上面,但是由于它是服务程序,是没有界面显示的,因此不建议在上面安放Edit之类的控件,服务只是应该做处理工作的,显示界面应该由其它的程序来完成。
Service控件的DisplayName属性是显示在管理工具-》服务的左边的名称的内容,而Name属性则是服务名称,当你用命令提示符来启动、停止服务时,就需要用到。
在事件OnStart内,我们应该完成启动线程的工作。
如:
procedure (Sender:
TService;
var Started:
Boolean);
var Reg:
TRegistry;
LogFileName,LogPath:
String;
slTemp:
TStringList;
begin
CoInitialize(nil);
Reg:
=;
:
=HKEY_LOCAL_MACHINE;
('\SoftWare\BHome\Education',True);
LogPath:
=Trim('LogPath'));
SourceConnStr:
=Trim('SourceConnStr'));
if Trim(LogPath)='' then
LogPath:
='C:
\';
;
;
if RightStr(LogPath,1)<>'\' then
LogPath:
=LogPath+'\';
LogFileName:
=LogPath+FormatDateTime('yyyymmdd',Now)+'';
Try
if not FileExists(LogFileName) then begin
slTemp:
=;
;
(LogFileName);
;
end;
AssignFile(LogFile, LogFileName);
Append(LogFile);
Except
Started:
=False;
Exit;
End;
Started:
=True;
try
AC_Source:
=(nil);
Q_Source:
=(nil) ;
:
=AC_Source;
try
;
:
=SourceConnStr;
;
SYSLog('与源数据库连接成功!
');
DBOK:
=True;
Except
on E:
Exception do begin
DBOK:
=False;
SYSLog('数据库连接失败!
'+;
end;
End;
MyPHSThread :
= ();
:
=True;
:
= tpLower ;
end;
在OnStop事件内,我们应该停止线程,并释放打开的资源,需要注意的是当你停止线程时,一般用Terminate方法,在线程内用Terminated属性来判断是否需要结束线程,而由于是线程,和主进程是时间运行的,有可能你刚好在进行Terminate时,线程已经刚进行过Terminated判断,正在进行比较费时的处理工作,而此时主进程立即执行Terminate后就进行释放资源的工作时,会造成线程执行错误,因此应该等到线程真正的正确停止后,主进程才能进行资源释放工作。
如:
procedure (Sender:
TService;
var Stopped:
Boolean);
begin
try
;
while __ThreadIsRun do
sleep(1000);
;
CloseFile(LogFile);
FreeAndNil(Q_Source);
FreeAndNil(AC_Source);
CoUnInitialize;
Except
End;
Stopped:
=True;
end;
分类:
Windows 2000/XP和2003等支持一种叫做"服务程序"的东西.程序作为服务启动有以下几个好处:
(1)不用登陆进系统即可运行.
(2)具有SYSTEM特权.所以你在进程管理器里面是无法结束它的.
笔者在2003年为一公司开发机顶盒项目的时候,曾经写过课件上传和媒体服务,下面就介绍一下如何用Delphi7创建一个Service程序.
运行Delphi7,选择菜单File-->New-->Other--->Service Application.将生成一个服务程序的框架.将工程保存为和,然后回到主框架.我们注意到,Service有几个属性.其中以下几个是我们比较常用的:
(1)DisplayName:
服务的显示名称
(2)Name:
服务名称.
我们在这里将DisplayName的值改为"Delphi服务演示程序",Name改为"DelphiService".编译这个项目,将得到 .这已经是一个服务程序了!
进入CMD模式,切换致工程所在目录,运行命令" /install",将提示服务安装成功!
然后"net start DelphiService"将启动这个服务.进入控制面版-->管理工具-->服务,将显示这个服务和当前状态.不过这个服务现在什么也干不了,因为我们还没有写代码:
)先"net stop DelphiService"停止再" /uninstall"删除这个服务.回到Delphi7的IDE.
我们的计划是为这个服务添加一个主窗口,运行后任务栏显示程序的图标,双击图标将显示主窗口,上面有一个按钮,点击该按钮将实现Ctrl+Alt+Del功能.
实际上,服务程序莫认是工作于Winlogon桌面的,可以打开控制面板,查看我们刚才那个服务的属性-->登陆,其中"允许服务与桌面交互 "是不打钩的.怎么办?
呵呵,回到IDE,注意那个布尔属性:
Interactive,当这个属性为True的时候,该服务程序就可以与桌面交互了.
File-->New-->Form为服务添加窗口FrmMain,单元保存为Unit_FrmMain,并且把这个窗口设置为手工创建.完成后的代码如下:
unit Unit_Main;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, SvcMgr, Dialogs, Unit_FrmMain;
type
TDelphiService = class(TService)
procedure ServiceContinue(Sender:
TService; var Continued:
Boolean);
procedure ServiceExecute(Sender:
TService);
procedure ServicePause(Sender:
TService; var Paused:
Boolean);
procedure ServiceShutdown(Sender:
TService);
procedure ServiceStart(Sender:
TService; var Started:
Boolean);
procedure ServiceStop(Sender:
TService; var Stopped:
Boolean);
private
{ Private declarations }
public
function GetServiceController:
TServiceController; override;
{ Public declarations }
end;
var
DelphiService:
TDelphiService;
FrmMain:
TFrmMain;
implementation
{$R *.DFM}
procedure ServiceController(CtrlCode:
DWord); stdcall;
begin
(CtrlCode);
end;
function :
TServiceController;
begin
Result :
= ServiceController;
end;
procedure (Sender:
TService;
var Continued:
Boolean);
begin
while not Terminated do
begin
Sleep(10);
(False);
end;
end;
procedure (Sender:
TService);
begin
while not Terminated do
begin
Sleep(10);
(False);
end;
end;
procedure (Sender:
TService;
var Paused:
Boolean);
begin
Paused :
= True;
end;
procedure (Sender:
TService);
begin
gbCanClose :
= true;
;
Status :
= csStopped;
ReportStatus();
end;
procedure (Sender:
TService;
var Started:
Boolean);
begin
Started :
= True;
FrmMain);
gbCanClose :
= False;
;
end;
procedure (Sender:
TService;
var Stopped:
Boolean);
begin
Stopped :
= True;
gbCanClose :
= True;
;
end;
end.
主窗口单元如下:
unit Unit_FrmMain;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, ShellApi, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls;
const
WM_TrayIcon = WM_USER + 1234;
type
TFrmMain = class(TForm)
Timer1:
TTimer;
Button1:
TButton;
procedure FormCreate(Sender:
TObject);
procedure FormCloseQuery(Sender:
TObject; var CanClose:
Boolean);
procedure FormDestroy(Sender:
TObject);
procedure Timer1Timer(Sender:
TObject);
procedure Button1Click(Sender:
TObject);
private
{ Private declarations }
IconData:
TNotifyIconData;
procedure AddIconToTray;
procedure DelIconFromTray;
procedure TrayIconMessage(var Msg:
TMessage); message WM_TrayIcon;
procedure SysButtonMsg(var Msg:
TMessage); message WM_SYSCOMMAND;
public
{ Public declarations }
end;
var
FrmMain:
TFrmMain;
gbCanClose:
Boolean;
implementation
{$R *.dfm}
procedure (Sender:
TObject);
begin
FormStyle :
= fsStayOnTop;
SetWindowLong, GWL_EXSTYLE, WS_EX_TOOLWINDOW);
gbCanClose :
= False;
:
= 1000;
:
= True;
end;
procedure (Sender:
TObject; var CanClose:
Boolean);
begin
CanClose :
= gbCanClose;
if not CanClose then
begin
Hide;
end;
end;
procedure (Sender:
TObject);
begin
:
= False;
DelIconFromTray;
end;
procedure ;
begin
ZeroMemory(@IconData, SizeOf(TNotifyIconData));
:
= SizeOf(TNotifyIconData);
:
= Handle;
:
= 1;
:
= NIF_MESSAGE or NIF_ICON or NIF_TIP;
:
= WM_TrayIcon;
:
= :
= Delphi服务演示程序;
Shell_NotifyIcon(NIM_ADD, @IconData);
end;
procedure ;
begin
Shell_NotifyIcon(NIM_DELETE, @IconData);
end;
procedure (var Msg:
TMessage);
begin
if = SC_CLOSE) or
= SC_MINIMIZE) then Hide
else inherited; 补充:
(1)关于更多服务程序的演示程序,请访问以下Url上面包含了多个演示如何控制和管理系统服务的代码.
(2)请切记:
Windows实际上存在多个桌面.例如屏幕传输会出现白屏,可能有两个原因:
一是系统处于锁定或未登陆桌面,二是处于屏幕保护桌面.这时候要将当前桌面切换到该桌面才能抓屏.
(3)关于服务程序与桌面交互,还有种动态切换方法.大概单元如下:
unit ServiceDesktop;
interface
function InitServiceDesktop:
boolean;
procedure DoneServiceDeskTop;
implementation
uses Windows, SysUtils;
const
DefaultWindowStation = WinSta0;
DefaultDesktop = Default;
var
hwinstaSave:
HWINSTA;
hdeskSave:
HDESK;
hwinstaUser:
HWINSTA;
hdeskUser:
HDESK;
function InitServiceDesktop:
boolean;
var
dwThreadId:
DWORD;
begin
dwThreadId :
= GetCurrentThreadID;
hwinstaSave :
= GetProcessWindowStation;
hdeskSave :
= GetThreadDesktop(dwThreadId);
hwinstaUser :
= OpenWindowStation(DefaultWindowStation, FALSE, MAXIMUM_ALLOWED);
if hwinstaUser = 0 then
begin
OutputDebugString(PChar(OpenWindowStation failed + SysErrorMessage(GetLastError)));
Result :
= false;
exit;
end;
if not SetProcessWindowStation(hwinstaUser) then
begin
OutputDebugString(SetProcessWindowStation failed);
Result :
= false;
exit;
end;
hdeskUser :
= OpenDesktop(DefaultDesktop, 0, FALSE, MAXIMUM_ALLOWED);
if hdeskUser = 0 then
begin
OutputDebugString(OpenDesktop failed);
SetProcessWindowStation(hwinstaSave);
CloseWindowStation(hwinstaUser);
Result :
= false;
exit;
end;
Result :
= SetThreadDesktop(hdeskUser);
if not Result then
OutputDebugString(PChar(SetThreadDesktop + SysErrorMessage(GetLastError)));
end;
procedure DoneServiceDeskTop;
begin
SetThreadDesktop(hdeskSave);
SetProcessWindowStation(hwinstaSave);
if hwinstaUser <> 0 then
CloseWindowStation(hwinstaUser);
if hdeskUser <> 0 then
CloseDesktop(hdeskUser);
end;
initialization
InitSer
- 配套讲稿:
如PPT文件的首页显示word图标,表示该PPT已包含配套word讲稿。双击word图标可打开word文档。
- 特殊限制:
部分文档作品中含有的国旗、国徽等图片,仅作为作品整体效果示例展示,禁止商用。设计者仅对作品中独创性部分享有著作权。
- 关 键 词:
- Delphi 编写 Windows 服务 程序