unit uROComboService;

{----------------------------------------------------------------------------}
{ RemObjects SDK Library - Core Library                                      }
{                                                                            }
{ compiler: Delphi 5 and up, Kylix 2 and up                                  }
{ platform: Win32, Linux                                                     }
{                                                                            }
{ (c)opyright RemObjects Software. all rights reserved.                      }
{                                                                            }
{ Using this code requires a valid license of the RemObjects SDK             }
{ which can be obtained at http://www.remobjects.com.                        }
{----------------------------------------------------------------------------}


interface

uses
  Classes, SvcMgr;

type
  TROService = class(TService)
  private
  protected
    procedure Start(Sender: TService; var Started: boolean);
    procedure Stop(Sender: TService; var Stopped: boolean);

    procedure Execute(Sender: TService);
  public
    function GetServiceController: TServiceController; override;

    constructor CreateNew(AOwner: TComponent; Dummy: integer = 0); override;

    procedure CreateForm(InstanceClass: TComponentClass; var Reference);
    procedure Run;
  published
  end;

function ROStartService(const aServiceName, aDisplayName: string; aDescription: string = '';
  aStartType: TStartType = stAuto; aDependency : string = ''; aServiceType: TServiceType = stWin32;
  aUserName: string = ''; aPassword: string = ''; aLoadGroup: string = '---'; aParameters: string = ''): Boolean;
function ROStartDependentService(const aServiceName, aDisplayName: string; aDependency : string = ''): Boolean;
function ROIsService: boolean;

var
  ROService: TROService;

implementation
uses
  Windows, SysUtils, WinSvc;

var
  FIsService: boolean;
  FServiceName: string;
  FDisplayName: string;
  FStartType: TStartType;
  FServiceType: TServiceType;
  FUserName: string;
  FPassword: string;
  FLoadGroup: string;
  FRegisterService: boolean = False;

type
  PServiceDescriptionA = ^TServiceDescriptionA;
  PServiceDescriptionW = ^TServiceDescriptionW;
  PServiceDescription = ^TServiceDescriptionA;
  _SERVICE_DESCRIPTIONA = record
    lpDescription: PChar;
  end;
  {$EXTERNALSYM _SERVICE_DESCRIPTIONA}
  _SERVICE_DESCRIPTIONW = record
    lpDescription: PWideChar;
  end;
  {$EXTERNALSYM _SERVICE_DESCRIPTIONW}
  _SERVICE_DESCRIPTION = _SERVICE_DESCRIPTIONA;
  {$EXTERNALSYM _SERVICE_DESCRIPTION}
  SERVICE_DESCRIPTIONA = _SERVICE_DESCRIPTIONA;
  {$EXTERNALSYM SERVICE_DESCRIPTIONA}
  SERVICE_DESCRIPTIONW = _SERVICE_DESCRIPTIONW;
  {$EXTERNALSYM SERVICE_DESCRIPTIONW}
  SERVICE_DESCRIPTION = _SERVICE_DESCRIPTIONA;
  {$EXTERNALSYM SERVICE_DESCRIPTION}
  TServiceDescriptionA = _SERVICE_DESCRIPTIONA;
  TServiceDescriptionW = _SERVICE_DESCRIPTIONW;
  TServiceDescription = TServiceDescriptionA;

  TChangeServiceConfig2 = function (hService: SC_HANDLE; dwInfoLevel: DWORD; lpInfo: Pointer): BOOL; stdcall;

const
  SERVICE_CONFIG_DESCRIPTION     = 1;
  {$EXTERNALSYM SERVICE_CONFIG_DESCRIPTION}
  SERVICE_CONFIG_FAILURE_ACTIONS = 2;
  {$EXTERNALSYM SERVICE_CONFIG_FAILURE_ACTIONS}

procedure ServiceController(CtrlCode: dword); stdcall;
begin
  ROService.Controller(CtrlCode);
end;

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

procedure TROService.CreateForm(InstanceClass: TComponentClass; var Reference);
begin
  SvcMgr.Application.CreateForm(InstanceClass, Reference);
end;

procedure TROService.Run;
begin
  SvcMgr.Application.Run;
end;

constructor TROService.CreateNew(AOwner: TComponent; Dummy: integer);
begin
  inherited;
  AllowPause := False;
  Interactive := True;
  DisplayName := FDisplayName;
  Name := FServiceName;
  OnStart := Start;
  OnStop := Stop;

  if FRegisterService then
  begin
    // New part
    StartType := FStartType;
    ServiceType := FServiceType;
    ServiceStartName := FUserName;
    Password := FPassword;
    LoadGroup := FLoadGroup;
  end;
end;

procedure TROService.Start(Sender: TService; var Started: boolean);
begin
  Started := True;
end;

procedure TROService.Execute(Sender: TService);
begin
  while not Terminated do
    ServiceThread.ProcessRequests(True);
end;

procedure TROService.Stop(Sender: TService; var Stopped: boolean);
begin
  Stopped := True;
end;

function ROIsService: boolean;
begin
  Result := FIsService;
end;

function ROStartService(const aServiceName, aDisplayName: string; aDescription: string = '';
  aStartType: TStartType = stAuto; aDependency : string = ''; aServiceType: TServiceType = stWin32;
  aUserName: string = ''; aPassword: string = ''; aLoadGroup: string = '---'; aParameters: string = ''): Boolean;
var
  Mgr, Svc: Integer;
  ServiceStartName: string;
  Config: Pointer;
  Size: DWord;
  lServiceDescr: TServiceDescription;
  lHandle: HMODULE;
  lChangeServiceConfig2: TChangeServiceConfig2;
begin
  FRegisterService := False;
  FDisplayName := aDisplayName;
  FServiceName := StringReplace(aServiceName, ' ', '_', [rfReplaceAll]);
  FStartType := aStartType;
  FServiceType := aServiceType;
  FUserName := aUserName;
  FPassword := aPassword;
  FLoadGroup := aLoadGroup;

  FIsService := FindCmdLineSwitch('install', ['-', '\', '/'], True) or
    FindCmdLineSwitch('uninstall', ['-', '\', '/'], True);

  if FIsService then
  begin
    FRegisterService := True;
    try
      SvcMgr.Application.Initialize;
      ROService := TROService.CreateNew(SvcMgr.Application, 0);

      (* Version 1.1, block added 29.10.2004 by Janne Timmerbacka *)
      if Length( aDependency ) > 0 then
        with RoService.Dependencies do
        begin
          Clear;
          with Add as TDependency do Name := aDependency;
        end;

      ROService.Run;
      FreeAndNil(ROService);
    finally
      FRegisterService := False;
    end;

    Mgr := OpenSCManager(nil, nil, SC_MANAGER_CONNECT);
    if Mgr <> 0 then
    begin
      Svc := OpenService(Mgr, PChar(FServiceName), SERVICE_QUERY_CONFIG OR SERVICE_CHANGE_CONFIG);
      if Svc<>0 then
      begin
        if Length(aParameters)>0 then begin
          if pos(' ', ParamStr(0))>0 then
            ServiceStartName := AnsiQuotedStr(AnsiDequotedStr(ParamStr(0),'"'),'"')
          else
            ServiceStartName := ParamStr(0);
          if ChangeServiceConfig(Svc,
            SERVICE_NO_CHANGE, SERVICE_NO_CHANGE,
            SERVICE_NO_CHANGE,
            PChar(ServiceStartName + ' ' + aParameters),
            nil, nil, nil, nil, nil, nil) = False then begin
            //  OutputDebugString(Pchar(SysErrorMessage(GetLastError)));
            end;
          end;
        lServiceDescr.lpDescription := PChar(aDescription);
        lHandle := GetModuleHandle(advapi32);
        if lHandle <> 0 then
        begin
          @lChangeServiceConfig2 := GetProcAddress(lHandle, 'ChangeServiceConfig2A');
          if Assigned(lChangeServiceConfig2) then
            lChangeServiceConfig2(Svc, SERVICE_CONFIG_DESCRIPTION, @lServiceDescr);
        end;
        CloseServiceHandle(Svc);
      end;
      CloseServiceHandle(Mgr);
    end;
    ExitProcess(0);

    Result := True;
    Exit;
  end;

  if FindCmdLineSwitch('standalone', ['-', '\', '/'], True) then
    FIsService := False
  else begin
    Mgr := OpenSCManager(nil, nil, SC_MANAGER_CONNECT);
    if Mgr <> 0 then
    begin
      Svc := OpenService(Mgr, PChar(FServiceName), SERVICE_QUERY_CONFIG);
      FIsService := Svc <> 0;
      if FIsService then
      begin
        QueryServiceConfig(Svc, nil, 0, Size);
        Config := AllocMem(Size);
        try
          QueryServiceConfig(Svc, Config, Size, Size);
          ServiceStartName := PQueryServiceConfig(Config)^.lpServiceStartName;
          if CompareText(ServiceStartName, 'LocalSystem') = 0 then
            ServiceStartName := 'SYSTEM';
        finally
          Dispose(Config);
        end;
        CloseServiceHandle(Svc);
      end;
      CloseServiceHandle(Mgr);
    end;
  end;
(*
  if FIsService then
  begin
    Size := 256;
    SetLength(UserName, Size);
    GetUserName(PChar(UserName), Size);
    SetLength(UserName, StrLen(PChar(UserName)));
    n := Pos('\', ServiceStartName);
    if (n <> -1) then
      ServiceStartName := Trim(Copy(ServiceStartName, n + 1, maxInt));
    FIsService := CompareText(UserName, ServiceStartName) = 0;
  end;
*)
  Result := FIsService;

  if FIsService then
  begin
    SvcMgr.Application.Initialize;
    ROService := TROService.CreateNew(SvcMgr.Application, 0);
  end;
end;

function ROStartDependentService(const aServiceName, aDisplayName: string; aDependency : string = ''): Boolean;
begin
  Result := ROStartService(aServiceName, aDisplayName, '', stAuto,
  aDependency);
end;


end.