转帖:DELPHI编写服务程序总结一--编写技巧

Bear_hx 2009-10-12 02:37:04
原文地址:http://hi.baidu.com/sqldebug/blog/item/8e2749213082c0589922ed61.html

直接贴过来的,有点乱,大家凑合看。

一、服务程序和桌面程序的区别

Windows 2000/XP/2003等支持一种叫做“系统服务程序”的进程,系统服务和桌面程序的区别是:
系统服务不用登陆系统即可运行;系统服务是运行在System Idle Process/System/smss/winlogon/services下的,而桌面程序是运行在Explorer下的;系统服务拥有更高的权限,系统服务拥有Sytem的权限,而桌面程序只有Administrator权限;在Delphi中系统服务是对桌面程序进行了再一次的封装,既系统服务继承于桌面程序。因而拥有桌面程序所拥有的特性;系统服务对桌面程序的DoHandleException做了改进,会自动把异常信息写到NT服务日志中;普通应用程序启动只有一个线程,而服务启动至少含有三个线程。(服务含有三个线程:TServiceStartThread服务启动线程;TServiceThread服务运行线程;Application主线程,负责消息循环);
摘录代码:
procedure TServiceApplication.Run;
begin
.
.
.
StartThread := TServiceStartThread.Create(ServiceStartTable);
try
while not Forms.Application.Terminated do
Forms.Application.HandleMessage;
Forms.Application.Terminate;
if StartThread.ReturnValue <> 0 then
FEventLogger.LogMessage(SysErrorMessage(StartThread.ReturnValue));
finally
StartThread.Free;
end;
.
.
.
end;

procedure TService.DoStart;
begin
try
Status := csStartPending;
try
FServiceThread := TServiceThread.Create(Self);
FServiceThread.Resume;
FServiceThread.WaitFor;
FreeAndNil(FServiceThread);
finally
Status := csStopped;
end;
except
on E: Exception do
LogMessage(Format(SServiceFailed,[SExecute, E.Message]));
end;
end;
在系统服务中也可以使用TTimer这些需要消息的定时器,因为系统服务在后台使用TApplication在分发消息;

二、如何编写一个系统服务

打开Delphi编辑器,选择菜单中的File|New|Other...,在New Item中选择Service Application项,Delphi便自动为你建立一个基于TServiceApplication的新工程,TserviceApplication是一个封装NT服务程序的类,它包含一个TService1对象以及服务程序的装卸、注册、取消方法。
TService属性介绍:
AllowPause:是否允许暂停;
AllowStop:是否允许停止;
Dependencies:启动服务时所依赖的服务,如果依赖服务不存在则不能启动服务,而且启动本服务的时候会自动启动依赖服务;
DisplayName:服务显示名称;
ErrorSeverity:错误严重程度;
Interactive:是否允许和桌面交互;
LoadGroup:加载组;
Name:服务名称;
Password:服务密码;
ServiceStartName:服务启动名称;
ServiceType:服务类型;
StartType:启动类型;
事件介绍:
AfterInstall:安装服务之后调用的方法;
AfterUninstall:服务卸载之后调用的方法;
BeforeInstall:服务安装之前调用的方法;
BeforeUninstall:服务卸载之前调用的方法;
OnContinue:服务暂停继续调用的方法;
OnExecute:执行服务开始调用的方法;
OnPause:暂停服务调用的方法;
OnShutDown:关闭时调用的方法;
OnStart:启动服务调用的方法;
OnStop:停止服务调用的方法;

三、编写一个两栖服务

采用下面的方法,可以实现一个两栖系统服务(既系统服务和桌面程序的两种模式)
工程代码:
program FleetReportSvr;

uses
SvcMgr,
Forms,
SysUtils,
Windows,
SvrMain in 'SvrMain.pas' {FleetReportService: TService},
AppMain in 'AppMain.pas' {FmFleetReport};

{$R *.RES}

const
CSMutexName = 'Global\Services_Application_Mutex';
var
OneInstanceMutex: THandle;
SecMem: SECURITY_ATTRIBUTES;
aSD: SECURITY_DESCRIPTOR;
begin
InitializeSecurityDescriptor(@aSD, SECURITY_DESCRIPTOR_REVISION);
SetSecurityDescriptorDacl(@aSD, True, nil, False);
SecMem.nLength := SizeOf(SECURITY_ATTRIBUTES);
SecMem.lpSecurityDescriptor := @aSD;
SecMem.bInheritHandle := False;
OneInstanceMutex := CreateMutex(@SecMem, False, CSMutexName);
if (GetLastError = ERROR_ALREADY_EXISTS)then
begin
DlgError('Error, Program or service already running!');
Exit;
end;
if FindCmdLineSwitch('svc', True) or
FindCmdLineSwitch('install', True) or
FindCmdLineSwitch('uninstall', True) then
begin
SvcMgr.Application.Initialize;
SvcMgr.Application.CreateForm(TSvSvrMain, SvSvrMain);
SvcMgr.Application.Run;
end
else
begin
Forms.Application.Initialize;
Forms.Application.CreateForm(TFmFmMain, FmMain);
Forms.Application.Run;
end;
end.
然后在SvrMain注册服务:
unit SvrMain;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, SvcMgr, Dialogs, MsgCenter;

type
TSvSvrMain = class(TService)
procedure ServiceStart(Sender: TService; var Started: Boolean);
procedure ServiceStop(Sender: TService; var Stopped: Boolean);
procedure ServiceBeforeInstall(Sender: TService);
procedure ServiceAfterInstall(Sender: TService);
private
{ Private declarations }
public
function GetServiceController: TServiceController; override;
{ Public declarations }
end;

var
SvSvrMain: TSvSvrMain;

implementation

const
CSRegServiceURL = 'SYSTEM\CurrentControlSet\Services\';
CSRegDescription = 'Description';
CSRegImagePath = 'ImagePath';
CSServiceDescription = 'Services Sample.';

{$R *.DFM}

procedure ServiceController(CtrlCode: DWord); stdcall;
begin
SvSvrMain.Controller(CtrlCode);
end;

function TSvSvrMain.GetServiceController: TServiceController;
begin
Result := ServiceController;
end;

procedure TSvSvrMain.ServiceStart(Sender: TService;
var Started: Boolean);
begin
Started := dmPublic.Start;
end;

procedure TSvSvrMain.ServiceStop(Sender: TService;
var Stopped: Boolean);
begin
Stopped := dmPublic.Stop;
end;

procedure TSvSvrMain.ServiceBeforeInstall(Sender: TService);
begin
RegValueDelete(HKEY_LOCAL_MACHINE, CSRegServiceURL + Name, CSRegDescription);
end;

procedure TSvSvrMain.ServiceAfterInstall(Sender: TService);
begin
RegWriteString(HKEY_LOCAL_MACHINE, CSRegServiceURL + Name, CSRegDescription,
CSServiceDescription);
RegWriteString(HKEY_LOCAL_MACHINE, CSRegServiceURL + Name, CSRegImagePath,
ParamStr(0) + ' -svc');
end;

end.
这样,双击程序,则以普通程序方式运行,若用服务管理器来运行,则作为服务运行。
例如公共模块:
dmPublic,提供Start,Stop方法。

在主窗体中,调用dmPublic.Start,dmPublic.Stop方法。
同样在Service中,调用dmPublic.Start,dmPublic.Stop方法。
...全文
867 22 打赏 收藏 转发到动态 举报
写回复
用AI写文章
22 条回复
切换为时间正序
请发表友善的回复…
发表回复
huozhouhftze 2010-10-22
  • 打赏
  • 举报
回复
楼主真好,正需要呢。
zhiwuyang602 2010-09-21
  • 打赏
  • 举报
回复
good
LIANGQIAN1984 2009-10-14
  • 打赏
  • 举报
回复
mark
kampan 2009-10-13
  • 打赏
  • 举报
回复
2楼的瘦子是传说中的如花?
ygluu 2009-10-13
  • 打赏
  • 举报
回复
mark
sparklerl 2009-10-13
  • 打赏
  • 举报
回复
[Quote=引用 11 楼 dahai9825 的回复:]
功德无量啊
[/Quote].
wsxcdx 2009-10-13
  • 打赏
  • 举报
回复
xx
fjtxwd 2009-10-13
  • 打赏
  • 举报
回复
收藏
Radar2006 2009-10-13
  • 打赏
  • 举报
回复
学习,mark
lvqiang 2009-10-12
  • 打赏
  • 举报
回复
看完了。不错
dahai9825 2009-10-12
  • 打赏
  • 举报
回复
功德无量啊
Bear_hx 2009-10-12
  • 打赏
  • 举报
回复
Service Application是系统在启动的时候帮你的加载的。
lhy 2009-10-12
  • 打赏
  • 举报
回复
明白了,Service Application是独立的。Service不是,而是窗体一级的东西。
gyk120 2009-10-12
  • 打赏
  • 举报
回复
连发了两贴?
Service Application应该可以做成一个EXE,好像也可以和桌面进行交互
lhy 2009-10-12
  • 打赏
  • 举报
回复
Service和Service Application有啥区别?
Harryfin 2009-10-12
  • 打赏
  • 举报
回复
学习
风之谷 2009-10-12
  • 打赏
  • 举报
回复
灰常棒~
de410 2009-10-12
  • 打赏
  • 举报
回复
学习了~~
bdmh 2009-10-12
  • 打赏
  • 举报
回复
真好
林石公 2009-10-12
  • 打赏
  • 举报
回复
接分都不好意思,嘿嘿
加载更多回复(1)

1,593

社区成员

发帖
与我相关
我的任务
社区描述
Delphi 网络通信/分布式开发
社区管理员
  • 网络通信/分布式开发社区
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧