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

Я создал несколько сервисов в 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 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;

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

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

ИЗМЕНИТЬ

Я только что начал проект NEW в 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

посмотрите исходный код метода 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 и запуск вашего workthread в событии Service.OnStart и завершение/освобождение его в событии Service.OnStop.

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