[英]Multiple instances of the same service in Delphi
I have have an old windows service made in delphi that now has to be installed multiple times in the same server, I am trying to change the code so I am able to change the service name as I am instaling the service but I cannot make it work. 我有一个旧的Windows服务在delphi中,现在必须在同一台服务器上多次安装,我正在尝试更改代码,以便我能够更改服务名称,因为我正在安装服务,但我不能使它工作。
I find some information here and some here about it, and after study the posts and make the necessary modifications I am able to install two services with different names, however the services does not start. 我找了一些资料在这里 ,有的在这里一下吧,学习后的职位,并进行必要的修改,我能够安装两个服务具有不同名称,但该服务不启动。
I post the class responsible to control the service below (inherited TService), I know is quite a bit of code but I would really appreciate any help. 我发布负责控制下面的服务的类(继承TService),我知道相当多的代码,但我真的很感激任何帮助。
procedure ServiceController(CtrlCode: DWord); stdcall;
begin
tvdAvalancheDataCenterService.Controller(CtrlCode);
end;
function TtvdAvalancheDataCenterService.GetServiceController: TServiceController;
begin
Result := ServiceController;
end;
procedure TtvdAvalancheDataCenterService.ServiceLoadInfo(Sender : TObject);
begin
Name := ParamStr(2);
DisplayName := ParamStr(3);
end;
procedure TtvdAvalancheDataCenterService.ServiceBeforeInstall(Sender: TService);
begin
ServiceLoadInfo(Self);
end;
procedure TtvdAvalancheDataCenterService.ServiceCreate(Sender: TObject);
begin
ServiceLoadInfo(Self);
end;
procedure TtvdAvalancheDataCenterService.ServiceStart(Sender: TService;
var Started: Boolean);
begin
FtvdTrayIcon := TtvdEnvoyTrayIcon.Create(Self);
SetServiceDescription;
FtvdDataCenter.tvdActive := true;
end;
procedure TtvdAvalancheDataCenterService.ServiceStop(Sender: TService;
var Stopped: Boolean);
begin
FreeAndNil(FtvdTrayIcon);
FtvdDataCenter.tvdActive := False;
end;
procedure TtvdAvalancheDataCenterService.ServiceAfterInstall(Sender: TService);
begin
SetServiceDescription;
end;
procedure TtvdAvalancheDataCenterService.SetServiceDescription;
var
aReg: TRegistry;
begin
if FDescriptionUpdated then
Exit;
aReg := TRegistry.Create(KEY_READ or KEY_WRITE);
try
aReg.RootKey := HKEY_LOCAL_MACHINE;
if aReg.OpenKey(cnRegKey+ Name, true) then
begin
aReg.WriteString('Description', cnServiceDescription);
aReg.CloseKey;
end;
FDescriptionUpdated:= True;
finally
aReg.Free;
end;
end;
I am using Delphi XE and the service need to run in windows services. 我正在使用Delphi XE,并且该服务需要在Windows服务中运行。
Thanks in advance 提前致谢
Since the service does not know what name it has received on installation, you can supply that name as a parameter into it's ImagePath registry value. 由于服务不知道安装时收到的名称,因此您可以将该名称作为参数提供给它的ImagePath注册表值。
here's a basic service skeleton for multiple instances: 这是多个实例的基本服务框架:
unit u_svc_main;
interface
uses
Winapi.Windows,
System.Win.Registry,
System.SysUtils,
System.Classes,
Vcl.Dialogs,
Vcl.SvcMgr;
type
TSvc_test = class(TService)
procedure ServiceAfterInstall(Sender: TService);
procedure ServiceBeforeInstall(Sender: TService);
procedure ServiceCreate(Sender: TObject);
procedure ServiceBeforeUninstall(Sender: TService);
private
{ Private declarations }
procedure GetServiceName;
procedure GetServiceDisplayName;
public
function GetServiceController: TServiceController; override;
{ Public declarations }
end;
var
Svc_test: TSvc_test;
implementation
{$R *.dfm}
procedure TSvc_test.GetServiceDisplayName;
var
ServiceDisplayName : String;
begin
if not FindCmdLineSwitch('display', ServiceDisplayName) then
raise Exception.Create('Please specify the service displayname with /display switch');
DisplayName := ServiceDisplayName;
end;
procedure TSvc_test.GetServiceName;
var
ServiceName : String;
begin
if not FindCmdLineSwitch('name', ServiceName) then
raise Exception.Create('Please specify the service name with /name switch');
Name := ServiceName;
end;
procedure ServiceController(CtrlCode: DWord); stdcall;
begin
Svc_test.Controller(CtrlCode);
end;
function TSvc_test.GetServiceController: TServiceController;
begin
Result := ServiceController;
end;
procedure TSvc_test.ServiceAfterInstall(Sender: TService);
var
Reg : TRegistry;
ImagePath : String;
begin
Reg := TRegistry.Create(KEY_READ OR KEY_WRITE);
try
Reg.RootKey := HKEY_LOCAL_MACHINE;
if Reg.OpenKey('SYSTEM\CurrentControlSet\Services\'+Name, False) then
begin
// set service description
Reg.WriteString('Description', 'Multi instance test for service '+Name);
// add name parameter to ImagePath value
ImagePath := ParamStr(0) + ' /name '+Name;
Reg.WriteString('ImagePath', ImagePath);
Reg.CloseKey;
end;
finally
Reg.Free;
end;
end;
procedure TSvc_test.ServiceBeforeInstall(Sender: TService);
begin
GetServiceName;
GetServiceDisplayName;
end;
procedure TSvc_test.ServiceBeforeUninstall(Sender: TService);
begin
GetServiceName;
end;
procedure TSvc_test.ServiceCreate(Sender: TObject);
begin
if not Application.Installing then
GetServiceName;
end;
end.
Service installation: 服务安装:
<path1>\MyService.Exe /install /name "test1" /display "test instance1"
<path2>\MyService.Exe /install /name "test2" /display "test instance2"
Service removal: 服务搬迁:
<path1>\MyService.Exe /uninstall /name "test1"
<path2>\MyService.Exe /uninstall /name "test2"
It's fairly simple. 这很简单。 You just have to set the name different for each service. 您只需为每个服务设置不同的名称。
You now have: 你现在有:
Name := ParamStr(2); 名称:= ParamStr(2);
DisplayName := ParamStr(3); DisplayName:= ParamStr(3);
and just have to change it to: 只需将其更改为:
Name := baseServiceName + '-' + GetLastDirName; 名称:= baseServiceName +' - '+ GetLastDirName;
DisplayName := baseServiceDisplayName + ' (' + GetLastDirName + ')'; DisplayName:= baseServiceDisplayName +'('+ GetLastDirName +')';
where baseServiceName is a constant with the name of the service; 其中baseServiceName是一个带有服务名称的常量; baseServiceDisplayName is a constant with the display name and GetLastDirName is a function that returns the name of a directory (last directory) from ExtractFilePath(ParamStr(0)) baseServiceDisplayName是一个带有显示名称的常量, GetLastDirName是一个从ExtractFilePath(ParamStr(0))返回目录名称(最后一个目录)的函数
``` ```
function GetLastDirName: string;
var
aux: string;
p: Integer;
begin
aux := strDelSlash(ExtractFilePath(ParamStr(0)));
p := StrLastPos('\', aux);
if p > 0 then
result := Copy(aux, p + 1, Length(aux))
else
result := aux;
end;
``` ```
strDelSlash deletes the last slash; strDelSlash删除最后一个斜杠; StrLastPos searches for the last position of the slash StrLastPos搜索斜杠的最后位置
The solution suggested by @whosrdaddy works for me. @whosrdaddy建议的解决方案适合我。
However the eventviewer displays logged messages (MyService.LogMessage(...)) as undefined or uninstalled. 但是,eventviewer将记录的消息(MyService.LogMessage(...))显示为未定义或未安装。
These messages displays fine if the name and the displayname are same as were at designtime. 如果名称和显示名称与设计时相同,则这些消息显示正常。 There are few predefined message types, linked in exetubale, as resources. 在exetubale中链接的预定义消息类型很少作为资源。
With Eventwiver the user can attach any user defined action, when any of predefined events occur. 使用Eventwiver,用户可以在发生任何预定义事件时附加任何用户定义的操作。
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.