如何用 Delphi 创建系统服务程序

在 delphi 的 IDE 里，点击主菜单 File ->New ->Other ->Service Application，就可以生成一个服务程序的框架：

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

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方法。

具体看这：网页链接

　自动化是从一个应用程序内部自动控制另一个应用程序的方法 例如下面的代码 procedure CreateNewWordvarWordObj: VariantbeginWordObj := CreateOleObject( Word Basic ){此函数声明于ComObj单元}WordObj AppShowWordObj FileNewend这段代码将会打开WORD 并自动建立一个新的文档(当然前提是你的机子上安装了WORD) 这看来很有趣 也是一种非常有用的功能 那么如何让我们的程序也拥有类似WORD等的自动化功能并能让其它任何语言开发的程序对我们的程序进行自动化呢?用DELPHI来实现非常简单

这篇文章将会以实例形式一步步的来说明如何开发一个简单的自动化服务器

新建一个普通的应用程序 将工程保存为AutoSrv bpr 在主窗体上放一个Edit控件 并保存为MainForm pas 在这里我们打算给这个程序加上对窗口标题 窗体颜色 和Edit控件文本的自动化控制(当然这实现的功能很少 但对于讲解如何开发自动化服务器程序足够了) 在主窗口中加入如下代码:(注意:请自行将这些函数和过程的声明加入TForm 的public区)function TForm GetCaption: stringbeginresult := Self Captionend

procedure TForm SetCaption(ACaption: string)beginSelf Caption := ACaptionend

procedure TForm SetColor(AColor: TColor)beginSelf Color := AColorend

procedure TForm SetEditText(AText: string)beginSelf Edit Text := ATextend然后我们来给这个程序加上自动化的功能 点击New Items按钮 在弹出的New Items窗口中点击ActiveX选项卡 选择Automation Object点击OK按钮 在弹出的Automation Object Wizard窗口中CoClass Name一项中输入MyAutoSrv Delphi就会自动生成一个AutoSrv_TLB pas文件(类库)和实现类库接口类的单元 将这个新的单元保存为AutoSrvClass pas．

现在这个程序已经成为一个自动化服务器了 我们再来为其加上自动化的接口函数:( )点击View >Type Libray菜单 在Type Library Editor选择IMyAutoSrv接口 点击New Property 选择其属性为Read|Write 并把其命名为Caption Type设定为BSTR ( )点击New Method 将其命名为SetColor 点击右边的Parameters选项卡 点击ADD为新添的接口函数添加一个参数 将参数名设为AColor 参数Type设为OLE_COLOR ( )再次点击New Method 将其命名为SetEditText 以上面的方法为其添加一个参数 将参数名设为AText 参数Type设为BSTR

最后添加上接口函数的实现代码就OK了:在AutoSrvClass pas的Uses部分添加上MainForm 并将其代码改为如下代码 unit AutoSrvClass

{$WARN SYMBOL_PLATFORM OFF}

interface

usesComObj ActiveX AutoSrv_TLB StdVcl MainForm

typeTMyAutoSrv = class(TAutoObject IMyAutoSrv)protectedfunction Get_Caption: WideStringsafecallprocedure Set_Caption(const Value: WideString)safecallprocedure SetColor(AColor: OLE_COLOR)safecallprocedure SetEditText(const AText: WideString)safecall

end

implementation

uses ComServ

function TMyAutoSrv Get_Caption: WideStringbeginResult := Form GetCaptionend

procedure TMyAutoSrv Set_Caption(const Value: WideString)beginForm SetCaption(Value)end

procedure TMyAutoSrv SetColor(AColor: OLE_COLOR)beginForm SetColor(AColor)end

procedure TMyAutoSrv SetEditText(const AText: WideString)beginForm SetEditText(AText)end

initializationTAutoObjectFactory Create(ComServer TMyAutoSrv Class_MyAutoSrv ciMultiInstance tmApartment)end 运行这个程序一次 将会自动注册为自动化服务器 可以在注册表中的HKEY_CLASSES_ROOT主键下面找到其相关的注册信息

上面演示了如何开发一个自动化服务器 在这里我们将调用它 新建一个程序 添加一个Button 在其VAR区声明一个Variant变量: AutoSrv: variant再在Button 中添加如下代码 procedure TForm Button Click(Sender: TObject)beginAutoSrv := CreateOleObject( AutoSrv MyAutoSrv ){这个字符串就是自动化服务器的工程名加上CoClass Name}Self Caption := AutoSrv CaptionAutoSrv Caption := HEHE AutoSrv SetColor(CLRed)AutoSrv SetEditText( HAHA )end其中的CreateOleObject函数将会返回一个IDispatch类型的接口 正是IDispatch接口让我们的程序可以对自动化服务器接口的调用进行后期连接 比如我们在上面添加一句AutoSrv Hello 程序也能被编释通过 但在执行时就会出错 使用Variant在执行效率上会比直接使用接口声明要慢一些 运行并点击按钮 可以看到自动化服务程序被加载 并按我们的代码设置了窗体色和EDIT 中的字串 呵呵 是不是很简单啊?

lishixinzhi/Article/program/Delphi/201311/24993

---