| Форумы
ЧАТ |
Орешник |
|
| Форумы -» | Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG |
|
| ||
|
|
Новости |
Поиск |
FAQ |
Статьи |
Книги |
Новости VCL
| | Форумы ЧАТ |
Орешник |
|
| |||
| |||
| |||
« предыдущая ветвь | форум | следующая ветвь »
Помогите разобраться с потоками в сервисе
jcl © (2016-08-25 15:49:00)Добрый день!
Тема со службами и с потоками для меня новая, поэтому вышла путаница.
Для создания службы использую стандартный Service Application (все делаю на примере http://www.tolderlund.eu/delphi/service/service.htm). Добавляю обработчики событий onStart, onStop и onShutDown. В обработчике onStart создают первый поток, а в его методе Execute делаю бесконечный цикл, пока не Terminated. Собственно код стандартный. Теперь мне нужно сделать несколько потоков (на чтение входящих документов, на отправку квитанции о доставке, на запись исходящих документов, на получение квитанций о регистрации документа). Вопрос: в каком месте это следует сделать так, чтобы службу не посчитали умершей (т.к. предполагается обращение к базе, работа с данными)? в методе onStart службы (где, собственно первый поток и создается) или в методе Execute первого потока? И еще вопросы: как лучше построить иерархию классов потоков: один родительский поток с виртуальными методами, а от него наследовать и переопределять или тупо создать несколько классов потоков?
И еще: логирование посредством Log4D следует сделать тоже отдельным потоком или просто из рабочих вызывать? Если отдельным, то как передавать управление?
Не ругайте слишком сильно, материал для меня оказался сложным и в посмотрев примеры в инете не уложилось....
Спасибо!!!
P.S. использую D2007
iop (2016-08-29 11:40:00) [21]Почему не работает событие onStart
всё там работает.
и в лог все пишется.
но текущий каталог сервиса не тот, к которому ты привык.
jcl (2016-08-29 11:34:00) [22]
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.
jcl (2016-08-29 11:32:00) [23]
> 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.
KSergey (2016-08-26 08:54:00) [24]Вот здесь - всё подробно
http://www.delphikingdom.ru/asp/viewitem.asp?catalogid=1348
Игорь Шевченко (2016-08-25 19:01:00) [25]https://rsdn.org/article/baseserv/svcadmin-1.xml
https://rsdn.org/article/baseserv/svcadmin-2.xml
Полезно почитать
| |
Страницы: 