घर
Top.Mail.Ru Yandeks.Metrika
मंच: "शुरुआती";
वर्तमान संग्रह: 2018.12.23;
डाउनलोड करें: [xml.tar.bz2];

नीचे

कृपया सेवा में प्रवाह में मेरी मदद करें इसी तरह की शाखाएँ खोजें


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;
> ...
> अंत;
без имени у потока не обойтись? насколько знаю только для скриптовых языков/вставок нужно, внутри же найтивного кода излишество, всегда можно по объекту напрямую работать.

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



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


> स्निकनिक © (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]

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

नींद (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



Eraser ©   (2016-08-30 01:16) [19]


> jcl (25.08.16 15:49)

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

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



Игорь Шевченко ©   (2016-08-30 11:09) [20]

इरेज़र © (30.08.16 01: 16) [19]


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


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



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


> इरेज़र © (30.08.16 01: 16) [19]


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

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


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



sniknik ©   (2016-08-30 16:32) [22]

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



Eraser ©   (2016-08-31 20:26) [23]


> इगोर शेवचेंको © (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]


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

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



Игорь Шевченко ©   (2016-08-31 23:08) [24]

इरेज़र © (31.08.16 20: 26) [23]


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


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



Тимохов Дима ©   (2016-09-25 22:43) [25]


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


मैं पूरा समर्थन करता हूं।
Сначала надо суть понять.
А потом можно и классы стандартные использовать.



पन्ने: 1 पूरी शाखा

मंच: "शुरुआती";
वर्तमान संग्रह: 2018.12.23;
डाउनलोड करें: [xml.tar.bz2];

ऊपर









मेमोरी: 0.68 एमबी
समय: 0.066 c
15-1476200879
किसको शक होगा
2016-10-11 18:47
2018.12.23
क्या ईमेल की जाँच के लिए क्रोम एक्सटेंशन हैं?


15-1475789401
यूरी
2016-10-07 00:30
2018.12.23
आपको जन्मदिन की शुभकामनाएं! 7 अक्टूबर 2016 शुक्रवार


15-1475703002
यूरी
2016-10-06 00:30
2018.12.23
आपको जन्मदिन की शुभकामनाएं! 6 अक्टूबर 2016 गुरुवार


15-1476172583
xteam777
2016-10-11 10:56
2018.12.23
डेल्फी में सी ++ कोड को फिर से लिखने में मदद करें


2-1474431273
ग्लाज़्कोव
2016-09-21 07:14
2018.12.23
TreeView





अफ्रीकी अल्बानियन अरबी भाषा अर्मेनियाई आज़रबाइजानी बस्क बेलारूसी बल्गेरियाई कैटलन सरलीकृत चीनी) चीनी पारंपरिक) क्रोएशियाई चेक डेनिश डच अंग्रेज़ी एस्तोनियावासी फिलिपिनो फिनिश फ्रेंच
गैलिशियन् जॉर्जियाई जर्मन यूनानी हाईटियन यहूदी हिंदी हंगरी आइसलैंड का इन्डोनेशियाई आयरिश इतालवी जापानी कोरियाई लात्वीयावासी लिथुआनियाई मेसीडोनियन मलायी मोलतिज़ नार्वेजियन
फ़ारसी पोलिश पुर्तगाली रोमानियाई रूसी सर्बियाई स्लोवाक स्लोवेनियाई स्पेनिश स्वाहिली स्वीडिश थाई तुर्की यूक्रेनी उर्दू वियतनामी वेल्श यहूदी बंगाली बोस्नियाई
सिबुआनो एस्पेरांतो गुजराती हौसा हमोंग ईग्बो जावानीस कन्नड़ खमेर लाओ लैटिन माओरी मराठी मंगोलियन नेपाली पंजाबी सोमाली तामिल तेलुगु योरूबा
ज़ुलु
Английский Французский Немецкий Итальянский Португальский Русский Испанский