Beliebiges Programm als Service?

[himitsu]

Oder andersrum.

Man baut einen Service, welcher sich (über einen Parameter, bzw. über eine Debugger-Erkennung) als normales Programm startet.
So hab ich das mit dem Service unsere unserer Produktes auch gehandhabt.

[edit]

Delphi-Quellcode:

unit MyServiceDataModul;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, SvcMgr, Math, AppEvnts, Registry, Dialogs, ExtCtrls, Types, StdCtrls;

type
  TMyService = class(TService)
    function  GetServiceController: TServiceController; override;
    procedure ServiceCreate(Sender: TObject);
    procedure ServiceStart(Sender: TService; var Started: Boolean);
    procedure ServiceExecute(Sender: TService);
    procedure DebugServiceClose(Sender: TObject; var CanClose: Boolean);
  end;

var
  MyService: TMyService;

implementation

{$R *.DFM}

procedure ServiceController(CtrlCode: DWord); stdcall;
begin
  MyService.Controller(CtrlCode);
end;

function TMyService.GetServiceController: TServiceController;
begin
  Result := ServiceController;
end;

type
  TServiceApplicationHack = class(TServiceApplication);

procedure TMyService.ServiceCreate(Sender: TObject);
var
  Started: Boolean;
  Temp:    TForm;
begin
  if IsDebuggerPresent or FindCmdLineSwitch('DEBUG', ['-', '/'], True) then begin
    Forms.Application.MainFormOnTaskBar := False; // geht leider doch nicht ohne Form
    Forms.Application.CreateForm(TForm, Temp);    // Form zum Beenden und für Eintrag in Taskbar
    Temp.Caption      := 'Debug-Mode: ' + SvcMgr.Application.Title;
    Temp.OnCloseQuery := DebugServiceClose;
    Temp.Visible      := True;
    { SvcMgr.Application.Run; }
    {}if FindCmdLineSwitch('INSTALL', ['-', '/'], True) then
    {}  TServiceApplicationHack(Application).RegisterServices(True, FindCmdLineSwitch('SILENT', ['-', '/'], True))
    {}else if FindCmdLineSwitch('UNINSTALL', ['-', '/'], True) then
    {}  TServiceApplicationHack(Application).RegisterServices(False, FindCmdLineSwitch('SILENT', ['-', '/'], True))
    {}else begin
    {}  Started := True;
    {}  ServiceStart(Self, Started);
    {}  if Started then
    {}    while not Terminated do begin
    {}      Forms.Application.ProcessMessages;
    {}      Sleep(20);
    {}    end;
    {}  Forms.Application.Terminate;
    {}end;
  end;
end;

procedure TMyService.ServiceStart(Sender: TService; var Started: Boolean);
begin
  try

    ...

  except
    on E: Exception do begin
      Started   := False;
      ErrCode   := 666;
      E.Message := 'Service konnte nicht gestartet werden.' + sLineBreak + E.Message;
      raise;
    end;
  end;
end;

procedure TMyService.ServiceExecute(Sender: TService);
begin
  while not Terminated do
    try
      ServiceThread.ProcessRequests(False);
    except
      on E: Exception do begin
        LogEvent('Es ist ein nicht abgefangener Fehler aufgetreten.', E);
        Sleep(500);
      end;
    end;
end;

procedure TMyService.DebugServiceClose(Sender: TObject; var CanClose: Boolean);
begin
  if Assigned(MyService) and Assigned(MyService.ServiceThread) then
    MyService.ServiceThread.Terminate;
end;

end.