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

(1)不用登陆进系统即可运行.

(2)具有SYSTEM特权.所以你在进程管理器里面是无法结束它的.

笔者在2003年为一公司开发机顶盒项目的时候,曾经写过课件上传和媒体服务,下面就介绍一下如何用Delphi7创建一个Service程序.

运行Delphi7,选择菜单File-->New-->Other--->Service Application.将生成一个服务程序的框架.将工程保存为ServiceDemo.dpr和Unit_Main.pas,然后回到主框架.我们注意到,Service有几个属性.其中以下几个是我们比较常用的:

(1)DisplayName:服务的显示名称

(2)Name:服务名称.

我们在这里将DisplayName的值改为"Delphi服务演示程序",Name改为"DelphiService".编译这个项目,将得到 ServiceDemo.exe.这已经是一个服务程序了!进入CMD模式,切换致工程所在目录,运行命令"ServiceDemo.exe /install",将提示服务安装成功!然后"net start DelphiService"将启动这个服务.进入控制面版-->管理工具-->服务,将显示这个服务和当前状态.不过这个服务现在什么也干不了,因为我们还没有写代码:)先"net stop DelphiService"停止再"ServiceDemo.exe /uninstall"删除这个服务.回到Delphi7的IDE.

我们的计划是为这个服务添加一个主窗口,运行后任务栏显示程序的图标,双击图标将显示主窗口,上面有一个按钮,点击该按钮将实现Ctrl+Alt+Del功能.

实际上,服务程序莫认是工作于Winlogon桌面的,可以打开控制面板,查看我们刚才那个服务的属性-->登陆,其中"允许服务与桌面交互 "是不打钩的.怎么办?呵呵,回到IDE,注意那个布尔属性:Interactive,当这个属性为True的时候,该服务程序就可以与桌面交互了.

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

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按钮 在d出的New Items窗口中点击ActiveX选项卡 选择Automation Object点击OK按钮 在d出的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

---