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

Тема в разделе "Delphi - Компоненты", создана пользователем michael_is_98, 29 май 2014.

  1. michael_is_98

    michael_is_98 Member

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

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

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

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

    sinkopa Well-Known Member

    Регистрация:
    17 июн 2009
    Сообщения:
    344
    Симпатии:
    9
    По разному... Например вот так (чтоб не париться сильно).
    1. Добавляем поле и переопределяем конструктор.
    Код (Delphi):
    type
    TmyThread = class(TThread)
    private
    FService: TService;
    protected
    procedure Execute; override;
    public
    constructor Create(Service: TService; CreateSuspended: Boolean);
    end;
    2. В переопределенном методе Execute, в случае "пожарного выхода" "тушим" службу.
    Код (Delphi):
    { 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;
    или можно останавливать более "гуманно"
    Код (Delphi):
    //...
    implementation
    uses WinSvc;

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

    michael_is_98 Member

    Регистрация:
    15 окт 2005
    Сообщения:
    14
    Симпатии:
    0
    Получается, что поток останавливает службу, которая его создала.
    Есть ли гарантия, что после такого "принудительного" останова будут очищены все структуры, связанные с потоком.
    Сейчас сделал следующим образом
    Код (Text):
    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;
    При запуске сервиса
    Код (Text):
    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;
    При останове сервиса
    Код (Text):
    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?
     
  4. sinkopa

    sinkopa Well-Known Member

    Регистрация:
    17 июн 2009
    Сообщения:
    344
    Симпатии:
    9
    Если через Terminate то нет. Хотя память очистится (потому что процесс службы завершится) но если на OnStop у Вас запланированы какие либо операции (например запись настроек в файл или реест) то они не выполнятся потому как событие не наступит.
    Если вот так
    Код (Delphi):
    PostThreadMessage(FService.ServiceThread.ThreadID, CM_SERVICE_CONTROL_CODE, SERVICE_CONTROL_STOP, 0);
    то гарантия безусловно есть. Потому что это штатное завершение службы. Именно это сообщение посылает диспетчер служб, когда OS завершает работу или когда (например) Вы сами через GUI менеджера служб нажимаете кнопку "Остановить службу". Советую "не полениться" и заглянуть в исходники TService и TServiceThread.Execute и посмотреть код (порядок выполненяемых действий при остановке службы).

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

    Кстати, альтернативой может быть - запуск еще одного (аварийно-спасательного) потока, который самостоятельно подключится к обвязке диспетчера служб, отдаст команду на остановку слубы, а потом сам умрёт...
    Если Вам такой вариант нравится больше, то код функции "тормозящей" службу можете подглядеть вот тут например http://www.delphisources.ru/pages/faq/base...rt_service.html
     
  5. michael_is_98

    michael_is_98 Member

    Регистрация:
    15 окт 2005
    Сообщения:
    14
    Симпатии:
    0
    Указанный PostThreadMessage, вызванный из потока, созданного в процедуре ServiceStart, действительно приводит к вызову процедуры ServiceStop, которая, в свою очередь, завершает поток и очищает его структуры. Спасибо вам за помощь!
     
Загрузка...
Похожие Темы - Служба Потоком Состояние
  1. kutzhanov
    Ответов:
    4
    Просмотров:
    2.850
  2. Triolit
    Ответов:
    0
    Просмотров:
    1.221
  3. deeeman
    Ответов:
    2
    Просмотров:
    3.507

Поделиться этой страницей