mORMot and Open Source friends
Check-in [4102d9f50b]
Not logged in
Home Documentation Forum Download Blog Donate Timeline Tickets Wiki Login

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:{2636} some enhancements to mORMotServices.pas unit - thanks Eric for the feedback!
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 4102d9f50bc205812f5adcd81950e87098f439ec
User & Date: ab 2016-05-09 11:21:58
Context
2016-05-09
11:47
{2637} enhance [1bb016e5cf] so that TSQLAuthUser.SetPassword() and ComputeHashedPassword() would now use PBKDF2_HMAC_SHA256() and a custom salt (maybe containing the LogonName) and number of iterations (default 20000) - it would reduce a lot potential brute force attack via use of pre-computed rainbow tables check-in: 6203c891bc user: ab tags: trunk
11:21
{2636} some enhancements to mORMotServices.pas unit - thanks Eric for the feedback! check-in: 4102d9f50b user: ab tags: trunk
11:15
{2635} fixed compilation warning under Delphi XE in SearchRecToDateTime() - thanks Eric for the report! check-in: f686cd0d19 user: ab tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to SQLite3/ServiceTestForm.pas. 

10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

  Classes,
  Forms,
  Controls,
  StdCtrls,
  Dialogs,
  SynCrtSock,
  mORMot,
  WinSvc,
  mORMotService;

const
  SERVICENAME = 'KOL_ServiceA';
  SERVICEEXE = 'd:\temp\debug\TestKOLService.exe';

type







<








10
11
12
13
14
15
16

17
18
19
20
21
22
23

  Classes,
  Forms,
  Controls,
  StdCtrls,
  Dialogs,
  SynCrtSock,
  mORMot,

  mORMotService;

const
  SERVICENAME = 'KOL_ServiceA';
  SERVICEEXE = 'd:\temp\debug\TestKOLService.exe';

type

Changes to SQLite3/mORMotService.pas. 

86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
...
172
173
174
175
176
177
178































179
180
181
182
183
184
185
...
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
...
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
...
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747

uses
  Windows, Messages, Classes, SysUtils,
  {$ifndef LVCL}Contnrs,{$endif}
  SynCommons,
  SynLog;

{ *** some minimal Windows API types and constants, missing for FPC }

const
  CM_SERVICE_CONTROL_CODE = WM_USER+1000;

  SERVICE_QUERY_CONFIG         = $0001;
  SERVICE_CHANGE_CONFIG        = $0002;
  SERVICE_QUERY_STATUS         = $0004;
................................................................................
  SC_HANDLE = THandle;
  SERVICE_STATUS_HANDLE = DWORD;
  TServiceTableEntry = record
    lpServiceName: PChar;
    lpServiceProc: TFarProc;
  end;

































{ *** high level classes to define and manage Windows Services }

var
  /// you can set this global variable to TSynLog or TSQLLog to enable logging
  // - default is nil, i.e. disabling logging, since it may interfere with the
  // logging process of the service itself
................................................................................

/// return the ready to be displayed text of a TServiceState value
function ServiceStateText(State: TServiceState): string;


implementation

function OpenSCManager(lpMachineName, lpDatabaseName: PChar;
  dwDesiredAccess: DWORD): SC_HANDLE; stdcall; external advapi32
  name 'OpenSCManager'+{$ifdef UNICODE}'W'{$else}'A'{$endif};
function ChangeServiceConfig2(hService: SC_HANDLE; dwsInfoLevel: DWORD;
  lpInfo: Pointer): BOOL; stdcall; external advapi32 name 'ChangeServiceConfig2W';
function StartService(hService: SC_HANDLE; dwNumServiceArgs: DWORD;
  lpServiceArgVectors: Pointer): BOOL; stdcall; external advapi32
  name 'StartService'+{$ifdef UNICODE}'W'{$else}'A'{$endif};
function CreateService(hSCManager: SC_HANDLE; lpServiceName, lpDisplayName: PChar;
  dwDesiredAccess, dwServiceType, dwStartType, dwErrorControl: DWORD;
  lpBinaryPathName, lpLoadOrderGroup: PChar; lpdwTagId: LPDWORD; lpDependencies,
  lpServiceStartName, lpPassword: PChar): SC_HANDLE; stdcall; external advapi32
  name 'CreateService'+{$ifdef UNICODE}'W'{$else}'A'{$endif};
function OpenService(hSCManager: SC_HANDLE; lpServiceName: PChar;
  dwDesiredAccess: DWORD): SC_HANDLE; stdcall; external advapi32
  name 'OpenService'+{$ifdef UNICODE}'W'{$else}'A'{$endif};
function DeleteService(hService: SC_HANDLE): BOOL; stdcall; external advapi32;
function CloseServiceHandle(hSCObject: SC_HANDLE): BOOL; stdcall; external advapi32;
function QueryServiceStatus(hService: SC_HANDLE;
  var lpServiceStatus: TServiceStatus): BOOL; stdcall; external advapi32;
function ControlService(hService: SC_HANDLE; dwControl: DWORD;
  var lpServiceStatus: TServiceStatus): BOOL; stdcall; external advapi32;
function SetServiceStatus(hServiceStatus: SERVICE_STATUS_HANDLE;
  var lpServiceStatus: TServiceStatus): BOOL; stdcall; external advapi32;
function RegisterServiceCtrlHandler(lpServiceName: PChar;
  lpHandlerProc: TFarProc): SERVICE_STATUS_HANDLE; stdcall; external advapi32
  name 'RegisterServiceCtrlHandler'+{$ifdef UNICODE}'W'{$else}'A'{$endif};
function StartServiceCtrlDispatcher(
  var lpServiceStartTable: TServiceTableEntry): BOOL; stdcall; external advapi32
  name 'StartServiceCtrlDispatcher'+{$ifdef UNICODE}'W'{$else}'A'{$endif};


{ TServiceController }

constructor TServiceController.CreateNewService(const TargetComputer,
  DatabaseName,Name,DisplayName,Path,OrderGroup,Dependencies,Username,Password: String;
  DesiredAccess,ServiceType,StartType,ErrorControl: DWORD);
var Exe: TFileName;
................................................................................
    CloseServiceHandle(FSCHandle);
  inherited;
end;

function TServiceController.GetState: TServiceState;
begin
  if (self=nil) or (FSCHandle=0) or (FHandle=0) then
    result := ssErrorRetrievingState else
    result := CurrentStateToServiceState(Status.dwCurrentState);
  ServiceLog.Add.Log(sllTrace,FName,TypeInfo(TServiceState),result);
end;

function TServiceController.GetStatus: TServiceStatus;
begin
  FillChar(FStatus, Sizeof(FStatus), 0);
................................................................................

{ 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;
{$ifdef CPU64}
{$ifdef FPC}nostackframe; assembler;







|







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







 







<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<







 







|







 







|








86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
...
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
...
515
516
517
518
519
520
521































522
523
524
525
526
527
528
...
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
...
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747

uses
  Windows, Messages, Classes, SysUtils,
  {$ifndef LVCL}Contnrs,{$endif}
  SynCommons,
  SynLog;

{ *** some minimal Windows API definitions, replacing WinSvc.pas missing for FPC }

const
  CM_SERVICE_CONTROL_CODE = WM_USER+1000;

  SERVICE_QUERY_CONFIG         = $0001;
  SERVICE_CHANGE_CONFIG        = $0002;
  SERVICE_QUERY_STATUS         = $0004;
................................................................................
  SC_HANDLE = THandle;
  SERVICE_STATUS_HANDLE = DWORD;
  TServiceTableEntry = record
    lpServiceName: PChar;
    lpServiceProc: TFarProc;
  end;

function OpenSCManager(lpMachineName, lpDatabaseName: PChar;
  dwDesiredAccess: DWORD): SC_HANDLE; stdcall; external advapi32
  name 'OpenSCManager'+{$ifdef UNICODE}'W'{$else}'A'{$endif};
function ChangeServiceConfig2(hService: SC_HANDLE; dwsInfoLevel: DWORD;
  lpInfo: Pointer): BOOL; stdcall; external advapi32 name 'ChangeServiceConfig2W';
function StartService(hService: SC_HANDLE; dwNumServiceArgs: DWORD;
  lpServiceArgVectors: Pointer): BOOL; stdcall; external advapi32
  name 'StartService'+{$ifdef UNICODE}'W'{$else}'A'{$endif};
function CreateService(hSCManager: SC_HANDLE; lpServiceName, lpDisplayName: PChar;
  dwDesiredAccess, dwServiceType, dwStartType, dwErrorControl: DWORD;
  lpBinaryPathName, lpLoadOrderGroup: PChar; lpdwTagId: LPDWORD; lpDependencies,
  lpServiceStartName, lpPassword: PChar): SC_HANDLE; stdcall; external advapi32
  name 'CreateService'+{$ifdef UNICODE}'W'{$else}'A'{$endif};
function OpenService(hSCManager: SC_HANDLE; lpServiceName: PChar;
  dwDesiredAccess: DWORD): SC_HANDLE; stdcall; external advapi32
  name 'OpenService'+{$ifdef UNICODE}'W'{$else}'A'{$endif};
function DeleteService(hService: SC_HANDLE): BOOL; stdcall; external advapi32;
function CloseServiceHandle(hSCObject: SC_HANDLE): BOOL; stdcall; external advapi32;
function QueryServiceStatus(hService: SC_HANDLE;
  var lpServiceStatus: TServiceStatus): BOOL; stdcall; external advapi32;
function ControlService(hService: SC_HANDLE; dwControl: DWORD;
  var lpServiceStatus: TServiceStatus): BOOL; stdcall; external advapi32;
function SetServiceStatus(hServiceStatus: SERVICE_STATUS_HANDLE;
  var lpServiceStatus: TServiceStatus): BOOL; stdcall; external advapi32;
function RegisterServiceCtrlHandler(lpServiceName: PChar;
  lpHandlerProc: TFarProc): SERVICE_STATUS_HANDLE; stdcall; external advapi32
  name 'RegisterServiceCtrlHandler'+{$ifdef UNICODE}'W'{$else}'A'{$endif};
function StartServiceCtrlDispatcher(
  var lpServiceStartTable: TServiceTableEntry): BOOL; stdcall; external advapi32
  name 'StartServiceCtrlDispatcher'+{$ifdef UNICODE}'W'{$else}'A'{$endif};


{ *** high level classes to define and manage Windows Services }

var
  /// you can set this global variable to TSynLog or TSQLLog to enable logging
  // - default is nil, i.e. disabling logging, since it may interfere with the
  // logging process of the service itself
................................................................................

/// 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,Dependencies,Username,Password: String;
  DesiredAccess,ServiceType,StartType,ErrorControl: DWORD);
var Exe: TFileName;
................................................................................
    CloseServiceHandle(FSCHandle);
  inherited;
end;

function TServiceController.GetState: TServiceState;
begin
  if (self=nil) or (FSCHandle=0) or (FHandle=0) then
    result := ssNotInstalled else
    result := CurrentStateToServiceState(Status.dwCurrentState);
  ServiceLog.Add.Log(sllTrace,FName,TypeInfo(TServiceState),result);
end;

function TServiceController.GetStatus: TServiceStatus;
begin
  FillChar(FStatus, Sizeof(FStatus), 0);
................................................................................

{ TService }

function FindServiceIndex(const Name: String): integer;
begin
  if Services<>nil then
  for result := 0 to Services.Count-1 do
    if TService(Services.List[result]).ServiceName=Name then
      exit;
  result := -1;
end;

procedure JumpToService;
{$ifdef CPU64}
{$ifdef FPC}nostackframe; assembler;

Changes to SynopseCommit.inc. 

1

'1.18.2635'

|

1

'1.18.2636'

©2010-2022 Synopse Informatique