Question

我有一个在delphi中制作的旧Windows服务，现在必须在同一台服务器上多次安装，我正在尝试更改代码，以便我能够更改服务名称，因为我正在安装服务但是我不能使它发挥作用。

我找到了一些关于它的信息here和一些here，在研究了帖子并做了必要的修改之后，我能够安装两个不同名称的服务，但服务无法启动。

我发布负责控制以下服务的类（继承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;

我正在使用Delphi XE，并且该服务需要在Windows服务中运行。

提前致谢

Answer 1

由于服务不知道安装时收到的名称，因此您可以将该名称作为参数提供给它的ImagePath注册表值。

这里是多个实例的基本服务框架：

<?=
  GridView::widget([
    ...
    'columns' => [
       ...
        [
            'label' => 'Article count',
            'attribute' => 'articles',
            'value' => function ($model, $key, $index, $column) {
                return count($model->articles);

            },
        ],
        ...
    ],
  ])
?>

服务安装：

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.

服务移除：

<path1>\MyService.Exe /install /name "test1" /display "test instance1"
<path2>\MyService.Exe /install /name "test2" /display "test instance2"

Answer 2

这很简单。您只需为每项服务设置不同的名称。

你现在有：

名称：= ParamStr（2）;

DisplayName：= ParamStr（3）;

只需将其更改为：

名称：= baseServiceName +＆＃39; - ＆＃39; + GetLastDirName;

DisplayName：= baseServiceDisplayName +＆＃39; （＆＃39; + GetLastDirName +＆＃39;）＆＃39 ;;

其中 baseServiceName 是一个带有服务名称的常量; baseServiceDisplayName 是一个带有显示名称的常量， GetLastDirName 是一个从 ExtractFilePath（ParamStr（0））<返回目录名称（最后一个目录）的函数/ em>的

```

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 删除最后一个斜杠; StrLastPos 搜索斜杠的最后位置

Answer 3

@whosrdaddy建议的解决方案对我有用。

但是，eventviewer将记录的消息（MyService.LogMessage（...））显示为未定义或未安装。

如果名称和显示名称与设计时相同，则这些消息显示正常。在exetubale中链接的预定义消息类型很少作为资源。

使用Eventwiver，当发生任何预定义事件时，用户可以附加任何用户定义的操作。

Delphi

3 个答案: