294 lines
9.0 KiB
ObjectPascal
294 lines
9.0 KiB
ObjectPascal
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.
|