From 4a287a07159c2da10242192320fe7554dab1d195 Mon Sep 17 00:00:00 2001 From: Mark van Renswoude Date: Fri, 21 Oct 2016 13:58:28 +0200 Subject: [PATCH] Added X2UtService wrapper --- .gitignore | 1 + X2UtService.GUIContext.Form.dfm | 105 ++++++++++++++++++++++++++ X2UtService.GUIContext.Form.pas | 95 ++++++++++++++++++++++++ X2UtService.GUIContext.pas | 51 +++++++++++++ X2UtService.Intf.pas | 82 ++++++++++++++++++++ X2UtService.ServiceContext.pas | 128 ++++++++++++++++++++++++++++++++ X2UtService.pas | 65 ++++++++++++++++ 7 files changed, 527 insertions(+) create mode 100644 .gitignore create mode 100644 X2UtService.GUIContext.Form.dfm create mode 100644 X2UtService.GUIContext.Form.pas create mode 100644 X2UtService.GUIContext.pas create mode 100644 X2UtService.Intf.pas create mode 100644 X2UtService.ServiceContext.pas create mode 100644 X2UtService.pas diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..82ab9f9 --- /dev/null +++ b/.gitignore @@ -0,0 +1 @@ +__history/ diff --git a/X2UtService.GUIContext.Form.dfm b/X2UtService.GUIContext.Form.dfm new file mode 100644 index 0000000..9a9f940 --- /dev/null +++ b/X2UtService.GUIContext.Form.dfm @@ -0,0 +1,105 @@ +object X2ServiceContextGUIForm: TX2ServiceContextGUIForm + Left = 0 + Top = 0 + BorderIcons = [biSystemMenu, biMinimize] + BorderStyle = bsSingle + Caption = 'X2ServiceContextGUIForm' + ClientHeight = 177 + ClientWidth = 285 + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [] + OldCreateOrder = False + OnCloseQuery = FormCloseQuery + DesignSize = ( + 285 + 177) + PixelsPerInch = 96 + TextHeight = 13 + object btnClose: TButton + Left = 107 + Top = 144 + Width = 75 + Height = 25 + Anchors = [akLeft, akBottom] + Caption = '&Close' + TabOrder = 0 + ExplicitTop = 180 + end + object gbStatus: TGroupBox + AlignWithMargins = True + Left = 8 + Top = 8 + Width = 269 + Height = 57 + Margins.Left = 8 + Margins.Top = 8 + Margins.Right = 8 + Margins.Bottom = 0 + Align = alTop + Caption = ' Status ' + TabOrder = 1 + ExplicitWidth = 261 + object lblStatus: TLabel + Left = 34 + Top = 26 + Width = 50 + Height = 13 + Caption = 'Starting...' + end + object Shape1: TShape + Left = 12 + Top = 24 + Width = 16 + Height = 16 + end + end + object gbCustomControl: TGroupBox + AlignWithMargins = True + Left = 8 + Top = 73 + Width = 269 + Height = 60 + Margins.Left = 8 + Margins.Top = 8 + Margins.Right = 8 + Margins.Bottom = 0 + Align = alTop + Caption = ' Custom control ' + TabOrder = 2 + DesignSize = ( + 269 + 60) + object lblControlCode: TLabel + Left = 12 + Top = 27 + Width = 25 + Height = 13 + Caption = 'Code' + end + object edtControlCode: TEdit + Left = 72 + Top = 24 + Width = 102 + Height = 21 + Anchors = [akLeft, akTop, akRight] + TabOrder = 0 + Text = '128' + OnChange = edtControlCodeChange + ExplicitWidth = 173 + end + object btnSend: TButton + Left = 180 + Top = 24 + Width = 75 + Height = 21 + Anchors = [akTop, akRight] + Caption = '&Send' + TabOrder = 1 + ExplicitLeft = 251 + end + end +end diff --git a/X2UtService.GUIContext.Form.pas b/X2UtService.GUIContext.Form.pas new file mode 100644 index 0000000..f2b8a2b --- /dev/null +++ b/X2UtService.GUIContext.Form.pas @@ -0,0 +1,95 @@ +unit X2UtService.GUIContext.Form; + +interface +uses + System.Classes, + Vcl.Controls, + Vcl.ExtCtrls, + Vcl.Forms, + Vcl.StdCtrls, + Winapi.Messages, + + X2UtService.Intf; + + +const + CM_AFTERSHOW = WM_USER + 1; + +type + TX2ServiceContextGUIForm = class(TForm) + btnClose: TButton; + gbStatus: TGroupBox; + lblStatus: TLabel; + Shape1: TShape; + gbCustomControl: TGroupBox; + lblControlCode: TLabel; + edtControlCode: TEdit; + btnSend: TButton; + + procedure edtControlCodeChange(Sender: TObject); + procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean); + private + FContext: IX2ServiceContext; + FService: IX2Service; + protected + procedure DoShow; override; + + procedure CMAfterShow(var Msg: TMessage); message CM_AFTERSHOW; + public + property Context: IX2ServiceContext read FContext write FContext; + property Service: IX2Service read FService write FService; + end; + + +implementation +uses + System.Math, + System.SysUtils, + Winapi.Windows; + + +{$R *.dfm} + + +// #ToDo1 -oMvR: 21-10-2016: separate service handling out to thread to prevent blocking of the UI + + +{ TX2ServiceContextGUIForm } +procedure TX2ServiceContextGUIForm.DoShow; +begin + inherited DoShow; + + PostMessage(Self.Handle, CM_AFTERSHOW, 0, 0); +end; + + +procedure TX2ServiceContextGUIForm.CMAfterShow(var Msg: TMessage); +begin + lblStatus.Caption := 'Starting...'; + lblStatus.Update; + + if Service.Start(Context) then + lblStatus.Caption := 'Started' + else + lblStatus.Caption := 'Failed to start'; +end; + + +procedure TX2ServiceContextGUIForm.edtControlCodeChange(Sender: TObject); +begin + edtControlCode.Text := IntToStr(Min(Max(StrToIntDef(edtControlCode.Text, 0), 128), 255)); +end; + + +procedure TX2ServiceContextGUIForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean); +begin + lblStatus.Caption := 'Stopping...'; + lblStatus.Update; + + CanClose := Service.Stop; + + if not CanClose then + lblStatus.Caption := 'Failed to stop'; +end; + +end. diff --git a/X2UtService.GUIContext.pas b/X2UtService.GUIContext.pas new file mode 100644 index 0000000..f114658 --- /dev/null +++ b/X2UtService.GUIContext.pas @@ -0,0 +1,51 @@ +unit X2UtService.GUIContext; + +interface +uses + X2UtService.Intf; + + +type + TX2ServiceContextGUI = class(TInterfacedObject, IX2ServiceContext) + protected + procedure StartService(AService: IX2Service); virtual; + public + constructor Create(AService: IX2Service); + + { IX2ServiceContext } + function GetMode: TX2ServiceMode; + end; + + +implementation +uses + X2UtService.GUIContext.Form; + + +{ TX2ServiceContextGUI } +constructor TX2ServiceContextGUI.Create(AService: IX2Service); +begin + inherited Create; +end; + + +function TX2ServiceContextGUI.GetMode: TX2ServiceMode; +begin + Result := smInteractive; +end; + + +procedure TX2ServiceContextGUI.StartService(AService: IX2Service); +begin + with TX2ServiceContextGUIForm.Create(nil) do + try + Caption := AService.DisplayName; + Service := AService; + + ShowModal; + finally + Free; + end; +end; + +end. diff --git a/X2UtService.Intf.pas b/X2UtService.Intf.pas new file mode 100644 index 0000000..e1946b0 --- /dev/null +++ b/X2UtService.Intf.pas @@ -0,0 +1,82 @@ +unit X2UtService.Intf; + +interface +uses + Classes; + + +type + TX2ServiceMode = (smService, smInteractive); + + + IX2ServiceContext = interface + ['{0AC283A7-B46C-4E4E-8F36-F8AA1272E04B}'] + function GetMode: TX2ServiceMode; + + property Mode: TX2ServiceMode read GetMode; + end; + + + IX2Service = interface + ['{C8597906-87B8-444E-847B-37A034F72FFC}'] + function GetServiceName: string; + function GetDisplayName: string; + + + { Called when the service starts. Return True if succesful. + Storing a reference to AContext is allowed, but must be released when Stop is called. } + function Start(AContext: IX2ServiceContext): Boolean; + + { Called when the service is about to stop. + Return True if succesful. } + function Stop: Boolean; + + { Called for control codes in the user-defined range of 128 to 255. } + function DoCustomControl(ACode: Byte): Boolean; + + + property ServiceName: string read GetServiceName; + property DisplayName: string read GetDisplayName; + end; + + + TX2CustomService = class(TInterfacedObject, IX2Service) + private + FContext: IX2ServiceContext; + protected + property Context: IX2ServiceContext read FContext; + public + { IX2Service } + function GetServiceName: string; virtual; abstract; + function GetDisplayName: string; virtual; abstract; + + function Start(AContext: IX2ServiceContext): Boolean; virtual; + function Stop: Boolean; virtual; + + function DoCustomControl(ACode: Byte): Boolean; virtual; + end; + + + +implementation + + +{ TX2CustomService } +function TX2CustomService.Start(AContext: IX2ServiceContext): Boolean; +begin + FContext := AContext; +end; + + +function TX2CustomService.Stop: Boolean; +begin + FContext := nil; +end; + + +function TX2CustomService.DoCustomControl(ACode: Byte): Boolean; +begin + Result := True; +end; + +end. diff --git a/X2UtService.ServiceContext.pas b/X2UtService.ServiceContext.pas new file mode 100644 index 0000000..01b6d71 --- /dev/null +++ b/X2UtService.ServiceContext.pas @@ -0,0 +1,128 @@ +unit X2UtService.ServiceContext; + +interface +uses + X2UtService.Intf; + + +type + TX2ServiceContextService = class(TInterfacedObject, IX2ServiceContext) + protected + procedure StartService(AService: IX2Service); virtual; + public + constructor Create(AService: IX2Service); + + { IX2ServiceContext } + function GetMode: TX2ServiceMode; + end; + + +implementation +uses + System.Classes, + Vcl.SvcMgr; + + +type + TX2ServiceModule = class(TService) + private + FContext: IX2ServiceContext; + FService: IX2Service; + protected + function GetServiceController: TServiceController; override; + + procedure HandleStart(Sender: TService; var Started: Boolean); virtual; + procedure HandleStop(Sender: TService; var Stopped: Boolean); virtual; + + function DoCustomControl(CtrlCode: Cardinal): Boolean; override; + + property Context: IX2ServiceContext read FContext; + property Service: IX2Service read FService; + public + constructor Create(AOwner: TComponent; AContext: IX2ServiceContext; AService: IX2Service); reintroduce; + end; + + +var + ServiceModuleInstance: TX2ServiceModule; + + +procedure ServiceController(CtrlCode: Cardinal); stdcall; +begin + if Assigned(ServiceModuleInstance) then + ServiceModuleInstance.Controller(CtrlCode); +end; + + + +{ TX2ServiceContextService } +constructor TX2ServiceContextService.Create(AService: IX2Service); +begin + inherited Create; +end; + + +function TX2ServiceContextService.GetMode: TX2ServiceMode; +begin + Result := smService; +end; + + +procedure TX2ServiceContextService.StartService(AService: IX2Service); +begin + if Assigned(ServiceModuleInstance) then + raise EInvalidOperation.Create('An instance of TX2ServiceContextService is already running'); + + Application.Initialize; + ServiceModuleInstance := TX2ServiceModule.Create(Application, Self, AService); + try + ServiceModuleInstance.DisplayName := '';// + ServiceModuleInstance.ServiceStartName := '';// + + Application.Run; + finally + ServiceModuleInstance := nil; + end; +end; + + +{ TX2ServiceModule } +constructor TX2ServiceModule.Create(AOwner: TComponent; AContext: IX2ServiceContext; AService: IX2Service); +begin + inherited Create(AOwner); + + FContext := AContext; + FService := AService; + + OnStart := HandleStart; + OnStop := HandleStop; +end; + + +function TX2ServiceModule.GetServiceController: TServiceController; +begin + Result := ServiceController; +end; + + +function TX2ServiceModule.DoCustomControl(CtrlCode: Cardinal): Boolean; +begin + Result := True; + + if (CtrlCode >= 128) and (CtrlCode <= 255) then + Result := Service.DoCustomControl(Byte(CtrlCode)); +end; + + +procedure TX2ServiceModule.HandleStart(Sender: TService; var Started: Boolean); +begin + Started := Service.Start(Context); +end; + + +procedure TX2ServiceModule.HandleStop(Sender: TService; var Stopped: Boolean); +begin + Stopped := Service.Stop; +end; + +end. diff --git a/X2UtService.pas b/X2UtService.pas new file mode 100644 index 0000000..27a3f91 --- /dev/null +++ b/X2UtService.pas @@ -0,0 +1,65 @@ +unit X2UtService; + +interface +uses + X2UtService.Intf; + + +type + TX2Service = class(TObject) + public + class function Run(AService: IX2Service): IX2ServiceContext; + end; + + + function IsUserInteractive: Boolean; + + +implementation +uses + System.SysUtils, + Winapi.Windows, + + X2UtService.GUIContext, + X2UtService.ServiceContext; + + + +function IsUserInteractive: Boolean; +var + windowStation: HWINSTA; + userObject: TUserObjectFlags; + lengthNeeded: Cardinal; + +begin + Result := True; + + windowStation := GetProcessWindowStation; + if windowStation <> 0 then + begin + lengthNeeded := 0; + FillChar(userObject, SizeOf(userObject), 0); + + if GetUserObjectInformation(windowStation, UOI_FLAGS, @userObject, SizeOf(userObject), lengthNeeded) and + ((userObject.dwFlags and WSF_VISIBLE) = 0) then + begin + Result := False; + end; + end; +end; + + + +{ TX2Service } +class function TX2Service.Run(AService: IX2Service): IX2ServiceContext; +begin + if FindCmdLineSwitch('install', ['-', '/'], True) or + FindCmdLineSwitch('uninstall', ['-', '/'], True) or + (not IsUserInteractive) then + begin + Result := TX2ServiceContextService.Create(AService); + end else + Result := TX2ServiceContextGUI.Create(AService); +end; + +end.