| Форумы
ЧАТ |
Орешник |
|
| Форумы -» | Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG |
|
| ||
|
|
Новости |
Поиск |
FAQ |
Статьи |
Книги |
Новости VCL
| | Форумы ЧАТ |
Орешник |
|
| |||
| |||
| |||
« предыдущая ветвь | форум | следующая ветвь »
Написание службы с циклом
Molnia © (2010-08-11 09:08:00)Доброго времени суток уважаемые знатоки. Необходимо написать сервис VCL, который по таймеру будет выполнять определенные действия. Код который нужно выполнять есть, но проблема в том что сервис не запускает таймер =( Google не выдал ни одного рабочего примера. Пожалуйста дайте исходник работающего сервиса который например по таймеру пишет в файл фразу.
Заранее благодарю.
FillAll (2010-10-11 17:17:00) [1]sniknik - Спасибо. Объяснил доходчиво. Я заглядывал но не понял.
sniknik (2010-10-11 16:48:00) [2]чего там объяснять, исходники генофонда пропали что ли?
смотришь в них -
procedure TServiceThread.Execute;
var
msg: TMsg;
Started: Boolean;
begin
PeekMessage(msg, 0, WM_USER, WM_USER, PM_NOREMOVE); { Create message queue }
try
FService.Status := csStartPending;
Started := True;
if Assigned(FService.OnStart) then FService.OnStart(FService, Started);
if not Started then Exit;
try
FService.Status := csRunning;
if Assigned(FService.OnExecute) then
FService.OnExecute(FService)
else
ProcessRequests(True);
ProcessRequests(False);
except
on E: Exception do
FService.LogMessage(Format(SServiceFailed,[SExecute, E.Message]));
end;
except
on E: Exception do
FService.LogMessage(Format(SServiceFailed,[SStart, E.Message]));
end;
end;
все очевидно.
FillAll (2010-10-11 16:33:00) [3]У меня есть подозрение что в компоненте TService есть внутренний Thread, который и поддерживает такой невизуальный VCL компонент как TTimer.
Это просто любопытство. Я попробовал (текст приводить не буду) запустить сервис с обработкой парадоксовских таблиц используя TTable к стандартному BDDEMOS псевдониму (простите за терминологию Paradox 5).
Пробовал "бросить" на Service1 невизуальные компоненты TserverSocket, TWordApplication - сервис активен если есть эти компоненты и выполнена процедура Create.
Я еще попробовал объявить в тексте (а не "бросить") такие компоненты и создать командой
Create(self) - сервис работает
и командой
Create(Nil) - сервис не работает (спустя некоторое время останавливается)
Наверное я был прав - есть внетренний Thread.
Может кто объяснит?
Palladin (2010-10-10 01:05:00) [4]
> Посчитал - интервал - 16 минут 39 секунд. Примерно совпадает.
что значит примерно? совпадает полностью, в точности до секунды
считать научись
FillAll (2010-10-09 21:55:00) [5]Попробовал.
Докладаю.
Поставил свойство Interval равным 999000.
Запустил.
Через некоторое время читаю в файле:
09.10.2010 20:24:53 событие таймера.
09.10.2010 20:41:32 событие таймера.
Посчитал - интервал - 16 минут 39 секунд. Примерно совпадает.
Вспомнил анекдот: Это не возможно объяснить. Это надо запомнить.
FillAll (2010-10-09 20:58:00) [6]Сергей М.
А возьми и попробуй.
Я когда прочитал комментарий
А у тебя мало того что ProcessRequests() нигде не вызывается, так еще и обработчика OnExecute нет в принципе. При отсутствии этого обработчика сервис останавливается тут же сразу после старта, ибо ему попросту делать нечего - обработчика-то нет)
Запустил сервис, перегрузил компьютер, десять минут жду - полет нормальный.
Правда задумался:интервал 1 секунда, если 10 минут?
попробую - доложу.
Dennis I. Komarov (2010-10-04 17:15:00) [7]1. Выбросить таймер ...... (вобщем, далеко очень)
2. Доп. поток для разного рода действий, основной оставить в покое.
Сергей М. (2010-10-03 22:38:00) [8]
> если надо - приостанавливается и продолжить можно. Все как
> по нотам
Ну эт ты врешь)
Сервис реагирует на команды (в т.ч. на pause и resume) именно потому что в OnExecute в цикле вызывается ProcessRequests().
А у тебя мало того что ProcessRequests() нигде не вызывается, так еще и обработчика OnExecute нет в принципе. При отсутствии этого обработчика сервис останавливается тут же сразу после старта, ибо ему попросту делать нечего - обработчика-то нет)
FillAll (2010-10-03 22:08:00) [9]Я тут попробовал в семерочке. Создал ServiceApplication.На service1 кинул Timer1 и написал код:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, SvcMgr, Dialogs,
ExtCtrls, Registry;
const
cRegPath = '\SYSTEM\CurrentControlSet\Services\';
cImagePath = 'ImagePath';
type
TService1 = class(TService)
Timer1: TTimer;
procedure ServiceStart(Sender: TService; var Started: Boolean);
procedure ServicePause(Sender: TService; var Paused: Boolean);
procedure ServiceContinue(Sender: TService; var Continued: Boolean);
procedure ServiceStop(Sender: TService; var Stopped: Boolean);
procedure Timer1Timer(Sender: TObject);
private
{ Private declarations }
ServicePath: String;
public
function GetServiceController: TServiceController; override;
{ Public declarations }
end;
var
Service1: TService1;
implementation
{$R *.DFM}
procedure ServiceController(CtrlCode: DWord); stdcall;
begin
Service1.Controller(CtrlCode);
end;
function TService1.GetServiceController: TServiceController;
begin
Result := ServiceController;
end;
procedure TService1.ServiceStart(Sender: TService; var Started: Boolean);
var
Reg: TRegistry;
vImagePath: String;
begin
//start
// оределяем путь к папке сервиса
Reg := TRegINIFile.Create('');
Reg.RootKey := HKEY_LOCAL_MACHINE;
Reg.OpenKey(cRegPath+Name, True);
vImagePath:=Reg.ReadString(cImagePath);
ServicePath:=ExtractFilePath(vImagePath);
Reg.Free;
// запускаем таймер
Timer1.Enabled:=True;
end;
procedure TService1.ServicePause(Sender: TService; var Paused: Boolean);
begin
// pause
Timer1.Enabled:=False;
end;
procedure TService1.ServiceContinue(Sender: TService;
var Continued: Boolean);
begin
// continue
Timer1.Enabled:=True;
end;
procedure TService1.ServiceStop(Sender: TService; var Stopped: Boolean);
begin
// stop
Timer1.Enabled:=False;
end;
procedure TService1.Timer1Timer(Sender: TObject);
var
f: TextFile;
begin
// on timer
{$I-}
AssignFile(f,ServicePath+'Log.log');
Append(f);
if IOResult <> 0 then
Rewrite(f);
Writeln(f,DateTimeToStr(Now)+' событие таймера.');
CloseFile(f);
{$I+}
end;
end.
и все работает. Может вы зря на ServiceExecute надеялись?
FillAll (2010-10-03 22:03:00) [10]Хотел понять в чем проблема - не понял.
Я тут в семерочке создал ServiceApplication, кинул на него таймер инаписал вот такую фигню:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, SvcMgr, Dialogs,
ExtCtrls, Registry;
const
cRegPath = '\SYSTEM\CurrentControlSet\Services\';
cImagePath = 'ImagePath';
type
TService1 = class(TService)
Timer1: TTimer;
procedure ServiceStart(Sender: TService; var Started: Boolean);
procedure ServicePause(Sender: TService; var Paused: Boolean);
procedure ServiceContinue(Sender: TService; var Continued: Boolean);
procedure ServiceStop(Sender: TService; var Stopped: Boolean);
procedure Timer1Timer(Sender: TObject);
private
{ Private declarations }
ServicePath: String;
public
function GetServiceController: TServiceController; override;
{ Public declarations }
end;
var
Service1: TService1;
implementation
{$R *.DFM}
procedure ServiceController(CtrlCode: DWord); stdcall;
begin
Service1.Controller(CtrlCode);
end;
function TService1.GetServiceController: TServiceController;
begin
Result := ServiceController;
end;
procedure TService1.ServiceStart(Sender: TService; var Started: Boolean);
var
Reg: TRegistry;
vImagePath: String;
begin
//start
// оределяем путь к папке сервиса
Reg := TRegINIFile.Create('');
Reg.RootKey := HKEY_LOCAL_MACHINE;
Reg.OpenKey(cRegPath+Name, True);
vImagePath:=Reg.ReadString(cImagePath);
ServicePath:=ExtractFilePath(vImagePath);
Reg.Free;
// запускаем таймер
Timer1.Enabled:=True;
end;
procedure TService1.ServicePause(Sender: TService; var Paused: Boolean);
begin
// pause
Timer1.Enabled:=False;
end;
procedure TService1.ServiceContinue(Sender: TService;
var Continued: Boolean);
begin
// continue
Timer1.Enabled:=True;
end;
procedure TService1.ServiceStop(Sender: TService; var Stopped: Boolean);
begin
// stop
Timer1.Enabled:=False;
end;
procedure TService1.Timer1Timer(Sender: TObject);
var
f: TextFile;
begin
// on timer
{$I-}
AssignFile(f,ServicePath+'Log.log');
Append(f);
if IOResult <> 0 then
Rewrite(f);
Writeln(f,DateTimeToStr(Now)+' событие таймера.');
CloseFile(f);
{$I+}
end;
end.
Самое удивительное - с интервалом в одну секунду пишет в Log.log как миленький. А если надо - приостанавливается и продолжить можно. Все как по нотам. Может вы, ребята зря с Execute методом связались?
Anatoly Podgoretsky (2010-08-11 21:30:00) [11]> Сергей М. (11.08.2010 13:45:22) [22]
FileMode для текстовых файлов не применим.
И
> FileMode is declared as a variable, not as a threadvar. Therefore this
> variable is not thread-safe.
Anatoly Podgoretsky (2010-08-11 21:28:00) [12]> Molnia (11.08.2010 11:41:16) [16]
Код не видим.
Anatoly Podgoretsky (2010-08-11 21:27:00) [13]> Molnia (11.08.2010 11:19:11) [11]
Текстовый файл, открытый для чтения, а ты пытаешься записать туда, вот тебе
и исключение.
Сергей М. (2010-08-11 13:45:00) [14]
> Molnia © (11.08.10 12:23) [20]
> Reset открывает файл для чтения, а не записи
Сам придумал ?)
Читаем справку:
Reset opens the existing external file with the name assigned to F using the mode specified by the global FileMode variable
Там же в справке рядом, кстати, и примерчик имеется)
George (2010-08-11 13:25:00) [15]
> Molnia © (11.08.10 12:23) [20]
Ой ли?
Molnia (2010-08-11 12:23:00) [16]
> файл недоступен для записи или что-то вроде того?
Reset открывает файл для чтения, а не записи. Вся проблема была только в этом, через потоки тоже попробовал, замечательно работает, через таймер тоже.
George (2010-08-11 12:16:00) [17]
> Molnia © (11.08.10 11:44) [18]
файл недоступен для записи или что-то вроде того?
Molnia (2010-08-11 11:44:00) [18]
> PS. Справку по Reset уже прочитал?
Блиииин так и знал что ошибка будет идиотская. Огромное спасибо.
Плохиш (2010-08-11 11:42:00) [19]
> Molnia © (11.08.10 09:08)
> но проблема в том что сервис не запускает таймер
Сервисы ничего не запускают, для запусков существуют программисты. Вам стоит одного из них поискать.
Molnia (2010-08-11 11:41:00) [20]
> Ну опять же - с чего ты взял что "ни разу" ?
> То что в файл не добавляется строка 'test', запросто может
> говорить о падении сервиса на строчке Reset()
>
>
Добавил Try/except, сейчас служба работает, не останавливается, но ничего в файл не пишет.
| |
Страницы: 