Warum lässt sich der Dienst nicht beenden?

[Chewie]

Ich habe einen Dienst gebastelt, der ohne die TService-Klasse von Delphi auskommt. Er lässt sich auch wunderbar starten, nur mit dem Beenden gibts Probleme. Wenn ich das ganze mit Delphi kompiliere, passiert beim Stoppen eine Zeit lang gar nichts, mit FreePascal kommt nach ein paar Sekunden eine Fehlermeldung, der Dienst wird beendet, die Prozedur OnStart (siehe Quellcode) wird aber nicht mehr ausgeführt.

Hier mal die relevanten Codefragmente:

Delphi-Quellcode:

procedure ServiceMain(dwArgc: DWord; var lpszArgv: PChar);
begin
  //Service-Handler registrieren
  Service.FhStatus := RegisterServiceCtrlHandler(SCServiceName, @ServiceHandler);
  if Service.FhStatus <> 0 then
  begin
    //Service initialisieren
    ZeroMemory(@Service.Fss, Sizeof(Service.Fss));
    Service.Fss.dwServiceType := SERVICE_WIN32_OWN_PROCESS;
    Service.Fss.dwCurrentState := SERVICE_START_PENDING;
    Service.Fss.dwControlsAccepted := SERVICE_ACCEPT_STOP;
    Service.Fss.dwWin32ExitCode := NO_ERROR;
    Service.Fss.dwWaitHint := 1000;
    SetServiceStatus(Service.FhStatus, Service.Fss);

    //Event OnStart
    if Assigned(Service.OnStart) then
      Service.OnStart;

    //Service läuft
    Service.FStopped := False;
    Service.Fss.dwCurrentState := SERVICE_RUNNING;
    SetServiceStatus(Service.FhStatus, Service.Fss);

    //Event OnExecute
    if Assigned(Service.OnExecute) then
      Service.OnExecute;

    //Event OnStop
    if Assigned(Service.OnStop) then
      Service.OnStop;

    //Service wurde beendet
    Service.Fss.dwCurrentState := SERVICE_STOPPED;
    SetServiceStatus(Service.FhStatus, Service.Fss);    
  end;
end;

procedure ServiceHandler(fdwControl: DWord);
begin
  case fdwcontrol of
    SERVICE_CONTROL_STOP:
      begin
        Service.Stopped := True;
        Service.Fss.dwCurrentState := SERVICE_STOP_PENDING;
        SetServiceStatus(Service.FhStatus, Service.Fss);
      end;
    SERVICE_CONTROL_SHUTDOWN:
      Service.Stopped := true;
  end;
end;

procedure TService.Start;
var
  dpTable: Array[0..0] of TServiceTableEntry;
begin
  dpTable[0].lpServiceName := 'Doesnt matter';
  dpTable[0].lpServiceProc := @ServiceMain;
  StartServiceCtrlDispatcher(dpTable[0]);
end;

Die Methode Start von TService wird dabei als Programmeinstiegspunkt aufgerufen. Service ist eine globale Instanz von TService.

Die Methode in OnExecute sieht so aus:

Delphi-Quellcode:

procedure TUCClass.MyExecuteMethod;
begin
  while not Stopped do
  begin
    Log(DateTimeToStr(Now) + ': Engine läuft');
    Sleep(5000);
  end;
end;

Hat einer ne Idee, worans liegt?

[Basilikum]

ich weiss nicht, ob dies alles ist, aber die Signatur müsste so sein:

Delphi-Quellcode:

procedure ServiceMain(dwArgc: DWord; lpszArgv: PChar); stdcall;

[Chewie]

Argh, ich habs gefunden: In der OnExecute-Methode greife ich auch das Property Stopped zu. Das ist aber ein anderes Stopped als Service.Stopped. :wall:

[Chewie]

Zitat:

Zitat von Basilikum

ich weiss nicht, ob dies alles ist, aber die Signatur müsste so sein:

Delphi-Quellcode:

procedure ServiceMain(dwArgc: DWord; lpszArgv: PChar); stdcall;

Hast recht, daran hatte ich nicht gedacht. Aber da ich bisher sowieso keine Parameter ausgewertet hab, hatte das nichts gemacht.

[Chewie]

Na ja, zu früh gefreut, mit Delphi klappt es jetzt, aber wenn ich das ganze mit FreePascal kompilier, kommt immer noch folgende Fehlermeldung:

Code:

---------------------------
Dienste
---------------------------
Der Dienst "UniverseClaim-Engine" auf "Lokaler Computer" konnte nicht beendet werden.



Fehler 1067: Der Prozess wurde unerwartet beendet.


---------------------------
OK   
---------------------------

Na ja, wär schön, wenn das auch mit FPC gehen würde, aber ich kann auch so damit leben.

[Basilikum]

ein weiterer Punkt - gemäss Win32-Doc muss der Aufruf so erfolgen:

Delphi-Quellcode:

procedure TService.Start;
var
  dpTable: Array[0..1] of TServiceTableEntry;
begin
  dpTable[0].lpServiceName := 'Doesnt matter';
  dpTable[0].lpServiceProc := @ServiceMain;
  dpTable[1].lpServiceName := nil;
  dpTable[1].lpServiceProc := nil;
  StartServiceCtrlDispatcher(dpTable[0]);
end;

[Chewie]

Danke für den Tip, aber immer noch das gleiche Problem :(