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;
служба с потоком и состояние службы
Служба (на основе TService)
В процедуре OnStart создается поток со свойством FreeOnTerminate равным False и запускает его на выполнение.
В процедуре OnStop для потока устанавливается свойство Terminated равным true и происходит ожидание завершения потока методом WaitFor.
Поток (на основе TThread)
В процедуре Execute читает файл параметров. При ошибке чтения осуществляется выход из процедуры. После успешного чтения запускается бесконечный цикл, в котором периодически выполняется одно и то же действие. В цикле проверяется свойство Terminated и осуществляется выход из процедуры, если оно равно true.
Проблема
После установки и запуска службы, если возникла ошибка чтения файла параметров, служба остаётся в состоянии "Запущен", хотя поток уже ничего не выполняет.
В процедуре OnStart создается поток со свойством FreeOnTerminate равным False и запускает его на выполнение.
В процедуре OnStop для потока устанавливается свойство Terminated равным true и происходит ожидание завершения потока методом WaitFor.
Поток (на основе TThread)
В процедуре Execute читает файл параметров. При ошибке чтения осуществляется выход из процедуры. После успешного чтения запускается бесконечный цикл, в котором периодически выполняется одно и то же действие. В цикле проверяется свойство Terminated и осуществляется выход из процедуры, если оно равно true.
Проблема
После установки и запуска службы, если возникла ошибка чтения файла параметров, служба остаётся в состоянии "Запущен", хотя поток уже ничего не выполняет.
Код бы посмотреть, особенно в части где ошибка обрабатывается. Ну и версию узнать. А то со времён D2010 в TThread'ах кое-что изменилось, и там может быть шило.
Код весь изложил на словах. Delphi 2010.
Все действия в потоке не вызывают исключений, они обрабатываются блоками try-except.
Нужно перевести состояние службы с "Запущен" на "Остановлен" после того, как осуществлён выход из процедуры Execute потока.
Все действия в потоке не вызывают исключений, они обрабатываются блоками try-except.
Нужно перевести состояние службы с "Запущен" на "Остановлен" после того, как осуществлён выход из процедуры Execute потока.
Стоп! А с какого кипариса служба должна останавливаться? Указанный поток - это поток внутри, а поток программы - это другой поток. Его нужно закрывать, чтобы остановить службу.
По рекомендациям авторов, найденных в сети, полезные действия служба Windows должны выполнять в отдельном потоке. Основной поток службы реагирует только на действия пользователя и системы - остановить, запустить, приостановить, возобновить. В данном случае для упрощения возможность приостановки службы и возобновления отключена. То есть службу пользователь может только остановить и запустить.
Всё вроде бы работает, но вот есть такой артефакт, который вводит в заблуждение. Служба работает, но при ошибке чтения файла параметров ничего не делает. В случае ошибки её состояние по логике должно измениться на "Остановлена"
Всё вроде бы работает, но вот есть такой артефакт, который вводит в заблуждение. Служба работает, но при ошибке чтения файла параметров ничего не делает. В случае ошибки её состояние по логике должно измениться на "Остановлена"
Не должно. Она остановится, если AV будет, но это совсем другая история, которая как раз не должна происходить. А службу останавливать надо командой stop service_name вроде бы.
Возникла идея разрешения ситуации.
В процедуре OnStart службы после создания потока и его запуска можно вызвать Sleep(5000), а затем проверить, работает ли метод Execute потока. Если нет - значит службу не нужно запускать (возникла ошибка чтения файла параметров), вывести в лог Windows ошибку.
Теперь вопрос - каким образом проверить, что у экземпляра потока TThread работает метод Execute?
В процедуре OnStart службы после создания потока и его запуска можно вызвать Sleep(5000), а затем проверить, работает ли метод Execute потока. Если нет - значит службу не нужно запускать (возникла ошибка чтения файла параметров), вывести в лог Windows ошибку.
Теперь вопрос - каким образом проверить, что у экземпляра потока TThread работает метод Execute?
Сейчас сделал следующим образом
При запуске сервиса
При останове сервиса
Суть в том, что поток сразу же после запуска читает файл параметров. Если возникла ошибка чтения, то метод Execute потока завершается.
Таким образом можно запустить поток и подождать немного (TimeOutStarting), если поток завершён, значит, службу запскать не нужно.
Код:
Код:
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;
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;
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;
Таким образом можно запустить поток и подождать немного (TimeOutStarting), если поток завершён, значит, службу запскать не нужно.