1、用 Delphi 编写 Windows 服务程序(1)一、Windows 服务简介服务程序（Service Application）是一种运行于 WinNT 的后台程序，每个服务程序（Service Application）中可能包含若干个服务（Service），每个服务就是其中的一个线程（该服务也可以创建多个子线程）。采用服务，应用程序可以获得特殊的权限，而且不会被用户通过Win2000 的任务管理器直接结束程序，所以服务常常用来实现一些特殊的目标。通过 Win2000 控制面板中的服务管理工具，我们可以设置/查看服务的特性：（1）服务名称；（2 ）显示名称；（3 ）描述；（4）启动类型；（
2、5）依赖关系；其中，服务名称是标识给服务的。以 Win2000 的 C:WINNTSystem32services.exe 程序为例子，该 Exe 文件对应一个 Service Application，是该服务程序的可见实体；该 exe 中包含多个服务（Service），例如 Alerter，Dhcp（DHCP Client），Messenger 等。当我们结束一个服务的时候，该服务所在的Service Application 中的其他服务并没有被终止。在 Delphi 中，Borland 的工程师为我们提供了 TServiceApplication，TService，TServiceThre
3、ad 等类，封装了大量细节，简化了服务程序的开发。二、TServiceApplication在 Delphi 中，类 TServiceApplication 就对应上述的 ServiceApplication。利用 Delphi 的开发环境，我们新建一个 Service Application Project，同时就创建了一个继承自 TService 的类。项目文件中的 Application 对象就是一个 TServiceApplication 实例。每个TServiceApplication 包含若干个 TService 对象，正好对应上述的服务程序和服务之间的数量关系。通过阅读 TSer
4、viceApplication 和 TService 类的定义，可以得知，TServiceApplication 从 TComponent 类继承而来，TService 从类TDataModule 基础而来，Application 对象负责各个 TService 对象的 Create 和 Destroy。跟踪下列代码Application.CreateForm(TService1, Service1);可以发现创建的 TService 对象的 Owner 都是 Application 对象；在 VCL FrameWork 中 Owner 总是负责 Destroy 各个 Component 对象
5、（VCL 的 TComponent 类采用了 Composite 模式），所以 TServiceApplication 也将 Destroy 各个 TService 对象。下面跟踪 TServiceApplication.Run 的代码，可以发现 TServiceApplication 首先解析运行参数，实现了服务的 Install 和 Uninstall。然后，初始化一个 ServiceStartTable 数组，该数组包含了各个 service 对象的服务名称和运行入口；最后创建一个 TServiceStartThread 对象，该对象是一个线程对象，从线程调用 API：StartServ
6、iceCtrlDispatcher 来启动 ServiceStartTable 中指定的若干个服务；而ServiceApplication 主线程就不断循环，处理消息，比如接收请求来停止/暂停某个服务。三、TServiceTService 类继承自类 TDataModule，这意味着我们可以加入大量的 VCL 控件，实现丰富的功能。此外，我们还可以处理OnStart，OnPause， OnStop，OnContinue，OnCreate ，OnShutDown 等事件。其中需要说明的是：OnStop 表示该服务被停止；而OnShutDown 表示该 ServiceApplication 停止运
7、行，这意味着其他服务也被终止了；两者含义是不一样的。前面讲过，ServiceApplication 通过调用 StartServiceCtrlDispatcher 来启动各个服务。StartServiceCtrlDispatcher 启动 TService 的入口，该入库就是 TService.Main。TService.Main 首先注册该服务，然后调用 TService.DoStart。TService.DoStart 创建一个内部TServiceThread 成员对象，这是一个线程对象；考察 TServiceThread.Execute 可以得知，当我们处理的 TService1. On
8、Execute，那么TService 会把所有的请求委托给该 TServiceThread 成员对象处理，该对象以默认的方式处理所有的请求。TService. ServiceExecute 是 TService 的主体内容。一个服务要正常运行，除了需要处理它要关注的目标（比如监听某个端口、执行某个任务等）外，还要响应外部命令/请求：比如终止、暂停、恢复该服务。因此可以考虑创建一个专门的线程来完成该任务，而在 ServiceExecute中处理外面命令/请求。因此代码如下：while not Terminated do beginServiceThread.ProcessRequests(Fal
9、se);end;当然，也可以在 OnExecute 中处理某些任务，如监听某个端口，但是这常常会导致该 Service 不能及时响应 Stop/Pause 等请求。当OnExecute 执行完了，该服务实际上就完成了任务要结束了（terminate）。用 Delphi 编写 Windows 服务程序(2)Windows 的服务是一个比较实用的功能，你的程序可以在 Windows 未进行登录的时候就开始运行，不受用户注销的影响，也不容易被用户误关闭。但是编写服务也许不是一件容易的事情，幸好 Delphi 给我们提供了一个模板，可以很容易的编写一个标准的 Windows 服务程序。首先，在 Del
10、phi 内新建一个 Service Application。此时，Delphi 已经给我们建好了一个 Service 程序的框架，我们只需要把我们的代码加到合适的位置就行了。一般情况下，Service 内需要一个线程来不断的工作，也许定时器也可以，但线程工作起来更好。Delphi 会生成一个可视化的 Service 容器，你可以一些必要的控件在它上面，但是由于它是服务程序，是没有界面显示的，因此不建议在上面安放 Edit 之类的控件，服务只是应该做处理工作的，显示界面应该由其它的程序来完成。Service 控件的 DisplayName 属性是显示在管理工具- 服务的左边的名称的内容，而 Na
11、me 属性则是服务名称，当你用命令提示符来启动、停止服务时，就需要用到。在事件 OnStart 内，我们应该完成启动线程的工作。如：procedure TS2HConv.ServiceStart(Sender: TService;var Started: Boolean);var Reg:TRegistry;LogFileName,LogPath:String;slTemp:TStringList;beginCoInitialize(nil);Reg:=TRegistry.Create;Reg.RootKey:=HKEY_LOCAL_MACHINE;Reg.OpenKey(SoftWareBH
12、omeEducation,True);LogPath:=Trim(Reg.ReadString(LogPath);SourceConnStr:=Trim(Reg.ReadString(SourceConnStr);if Trim(LogPath)= thenLogPath:=C:;Reg.CloseKey;Reg.Free;if RightStr(LogPath,1)NewOther-Service Application.将生成一个服务程序的框架.将工程保存为 ServiceDemo.dpr 和 Unit_Main.pas,然后回到主框架.我们注意到,Service 有几个属性.其中以下几个
13、是我们比较常用的:(1)DisplayName:服务的显示名称(2)Name:服务名称.我们在这里将 DisplayName 的值改为“Delphi 服务演示程序 “,Name 改为“DelphiService“.编译这个项目,将得到 ServiceDemo.exe.这已经是一个服务程序了!进入CMD 模式 ,切换致工程所在目录 ,运行命令“ServiceDemo.exe /install“,将提示服务安装成功!然后“net start DelphiService“将启动这个服务.进入控制面版 管理工具服务,将显示这个服务和当前状态.不过这个服务现在什么也干不了,因为我们还没有写代码:)先“n
14、et stop DelphiService“停止再“ServiceDemo.exe /uninstall“删除这个服务.回到Delphi7 的 IDE.我们的计划是为这个服务添加一个主窗口,运行后任务栏显示程序的图标,双击图标将显示主窗口,上面有一个按钮,点击该按钮将实现 Ctrl+Alt+Del 功能.实际上,服务程序莫认是工作于 Winlogon 桌面的,可以打开控制面板,查看我们刚才那个服务的属性登陆,其中“允许服务与桌面交互 “是不打钩的.怎么办? 呵呵,回到 IDE,注意那个布尔属性:Interactive,当这个属性为 True 的时候,该服务程序就可以与桌面交互了.FileNew
15、Form 为服务添加窗口 FrmMain,单元保存为 Unit_FrmMain,并且把这个窗口设置为手工创建.完成后的代码如下:unit Unit_Main;interfaceusesWindows, Messages, SysUtils, Classes, Graphics, Controls, SvcMgr, Dialogs, Unit_FrmMain;typeTDelphiService = class(TService)procedure ServiceContinue(Sender: TService; var Continued: Boolean);procedure Servic
16、eExecute(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 publicfunctio
17、n GetServiceController: TServiceController; override; Public declarations end;varDelphiService: TDelphiService;FrmMain: TFrmMain;implementation$R *.DFMprocedure ServiceController(CtrlCode: DWord); stdcall;beginDelphiService.Controller(CtrlCode);end;function TDelphiService.GetServiceController: TServ
18、iceController;beginResult := ServiceController;end;procedure TDelphiService.ServiceContinue(Sender: TService;var Continued: Boolean);beginwhile not Terminated dobeginSleep(10);ServiceThread.ProcessRequests(False);end;end;procedure TDelphiService.ServiceExecute(Sender: TService);beginwhile not Termin
19、ated dobeginSleep(10);ServiceThread.ProcessRequests(False);end;end;procedure TDelphiService.ServicePause(Sender: TService;var Paused: Boolean);beginPaused := True;end;procedure TDelphiService.ServiceShutdown(Sender: TService);begingbCanClose := true;FrmMain.Free;Status := csStopped;ReportStatus();en
20、d;procedure TDelphiService.ServiceStart(Sender: TService;var Started: Boolean);beginStarted := True;Svcmgr.Application.CreateForm(TFrmMain, FrmMain);gbCanClose := False;FrmMain.Hide;end;procedure TDelphiService.ServiceStop(Sender: TService;var Stopped: Boolean);beginStopped := True;gbCanClose := Tru
21、e;FrmMain.Free;end;end.主窗口单元如下:unit Unit_FrmMain;interfaceusesWindows, Messages, SysUtils, Variants, Classes, ShellApi, Graphics, Controls,Forms,Dialogs, ExtCtrls, StdCtrls;constWM_TrayIcon = WM_USER + 1234;typeTFrmMain = class(TForm)Timer1: TTimer;Button1: TButton;procedure FormCreate(Sender: TObje
22、ct);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;procedur
23、e TrayIconMessage(var Msg: TMessage); message WM_TrayIcon;procedure SysButtonMsg(var Msg: TMessage); message WM_SYSCOMMAND;public Public declarations end;varFrmMain: TFrmMain;gbCanClose: Boolean;implementation$R *.dfmprocedure TFrmMain.FormCreate(Sender: TObject);beginFormStyle := fsStayOnTop;SetWin
24、dowLong(Application.Handle, GWL_EXSTYLE, WS_EX_TOOLWINDOW);gbCanClose := False;Timer1.Interval := 1000;Timer1.Enabled := True;end;procedure TFrmMain.FormCloseQuery(Sender: TObject; var CanClose: Boolean);beginCanClose := gbCanClose;if not CanClose thenbeginHide;end;end;procedure TFrmMain.FormDestroy
25、(Sender: TObject);beginTimer1.Enabled := False;DelIconFromTray;end;procedure TFrmMain.AddIconToTray;beginZeroMemory(IconData, SizeOf(TNotifyIconData);IconData.cbSize := SizeOf(TNotifyIconData);IconData.Wnd := Handle;IconData.uID := 1;IconData.uFlags := NIF_MESSAGE or NIF_ICON or NIF_TIP;IconData.uCa
26、llbackMessage := WM_TrayIcon;IconData.hIcon := Application.Icon.Handle;IconData.szTip := Delphi 服务演示程序;Shell_NotifyIcon(NIM_ADD, IconData);end;procedure TFrmMain.DelIconFromTray;beginShell_NotifyIcon(NIM_DELETE, IconData);end;procedure TFrmMain.SysButtonMsg(var Msg: TMessage);beginif (Msg.wParam = S
27、C_CLOSE) or(Msg.wParam = SC_MINIMIZE) then Hideelse inherited; / 执行默认动作end;procedure TFrmMain.TrayIconMessage(var Msg: TMessage);beginif (Msg.LParam = WM_LBUTTONDBLCLK) then Show();end;procedure TFrmMain.Timer1Timer(Sender: TObject);beginAddIconToTray;end;procedure SendHokKey;stdcall;varHDesk_WL: HDESK;beginHDesk_WL := OpenDesktop (Winlogon, 0, False, DESKTOP_JOURNALPLAYBACK);if (HDesk_WL 0 thenCloseWindowStation(hwinstaUser);if hdeskUser 0 thenCloseDesktop(hdeskUser);
