Написание службы с циклом

← →
Molnia © (2010-08-11 09:08) [0]

Доброго времени суток уважаемые знатоки. Необходимо написать сервис VCL, который по таймеру будет выполнять определенные действия. Код который нужно выполнять есть, но проблема в том что сервис не запускает таймер =( Google не выдал ни одного рабочего примера. Пожалуйста дайте исходник работающего сервиса который например по таймеру пишет в файл фразу.

Заранее благодарю.

← →
KilkennyCat © (2010-08-11 09:40) [1]

> сервис VCL

это что за хрень такая?

← →
Molnia © (2010-08-11 09:48) [2]

> это что за хрень такая?

Имелось ввиду с использованием VCL, а на WinAPI. VCL - библиотека классов.

← →
George © (2010-08-11 09:53) [3]

А я, например делал проще:
while not self.terminated do begin <do_something>; sleep(5000); self.ReportStatus; self.ServiceThread.ProcessRequests(false); end;
И таймер не нужен.

← →
Molnia © (2010-08-11 10:30) [4]

Так служба сразу стопится, а код не выполняется в принципе =(

← →
Сергей М. © (2010-08-11 10:44) [5]

> Так служба сразу стопится

Так ты поди исп.файл службы запускаешь не как службу, а как обычное приложение)

← →
Molnia © (2010-08-11 10:47) [6]

неа, устанавливал с ключиком /install и запускал через оснастку сервисов.

← →
Сергей М. © (2010-08-11 10:57) [7]

Ну тады показывай код ..

← →
Molnia © (2010-08-11 11:01) [8]

unit Unit1; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, SvcMgr, Dialogs; type TService1 = class(TService) procedure ServiceExecute(Sender: TService); private { Private declarations } 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.ServiceExecute(Sender: TService); var f:textfile; begin Assignfile(f,"C:\test\test.txt"); Rewrite(f); CloseFile(f); while not self.terminated do begin Reset(f); writeln(f,"test"); CloseFile(f); sleep(5000); self.ReportStatus; self.ServiceThread.ProcessRequests(false); end; end; end.

← →
George © (2010-08-11 11:11) [9]

Возможно где-то ошибка вылетает, надо отлаживать, я отлаживал с помощью функции OutputDebugString(), которую потом переделал во WriteToLog() :). Кстати, я бы порекомендовал создать отдельный поток и делать через события OnStart и OnStop.

← →
Сергей М. © (2010-08-11 11:12) [10]

И где в этом коде таймер ?

> служба сразу стопится, а код не выполняется в принципе

"Ты видишь суслика ? И я не вижу. А он есть" (с) ДМБ

То что нет видимых результатов выполнения, вовсе не говорит о том что код не выполняется.
Ты ждешь появления файла C:\test\test.txt, а он не появляется ?
Это, скорее всего, говорит о том что при выполнении кода обработчика OnExecute возникло исключение и сервис по этой причине завершил работу.
Искл-е вполне могло возникнуть уже на строчке Rewrite().

← →
Molnia © (2010-08-11 11:19) [11]

Файл как раз появляется, и исключений там нет, а вот кусок кода

while not self.terminated do begin Reset(f); writeln(f,"test"); CloseFile(f); sleep(5000); self.ReportStatus; self.ServiceThread.ProcessRequests(false); end;

не выполняется вообще ни разу

← →
Сергей М. © (2010-08-11 11:26) [12]

Ну опять же - с чего ты взял что "ни разу" ?
То что в файл не добавляется строка "test", запросто может говорить о падении сервиса на строчке Reset()

← →
Ega23 © (2010-08-11 11:29) [13]

Assignfile(f,"C:\test\test.txt"); Rewrite(f); CloseFile(f);

Вы делаете мне смеяться.

← →
Ega23 © (2010-08-11 11:31) [14]

Хотя нет, отставить. Поторопился.

← →
Плохиш © (2010-08-11 11:39) [15]

> Molnia © (11.08.10 11:19) [11]

> не выполняется вообще ни разу

Неужели в файле нет слова "test"?

PS. Справку по Reset уже прочитал?

← →
Molnia © (2010-08-11 11:41) [16]

> Ну опять же - с чего ты взял что "ни разу" ?
> То что в файл не добавляется строка "test", запросто может
> говорить о падении сервиса на строчке Reset()
>
>

Добавил Try/except, сейчас служба работает, не останавливается, но ничего в файл не пишет.

← →
Плохиш © (2010-08-11 11:42) [17]

> Molnia © (11.08.10 09:08)

> но проблема в том что сервис не запускает таймер

Сервисы ничего не запускают, для запусков существуют программисты. Вам стоит одного из них поискать.

← →
Molnia © (2010-08-11 11:44) [18]

> PS. Справку по Reset уже прочитал?

Блиииин так и знал что ошибка будет идиотская. Огромное спасибо.

← →
George © (2010-08-11 12:16) [19]

> Molnia © (11.08.10 11:44) [18]

файл недоступен для записи или что-то вроде того?

← →
Molnia © (2010-08-11 12:23) [20]

> файл недоступен для записи или что-то вроде того?

Reset открывает файл для чтения, а не записи. Вся проблема была только в этом, через потоки тоже попробовал, замечательно работает, через таймер тоже.

← →
George © (2010-08-11 13:25) [21]

> Molnia © (11.08.10 12:23) [20]

Ой ли?

← →
Сергей М. © (2010-08-11 13:45) [22]

> 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

Там же в справке рядом, кстати, и примерчик имеется)

← →
Anatoly Podgoretsky © (2010-08-11 21:27) [23]

> Molnia (11.08.2010 11:19:11) [11]

Текстовый файл, открытый для чтения, а ты пытаешься записать туда, вот тебе
и исключение.

← →
Anatoly Podgoretsky © (2010-08-11 21:28) [24]

> Molnia (11.08.2010 11:41:16) [16]

Код не видим.

> Сергей М. (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.

Хотел понять в чем проблема - не понял.
Я тут в семерочке создал 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 методом связались?

Я тут попробовал в семерочке. Создал 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 надеялись?

> если надо - приостанавливается и продолжить можно. Все как
> по нотам

Ну эт ты врешь)

Сервис реагирует на команды (в т.ч. на pause и resume) именно потому что в OnExecute в цикле вызывается ProcessRequests().
А у тебя мало того что ProcessRequests() нигде не вызывается, так еще и обработчика OnExecute нет в принципе. При отсутствии этого обработчика сервис останавливается тут же сразу после старта, ибо ему попросту делать нечего - обработчика-то нет)

1. Выбросить таймер ...... (вобщем, далеко очень)
2. Доп. поток для разного рода действий, основной оставить в покое.

Сергей М.
А возьми и попробуй.
Я когда прочитал комментарий
А у тебя мало того что ProcessRequests() нигде не вызывается, так еще и обработчика OnExecute нет в принципе. При отсутствии этого обработчика сервис останавливается тут же сразу после старта, ибо ему попросту делать нечего - обработчика-то нет)
Запустил сервис, перегрузил компьютер, десять минут жду - полет нормальный.
Правда задумался:интервал 1 секунда, если 10 минут?
попробую - доложу.

Попробовал.
Докладаю.
Поставил свойство Interval равным 999000.
Запустил.
Через некоторое время читаю в файле:
09.10.2010 20:24:53 событие таймера.
09.10.2010 20:41:32 событие таймера.
Посчитал - интервал - 16 минут 39 секунд. Примерно совпадает.

Вспомнил анекдот: Это не возможно объяснить. Это надо запомнить.

> Посчитал - интервал - 16 минут 39 секунд. Примерно совпадает.

что значит примерно? совпадает полностью, в точности до секунды
считать научись

У меня есть подозрение что в компоненте TService есть внутренний Thread, который и поддерживает такой невизуальный VCL компонент как TTimer.
Это просто любопытство. Я попробовал (текст приводить не буду) запустить сервис с обработкой парадоксовских таблиц используя TTable к стандартному BDDEMOS псевдониму (простите за терминологию Paradox 5).
Пробовал "бросить" на Service1 невизуальные компоненты TserverSocket, TWordApplication - сервис активен если есть эти компоненты и выполнена процедура Create.
Я еще попробовал объявить в тексте (а не "бросить") такие компоненты и создать командой
Create(self) - сервис работает
и командой
Create(Nil) - сервис не работает (спустя некоторое время останавливается)
Наверное я был прав - есть внетренний Thread.

Может кто объяснит?

чего там объяснять, исходники генофонда пропали что ли?
смотришь в них -
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;
все очевидно.

sniknik - Спасибо. Объяснил доходчиво. Я заглядывал но не понял.

Написание службы с циклом Найти похожие ветки