opensource/HeidiSQL
1
0
Fork 0
mirror of https://github.com/HeidiSQL/HeidiSQL.git synced 2026-03-13 09:24:25 +08:00
Code Issues Packages Projects Releases Wiki Activity
Files
2b83aeafcb74afbf97861fe416a461dcb4046bfa
HeidiSQL/components/mORMot/SQLite3/SQLite3Service.pas

752 lines
28 KiB
ObjectPascal
Raw Blame History

/// Win NT Service managment classes
// - this unit is a part of the freeware Synopse mORMot framework,
// licensed under a MPL/GPL/LGPL tri-license; version 1.17
unit SQLite3Service;
{
This file is part of Synopse mORMot framework.
Synopse mORMot framework. Copyright (C) 2012 Arnaud Bouchez
Synopse Informatique - http://synopse.info
*** BEGIN LICENSE BLOCK *****
Version: MPL 1.1/GPL 2.0/LGPL 2.1
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 Synopse SQLite3/mORMot database framework.
The Initial Developer of the Original Code is Arnaud Bouchez.
Portions created by the Initial Developer are Copyright (C) 2012
the Initial Developer. All Rights Reserved.
Contributor(s):
Alternatively, the contents of this file may be used under the terms of
either the GNU General Public License Version 2 or later (the "GPL"), or
the GNU Lesser General Public License Version 2.1 or later (the "LGPL"),
in which case the provisions of the GPL or the LGPL are applicable instead
of those above. If you wish to allow use of your version of this file only
under the terms of either the GPL or the LGPL, and not to allow others to
use your version of this file under the terms of the MPL, indicate your
decision by deleting the provisions above and replace them with the notice
and other provisions required by the GPL or the LGPL. If you do not delete
the provisions above, a recipient may use your version of this file under
the terms of any one of the MPL, the GPL or the LGPL.
***** END LICENSE BLOCK *****
Win NT Service managment classes
--------------------------------
Version 1.3
- TService debug and enhancements
- can compile without SQLite3Commons dependency for smaller executables
Version 1.4 - February 8, 2010
- whole Synopse SQLite3 database framework released under the GNU Lesser
General Public License version 3, instead of generic "Public Domain"
Version 1.16
- code refactoring after Leander007 proposals for better compatibility -
see http://synopse.info/forum/viewtopic.php?id=584
}
interface
{$I Synopse.inc}
{$ifdef LVCL}
{$define NOSQLITE3COMMONS}
// define it if you don't need to include the SQLite3Commons unit
// - could save some code size in the final executable
{$endif}
uses
Windows, WinSVC, Messages, Classes, SysUtils, SynCommons
{$ifndef NOSQLITE3COMMONS}, SQLite3Commons{$endif} // translated caption needed only if with full UI
;
const
CM_SERVICE_CONTROL_CODE = WM_USER+1000;
type
{{ all possible states of the service }
TServiceState =
(ssNotInstalled, ssStopped, ssStarting, ssStopping, ssRunning,
ssResuming, ssPausing, ssPaused, ssErrorRetrievingState);
{{ TServiceControler class is intended to create a new service instance or
to maintain (that is start, stop, pause, resume...) an existing service
- to provide the service itself, use the TService class }
TServiceController = class
protected
FSCHandle: THandle;
FHandle: THandle;
FStatus: TServiceStatus;
private
function GetStatus: TServiceStatus;
function GetState: TServiceState;
public
{{ Creates a new service and allows to control it and/or its configuration.
Expected Parameters (strings are unicode-ready since Delphi 2009):
- TargetComputer - set it to empty string if local computer is the target.
- DatabaseName - set it to empty string if the default database is supposed
('ServicesActive').
- Name - name of a service.
- DisplayName - display name of a service.
- Path - a path to binary (executable) of the service created.
- OrderGroup - an order group name (unnecessary)
- Dependances - string containing a list with names of services, which must
start before (every name should be separated with #0, entire
list should be separated with #0#0. Or, an empty string can be
passed if there are no dependances).
- Username - login name. For service type SERVICE_WIN32_OWN_PROCESS, the
account name in the form of "DomainName\Username"; If the account
belongs to the built-in domain, ".\Username" can be specified;
Services of type SERVICE_WIN32_SHARE_PROCESS are not allowed to
specify an account other than LocalSystem. If '' is specified, the
service will be logged on as the 'LocalSystem' account, in which
case, the Password parameter must be empty too.
- Password - a password for login name. If the service type is
SERVICE_KERNEL_DRIVER or SERVICE_FILE_SYSTEM_DRIVER,
this parameter is ignored.
- DesiredAccess - a combination of following flags:
SERVICE_ALL_ACCESS (default value), SERVICE_CHANGE_CONFIG,
SERVICE_ENUMERATE_DEPENDENTS, SERVICE_INTERROGATE, SERVICE_PAUSE_CONTINUE,
SERVICE_QUERY_CONFIG, SERVICE_QUERY_STATUS, SERVICE_START, SERVICE_STOP,
SERVICE_USER_DEFINED_CONTROL
- ServiceType - a set of following flags:
SERVICE_WIN32_OWN_PROCESS (default value, which specifies a Win32 service
that runs in its own process), SERVICE_WIN32_SHARE_PROCESS,
SERVICE_KERNEL_DRIVER, SERVICE_FILE_SYSTEM_DRIVER,
SERVICE_INTERACTIVE_PROCESS (default value, which enables a Win32 service
process to interact with the desktop)
- StartType - one of following values:
SERVICE_BOOT_START, SERVICE_SYSTEM_START,
SERVICE_AUTO_START (which specifies a device driver or service started by
the service control manager automatically during system startup),
SERVICE_DEMAND_START (default value, which specifies a service started by
a service control manager when a process calls the StartService function,
that is the TServiceController.Start method), SERVICE_DISABLED
- ErrorControl - one of following:
SERVICE_ERROR_IGNORE, SERVICE_ERROR_NORMAL (default value, by which
the startup program logs the error and displays a message but continues
the startup operation), SERVICE_ERROR_SEVERE,
SERVICE_ERROR_CRITICAL }
constructor CreateNewService(const TargetComputer, DatabaseName,
Name, DisplayName, Path: string;
const OrderGroup: string = ''; const Dependances: string = '';
const Username: string = ''; const Password: string = '';
DesiredAccess: DWORD = SERVICE_ALL_ACCESS;
ServiceType: DWORD = SERVICE_WIN32_OWN_PROCESS or SERVICE_INTERACTIVE_PROCESS;
StartType: DWORD = SERVICE_DEMAND_START; ErrorControl: DWORD = SERVICE_ERROR_NORMAL);
{{ Opens an existing service, in order to control it or its configuration
from your application. Parameters (strings are unicode-ready since Delphi 2009):
- TargetComputer - set it to empty string if local computer is the target.
- DatabaseName - set it to empty string if the default database is supposed
('ServicesActive').
- Name - name of a service.
- DesiredAccess - a combination of following flags:
SERVICE_ALL_ACCESS, SERVICE_CHANGE_CONFIG, SERVICE_ENUMERATE_DEPENDENTS,
SERVICE_INTERROGATE, SERVICE_PAUSE_CONTINUE, SERVICE_QUERY_CONFIG,
SERVICE_QUERY_STATUS, SERVICE_START, SERVICE_STOP, SERVICE_USER_DEFINED_CONTROL }
constructor CreateOpenService(const TargetComputer, DataBaseName, Name: String;
DesiredAccess: DWORD = SERVICE_ALL_ACCESS);
{{ release memory and handles }
destructor Destroy; override;
{{ Handle of SC manager }
property SCHandle: THandle read FSCHandle;
{{ Handle of service opened or created
- its value is 0 if something failed in any Create*() method }
property Handle: THandle read FHandle;
{{ Retrieve the Current status of the service }
property Status: TServiceStatus read GetStatus;
{{ Retrive the Current state of the service }
property State: TServiceState read GetState;
{{ Requests the service to stop }
function Stop: boolean;
{{ Requests the service to pause }
function Pause: boolean;
{{ Requests the paused service to resume }
function Resume: boolean;
{{ Requests the service to update immediately its current status information
to the service control manager }
function Refresh: boolean;
{{ Request the service to shutdown
- this function always return false }
function Shutdown: boolean;
{{ Removes service from the system, i.e. close the Service }
function Delete: boolean;
{{ starts the execution of a service with some specified arguments
- this version expect PChar pointers, either AnsiString (for FPC and old
Delphi compiler), either UnicodeString (till Delphi 2009) }
function Start(const Args: array of PChar): boolean;
end;
TService = class;
/// callback procedure for Windows Service Controller
TServiceCtrlHandler = procedure(CtrlCode: DWORD); stdcall;
/// event triggered for Control handler
TServiceControlEvent = procedure(Sender: TService; Code: DWORD) of object;
/// event triggered to implement the Service functionality
TServiceEvent = procedure(Sender: TService) of object;
{{ TService is the class used to implement a service provided by an application }
TService = class
protected
fSName: String;
fDName: String;
fStartType: DWORD;
fServiceType: DWORD;
fData: DWORD;
fCtrlHandler: TServiceCtrlHandler;
fOnControl: TServiceControlEvent;
fOnInterrogate: TServiceEvent;
fOnPause: TServiceEvent;
fOnShutdown: TServiceEvent;
fOnStart: TServiceEvent;
fOnExecute: TServiceEvent;
fOnResume: TServiceEvent;
fOnStop: TServiceEvent;
fStatusRec: TServiceStatus;
fArgsList: array of string;
fJumper: PByteArray;
fStatusHandle: THandle;
function GetArgCount: Integer;
function GetArgs(Idx: Integer): String;
function GetInstalled: boolean;
procedure SetStatus(const Value: TServiceStatus);
procedure CtrlHandle(Code: DWORD);
function GetCtrlHandler: TServiceCtrlHandler;
procedure SetCtrlHandler(const Value: TServiceCtrlHandler);
public
/// this method is the main service entrance, from the OS point of view
// - it will call OnControl/OnStop/OnPause/OnResume/OnShutdown events
// - and report the service status to the system (via ReportStatus method)
procedure DoCtrlHandle(Code: DWORD); virtual;
/// Creates the service
// - the service is added to the internal registered services
// - main application must call the global ServicesRun procedure to actually
// start the services
// - caller must free the TService instance when it's no longer used
constructor Create(const aServiceName, aDisplayName: String); reintroduce; virtual;
/// free memory and release handles
destructor Destroy; override;
{{ Reports new status to the system }
function ReportStatus(dwState, dwExitCode, dwWait: DWORD): BOOL;
{{ Installs the service in the database
- return true on success
- create a local TServiceController with the current executable file,
with the supplied command line parameters}
function Install(const Params: string=''): boolean;
{{ Removes the service from database
- uses a local TServiceController with the current Service Name }
procedure Remove;
{{ Starts the service
- uses a local TServiceController with the current Service Name }
procedure Start;
{{ Stops the service
- uses a local TServiceController with the current Service Name }
procedure Stop;
{{ this is the main method, in which the Service should implement its run }
procedure Execute; virtual;
{{ Name of the service. Must be unique }
property ServiceName: String read fSName;
{{ Display name of the service }
property DisplayName: String read fDName write fDName;
{{ Type of service }
property ServiceType: DWORD read fServiceType write fServiceType;
{{ Type of start of service }
property StartType: DWORD read fStartType write fStartType;
{{ Number of arguments passed to the service by the service controler }
property ArgCount: Integer read GetArgCount;
{{ List of arguments passed to the service by the service controler }
property Args[Idx: Integer]: String read GetArgs;
{{ Current service status
- To report new status to the system, assign another
value to this record, or use ReportStatus method (better) }
property Status: TServiceStatus read fStatusRec write SetStatus;
{{ Any data You wish to associate with the service object }
property Data: DWORD read FData write FData;
{{ Whether service is installed in DataBase
- uses a local TServiceController to check if the current Service Name exists }
property Installed: boolean read GetInstalled;
{{ Callback handler for Windows Service Controller
- if handler is not set, then auto generated handler calls DoCtrlHandle }
property ControlHandler: TServiceCtrlHandler read GetCtrlHandler write SetCtrlHandler;
{{ Start event is executed before the main service thread (i.e. in the Execute method) }
property OnStart: TServiceEvent read fOnStart write fOnStart;
{{ custom Execute event
- launched in the main service thread (i.e. in the Execute method) }
property OnExecute: TServiceEvent read fOnExecute write fOnExecute;
{{ custom event trigerred when a Control Code is received from Windows }
property OnControl: TServiceControlEvent read fOnControl write fOnControl;
{{ custom event trigerred when the service is stopped }
property OnStop: TServiceEvent read fOnStop write fOnStop;
{{ custom event trigerred when the service is paused }
property OnPause: TServiceEvent read fOnPause write fOnPause;
{{ custom event trigerred when the service is resumed }
property OnResume: TServiceEvent read fOnResume write fOnResume;
{{ custom event trigerred when the service receive an Interrogate }
property OnInterrogate: TServiceEvent read fOnInterrogate write fOnInterrogate;
{{ custom event trigerred when the service is shut down }
property OnShutdown: TServiceEvent read fOnShutdown write fOnShutdown;
end;
var
/// the internal list of Services handled by this unit
// - not to be accessed directly: create TService instances, and they will
// be added/registered to this list
// - then run the global ServicesRun procedure
// - every TService instance is to be freed by the main application, when
// it's no more used
Services: TList = nil;
{{ launch the registered Services execution
- the registered list of service provided by the aplication is sent
to the operating system }
procedure ServicesRun;
{{ convert the Control Code retrieved from Windows into a service state
enumeration item }
function CurrentStateToServiceState(CurrentState: DWORD): TServiceState;
/// return the ready to be displayed text of a TServiceState value
function ServiceStateText(State: TServiceState): string;
implementation
{ TServiceController }
constructor TServiceController.CreateNewService(const TargetComputer,
DatabaseName, Name, DisplayName, Path, OrderGroup, Dependances, Username,
Password: String; DesiredAccess, ServiceType, StartType,
ErrorControl: DWORD);
begin
inherited Create;
FSCHandle := OpenSCManager(pointer(TargetComputer), pointer(DatabaseName),
SC_MANAGER_ALL_ACCESS);
if FSCHandle = 0 then Exit;
FHandle := CreateService(FSCHandle, pointer(Name), pointer(DisplayName),
DesiredAccess, ServiceType, StartType, ErrorControl, pointer(Path),
pointer(OrderGroup), nil, pointer(Dependances),
pointer(Username), pointer(Password));
end;
constructor TServiceController.CreateOpenService(const TargetComputer,
DataBaseName, Name: String; DesiredAccess: DWORD);
begin
inherited Create;
FSCHandle := OpenSCManager(pointer(TargetComputer), pointer(DatabaseName),
SC_MANAGER_ALL_ACCESS);
if FSCHandle = 0 then Exit;
FHandle := OpenService(FSCHandle, pointer(Name), DesiredAccess);
end;
function TServiceController.Delete: boolean;
begin
Result := FALSE;
if FHandle <> 0 then
if DeleteService(FHandle) then begin
Result := CloseServiceHandle(FHandle);
FHandle := 0;
end;
end;
destructor TServiceController.Destroy;
begin
if FHandle <> 0 then
CloseServiceHandle(FHandle);
if FSCHandle <> 0 then
CloseServiceHandle(FSCHandle);
inherited;
end;
function TServiceController.GetState: TServiceState;
begin
if (self=nil) or (FSCHandle=0) then
result := ssErrorRetrievingState else
if FHandle=0 then
result := ssNotInstalled else
result := CurrentStateToServiceState(Status.dwCurrentState);
end;
function TServiceController.GetStatus: TServiceStatus;
begin
FillChar(FStatus, Sizeof(FStatus), 0);
QueryServiceStatus(FHandle, FStatus);
Result := FStatus;
end;
function TServiceController.Pause: boolean;
begin
Result := ControlService(FHandle, SERVICE_CONTROL_PAUSE, FStatus);
end;
function TServiceController.Refresh: boolean;
begin
Result := ControlService(FHandle, SERVICE_CONTROL_INTERROGATE, FStatus);
end;
function TServiceController.Resume: boolean;
begin
Result := ControlService(FHandle, SERVICE_CONTROL_CONTINUE, FStatus);
end;
function TServiceController.Shutdown: boolean;
begin
Result := ControlService(FHandle, SERVICE_CONTROL_SHUTDOWN, FStatus);
end;
function StartService(hService: SC_HANDLE; dwNumServiceArgs: DWORD;
lpServiceArgVectors: Pointer): BOOL; stdcall; external advapi32
name {$ifdef UNICODE}'StartServiceW';{$else}'StartServiceA';{$endif}
function TServiceController.Start(const Args: array of PChar): boolean;
begin
Result := StartService(FHandle, length(Args), @Args[0]);
end;
function TServiceController.Stop: boolean;
begin
Result := ControlService(FHandle, SERVICE_CONTROL_STOP, FStatus);
end;
{ TService }
function FindServiceIndex(const Name: String): integer;
begin
if Services<>nil then
for result := 0 to Services.Count-1 do
if TService(Services[result]).ServiceName=Name then
exit;
result := -1;
end;
procedure JumpToService;
asm
{$ifdef CPU64}
{$ifdef CPUX64}
.NOFRAME
{$endif}
pop rax
mov rax,[rax]
mov rdx,[esp+8]
call TService.CtrlHandle
ret 8
{$else}
pop eax
mov eax, [eax] // retrieve self value
mov edx, [esp+4]
call TService.CtrlHandle
ret 4
{$endif}
end;
constructor TService.Create(const aServiceName, aDisplayName: String);
begin
if FindServiceIndex(aServiceName)>=0 then
raise Exception.CreateFmt('Attempt to install a service ' +
'with duplicated name: %s', [aServiceName]);
fSName := aServiceName;
fDName := aDisplayName;
if aDisplayName = '' then
fDName := aServiceName;
if Services=nil then begin
Services := TList.Create;
GarbageCollector.Add(Services);
end;
Services.Add(self);
fServiceType := SERVICE_WIN32_OWN_PROCESS or SERVICE_INTERACTIVE_PROCESS;
fStartType := SERVICE_AUTO_START;
fStatusRec.dwServiceType := fServiceType;
fStatusRec.dwCurrentState := SERVICE_STOPPED;
fStatusRec.dwControlsAccepted := 31;
fStatusRec.dwWin32ExitCode := NO_ERROR;
end;
procedure TService.CtrlHandle(Code: DWORD);
begin
DoCtrlHandle(Code);
end;
destructor TService.Destroy;
var i: integer;
begin
i := FindServiceIndex(fsName);
if i<0 then
raise Exception.CreateFmt('Cannot find service %s to remove from the list',
[fsName]);
Services.Delete(i);
if Assigned(fJumper) then
VirtualFree(fJumper, 0, MEM_RELEASE);
inherited;
end;
procedure TService.DoCtrlHandle(Code: DWORD);
begin
case Code of
SERVICE_CONTROL_STOP: begin
ReportStatus(SERVICE_STOP_PENDING, NO_ERROR, 0);
if Assigned(fOnStop) then fOnStop(Self);
ReportStatus(SERVICE_STOPPED, NO_ERROR, 0);
end;
SERVICE_CONTROL_PAUSE: begin
ReportStatus(SERVICE_PAUSE_PENDING, NO_ERROR, 0);
if Assigned(fOnPause) then fOnPause(Self);
ReportStatus(SERVICE_PAUSED, NO_ERROR, 0)
end;
SERVICE_CONTROL_CONTINUE: begin
ReportStatus(SERVICE_CONTINUE_PENDING, NO_ERROR, 0);
if Assigned(fOnResume) then fOnResume(Self);
ReportStatus(SERVICE_RUNNING, NO_ERROR, 0);
end;
SERVICE_CONTROL_SHUTDOWN: begin
if Assigned(fOnShutdown) then fOnShutdown(Self);
Code := 0;
end;
SERVICE_CONTROL_INTERROGATE: begin
SetServiceStatus(FStatusHandle, fStatusRec);
if Assigned(fOnInterrogate) then fOnInterrogate(Self);
end;
end;
if Assigned(fOnControl) then fOnControl(Self, Code);
end;
procedure TService.Execute;
begin
if Assigned(fOnStart) then
fOnStart(@Self);
ReportStatus(SERVICE_RUNNING, 0, 0);
SetServiceStatus(FStatusHandle, fStatusRec);
if Assigned(fOnExecute) then
fOnExecute(@Self);
end;
function TService.GetArgCount: Integer;
begin
result := length(FArgsList);
end;
function TService.GetArgs(Idx: Integer): String;
begin
if cardinal(Idx)>cardinal(high(FArgsList)) then
result := '' else // avoid GPF
result := FArgsList[Idx];
end;
function TService.GetCtrlHandler: TServiceCtrlHandler;
var AfterCallAddr: Pointer;
Offset: Integer;
begin
Result := fCtrlHandler;
if not Assigned(Result) then
begin
if fJumper=nil then begin
fJumper := VirtualAlloc(nil, 5+sizeof(Pointer), MEM_COMMIT, PAGE_EXECUTE_READWRITE);
if fJumper=nil then
raise Exception.CreateFmt('Cannot allocate memory for service jump gate: %s',
[fSName]);
AfterCallAddr := Pointer(PtrUInt(fJumper)+5);
Offset := PtrInt(@JumpToService)-PtrInt(AfterCallAddr);
fJumper[0] := $E8; // call opcode
PInteger(@fJumper[1])^ := Offset; // points to JumpToService
PPtrUInt(@fJumper[5])^ := PtrUInt(self); // will be set as EAX=self
end;
Result := pointer(fJumper);
end;
end;
function CurrentStateToServiceState(CurrentState: DWORD): TServiceState;
begin
case CurrentState of
SERVICE_STOPPED: result := ssStopped;
SERVICE_START_PENDING: result := ssStarting;
SERVICE_STOP_PENDING: result := ssStopping;
SERVICE_RUNNING: result := ssRunning;
SERVICE_CONTINUE_PENDING: result := ssResuming;
SERVICE_PAUSE_PENDING: result := ssPausing;
SERVICE_PAUSED: result := ssPaused;
else result := ssNotInstalled; // e.g. SERVICE_CONTROL_SHUTDOWN
end;
end;
{$ifdef NOSQLITE3COMMONS} // translated caption needed only if with full UI
function ServiceStateText(State: TServiceState): string;
var P: PShortString;
begin
P := GetEnumName(TypeInfo(TServiceState),ord(State));
result := string(copy(P^,3,length(P^)-2));
end;
{$else}
function ServiceStateText(State: TServiceState): string;
begin
result := PTypeInfo(TypeInfo(TServiceState))^.EnumBaseType^.GetCaption(State);
end;
{$endif}
function TService.GetInstalled: boolean;
begin
with TServiceController.CreateOpenService('','',fSName,SERVICE_QUERY_STATUS) do
try
result := Handle<>0;
finally
Free;
end;
end;
function TService.Install(const Params: string): boolean;
var schService: SC_HANDLE;
schSCManager: SC_HANDLE;
ServicePath: String;
begin
result := false;
if installed then
exit;
ServicePath := paramstr(0);
if Params<>'' then
ServicePath := ServicePath+' '+Params;
schSCManager := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);
if (schSCManager>0) then begin
schService := CreateService(schSCManager,
pointer(fSName), pointer(fDName), SERVICE_ALL_ACCESS,
fServiceType, fStartType, SERVICE_ERROR_NORMAL,
pointer(ServicePath), nil, nil, nil, nil, nil);
if (schService>0) then begin
result := true;
CloseServiceHandle(schService);
end;
end;
end;
{procedure TService.MessageExecute(EndCode: DWORD);
var aMsg: TMsg;
begin
while fCurrentCode<>EndCode do begin
while PeekMessage(aMsg,0,0,0,PM_REMOVE) do begin
TranslateMessage(aMsg);
DispatchMessage(aMsg);
end;
if fCurrentCode=EndCode then
break;
WaitMessage;
end;
end;}
procedure TService.Remove;
begin
with TServiceController.CreateOpenService('','',fSName,SERVICE_ALL_ACCESS) do
try
if Handle=0 then exit;
Stop;
Delete;
finally
Free;
end;
end;
function TService.ReportStatus(dwState, dwExitCode, dwWait: DWORD): BOOL;
begin
if dwState = SERVICE_START_PENDING then
fStatusRec.dwControlsAccepted := 0 else
fStatusRec.dwControlsAccepted := 31;
fStatusRec.dwCurrentState := dwState;
fStatusRec.dwWin32ExitCode := dwExitCode;
fStatusRec.dwWaitHint := dwWait;
if (dwState = SERVICE_RUNNING) or (dwState = SERVICE_STOPPED) then
fStatusRec.dwCheckPoint := 0 else
inc(fStatusRec.dwCheckPoint);
Result := SetServiceStatus(FStatusHandle, fStatusRec);
end;
procedure TService.SetCtrlHandler(const Value: TServiceCtrlHandler);
begin
fCtrlHandler := Value;
if Assigned(fJumper) then
VirtualFree(fJumper, 0, MEM_RELEASE);
end;
procedure TService.SetStatus(const Value: TServiceStatus);
begin
fStatusRec := Value;
if FStatusHandle <> 0 then
SetServiceStatus(FStatusHandle, fStatusRec);
end;
procedure TService.Start;
begin
with TServiceController.CreateOpenService('','',fSName,SERVICE_ALL_ACCESS) do
try
Start([]);
finally
Free;
end;
end;
procedure TService.Stop;
begin
with TServiceController.CreateOpenService('','',fSName,SERVICE_ALL_ACCESS) do
try
Stop;
finally
Free;
end;
end;
{ function that a service process specifies as the entry point function
of a particular service. The function can have any application-defined name
- Args points to an array of pointers that point to null-terminated
argument strings. The first argument in the array is the name of the service,
and subsequent arguments are any strings passed to the service by the process
that called the StartService function to start the service. }
procedure ServiceProc(ArgCount: DWORD; Args: PPChar); stdcall;
var i: integer;
Srv: TService;
begin
i := FindServiceIndex(Args^);
if i<0 then
exit; // avoid any GPF
Srv := Services.Items[i];
for i := 1 to ArgCount-1 do begin
Inc(Args);
SetLength(Srv.FArgsList, length(Srv.FArgsList)+1);
Srv.FArgsList[high(Srv.FArgsList)] := Args^;
end;
Srv.FStatusHandle := RegisterServiceCtrlHandler(pointer(Srv.fSName), @Srv.ControlHandler);
if Srv.FStatusHandle = 0 then begin
Srv.ReportStatus(SERVICE_STOPPED, GetLastError, 0);
Exit;
end;
Srv.ReportStatus(SERVICE_START_PENDING, 0, 0);
Srv.Execute;
end;
procedure ServicesRun;
var S: array of TServiceTableEntry;
i: integer;
begin
SetLength(S,Services.Count+1);
for i := 0 to Services.Count-1 do begin
S[i].lpServiceName := pointer(TService(Services.List[i]).ServiceName);
S[i].lpServiceProc := @ServiceProc;
end;
StartServiceCtrlDispatcher(S[0]);
end;
end.
Reference in New Issue View Git Blame Copy Permalink