jclsvcctrl.pas

East make Tray Icon in delphi

{**************************************************************************************************}
{                                                                                                  }
{ Project JEDI Code Library (JCL)                                                                  }
{                                                                                                  }
{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); }
{ you may not use this file except in compliance with the License. You may obtain a copy of the    }
{ License at http://www.mozilla.org/MPL/                                                           }
{                                                                                                  }
{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF   }
{ ANY KIND, either express or implied. See the License for the specific language governing rights  }
{ and limitations under the License.                                                               }
{                                                                                                  }
{ The Original Code is JclSvcCtrl.pas.                                                             }
{                                                                                                  }
{ The Initial Developer of the Original Code is Flier Lu (<flier_lu att yahoo dott com dott cn>).  }
{ Portions created by Flier Lu are Copyright (C) Flier Lu.  All Rights Reserved.                   }
{                                                                                                  }
{ Contributors:                                                                                    }
{   Flier Lu (flier)                                                                               }
{   Matthias Thoma (mthoma)                                                                        }
{   Olivier Sannier (obones)                                                                       }
{   Petr Vones (pvones)                                                                            }
{   Rik Barker (rikbarker)                                                                         }
{   Robert Rossmair (rrossmair)                                                                    }
{   Warren Postma                                                                                  }
{                                                                                                  }
{**************************************************************************************************}
{                                                                                                  }
{ This unit contains routines and classes to control NT service                                    }
{                                                                                                  }
{ Unit owner: Flier Lu                                                                             }
{                                                                                                  }
{**************************************************************************************************}

// Last modified: $Date: 2005/02/25 07:20:16 $
// For history see end of file

{$R+} { TODO : Why Rangecheck on here? }

unit JclSvcCtrl;

{$I jcl.inc}
{$I windowsonly.inc}

interface

uses
  Windows, Classes, SysUtils, Contnrs,
  {$IFDEF FPC}
  JwaWinNT, JwaWinSvc,
  {$ELSE}
  WinSvc,
  {$ENDIF FPC}
  JclBase, JclSysUtils;

// Service Types
type
  TJclServiceType =
   (stKernelDriver,        // SERVICE_KERNEL_DRIVER
    stFileSystemDriver,    // SERVICE_FILE_SYSTEM_DRIVER
    stAdapter,             // SERVICE_ADAPTER
    stRecognizerDriver,    // SERVICE_RECOGNIZER_DRIVER
    stWin32OwnProcess,     // SERVICE_WIN32_OWN_PROCESS
    stWin32ShareProcess,   // SERVICE_WIN32_SHARE_PROCESS
    stInteractiveProcess); // SERVICE_INTERACTIVE_PROCESS

  TJclServiceTypes = set of TJclServiceType;

const
  stDriverService = [stKernelDriver, stFileSystemDriver, stRecognizerDriver];
  stWin32Service = [stWin32OwnProcess, stWin32ShareProcess];
  stAllTypeService = stDriverService + stWin32Service + [stAdapter, stInteractiveProcess];

// Service State
type
  TJclServiceState =
   (ssUnknown,         // Just fill the value 0
    ssStopped,         // SERVICE_STOPPED
    ssStartPending,    // SERVICE_START_PENDING
    ssStopPending,     // SERVICE_STOP_PENDING
    ssRunning,         // SERVICE_RUNNING
    ssContinuePending, // SERVICE_CONTINUE_PENDING
    ssPausePending,    // SERVICE_PAUSE_PENDING
    ssPaused);         // SERVICE_PAUSED

  TJclServiceStates = set of TJclServiceState;

const
  ssPendingStates = [ssStartPending, ssStopPending, ssContinuePending, ssPausePending];

// Start Type
type
  TJclServiceStartType =
   (sstBoot,      // SERVICE_BOOT_START
    sstSystem,    // SERVICE_SYSTEM_START
    sstAuto,      // SERVICE_AUTO_START
    sstDemand,    // SERVICE_DEMAND_START
    sstDisabled); // SERVICE_DISABLED

// Error control type
type
  TJclServiceErrorControlType =
   (ectIgnore,    // SSERVICE_ERROR_IGNORE
    ectNormal,    // SSERVICE_ERROR_NORMAL
    ectSevere,    // SSERVICE_ERROR_SEVERE
    ectCritical); // SERVICE_ERROR_CRITICAL


// Controls Accepted
type
  TJclServiceControlAccepted =
   (caStop,          // SERVICE_ACCEPT_STOP
    caPauseContinue, // SERVICE_ACCEPT_PAUSE_CONTINUE
    caShutdown);     // SERVICE_ACCEPT_SHUTDOWN

  TJclServiceControlAccepteds = set of TJclServiceControlAccepted;

// Service sort type
type
  TJclServiceSortOrderType =
   (sotServiceName,
    sotDisplayName,
    sotDescription,
    sotFileName,
    sotServiceState,
    sotStartType,
    sotErrorControlType,
    sotLoadOrderGroup,
    sotWin32ExitCode);

const
  // Everyone in WinNT/2K or Authenticated users in WinXP
  EveryoneSCMDesiredAccess =
    SC_MANAGER_CONNECT or
    SC_MANAGER_ENUMERATE_SERVICE or
    SC_MANAGER_QUERY_LOCK_STATUS or
    STANDARD_RIGHTS_READ;

  LocalSystemSCMDesiredAccess =
    SC_MANAGER_CONNECT or
    SC_MANAGER_ENUMERATE_SERVICE or
    SC_MANAGER_MODIFY_BOOT_CONFIG or
    SC_MANAGER_QUERY_LOCK_STATUS or
    STANDARD_RIGHTS_READ;

  AdministratorsSCMDesiredAccess = SC_MANAGER_ALL_ACCESS;
  DefaultSCMDesiredAccess = EveryoneSCMDesiredAccess;
  DefaultSvcDesiredAccess = SERVICE_ALL_ACCESS;

// Service description
const
  SERVICE_CONFIG_DESCRIPTION     = 1;
  {$EXTERNALSYM SERVICE_CONFIG_DESCRIPTION}
  SERVICE_CONFIG_FAILURE_ACTIONS = 2;
  {$EXTERNALSYM SERVICE_CONFIG_FAILURE_ACTIONS}

type
  LPSERVICE_DESCRIPTIONA = ^SERVICE_DESCRIPTIONA;
  {$EXTERNALSYM LPSERVICE_DESCRIPTIONA}
  SERVICE_DESCRIPTIONA = record
    lpDescription: LPSTR;
  end;
  {$EXTERNALSYM SERVICE_DESCRIPTIONA}
  TServiceDescriptionA = SERVICE_DESCRIPTIONA;
  PServiceDescriptionA = LPSERVICE_DESCRIPTIONA;

type
  TQueryServiceConfig2A = function(hService: SC_HANDLE; dwInfoLevel: DWORD;
    lpBuffer: PByte; cbBufSize: DWORD; var pcbBytesNeeded: DWORD): BOOL; stdcall;

// Service related classes
type
  TJclServiceGroup = class;
  TJclSCManager = class;

  TJclNtService = class(TObject)
  private
    FSCManager: TJclSCManager;
    FHandle: SC_HANDLE;
    FDesiredAccess: DWORD;
    FServiceName: string;
    FDisplayName: string;
    FDescription: string;
    FFileName: TFileName;
    FDependentServices: TList;
    FDependentGroups: TList;
    FDependentByServices: TList;
    FServiceTypes: TJclServiceTypes;
    FServiceState: TJclServiceState;
    FStartType: TJclServiceStartType;
    FErrorControlType: TJclServiceErrorControlType;
    FWin32ExitCode: DWORD;
    FGroup: TJclServiceGroup;
    FControlsAccepted: TJclServiceControlAccepteds;
    FCommitNeeded:Boolean;
    function GetActive: Boolean;
    procedure SetActive(const Value: Boolean);
    function GetDependentService(const Idx: Integer): TJclNtService;
    function GetDependentServiceCount: Integer;
    function GetDependentGroup(const Idx: Integer): TJclServiceGroup;
    function GetDependentGroupCount: Integer;
    function GetDependentByService(const Idx: Integer): TJclNtService;
    function GetDependentByServiceCount: Integer;
  protected
    constructor Create(const ASCManager: TJclSCManager; const SvcStatus: TEnumServiceStatus);
    procedure Open(const ADesiredAccess: DWORD = DefaultSvcDesiredAccess);
    procedure Close;
    function GetServiceStatus: TServiceStatus;
    procedure UpdateDescription;
    procedure UpdateDependents;
    procedure UpdateStatus(const SvcStatus: TServiceStatus);
    procedure UpdateConfig(const SvcConfig: TQueryServiceConfig);
    procedure CommitConfig(var SvcConfig: TQueryServiceConfig);
    procedure SetStartType(AStartType: TJclServiceStartType);
  public
    destructor Destroy; override;
    procedure Refresh;
    procedure Commit;
    procedure Delete;
    function Controls(const ControlType: DWORD; const ADesiredAccess: DWORD = DefaultSvcDesiredAccess): TServiceStatus;
    procedure Start(const Args: array of string; const Sync: Boolean = True); overload;
    procedure Start(const Sync: Boolean = True); overload;
    procedure Stop(const Sync: Boolean = True);
    procedure Pause(const Sync: Boolean = True);
    procedure Continue(const Sync: Boolean = True);
    function WaitFor(const State: TJclServiceState; const TimeOut: DWORD = INFINITE): Boolean;
    property SCManager: TJclSCManager read FSCManager;
    property Active: Boolean read GetActive write SetActive;
    property Handle: SC_HANDLE read FHandle;
    property ServiceName: string read FServiceName;
    property DisplayName: string read FDisplayName;
    property DesiredAccess: DWORD read FDesiredAccess;
    property Description: string read FDescription; // Win2K or later
    property FileName: TFileName read FFileName;
    property DependentServices[const Idx: Integer]: TJclNtService read GetDependentService;
    property DependentServiceCount: Integer read GetDependentServiceCount;
    property DependentGroups[const Idx: Integer]: TJclServiceGroup read GetDependentGroup;
    property DependentGroupCount: Integer read GetDependentGroupCount;
    property DependentByServices[const Idx: Integer]: TJclNtService read GetDependentByService;
    property DependentByServiceCount: Integer read GetDependentByServiceCount;
    property ServiceTypes: TJclServiceTypes read FServiceTypes;
    property ServiceState: TJclServiceState read FServiceState;
    property StartType: TJclServiceStartType read FStartType write SetStartType;
    property ErrorControlType: TJclServiceErrorControlType read FErrorControlType;
    property Win32ExitCode: DWORD read FWin32ExitCode;
    property Group: TJclServiceGroup read FGroup;
    property ControlsAccepted: TJclServiceControlAccepteds read FControlsAccepted;
  end;

  TJclServiceGroup = class(TObject)
  private
    FSCManager: TJclSCManager;
    FName: string;
    FOrder: Integer;
    FServices: TList;
    function GetService(const Idx: Integer): TJclNtService;
    function GetServiceCount: Integer;
  protected
    constructor Create(const ASCManager: TJclSCManager; const AName: string; const AOrder: Integer);
    function Add(const AService: TJclNtService): Integer;
    function Remove(const AService: TJclNtService): Integer;
  public
    destructor Destroy; override;
    property SCManager: TJclSCManager read FSCManager;
    property Name: string read FName;
    property Order: Integer read FOrder;
    property Services[const Idx: Integer]: TJclNtService read GetService;
    property ServiceCount: Integer read GetServiceCount;
  end;

  TJclSCManager = class(TObject)
  private
    FMachineName: string;
    FDatabaseName: string;
    FDesiredAccess: DWORD;
    FHandle: SC_HANDLE;
    FLock: SC_LOCK;
    FServices: TObjectList;
    FGroups: TObjectList;
    FAdvApi32Handle: TModuleHandle;
    FQueryServiceConfig2A: TQueryServiceConfig2A;
    function GetActive: Boolean;
    procedure SetActive(const Value: Boolean);
    function GetService(const Idx: Integer): TJclNtService;
    function GetServiceCount: Integer;
    function GetGroup(const Idx: Integer): TJclServiceGroup;
    function GetGroupCount: Integer;
    procedure SetOrderAsc(const Value: Boolean);
    procedure SetOrderType(const Value: TJclServiceSortOrderType);
    function GetAdvApi32Handle: TModuleHandle;
    function GetQueryServiceConfig2A: TQueryServiceConfig2A;
  protected
    FOrderType: TJclServiceSortOrderType;
    FOrderAsc: Boolean;
    procedure Open;
    procedure Close;
    function AddService(const AService: TJclNtService): Integer;
    function AddGroup(const AGroup: TJclServiceGroup): Integer;
    function GetServiceLockStatus: PQueryServiceLockStatus;
    property AdvApi32Handle: TModuleHandle read GetAdvApi32Handle;
    property QueryServiceConfig2A: TQueryServiceConfig2A read GetQueryServiceConfig2A;
  public
    constructor Create(const AMachineName: string = '';
      const ADesiredAccess: DWORD = DefaultSCMDesiredAccess;
      const ADatabaseName: string = SERVICES_ACTIVE_DATABASE);
    destructor Destroy; override;
    procedure Clear;
    procedure Refresh(const RefreshAll: Boolean = False);
    function Install(const ServiceName, DisplayName, ImageName: string;
      const Description: string = '';
      ServiceTypes: TJclServiceTypes = [stWin32OwnProcess];
      StartType: TJclServiceStartType = sstDemand;
      ErrorControlType: TJclServiceErrorControlType = ectNormal;
      DesiredAccess: DWORD = DefaultSvcDesiredAccess;
      const LoadOrderGroup: TJclServiceGroup = nil; const Dependencies: PChar = nil;
      const Account: PChar = nil; const Password: PChar = nil): TJclNtService;
    procedure Sort(const AOrderType: TJclServiceSortOrderType; const AOrderAsc: Boolean = True);
    function FindService(const SvcName: string; var NtSvc: TJclNtService): Boolean;
    function FindGroup(const GrpName: string; var SvcGrp: TJclServiceGroup;
      const AutoAdd: Boolean = True): Boolean;
    procedure Lock;
    procedure Unlock;
    function IsLocked: Boolean;
    function LockOwner: string;
    function LockDuration: DWORD;
    class function ServiceType(const SvcType: TJclServiceTypes): DWORD; overload;
    class function ServiceType(const SvcType: DWORD): TJclServiceTypes; overload;
    class function ControlAccepted(const CtrlAccepted: TJclServiceControlAccepteds): DWORD; overload;
    class function ControlAccepted(const CtrlAccepted: DWORD): TJclServiceControlAccepteds; overload;
    property MachineName: string read FMachineName;
    property DatabaseName: string read FDatabaseName;
    property DesiredAccess: DWORD read FDesiredAccess;
    property Active: Boolean read GetActive write SetActive;
    property Handle: SC_HANDLE read FHandle;
    property Services[const Idx: Integer]: TJclNtService read GetService;
    property ServiceCount: Integer read GetServiceCount;
    property Groups[const Idx: Integer]: TJclServiceGroup read GetGroup;
    property GroupCount: Integer read GetGroupCount;
    property OrderType: TJclServiceSortOrderType read FOrderType write SetOrderType;
    property OrderAsc: Boolean read FOrderAsc write SetOrderAsc;
  end;

// helper functions
function GetServiceStatus(ServiceHandle: SC_HANDLE): DWORD;
function GetServiceStatusWaitingIfPending(ServiceHandle: SC_HANDLE): DWORD;

function GetServiceStatusByName(const AServer,AServiceName:string):TJclServiceState;
function StopServiceByName(const AServer, AServiceName: String):Boolean;
function StartServiceByName(const AServer,AServiceName: String):Boolean;

implementation

uses
  {$IFDEF FPC}
  WinSysUt,
  JwaRegStr,
  {$ELSE}
  RegStr,
  {$ENDIF FPC}
  Math,
  JclRegistry, JclStrings, JclSysInfo;

const
  INVALID_SCM_HANDLE = 0;

  ServiceTypeMapping: array [TJclServiceType] of DWORD =
    (SERVICE_KERNEL_DRIVER, SERVICE_FILE_SYSTEM_DRIVER, SERVICE_ADAPTER,
     SERVICE_RECOGNIZER_DRIVER, SERVICE_WIN32_OWN_PROCESS,
     SERVICE_WIN32_SHARE_PROCESS, SERVICE_INTERACTIVE_PROCESS);

  ServiceControlAcceptedMapping: array [TJclServiceControlAccepted] of DWORD =
    (SERVICE_ACCEPT_STOP, SERVICE_ACCEPT_PAUSE_CONTINUE, SERVICE_ACCEPT_SHUTDOWN);

//=== { TJclNtService } ======================================================

constructor TJclNtService.Create(const ASCManager: TJclSCManager; const SvcStatus: TEnumServiceStatus);
begin
  Assert(Assigned(ASCManager));
  inherited Create;
  FSCManager := ASCManager;
  FHandle := INVALID_SCM_HANDLE;
  FServiceName := SvcStatus.lpServiceName;
  FDisplayName := SvcStatus.lpDisplayName;
  FDescription := '';
  FGroup := nil;