From 360f06ae74bb4eeac5e868a8d8395c6a084edab1 Mon Sep 17 00:00:00 2001 From: Mark van Renswoude Date: Mon, 24 Oct 2016 17:15:03 +0200 Subject: [PATCH] Added thread for running the service in GUIContext Added Elevation check for install / uninstall --- X2UtService.GUIContext.Form.pas | 221 +++++++++++++++++++++++++++----- X2UtService.GUIContext.pas | 22 ++-- X2UtService.ServiceContext.pas | 26 +++- X2UtService.pas | 9 +- 4 files changed, 227 insertions(+), 51 deletions(-) diff --git a/X2UtService.GUIContext.Form.pas b/X2UtService.GUIContext.Form.pas index 38376ca..9f03b10 100644 --- a/X2UtService.GUIContext.Form.pas +++ b/X2UtService.GUIContext.Form.pas @@ -6,15 +6,13 @@ uses Vcl.Controls, Vcl.ExtCtrls, Vcl.Forms, + Vcl.Graphics, Vcl.StdCtrls, Winapi.Messages, X2UtService.Intf; -const - CM_AFTERSHOW = WM_USER + 1; - type TX2ServiceContextGUIForm = class(TForm) btnClose: TButton; @@ -33,12 +31,15 @@ type private FContext: IX2ServiceContext; FService: IX2Service; + FServiceThread: TThread; + FAllowClose: Boolean; protected procedure DoShow; override; - procedure CMAfterShow(var Msg: TMessage); message CM_AFTERSHOW; - function GetControlCode: Byte; + procedure SetStatus(const AMessage: string; AColor: TColor); + + property ServiceThread: TThread read FServiceThread; public property Context: IX2ServiceContext read FContext write FContext; property Service: IX2Service read FService write FService; @@ -47,9 +48,10 @@ type implementation uses + System.Generics.Collections, System.Math, + System.SyncObjs, System.SysUtils, - Vcl.Graphics, Winapi.Windows; @@ -63,36 +65,87 @@ const StatusColorStopped = clRed; -// #ToDo1 -oMvR: 21-10-2016: separate service handling out to thread to prevent blocking of the UI +type + TX2ServiceThread = class(TThread) + private + FContext: IX2ServiceContext; + FService: IX2Service; + FWakeEvent: TEvent; + FSendCodeList: TList; + + FOnStarted: TThreadProcedure; + FOnStartFailed: TThreadProcedure; + FOnStopped: TThreadProcedure; + FOnStopFailed: TThreadProcedure; + protected + procedure Execute; override; + procedure TerminatedSet; override; + + procedure FlushSendCodeList; + + property Context: IX2ServiceContext read FContext; + property Service: IX2Service read FService; + property WakeEvent: TEvent read FWakeEvent; + public + constructor Create(AContext: IX2ServiceContext; AService: IX2Service); + destructor Destroy; override; + + procedure SendControlCode(ACode: Byte); + + property OnStarted: TThreadProcedure read FOnStarted write FOnStarted; + property OnStartFailed: TThreadProcedure read FOnStartFailed write FOnStartFailed; + property OnStopped: TThreadProcedure read FOnStopped write FOnStopped; + property OnStopFailed: TThreadProcedure read FOnStopFailed write FOnStopFailed; + end; + { TX2ServiceContextGUIForm } procedure TX2ServiceContextGUIForm.DoShow; +var + serviceThread: TX2ServiceThread; begin inherited DoShow; - PostMessage(Self.Handle, CM_AFTERSHOW, 0, 0); -end; - - -procedure TX2ServiceContextGUIForm.CMAfterShow(var Msg: TMessage); -begin - shpStatus.Brush.Color := StatusColorStarting; - lblStatus.Caption := 'Starting...'; - Application.ProcessMessages; - - if Service.Start(Context) then + if not Assigned(FServiceThread) then begin - shpStatus.Brush.Color := StatusColorStarted; - lblStatus.Caption := 'Started'; - end else - begin - shpStatus.Brush.Color := StatusColorStopped; - lblStatus.Caption := 'Failed to start'; + SetStatus('Starting...', StatusColorStarting); + serviceThread := TX2ServiceThread.Create(Context, Service); + serviceThread.OnStarted := + procedure + begin + SetStatus('Started', StatusColorStarted); + end; + + serviceThread.OnStartFailed := + procedure + begin + SetStatus('Start failed', StatusColorStopped); + FServiceThread := nil; + end; + + serviceThread.OnStopped := + procedure + begin + SetStatus('Stopped', StatusColorStopped); + + FAllowClose := True; + Close; + end; + + serviceThread.OnStopFailed := + procedure + begin + SetStatus('Stop failed', StatusColorStarted); + end; + + FServiceThread := serviceThread; + FServiceThread.Start; end; end; + procedure TX2ServiceContextGUIForm.edtControlCodeChange(Sender: TObject); begin edtControlCode.Text := IntToStr(GetControlCode); @@ -101,7 +154,7 @@ end; procedure TX2ServiceContextGUIForm.btnSendClick(Sender: TObject); begin - Service.DoCustomControl(GetControlCode); + (ServiceThread as TX2ServiceThread).SendControlCode(GetControlCode); end; @@ -113,14 +166,13 @@ end; procedure TX2ServiceContextGUIForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean); begin - shpStatus.Brush.Color := StatusColorStopping; - lblStatus.Caption := 'Stopping...'; - Application.ProcessMessages; + if not FAllowClose then + begin + SetStatus('Stopping...', StatusColorStopping); + CanClose := False; - CanClose := Service.Stop; - - if not CanClose then - lblStatus.Caption := 'Failed to stop'; + ServiceThread.Terminate; + end; end; @@ -129,4 +181,109 @@ begin Result := Byte(Min(Max(StrToIntDef(edtControlCode.Text, 0), 128), 255)); end; + +procedure TX2ServiceContextGUIForm.SetStatus(const AMessage: string; AColor: TColor); +begin + shpStatus.Brush.Color := AColor; + lblStatus.Caption := AMessage; +end; + + +{ TX2ServiceThread } +constructor TX2ServiceThread.Create(AContext: IX2ServiceContext; AService: IX2Service); +begin + inherited Create(True); + + FContext := AContext; + FService := AService; + + FWakeEvent := TEvent.Create(nil, False, False, ''); + FSendCodeList := TList.Create; +end; + + +destructor TX2ServiceThread.Destroy; +begin + FreeAndNil(FWakeEvent); + FreeAndNil(FSendCodeList); + + inherited Destroy; +end; + + +procedure TX2ServiceThread.Execute; +begin + try + Service.Start(Context); + except + if Assigned(FOnStartFailed) then + Synchronize(FOnStartFailed); + + exit; + end; + + if Assigned(FOnStarted) then + Synchronize(FOnStarted); + + while True do + begin + try + WakeEvent.WaitFor(INFINITE); + + if Terminated then + begin + Service.Stop; + + if Assigned(FOnStopped) then + Synchronize(FOnStopped); + + break; + end; + + FlushSendCodeList; + except + if Assigned(FOnStopFailed) then + Synchronize(FOnStopFailed); + end; + end; +end; + + +procedure TX2ServiceThread.FlushSendCodeList; +var + code: Byte; + +begin + System.TMonitor.Enter(FSendCodeList); + try + for code in FSendCodeList do + Service.DoCustomControl(code); + + FSendCodeList.Clear; + finally + System.TMonitor.Exit(FSendCodeList); + end; +end; + + +procedure TX2ServiceThread.TerminatedSet; +begin + inherited TerminatedSet; + + WakeEvent.SetEvent; +end; + + +procedure TX2ServiceThread.SendControlCode(ACode: Byte); +begin + System.TMonitor.Enter(FSendCodeList); + try + FSendCodeList.Add(ACode); + finally + System.TMonitor.Exit(FSendCodeList); + end; + + WakeEvent.SetEvent; +end; + end. diff --git a/X2UtService.GUIContext.pas b/X2UtService.GUIContext.pas index 9407ad7..c7d2d49 100644 --- a/X2UtService.GUIContext.pas +++ b/X2UtService.GUIContext.pas @@ -19,6 +19,8 @@ type implementation uses + Vcl.Forms, + X2UtService.GUIContext.Form; @@ -38,16 +40,18 @@ end; procedure TX2ServiceContextGUI.StartService(AService: IX2Service); -begin - with TX2ServiceContextGUIForm.Create(nil) do - try - Caption := AService.DisplayName; - Service := AService; +var + serviceForm: TX2ServiceContextGUIForm; - ShowModal; - finally - Free; - end; +begin + Application.Initialize; + Application.MainFormOnTaskBar := True; + + Application.CreateForm(TX2ServiceContextGUIForm, serviceForm); + serviceForm.Caption := AService.DisplayName; + serviceForm.Service := AService; + + Application.Run; end; end. diff --git a/X2UtService.ServiceContext.pas b/X2UtService.ServiceContext.pas index 01b6d71..a1a8ce9 100644 --- a/X2UtService.ServiceContext.pas +++ b/X2UtService.ServiceContext.pas @@ -10,6 +10,8 @@ type protected procedure StartService(AService: IX2Service); virtual; public + class function IsInstallUninstall: Boolean; + constructor Create(AService: IX2Service); { IX2ServiceContext } @@ -20,7 +22,10 @@ type implementation uses System.Classes, - Vcl.SvcMgr; + System.SysUtils, + Vcl.SvcMgr, + + X2UtElevation; type @@ -56,9 +61,21 @@ end; { TX2ServiceContextService } +class function TX2ServiceContextService.IsInstallUninstall: Boolean; +begin + Result := FindCmdLineSwitch('install', ['-', '/'], True) or + FindCmdLineSwitch('uninstall', ['-', '/'], True); +end; + + constructor TX2ServiceContextService.Create(AService: IX2Service); begin inherited Create; + + if IsInstallUninstall and (not IsElevated) then + raise Exception.Create('Elevation is required for install or uninstall'); + + StartService(AService); end; @@ -76,8 +93,8 @@ begin Application.Initialize; ServiceModuleInstance := TX2ServiceModule.Create(Application, Self, AService); try - ServiceModuleInstance.DisplayName := '';// - ServiceModuleInstance.ServiceStartName := '';// + ServiceModuleInstance.DisplayName := AService.DisplayName; + ServiceModuleInstance.Name := AService.ServiceName; Application.Run; finally @@ -89,7 +106,8 @@ end; { TX2ServiceModule } constructor TX2ServiceModule.Create(AOwner: TComponent; AContext: IX2ServiceContext; AService: IX2Service); begin - inherited Create(AOwner); + // Skip default constructor to prevent DFM streaming + CreateNew(AOwner); FContext := AContext; FService := AService; diff --git a/X2UtService.pas b/X2UtService.pas index 27a3f91..4942ed2 100644 --- a/X2UtService.pas +++ b/X2UtService.pas @@ -53,12 +53,9 @@ 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 + if TX2ServiceContextService.IsInstallUninstall or (not IsUserInteractive) then + Result := TX2ServiceContextService.Create(AService) + else Result := TX2ServiceContextGUI.Create(AService); end;