Delphi XE2 Служба не останавливается должным образом - PullRequest
Новая
       27

Delphi XE2 Служба не останавливается должным образом

10 голосов
/ 13 февраля 2012

Я создал несколько сервисов в Delphi 7 и у меня не было этой проблемы. Теперь, когда я запустил новое сервисное приложение в XE2, оно не остановится должным образом. Я не знаю, что-то не так, или это может быть ошибка в службах XE2.

Процедура выполнения выглядит следующим образом: 

procedure TMySvc.ServiceExecute(Sender: TService);
begin
  try
    CoInitialize(nil);
    Startup;
    try
      while not Terminated do begin
        DoSomething; //Problem persists even when nothing's here
      end;
    finally
      Cleanup;
      CoUninitialize;
    end;
  except
    on e: exception do begin
      PostLog('EXCEPTION in Execute: '+e.Message);
    end;
  end;
end;

У меня никогда нет исключения, как вы видите, я регистрирую любое исключение. PostLog сохраняет в INI-файл, который отлично работает. Теперь я использую компоненты ADO, поэтому я использую CoInitialize() и CoUninitialize. Он подключается к БД и правильно выполняет свою работу. Проблема возникает только тогда, когда я прекращаю эту услугу. Windows выдает мне следующее сообщение:

First stop failure

Затем служба продолжается. Я должен остановить это во второй раз. Во второй раз он останавливается, но со следующим сообщением:

Second stop failure

Файл журнала указывает, что служба успешно освободилась (событие OnDestroy было зарегистрировано), но никогда не было успешно остановлено (OnStop никогда не регистрировалось).

В приведенном выше коде у меня есть две процедуры Startup и Cleanup. Они просто создают / уничтожают и инициализируют / деинициализируют мои необходимые вещи ... 

procedure TMySvc.Startup;
begin
  FUpdateThread:= TMyUpdateThread.Create;
    FUpdateThread.OnLog:= LogUpdate;
    FUpdateThread.Resume;
end;

procedure TMySvc.Cleanup;
begin
  FUpdateThread.Terminate;
end;

Как видите, у меня запущен вторичный поток. Этот сервис на самом деле имеет множество потоков, работающих следующим образом, а основной поток службы только регистрирует события из каждого потока. Каждый поток имеет разные обязанности. Потоки правильно сообщают, и они также правильно завершаются.

Что может быть причиной этой остановки? Если мой опубликованный код ничего не раскрывает, я могу опубликовать больше кода позже - просто нужно «преобразовать» его из-за внутренних имен и т. Д.

EDIT

Я только что запустил новый сервисный проект в Delphi XE2, и у меня возникла та же проблема. Это весь мой код ниже: 

unit JDSvc;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes, JDSvcMgr;

type
  TJDService = class(TService)
    procedure ServiceExecute(Sender: TService);
  private
    FAfterInstall: TServiceEvent;
  public
    function GetServiceController: TServiceController; override;
  end;

var
  JDService: TJDService;

implementation

{$R *.DFM}

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

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

procedure TJDService.ServiceExecute(Sender: TService);
begin
  while not Terminated do begin

  end;
end;

end.

1 Ответ

6 голосов
/ 13 февраля 2012

посмотрите на исходный код метода Execute: 

procedure TServiceThread.Execute;
var
  msg: TMsg;
  Started: Boolean;
begin
  PeekMessage(msg, 0, WM_USER, WM_USER, PM_NOREMOVE); { Create message queue }
  try
    // Allow initialization of the Application object after
    // StartServiceCtrlDispatcher to prevent conflicts under
    // Windows 2003 Server when registering a class object with OLE.
    if Application.DelayInitialize then
      Application.Initialize;
    FService.Status := csStartPending;
    Started := True;
    if Assigned(FService.OnStart) then FService.OnStart(FService, Started);
    if not Started then Exit;
    try
      FService.Status := csRunning;
      if Assigned(FService.OnExecute) then
        FService.OnExecute(FService)
      else
        ProcessRequests(True);
      ProcessRequests(False);
    except
      on E: Exception do
        FService.LogMessage(Format(SServiceFailed,[SExecute, E.Message]));
    end;
  except
    on E: Exception do
      FService.LogMessage(Format(SServiceFailed,[SStart, E.Message]));
  end;
end;

, поскольку вы можете увидеть, что если вы не назначите метод OnExecute, Delphi будет обрабатывать запросы SCM (Service Start, Stop, ...) до тех пор, пока сервис не будет остановлен.Когда вы делаете цикл в Service.Execute, вы должны самостоятельно обрабатывать запросы SCM, вызывая ProcessRequests(False).Хорошая привычка - не использовать Service.execute и запускать рабочую нить в событии Service.OnStart, а завершать / освобождать ее в событии Service.OnStop.

Как сказано в комментариях, другая проблема заключается в FUpdateThread.Terminate часть.Дэвид Хеффернан был замечен в комментарии Free / WaitFor.Убедитесь, что вы правильно завершили поток, используя объекты синхронизации.

...