{*******************************************************}
{                                                       }
{       Tocsg.Service                                   }
{                                                       }
{       Copyright (C) 2022 kkuzil                       }
{                                                       }
{*******************************************************}

unit Tocsg.Service;

interface

uses
  System.SysUtils, Winapi.Messages, Winapi.Windows, Winapi.WinSvc;

type
  TInstallServiceDll = procedure(bSilent: BOOL; dwSvcType, dwSvcStart: DWORD); stdcall;
  TUninstallServiceDll = procedure(bSilent: BOOL); stdcall;

function InstallService(const sSvcName, sBinaryPath, sDisplayName: String;
                        dwServiceType, nStartMode: Integer): Boolean;
function UninstallService(const sSvcName: String): Boolean;

function InstallServiceDll(const sDllPath: String; dwSvcType, dwSvcStart: DWORD): Boolean;
function UninstallServiceDll(const sDllPath: String): Boolean;

function ServiceExists(const sSvcName: String): Boolean;

function SetServiceStartType(const sSvcName: String; dwMode: DWORD): Boolean;
function SetServiceState(const sSvcName: String; dwStatus: DWORD): Boolean;

function GetServiceStatus(const sSvcName: String): DWORD;

function ServiceStart(const sSvcName: String; dwDesiredAccess: DWORD = SERVICE_ALL_ACCESS): Boolean;
function ServiceStop(const sSvcName: String; nTmSec: Integer = 0): Boolean;
function ServicePause(const sSvcName: String): Boolean;
function ServiceContinue(const sSvcName: String): Boolean;
function GetServicePid(sSvcName: String): DWORD;

procedure SetVisibleService(sSvcName: String; bVisible: Boolean);


implementation

uses
  Tocsg.Registry, Tocsg.Shell, Tocsg.Trace, Tocsg.Exception;

function InstallService(const sSvcName, sBinaryPath, sDisplayName: String;
                        dwServiceType, nStartMode: Integer): Boolean;
var
  hScm,
  hSvc: SC_HANDLE;
begin
  Result := false;

  hScm := OpenSCManager(nil, SERVICES_ACTIVE_DATABASE, SC_MANAGER_ALL_ACCESS);
  if hScm <> 0 then
  begin
    hSvc := OpenService(hScm, PChar(sSvcName), SERVICE_ALL_ACCESS);
    if (hSvc = 0) and (GetLastError = ERROR_SERVICE_DOES_NOT_EXIST) then
    begin
			hSvc := CreateService(hScm,
                            PChar(sSvcName),
                            PChar(sDisplayName),
                            SERVICE_ALL_ACCESS,
                            dwServiceType,
                            nStartMode,
                            SERVICE_ERROR_NORMAL,
                            PChar(sBinaryPath),
                            nil, nil, nil, nil, nil);

    end;

    Result := hSvc <> 0;

    if hSvc <> 0 then
      CloseServiceHandle(hSvc);

    CloseServiceHandle(hScm);
  end;
end;

function UninstallService(const sSvcName: String): Boolean;
var
  hScm,
  hSvc: SC_HANDLE;
begin
  Result := true;

  hScm := OpenSCManager(nil, SERVICES_ACTIVE_DATABASE, SC_MANAGER_ALL_ACCESS);
  if hScm <> 0 then
  begin
    hSvc := OpenService(hScm, PChar(sSvcName), SERVICE_ALL_ACCESS);
    if hSvc <> 0 then
    begin
      Result := DeleteService(hSvc);
      CloseServiceHandle(hSvc);
    end;
    CloseServiceHandle(hScm);
  end;
end;

function InstallServiceDll(const sDllPath: String; dwSvcType, dwSvcStart: DWORD): Boolean;
var
  h: THandle;
  fnInstSvc: TInstallServiceDll;
begin
  Result := false;
  if not FileExists(sDllPath) then
    exit;

  h := LoadLibrary(PChar(sDllPath));
  if h = 0 then
    exit;

  try
    try
      fnInstSvc := GetProcAddress(h, 'InstallServices_dll');
      if @fnInstSvc = nil then
        exit;

      fnInstSvc(true, dwSvcType, dwSvcStart);
    except
      on E: EOSError do
      begin
        Result := E.ErrorCode = 1073;
        exit;
      end;

      on E: Exception do
        exit;
    end;
    Result := true;
  finally
    FreeLibrary(h);
  end;
end;

function UninstallServiceDll(const sDllPath: String): Boolean;
var
  h: THandle;
  fnUninstSvc: TUninstallServiceDll;
  bRetry: Boolean;
  nReCnt: Integer;
Label
  LB_Retry;
begin
  Result := false;
  if not FileExists(sDllPath) then
    exit;

  h := LoadLibrary(PChar(sDllPath));
  if h = 0 then
    exit;

  try
    bRetry := false;
    nReCnt := 0;

    fnUninstSvc := GetProcAddress(h, 'UnInstallServices_dll');
    if @fnUninstSvc = nil then
      exit;
  LB_Retry :
    try
      fnUninstSvc(true);
    except
      on E: EOSError do
      begin
        if E.ErrorCode = 5 then
          bRetry := true
        else
          exit;
      end;

      on E: Exception do
        exit;
    end;

    if bRetry then
    begin
      Inc(nReCnt);
      if nReCnt > 5 then
        exit;
      Sleep(1000);
      goto LB_Retry;
    end;

    Result := true;
  finally
    FreeLibrary(h);
  end;
end;

function ServiceExists(const sSvcName: String): Boolean;
var
  hScm,
  hSvc: SC_HANDLE;
begin
  Result := false;

  hScm := OpenSCManager(nil, SERVICES_ACTIVE_DATABASE, SC_MANAGER_ALL_ACCESS);
  if hScm <> 0 then
  begin
    hSvc := OpenService(hScm, PChar(sSvcName), SERVICE_ALL_ACCESS);
    if hSvc <> 0 then
    begin
      Result := true;
      CloseServiceHandle(hSvc);
    end;
    CloseServiceHandle(hScm);
  end;
end;

function SetServiceStartType(const sSvcName: String; dwMode: DWORD): Boolean;
const
  REG_SERVICE_KEY = 'SYSTEM\CurrentControlSet\Services\';
begin
  Result := false;
  if not ServiceExists(sSvcName) then
    exit;

  Result := SetRegValueInteger(HKEY_LOCAL_MACHINE,
                               REG_SERVICE_KEY + sSvcName,
                               'Start',
                               dwMode);
end;

function SetServiceState(const sSvcName: String; dwStatus: DWORD): Boolean;
var
  hScm,
  hSvc: SC_HANDLE;
  st: SERVICE_STATUS;
begin
  Result := false;

  hScm := OpenSCManager(nil, nil, SC_MANAGER_CONNECT);
  if hScm <> 0 then
  begin
    hSvc := OpenService(hScm, PChar(sSvcName), SERVICE_ALL_ACCESS);
    if hSvc <> 0 then
    begin
      ZeroMemory(@st, sizeof(st));
      Result := ControlService(hSvc, dwStatus, st);
      CloseServiceHandle(hSvc);
    end;
    CloseServiceHandle(hScm);
  end;
end;

function GetServiceStatus(const sSvcName: String): DWORD;
var
  hScm, hSvc : SC_HANDLE;
  st         : SERVICE_STATUS;
begin
  Result := 0;

  hScm := OpenSCManager(nil, SERVICES_ACTIVE_DATABASE, SC_MANAGER_ALL_ACCESS);

  if hScm <> 0 then
  begin
    hSvc := OpenService(hScm, PChar(sSvcName), SERVICE_ALL_ACCESS);
    if hSvc <> 0 then
    begin
      ZeroMemory(@st, sizeof(SERVICE_STATUS));
      if QueryServiceStatus(hSvc, st) then
      begin
        Result := st.dwCurrentState;

        (*
          >>>>>>> dwCurrentState
          {$EXTERNALSYM SERVICE_STOPPED}
          SERVICE_STOPPED                = $00000001;
          {$EXTERNALSYM SERVICE_START_PENDING}
          SERVICE_START_PENDING          = $00000002;
          {$EXTERNALSYM SERVICE_STOP_PENDING}
          SERVICE_STOP_PENDING           = $00000003;
          {$EXTERNALSYM SERVICE_RUNNING}
          SERVICE_RUNNING                = $00000004;
          {$EXTERNALSYM SERVICE_CONTINUE_PENDING}
          SERVICE_CONTINUE_PENDING       = $00000005;
          {$EXTERNALSYM SERVICE_PAUSE_PENDING}
          SERVICE_PAUSE_PENDING          = $00000006;
          {$EXTERNALSYM SERVICE_PAUSED}
          SERVICE_PAUSED                 = $00000007;
        *)
      end;
      CloseServiceHandle(hSvc);
    end;
    CloseServiceHandle(hScm);
  end;
end;

function ServiceStart(const sSvcName: String; dwDesiredAccess: DWORD = SERVICE_ALL_ACCESS): Boolean;
var
  hScm,
  hSvc: SC_HANDLE;
  sServiceArg: PChar;
begin
  Result := false;

  sServiceArg := nil;

  hScm := OpenSCManager(nil, SERVICES_ACTIVE_DATABASE, SC_MANAGER_ALL_ACCESS);
  if hScm <> 0 then
  begin
    hSvc := OpenService(hScm, PChar(sSvcName), dwDesiredAccess);
    if hSvc <> 0 then
    begin
      Result := StartService(hSvc, 0, sServiceArg);
      CloseServiceHandle(hSvc);
    end;
    CloseServiceHandle(hScm);
  end;
end;

function ServiceStop(const sSvcName: String; nTmSec: Integer = 0): Boolean;
begin
  if nTmSec > 0 then
  begin
    var nTm: Integer := nTmSec * 2;
    Result := SetServiceState(sSvcName, SERVICE_CONTROL_STOP);
    while not Result do
    begin
      Dec(nTm);
      if nTm = 0 then
        exit;
      Sleep(500);
      Result := SetServiceState(sSvcName, SERVICE_CONTROL_STOP);
    end;
  end else
    Result := SetServiceState(sSvcName, SERVICE_CONTROL_STOP);
end;

function ServicePause(const sSvcName: String): Boolean;
begin
  Result := SetServiceState(sSvcName, SERVICE_CONTROL_PAUSE);
end;

function ServiceContinue(const sSvcName: String): Boolean;
begin
  Result := SetServiceState(sSvcName, SERVICE_CONTROL_CONTINUE);
end;

function GetServicePid(sSvcName: String): DWORD;
var
  hScm, hSvc: SC_HANDLE;
  SvcProcStatus: SERVICE_STATUS_PROCESS;
  dwBufLen,
  dwNeedByte,
  dwInfoLevel: DWORD;
begin
  Result := 0;

  try
    hScm := OpenSCManager(nil, nil, SC_MANAGER_CONNECT);
    if hScm <> 0 then
    begin
      hSvc := OpenService(hScm, PChar(sSvcName), SERVICE_QUERY_STATUS);
      try
        if hSvc <> 0 then
        begin
          dwInfoLevel := 0;
          dwNeedByte := 0;
          dwBufLen := SizeOf(SvcProcStatus);
          ZeroMemory(@SvcProcStatus, dwBufLen);

          if QueryServiceStatusEx(hSvc, SC_STATUS_TYPE(dwInfoLevel), @SvcProcStatus,
                  dwBufLen, dwNeedByte) then
          begin
            Result := SvcProcStatus.dwProcessId;
          end;
        end;
      finally
        if hSvc <> 0 then
          CloseServiceHandle(hSvc);
        CloseServiceHandle(hScm);
      end;
    end;
  except
    on E: Exception do
      ETgException.TraceException(E, 'Fail .. GetServicePid()');
  end;
end;

// 서비스를 숨기면 윈도우 메이저 업데이트 시 서비스가 사라지는 문제가 있음 24_0105 08:18:24 kku
procedure SetVisibleService(sSvcName: String; bVisible: Boolean);
const
  PARAM_SVC_VISIBLE_TRUE = 'sdset %s D:(A;;CCLCSWRPWPDTLOCRRC;;;SY)(A;;CCDCLCSWRPWPDTLOCRSDRCWDWO;;;BA)(A;;CCLCSWLOCRRC;;;IU)(A;;CCLCSWLOCRRC;;;SU)S:(AU;FA;CCDCLCSWRPWPDTLOCRSDRCWDWO;;;WD)';
  PARAM_SVC_VISIBLE_FALSE = 'sdset %s D:(D;;DCLCWPDTSD;;;IU)(D;;DCLCWPDTSD;;;SU)(D;;DCLCWPDTSD;;;BA)(A;;CCLCSWRPWPDTLOCRRC;;;SY)(A;;CCDCLCSWRPWPDTLOCRSDRCWDWO;;;BA)(A;;CCLCSWLOCRRC;;;IU)(A;;CCLCSWLOCRRC;;;SU)S:(AU;FA;CCDCLCSWRPWPDTLOCRSDRCWDWO;;;WD)';
var
  sParam: String;
begin
// 숨기면 OpenService()로도 찾을 수 없다. 20_0413 16:33:22 sunk
  if bVisible then
    sParam := Format(PARAM_SVC_VISIBLE_TRUE, [sSvcName])
  else
    sParam := Format(PARAM_SVC_VISIBLE_FALSE, [sSvcName]);

  ExecutePath_hide('sc.exe', sParam);
end;

end.