Delphi 开发 Windows Service 技巧

(试用环境 Delphi 6 + Windows 2000)

这几天用 Delphi 作一个 Windows 的 Service 模块，遇到不少问题。大体整理了一下，与大家分享。

1.创建一个 Windows Service 项目（以前写过服务程序的可以跳过了）
运行 Delphi 菜单 File -> New -> Other -> Service Application 得到一个新项目，保存。
修改 Service1 的 Name 属性为你希望创建的服务名称，如:"MyFirstService"。
修改 DisplayName ，这是显示在系统服务管理中的名称。

2.为“事件查看器”注册消息字符串
调用TService.LogMessage();时会发现，记录到“事件查看器”中的信息总是多一些不想要的东西：

事件 ID ( 1 )的描述(在资源( SMSService )中)无法找到。本地
计算机可能没有必要的注册信息或消息 DLL 文件来从远端计算
机显示消息。部分事件包含了下列信息: .

Windows利用注册在.exe.dll中资源段的信息来显示信息，但是 Borland 好像没有什么好的工具来
制作这种资源文件，所以还要用到 VC++ 中的工具 "MC.EXE"。方法如下：

在文本文件中编写如下信息并存为 McMsgs.mc

LanguageNames=(Chinese=0x0804:MSG00804)

MessageId=1
Language=Chinese
%1
.

MessageId=2
Language=Chinese
服务已成功启动。
.

MessageId=3
Language=Chinese
服务已停止。
.

MessageId=4
Language=Chinese
请使用合法软件！
.

MessageId=5
Language=Chinese
错误,系统返回如下信息:%1
.

执行命令行,得到 Delphi 可使用的资源文件 McMsgs.res
>mc McMsgs.mc
>brc32 -r -foMcMsgs.res -v -32 McMsgs.rc
然后在项目的单元中加入 {$R McMsgs.res} 就可以了。

3.增加自动填写注册表的相关信息

// .....
var
MyFirstService: TMyFirstService;

implementation

uses
Registry;

{$R *.DFM}
{$R McMsgs.res}

procedure TMyFirstService.ServiceAfterInstall(Sender: TService);
var
Reg: TRegistry;
begin
Reg := TRegistry.Create;
try
Reg.RootKey := HKEY_LOCAL_MACHINE;
// 注册服务说明信息,在系统的服务管理中显示
Reg.OpenKey('SYSTEM/CurrentControlSet/Services/[red]MyFirstService[/red]', True);
Reg.WriteString('Description', '对这个服务的说明信息');
Reg.CloseKey;
// 注册事件查看器消息,NT4下好像不用注册这些,
// 如果.res存在其他.dll中可修改ParamStr(0)为.dll的绝对路径和文件名
Reg.OpenKey(EventLogMsgFileKey, True);
Reg.WriteString('EventMessageFile', ParamStr(0));
Reg.WriteInteger('TypesSupported', 7);
Reg.CloseKey;
finally
Reg.Free;
end;
end;

procedure TMyFirstService.ServiceAfterUninstall(Sender: TService);
var
Reg: TRegistry;
begin
Reg := TRegistry.Create;
try
Reg.RootKey := HKEY_LOCAL_MACHINE;
Reg.DeleteKey(EventLogMsgFileKey);
finally
Reg.Free;
end;
end;

4.安装/卸载服务
在 Delphi 菜单的 Run->Parameters 中填写 /install 和 /uninstall 参数并运行

5.在服务中使用ADO等控件
使用 ADO 等控件时，系统会提示 “尚未调用 CoInitialize;” 的错误。
在服务中引用 ActiveX 单元,并调用一下就好了。

procedure TMyFirstService.ServiceStart(Sender: TService; var Started: Boolean);
begin
CoInitialize(nil);
if "启动初始化函数" then
LogMessage('', EVENTLOG_INFORMATION_TYPE, 0, 2);
end else begin
Started := False;
LogMessage('"错误原因"', EVENTLOG_ERROR_TYPE, 0, 5);
end;
end;

procedure TMyFirstService.ServiceStop(Sender: TService; var Stopped: Boolean);
begin
LogMessage('', EVENTLOG_INFORMATION_TYPE, 0, 3);
CoUninitialize;
end;

[完]