Помогите разобраться с потоками в сервисе

← →
jcl (2016-08-25 15:49) [0]

Добрый день!

Тема со службами и с потоками для меня новая, поэтому вышла путаница.
Для создания службы использую стандартный Service Application (все делаю на примере http://www.tolderlund.eu/delphi/service/service.htm). Добавляю обработчики событий onStart, onStop и onShutDown. В обработчике onStart создают первый поток, а в его методе Execute делаю бесконечный цикл, пока не Terminated. Собственно код стандартный. Теперь мне нужно сделать несколько потоков (на чтение входящих документов, на отправку квитанции о доставке, на запись исходящих документов, на получение квитанций о регистрации документа). Вопрос: в каком месте это следует сделать так, чтобы службу не посчитали умершей (т.к. предполагается обращение к базе, работа с данными)? в методе onStart службы (где, собственно первый поток и создается) или в методе Execute первого потока? И еще вопросы: как лучше построить иерархию классов потоков: один родительский поток с виртуальными методами, а от него наследовать и переопределять или тупо создать несколько классов потоков?

И еще: логирование посредством Log4D следует сделать тоже отдельным потоком или просто из рабочих вызывать? Если отдельным, то как передавать управление?

Не ругайте слишком сильно, материал для меня оказался сложным и в посмотрев примеры в инете не уложилось....

Спасибо!!!

P.S. использую D2007

← →
Игорь Шевченко © (2016-08-25 19:01) [1]

https://rsdn.org/article/baseserv/svcadmin-1.xml
https://rsdn.org/article/baseserv/svcadmin-2.xml

Полезно почитать

← →
KSergey © (2016-08-26 08:54) [2]

Вот здесь - всё подробно
http://www.delphikingdom.ru/asp/viewitem.asp?catalogid=1348

← →
jcl (2016-08-29 11:32) [3]

> KSergey © (26.08.16 08:54) [2]

Это прочитано, не до конца уложилось.

Спасибо, Игорь Шевченко.

Тем не менее возникла проблема. Все было делано, как в статьях на delphikingdom и tolderlund, но код в обработчике Старт не работает. Лог не пишет.
unit MainServiceUnit; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, SvcMgr, Dialogs, Registry, MyServiceThreadUnit, MySecondThreadUnit, Log4D; type TDirectum_Integration = class(TService) procedure ServiceAfterInstall(Sender: TService); procedure ServiceStart(Sender: TService; var Started: Boolean); procedure ServiceStop(Sender: TService; var Stopped: Boolean); procedure ServiceShutdown(Sender: TService); private MyServiceThread: TMyServiceThread; MySecondThread: TMySecondThread; procedure ServiceStopShutdown; public function GetServiceController: TServiceController; override; { Public declarations } end; var Directum_Integration: TDirectum_Integration; //Logger: TLogRollingFileAppender; Logger : TLogLogger; implementation {$R *.DFM} procedure ServiceController(CtrlCode: DWord); stdcall; begin Directum_Integration.Controller(CtrlCode); end; function TDirectum_Integration.GetServiceController: TServiceController; begin Result := ServiceController; end; procedure TDirectum_Integration.ServiceAfterInstall(Sender: TService); var Reg: TRegistry; begin Reg := TRegistry.Create(KEY_READ or KEY_WRITE); try Reg.RootKey := HKEY_LOCAL_MACHINE; if Reg.OpenKey("\SYSTEM\CurrentControlSet\Services\" + Name, false) then begin Reg.WriteString("Description", ""); Reg.CloseKey; end; finally Reg.Free; end; end; procedure TDirectum_Integration.ServiceStart(Sender: TService; var Started: Boolean); var FStream: TFileStream; begin MyServiceThread := TMyServiceThread.Create; FStream:= TFileStream.Create("MyFileStreamLog.log",fmCreate or fmOpenWrite); FStream.WriteBuffer("ServiceStart работает!!!",Length("ServiceStart работает!!!")); MyServiceThread.Resume; FreeAndNil(FStream); end; procedure TDirectum_Integration.ServiceStop(Sender: TService; var Stopped: Boolean); begin ServiceStopShutdown; end; procedure TDirectum_Integration.ServiceShutdown( Sender: TService); begin ServiceStopShutdown; end; procedure TDirectum_Integration.ServiceStopShutdown; begin if Assigned(MyServiceThread) then begin MyServiceThread.Terminate; MyServiceThread.WaitFor; FreeAndNil(MyServiceThread); end; end; end.

Был лог добавлен в файл проекта, и заработал. Но только при install, uninstall службы!!! Помогите, пожалуйста, разобраться!! Почему не работает событие onStart (ServiceStart - было добавлено в object inspector как обработчик события onStart. Служба создавалась через File-New-Other-Service Application. Была создана при этом формочка, в ней и добавлен обработчик)? И почему код проекта службы выполняется при установки /удалении службы??

Спасибо!

program Directum_Integration; uses SvcMgr, MainServiceUnit in "MainServiceUnit.pas" {Directum_Integration: TService}, MyServiceThreadUnit in "MyServiceThreadUnit.pas", Classes, SysUtils; {$R *.RES} var FStream: TFileStream; begin if not Application.DelayInitialize or Application.Installing then Application.Initialize; Application.CreateForm(TDirectum_Integration,Directum_Integration); Application.Run; FStream:= TFileStream.Create("MyFileStreamLog.log",fmCreate or fmOpenWrite); FStream.WriteBuffer("ServiceStart НЕ работает!!!",Length("ServiceStart НЕ работает!!!")); FreeAndNil(FStream); end.

← →
jcl (2016-08-29 11:34) [4]

unit MyServiceThreadUnit; interface uses Classes {$IFDEF MSWINDOWS} , Windows {$ENDIF}, Log4D, Log4DXML; type TMyServiceThread = class(TThread) private procedure SetName; protected procedure Execute; override; public constructor Create; end; implementation {$IFDEF MSWINDOWS} type TThreadNameInfo = record FType: LongWord; // must be 0x1000 FName: PChar; // pointer to name (in user address space) FThreadID: LongWord; // thread ID (-1 indicates caller thread) FFlags: LongWord; // reserved for future use, must be zero end; {$ENDIF} { TMyServiceThread } procedure TMyServiceThread.SetName; {$IFDEF MSWINDOWS} var ThreadNameInfo: TThreadNameInfo; {$ENDIF} begin {$IFDEF MSWINDOWS} ThreadNameInfo.FType := $1000; ThreadNameInfo.FName := "MyServiceThread"; ThreadNameInfo.FThreadID := $FFFFFFFF; ThreadNameInfo.FFlags := 0; try RaiseException( $406D1388, 0, sizeof(ThreadNameInfo) div sizeof(LongWord), @ThreadNameInfo ); except end; {$ENDIF} end; constructor TMyServiceThread.Create; begin FreeOnTerminate := False; inherited Create(True); end; procedure TMyServiceThread.Execute; const SecBetweenRuns = 10; var Count: Integer; begin SetName; while not Terminated do // loop around until we should stop begin Inc(Count); if Count >= SecBetweenRuns then begin Count := 0; { place your service code here } { this is where the action happens } //SomeProcedureInAnotherUnit; end; Sleep(1000); end; end; end.

← →
iop © (2016-08-29 11:40) [5]

Почему не работает событие onStart

всё там работает.
и в лог все пишется.
но текущий каталог сервиса не тот, к которому ты привык.

← →
jcl (2016-08-29 13:02) [6]

Ахаха!! Спасибо!!!

← →
sniknik © (2016-08-29 13:32) [7]

а вот это вот нафига?
> procedure TMyServiceThread.SetName;
> ...
> end;
без имени у потока не обойтись? насколько знаю только для скриптовых языков/вставок нужно, внутри же найтивного кода излишество, всегда можно по объекту напрямую работать.

p.s. может просто не знаю и есть какой тайный смысл? (не считая функций поиска объекта по имени, которые практически не используются)

← →
jcl (2016-08-29 15:01) [8]

> sniknik © (29.08.16 13:32) [7]

Это при создании Thread Object было задано имя. Ну можно и убрать. просто хотелось посмотреть, что это такое.

У меня еще вопрос. Весь полезный код находится в OnExecute у Thread. А он не выполняется! Был помещен туда код лога после
if Count >= SecBetweenRuns then begin Count := 0;

И не работает. В чем может быть ошибка?

← →
iop © (2016-08-29 15:16) [9]

из неправильного места вызвал создание своей нитки

← →
iop © (2016-08-29 15:22) [10]

а еще наивно надеяться что в нитке это будет "тикать" раз в секунду.

Sleep(1000);

← →
jcl (2016-08-29 15:29) [11]

> iop © (29.08.16 15:16) [9]

Это здесь неправильно?
procedure TDirectum_Integration.ServiceStart .... MyServiceThread.Resume;

Так было в примере в статье. А откуда надо вызывать?

> iop © (29.08.16 15:22) [10]

Тут что не так?

← →
jcl (2016-08-29 15:32) [12]

> iop © (29.08.16 15:22) [10]

То есть, вы предлагаете перенести цикл в onStart сервиса, а в Thread просто выполнять полезную работу?

← →
iop © (2016-08-29 15:58) [13]

сервис делает всю свою полезную работу в своем онЭкзекуте
и этот онЭкзекут выполняется не в той нити что криэйт и старт.

← →
jcl (2016-08-29 16:08) [14]

> iop © (29.08.16 15:58) [13]
> сервис делает всю свою полезную работу в своем онЭкзекуте

Вырезка из статьи на Королевстве:

Вы можете реализовать работу службы двумя способами.

Вариант первый: стартует служба, вы начинаете что-то делать, время от времени уведомляя систему о своём состоянии, потом служба останавливается.

Вариант второй: стартует служба, создаёт рабочие потоки. По уведомлению от системы потоки останавливаются и служба выключается.

Обычно в службах используется второй вариант, но это ваш выбор — мы расскажем об обоих.

Для второго варианта реализации вы не должны назначать обработчик OnExecute, но обязаны реализовать, как минимум, OnStart и OnStop. В первом обработчике вы запускаете рабочие потоки службы, а в OnStop — останавливаете

Так в чем ошибка то?

← →
jcl (2016-08-29 16:08) [15]

Пытаюсь сделать второй вариант

← →
iop © (2016-08-29 16:18) [16]

Пытаюсь сделать второй вариант

ну и как? получается?

ps читать надо не левые статьи на королевствах, а документацию.

← →
jcl (2016-08-29 16:25) [17]

> iop © (29.08.16 16:18) [16]

А если без сарказма, нормально объяснить?

← →
jcl (2016-08-29 17:21) [18]

Проблема решилась, спасибо iop.

был сделан метод Execute у службы, в него добавлен
MyServiceThread := TMyServiceThread.Create; MyServiceThread.Resume; While NOT Terminated do Begin ServiceThread.ProcessRequests(true); End;

На тему True или False есть обсуждение http://www.sql.ru/forum/690236/prostenkiy-servis-cpu-usage-51-chto-posovetuete

А в procedure TMyServiceThread.Execute; добавить полезный код.

Еще полезная ссылка http://delphi.xcjc.net/viewthread.php?tid=48065

> jcl (25.08.16 15:49)

Эх, по ряду причин, настоятельно рекомендую не использовать стандартные VCL классы для реализации сервиса. Там все чрезмерно запутанно и плохо расширяемо. Закончится все копированием исходников SvcMgr в папку с проектом и правкой. Вот, к примеру, понадобится из сервиса перехватывать факт выхода/входа пользователя в систему.

Этот тот редкий случай, когда нужно писать с нуля. Там все не так сложно, как кажется, хороший пример базового сервиса есть у Розыча http://rouse.drkb.ru/winapi.php#twoservicedemo
абсолютно ничего сложно там нет.

Eraser © (30.08.16 01:16) [19]

> хороший пример базового сервиса есть у Розыча http://rouse.
> drkb.ru/winapi.php#twoservicedemo
> абсолютно ничего сложно там нет.

Там все чрезмерно запутано и нерасширяемо вообще.

← →
jcl (2016-08-30 15:49) [21]

> Eraser © (30.08.16 01:16) [19]

Спасибо большое, посмотрю.

> понадобится из сервиса перехватывать факт выхода/входа пользователя
> в систему

Для этого сервиса впринципе такой задачи не может быть поставлено. Впредь буду писать без стандартных классов, но на этапе обучения не получилось без них обойтись.

> Впредь буду писать без стандартных классов, но на этапе обучения не получилось без них обойтись.
:) я делал наоборот... чтобы разобраться/обучится писал сервис на winapi, а после с использованием стандартных классов. они ведь чисто для удобства/скорости написания нужны, а не для обучения. ИМХО конечно.

> Игорь Шевченко © (30.08.16 11:09) [20]

как оно может быть не расширяемо, если оно на чистом API, расширять можно на сколько фантазии хватит.
а вот стандартный класс спроектирован плохо и не расширяем. автор очень уж побаивался ключевого слова virtual.
не поленился полез посмотреть, что конкретно там не устраивало. надеялся может лет за 10 что-нибудь переписал. не переписали.
там проблема в самом сердце класса:

procedure TService.Main(Argc: DWord; Argv: PLPWSTR); type PPCharArray = ^TPCharArray; TPCharArray = array [0..1024] of PChar; var i: Integer; Controller: THandlerFunction; begin for i := 0 to Argc - 1 do FParams.Add(PPCharArray(Argv)[i]); Controller := GetServiceController(); FStatusHandle := RegisterServiceCtrlHandler(PChar(Name), @Controller); if (FStatusHandle = 0) then LogMessage(SysErrorMessage(GetLastError)) else DoStart; end;
это обычный, не виртуальный метод.
автор не слышал про существование RegisterServiceCtrlHandlerEx. т.о. мы можем обрабатывать только коды управления времен win2K, все что появилось позже не поддерживается.
+ была проблема с назначением описания к службе.

> jcl (30.08.16 15:49) [21]

> Впредь буду писать без стандартных классов

тут надо понимать, что в целом, я против такого подхода изобретения велосипедов. в конкретно взятом случае с сервисом свой велосипед, на основе той ссылки, будет грамотней и функциональнее.

Eraser © (31.08.16 20:26) [23]

> как оно может быть не расширяемо, если оно на чистом API

Вот поэтому и не расширяемо. Если бы был написан набор классов, то расширяемо, а портянка на API - я бы и рекомендовать не стал. И да, за свой древний пример по Named pipes мне тоже стыдно :)

> sniknik © (30.08.16 16:32) [22]
> > Впредь буду писать без стандартных классов, но на этапе
> обучения не получилось без них обойтись.
> :) я делал наоборот... чтобы разобраться/обучится писал
> сервис на winapi, а после с использованием стандартных классов.
> они ведь чисто для удобства/скорости написания нужны, а
> не для обучения. ИМХО конечно.

Поддерживаю полностью.
Сначала надо суть понять.
А потом можно и классы стандартные использовать.

Помогите разобраться с потоками в сервисе Найти похожие ветки