Служба С Потоком И Состояние Службы

[michael_is_98]

Служба (на основе TService)
В процедуре OnStart создается поток со свойством FreeOnTerminate равным False и запускает его на выполнение.
В процедуре OnStop для потока устанавливается свойство Terminated равным true и происходит ожидание завершения потока методом WaitFor.

Поток (на основе TThread)
В процедуре Execute читает файл параметров. При ошибке чтения осуществляется выход из процедуры. После успешного чтения запускается бесконечный цикл, в котором периодически выполняется одно и то же действие. В цикле проверяется свойство Terminated и осуществляется выход из процедуры, если оно равно true.

Проблема
После установки и запуска службы, если возникла ошибка чтения файла параметров, служба остаётся в состоянии "Запущен", хотя поток уже ничего не выполняет.

Вопрос: как перевести состояние службы с "Запущен" на "Остановлен" после того, как осуществлён выход из процедуры Execute потока?

 

[sinkopa]

Вопрос: как перевести состояние службы с "Запущен" на "Остановлен" после того, как осуществлён выход из процедуры Execute потока?

По разному... Например вот так (чтоб не париться сильно).
1. Добавляем поле и переопределяем конструктор.

type
TmyThread = class(TThread)
private
FService: TService;
protected
procedure Execute; override;
public
constructor Create(Service: TService; CreateSuspended: Boolean);
end;

2. В переопределенном методе Execute, в случае "пожарного выхода" "тушим" службу.

{ TmyThread }

constructor TmyThread.Create(Service: TService; CreateSuspended: Boolean);
begin
FService := Service;
inherited Create(CreateSuspended);
end;

procedure TmyThread.Execute;
var
Error: Boolean;
begin
Error := False;
try
while not Terminated do begin
{выход по исключению}
try
// bla bla
except
Error := True;
Break;
end;

{или по определенному условию}
if ({bla bla}) then begin
Error := True;
Break;
end;
end;
finally
{останавливаемся сами}
if not Terminated then
Terminate;

{останавливаем службу}
if Error then
FService.ServiceThread.Terminate;
end;
end;

или можно останавливать более "гуманно"

//...
implementation
uses WinSvc;

//...
{останавливаем службу}
if Error then
PostThreadMessage(FService.ServiceThread.ThreadID, CM_SERVICE_CONTROL_CODE, SERVICE_CONTROL_STOP, 0);
//...

Как-то так...

 

[michael_is_98]

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

type
TACADlicADgrpSyncService = class(TService)
procedure ServiceStart(Sender: TService; var Started: Boolean);
procedure ServiceStop(Sender: TService; var Stopped: Boolean);
private
{ Private declarations }
ServiceThread: TACADlicADgrpSyncThread;
public
function GetServiceController: TServiceController; override;
{ Public declarations }
end;

При запуске сервиса

procedure TACADlicADgrpSyncService.ServiceStart(Sender: TService; var Started: Boolean);
const
TimeOutStarting = 5000;
var
i: integer;

begin
ServiceThread := TACADlicADgrpSyncThread.Create;
ServiceThread.Start;

// подождать немного
// если поток завершён, значит возникла ошибка чтения файла параметров
// службу не запускать
i := TimeOutStarting;
while i > 0 do
begin
Sleep(1000);
ReportStatus;
i := i - 1000;
end;

if ServiceThread.Finished = true then
begin
Started := false;
end;
end;

При останове сервиса

procedure TACADlicADgrpSyncService.ServiceStop(Sender: TService; var Stopped: Boolean);
begin
if Assigned(ServiceThread) then
begin
// The TService must WaitFor the thread to finish (and free it)
// otherwise the thread is simply killed when the TService ends.
ServiceThread.Terminate;
ServiceThread.WaitFor;
FreeAndNil(ServiceThread);
end;
end;

Суть в том, что поток сразу же после запуска читает файл параметров. Если возникла ошибка чтения, то метод Execute потока завершается.
Таким образом можно запустить поток и подождать немного (TimeOutStarting), если поток завершён, значит, службу запскать не нужно.
Ваше решение нравится, но каково, повторюсь, останавливать службу, которая создала поток, из данного потока, даже через PostThreadMessage?

 

[sinkopa]

Получается, что поток останавливает службу, которая его создала.
Есть ли гарантия, что после такого "принудительного" останова будут очищены все структуры, связанные с потоком.

Если через Terminate то нет. Хотя память очистится (потому что процесс службы завершится) но если на OnStop у Вас запланированы какие либо операции (например запись настроек в файл или реест) то они не выполнятся потому как событие не наступит.
Если вот так

PostThreadMessage(FService.ServiceThread.ThreadID, CM_SERVICE_CONTROL_CODE, SERVICE_CONTROL_STOP, 0);

то гарантия безусловно есть. Потому что это штатное завершение службы. Именно это сообщение посылает диспетчер служб, когда OS завершает работу или когда (например) Вы сами через GUI менеджера служб нажимаете кнопку "Остановить службу". Советую "не полениться" и заглянуть в исходники TService и TServiceThread.Execute и посмотреть код (порядок выполненяемых действий при остановке службы).

Суть в том, что поток сразу же после запуска читает файл параметров. Если возникла ошибка чтения, то метод Execute потока завершается.
Таким образом можно запустить поток и подождать немного (TimeOutStarting), если поток завершён, значит, службу запскать не нужно.

Вот этого как раз нельзя. По "закону", если система в течении 2-3 секунд не получит от службы уведомление об изменении статуса (сначала SERVICE_START_PENDING а потом SERVICE_RUNNING), то она принудительно прервёт процесс запуска (вернее наоборот - запуск процесса)... А "добрый" доктор Ватсон предложит пользователю больше (никогда) не запускать "калечную" службу и сообщить о проблеме в компанию MicroSoft...

Ваше решение нравится, но каково, повторюсь, останавливать службу, которая создала поток, из данного потока, даже через PostThreadMessage?

Что вас смущает? PostThreadMessage просто ставит сообщение в очередь. Вызывающий данную процедуру код управления не теряет. Это значит что непостредственно доставка сообщения фактически произойдет уже после завершения выполнения кода метода (в данном случае Execute). Т.е. после "смерти" вашего потока.

Кстати, альтернативой может быть - запуск еще одного (аварийно-спасательного) потока, который самостоятельно подключится к обвязке диспетчера служб, отдаст команду на остановку слубы, а потом сам умрёт...
Если Вам такой вариант нравится больше, то код функции "тормозящей" службу можете подглядеть вот тут например

Ссылка скрыта от гостей

 

[michael_is_98]

Указанный PostThreadMessage, вызванный из потока, созданного в процедуре ServiceStart, действительно приводит к вызову процедуры ServiceStop, которая, в свою очередь, завершает поток и очищает его структуры. Спасибо вам за помощь!