uServiceController.pas

// Copyright (c) 2016, Jordi Corbilla
// All rights reserved.
//
// Redistribution and use in source and binary forms, with or without
// modification, are permitted provided that the following conditions are met:
//
// - Redistributions of source code must retain the above copyright notice,
// this list of conditions and the following disclaimer.
// - Redistributions in binary form must reproduce the above copyright notice,
// this list of conditions and the following disclaimer in the documentation
// and/or other materials provided with the distribution.
// - Neither the name of this library nor the names of its contributors may be
// used to endorse or promote products derived from this software without
// specific prior written permission.
//
// THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
// AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
// IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
// ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE
// LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
// CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
// SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
// INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
// CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
// ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
// POSSIBILITY OF SUCH DAMAGE.

unit uService;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, SvcMgr, Dialogs, WinSvc;

type
  TServiceExample = class(TService)
    procedure ServiceCreate(Sender: TObject);
    procedure ServiceBeforeUninstall(Sender: TService);
    procedure ServiceAfterInstall(Sender: TService);
  private
    FDescription: String;
    FPreviousName: String;
    FPreviusDisplayName: string;
  public
    function GetServiceController: TServiceController; override;
    { Public declarations }
  end;

type
  SERVICE_DESCRIPTION = packed record
    lpDescription: PChar;
  end;

  PSERVICE_DESCRIPTION = ^SERVICE_DESCRIPTION;

var
  ServiceExample: TServiceExample;

const
  SERVICE_CONFIG_DESCRIPTION = 1;

function ChangeServiceConfig2(hService: SC_HANDLE; dwInfoLevel: DWORD; lpInfo: Pointer): BOOL; stdcall; external 'advapi32.dll' name 'ChangeServiceConfig2W';

implementation

uses
  ComObj;
{$R *.DFM}

procedure ServiceController(CtrlCode: DWORD); stdcall;
begin
  ServiceExample.Controller(CtrlCode);
end;

function TServiceExample.GetServiceController: TServiceController;
begin
  Result := ServiceController;
end;

procedure TServiceExample.ServiceAfterInstall(Sender: TService);
var
  SvcMgr, Svc: SC_HANDLE;
  desc: SERVICE_DESCRIPTION;
begin
  SvcMgr := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);
  if SvcMgr = 0 then
    Exit;
  try
    Svc := OpenService(SvcMgr, PChar(Name), SERVICE_ALL_ACCESS);
    if Svc = 0 then
      RaiseLastOSError;
    try
      desc.lpDescription := PWideChar(ParamStr(0) + ' ' + FDescription);
      ChangeServiceConfig( Svc, SERVICE_NO_CHANGE, SERVICE_NO_CHANGE,SERVICE_NO_CHANGE, desc.lpDescription, nil, nil, nil, nil, nil, nil);
      desc.lpDescription := PWideChar('Service Example with Params = ' + FDescription);
      ChangeServiceConfig2(Svc, SERVICE_CONFIG_DESCRIPTION, @desc.lpDescription);
    finally
      CloseServiceHandle(Svc);
    end;
  finally
    CloseServiceHandle(SvcMgr);
  end;
end;

procedure TServiceExample.ServiceBeforeUninstall(Sender: TService);
begin
  Name := FPreviousName + FDescription;
  DisplayName := FPreviusDisplayName + FDescription;
end;

procedure TServiceExample.ServiceCreate(Sender: TObject);
begin
  FDescription := System.ParamStr(2);
  FPreviousName := Name;
  FPreviusDisplayName := DisplayName;
  Name := Name + FDescription;
  DisplayName := DisplayName + FDescription;
end;

end.