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.

[ralfiii]

Yeah!
Es geht ja doch!!!

Hier eine kleine Anleitung:
http://www.mcseboard.de/windows-foru...ml#post1113084

Man braucht beide, srvany und sc. Beide gemeinsam machen's möglich und stören sich auch nicht daran, wenn sich die Anwendung nicht an die Richtlinien für einen Dienst hält. (es geht also auch, selbst wenn die App ein Hauptfenster hat und so einiges in OnShow macht).

Man sollte nur im Hinterkopf behalten, dass die Anwendung bei Dienst-Stop einfach gekillt wird. Also kein OnDestroy, OnClose oder dergleichen.

hth,
Ralf