Service Control Another option for Control Panel >Administrative Tools > Services Service Control [with install, uninstall, run, stop, leave] Service Control [with install, uninstall, run, stop, leave] The Project File: ServiceControl.lpr Pascal (776 Bytes) 26.10.2015 00:53 // ***************************************************************************** // Title.............. : Service Control Project // // Modulname ......... : ServiceControl.lpr // Type .............. : Lazarus Project File // Author ............ : Udo Schmal // Development Status : 26.10.2015 // Operating System .. : Win32/Win64 // IDE ............... : Lazarus // ***************************************************************************** program ServiceControl; {$mode objfpc}{$H+} uses Interfaces, Forms, Main; {$R *.res} begin Application.Title:='Service Control'; RequireDerivedFormResource := True; Application.Initialize; Application.CreateForm(TfrmServiceControl, frmServiceControl); Application.Run; end. The Form File: (in this example for my webserver) main.pas Pascal (9,11 kByte) 26.10.2015 00:51 // ***************************************************************************** // Title.............. : Service Control Main // // Modulname ......... : main.pas (TfrmServiceControl) // Type .............. : Unit // Author ............ : Udo Schmal // Development Status : 26.10.2015 // Operating System .. : Win32/Win64 // IDE ............... : Lazarus // ***************************************************************************** unit Main; {$mode objfpc}{$H+} interface uses Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls, {$ifdef USE_SHELLAPI}Windows, ShellApi,{$else}Process,{$endif} {$ifdef USE_REGISTRY}Registry,{$endif} Menus, ServiceManager, JwaWinSvc, TaskScheduler_1_0_TLB; const ServiceName = 'httpServer'; ServiceTitel = 'UDOs Webserver'; ServiceExecutable = 'httpServer.exe'; type TfrmServiceControl = class(TForm) ImageList: TImageList; leave: TMenuItem; install: TMenuItem; uninstall: TMenuItem; stop: TMenuItem; start: TMenuItem; TrayMenu: TPopupMenu; TrayIcon: TTrayIcon; procedure FormCloseQuery(Sender: TObject; var CanClose: boolean); procedure FormCreate(Sender: TObject); procedure installClick(Sender: TObject); procedure leaveClick(Sender: TObject); procedure TrayMenuPopup(Sender: TObject); procedure startClick(Sender: TObject); procedure stopClick(Sender: TObject); procedure TrayIconMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure uninstallClick(Sender: TObject); private FPath: string; FServiceIsInstalled, FServiceIsRunning: Boolean; procedure SetAutoStart(bRegister: Boolean); procedure UpdateServiceStatus(); end; var frmServiceControl: TfrmServiceControl; implementation {$R *.lfm} {$ifdef USE_SHELLAPI} function RunAsAdmin(const Handle: Hwnd; const Path: string; Params: string = ''): Boolean; var sei: TShellExecuteInfoA; begin FillChar(sei, SizeOf(sei), 0); sei.cbSize := SizeOf(sei); sei.Wnd := Handle; sei.fMask := SEE_MASK_FLAG_DDEWAIT or SEE_MASK_FLAG_NO_UI; sei.lpVerb := 'runas'; sei.lpFile := PAnsiChar(Path); sei.lpParameters := PAnsiChar(Params); sei.nShow := SW_HIDE;//SW_SHOWNORMAL; Result := ShellExecuteExA(@sei); if not Result then RaiseLastOSError; end; {$endif} procedure TfrmServiceControl.SetAutoStart(bRegister: Boolean); {$ifdef USE_REGISTRY} // only works with UAC Disable and always Admin const RegKey = '\SOFTWARE\Microsoft\Windows\CurrentVersion\Run'; var Registry: TRegistry; begin Registry := TRegistry.Create; try // Registry.RootKey := HKEY_CURRENT_USER; Registry.RootKey := HKEY_LOCAL_MACHINE; if Registry.OpenKey(RegKey, False) then begin if bRegister = False then Registry.DeleteValue(ChangeFileExt(ExtractFileName(ParamStr(0)), '')) else Registry.WriteString(ChangeFileExt(ExtractFileName(ParamStr(0)), ''), '"'+ParamStr(0)+'"'); end; finally Registry.Free; end; end; {$else} var TS: ITaskService; TaskFolder: ITaskFolder; TaskDefinition: ITaskDefinition; RegInfo: IRegistrationInfo; Principal: IPrincipal; TaskSettings: ITaskSettings; Triggers: ITriggerCollection; Trigger: ITrigger; Exec: IAction; begin TS := CoTaskScheduler.Create; TS.Connect(null, null, null, null); TaskFolder := TS.GetFolder('\'); if (bRegister) then begin TaskDefinition := TS.NewTask(0); RegInfo := TaskDefinition.RegistrationInfo; RegInfo.Description := 'Service Control Task'; RegInfo.Author := 'Udo Schmal'; Principal := TaskDefinition.Principal; Principal.Id := 'Author'; Principal.RunLevel := TASK_RUNLEVEL_HIGHEST; Triggers := TaskDefinition.Triggers; Trigger := Triggers.Create(TASK_TRIGGER_LOGON); Trigger.StartBoundary := FormatDateTime('yyyy"-"mm"-"dd"T"hh":"nn":"ss', Now); // Trigger.EndBoundary := '2100-01-01T00:00:00'; // Trigger.ExecutionTimeLimit := 'PT72H'; Trigger.Id := 'AnyLogon'; Trigger.Enabled := true; TaskSettings := TaskDefinition.Settings; TaskSettings.MultipleInstances := TASK_INSTANCES_IGNORE_NEW; TaskSettings.DisallowStartIfOnBatteries := false; TaskSettings.StopIfGoingOnBatteries := false; TaskSettings.AllowHardTerminate := true; TaskSettings.StartWhenAvailable := true; TaskSettings.RunOnlyIfNetworkAvailable := false; TaskSettings.IdleSettings.StopOnIdleEnd := false; TaskSettings.IdleSettings.RestartOnIdle := false; TaskSettings.AllowDemandStart := true; TaskSettings.Enabled := true; TaskSettings.Hidden := false; TaskSettings.RunOnlyIfIdle := false; TaskSettings.WakeToRun := false; TaskSettings.ExecutionTimeLimit := 'PT0S'; TaskSettings.Priority := 7; TaskDefinition.Actions.Context := 'Author'; Exec := TaskDefinition.Actions.Create(0); IExecAction(Exec).Id := 'Action'; IExecAction(Exec).Path := ParamStr(0); IExecAction(Exec).Arguments := ''; IExecAction(Exec).WorkingDirectory := ExtractFilePath(ParamStr(0)); TaskFolder.RegisterTaskDefinition('Service Starter', TaskDefinition, TASK_CREATE_OR_UPDATE, NULL, NULL, TASK_LOGON_INTERACTIVE_TOKEN, NULL); end else TaskFolder.DeleteTask('Service Starter', 0); end; {$endif} procedure TfrmServiceControl.UpdateServiceStatus(); var Services: TServiceManager; ServiceStatus: TServiceStatus; begin FServiceIsInstalled := false; FServiceIsRunning := false; Services := TServiceManager.Create(nil); try try // Services.Acces := SC_MANAGER_CONNECT; Services.Connect; Services.GetServiceStatus(ServiceName, ServiceStatus); FServiceIsInstalled := ServiceStatus.dwCurrentState <> 0; FServiceIsRunning := ServiceStatus.dwCurrentState = SERVICE_RUNNING; Services.Disconnect; if FServiceIsRunning then TrayIcon.Hint := ServiceTitel + #10'status: running' else if FServiceIsInstalled then TrayIcon.Hint := ServiceTitel + #10'status: installed' else TrayIcon.Hint := ServiceTitel + #10'status: not installed'; except on E: Exception do begin FServiceIsInstalled := false; FServiceIsRunning := false; end; end; finally Services.Free; end; TrayMenu.Items[0].Visible := not FServiceIsInstalled; //install TrayMenu.Items[1].Visible := FServiceIsInstalled and not FServiceIsRunning; //start TrayMenu.Items[2].Visible := FServiceIsInstalled and FServiceIsRunning; //stop TrayMenu.Items[3].Visible := FServiceIsInstalled and not FServiceIsRunning; //uninstall TrayMenu.Items[4].Visible := not FServiceIsInstalled; //leave end; procedure TfrmServiceControl.FormCloseQuery(Sender: TObject; var CanClose: boolean); begin UpdateServiceStatus(); WindowState := wsMinimized; Hide; CanClose := not FServiceIsInstalled; end; procedure TfrmServiceControl.FormCreate(Sender: TObject); begin WindowState := wsMinimized; Hide; TrayIcon.Hint := ServiceTitel; TrayIcon.BalloonTitle := ServiceTitel; FPath := ExtractFilePath(ParamStr(0)); end; procedure TfrmServiceControl.TrayMenuPopup(Sender: TObject); begin UpdateServiceStatus(); end; procedure TfrmServiceControl.startClick(Sender: TObject); var Services: TServiceManager; begin Services := TServiceManager.Create(nil); try // Services.Acces := SC_MANAGER_ALL_ACCESS; Services.Connect; Services.StartService(ServiceName, nil); Services.Disconnect; finally Services.Free; end; UpdateServiceStatus(); end; procedure TfrmServiceControl.stopClick(Sender: TObject); var Services: TServiceManager; begin Services := TServiceManager.Create(nil); try // Services.Acces := SC_MANAGER_ALL_ACCESS; Services.Connect; Services.StopService(ServiceName, true); Services.Disconnect; finally Services.Free; end; UpdateServiceStatus(); end; procedure TfrmServiceControl.TrayIconMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); begin UpdateServiceStatus(); end; procedure TfrmServiceControl.installClick(Sender: TObject); {$ifdef USE_SHELLAPI} begin RunAsAdmin(self.Handle, FPath + ServiceExecutable, '--install'); {$else} var AProcess: TProcess; begin AProcess := TProcess.Create(nil); AProcess.Executable := FPath + ServiceExecutable; AProcess.Parameters.Add('--install'); AProcess.Options := [poWaitOnExit]; AProcess.Execute; AProcess.Free; {$endif} UpdateServiceStatus(); SetAutoStart(true); end; procedure TfrmServiceControl.uninstallClick(Sender: TObject); {$ifdef USE_SHELLAPI} begin RunAsAdmin(self.Handle, FPath + ServiceExecutable, '--uninstall'); {$else} var AProcess: TProcess; begin AProcess := TProcess.Create(nil); AProcess.Executable := FPath + ServiceExecutable; AProcess.Parameters.Add('--uninstall'); AProcess.Options := [poWaitOnExit]; AProcess.Execute; AProcess.Free; {$endif} UpdateServiceStatus(); SetAutoStart(false); end; procedure TfrmServiceControl.leaveClick(Sender: TObject); begin Close; end; end. The Complete Project: ServiceControl.zip (56,03 kByte) 30.12.2018 21:29 Author: Udo Schmal, published: 25.10.2015, last modified: 06.09.2023