Форум: "Потрепаться";
Текущий архив: 2005.11.27;
Скачать: [xml.tar.bz2];

Вниз

Сервис, таймер в нем отказывается работать...   Найти похожие ветки 

← →
Layner ©   (2005-10-27 10:37) [0]

Здравствуйте! Пишу сервис, самый примитивный..:

unit main;

interface

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

type
 TAutoStart = class(TService)
   Timer1: TTimer;
   procedure Timer1Timer(Sender: TObject);
   procedure ServiceStart(Sender: TService; var Started: Boolean);
 private
   { Private declarations }
 public
   function GetServiceController: TServiceController; override;
   { Public declarations }
 end;

var
 AutoStart: TAutoStart;

implementation

{$R *.DFM}

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

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

procedure Msg(text: string);
var
TF: TextFile;
begin
if FileExists("log.txt") then
begin
 AssignFile(TF, "log.txt");
 Append(TF);
end
else
begin
 AssignFile(TF, "log.txt");
 ReWrite(TF);
end;

 Writeln(TF, text);
 CloseFile(TF);
end;

procedure TAutoStart.Timer1Timer(Sender: TObject);
begin                      
    Msg(TimeToStr(Now));
end;

procedure TAutoStart.ServiceStart(Sender: TService;
 var Started: Boolean);
begin
 Timer1.Enabled:=True;
end;

end.


Компилирую, ставлю, запускаю, в файл пишется одна строка. По идее должны писатся так же каждую секунду, а нет... В чем может быть дело?

---

← →
DiamondShark ©   (2005-10-27 12:42) [1]

TTimer требует цикла выборки сообщений.

---

← →
Digitman ©   (2005-10-27 12:47) [2]

> В чем может быть дело?


в полном непонимании того что происходит при Timer1.Enabled:=True
в полном непонимании механизма Win-сообщений

---

← →
Layner ©   (2005-10-28 13:18) [3]

Дубль два. Непонимание.. но ведь другие работают? Например SysUtils.Beep; пишу вместо Msg(TimeToStr(Now)); и все прекрасно в динамиках звенит каждую сек.. а почему в файл не пишется не понятно...

---

← →
Digitman ©   (2005-10-28 13:25) [4]

> почему в файл не пишется не понятно


на то есть встроенный отладчик, чтобы "понять"

---

← →
Layner ©   (2005-10-28 13:34) [5]

Я сервис не могу оттрассировать.

---

← →
Digitman ©   (2005-10-28 13:37) [6]

> Layner ©   (28.10.05 13:34) [5]


а станд.справку на эту тему почитать в голову не приходило ?

---

← →
Digitman ©   (2005-10-28 13:40) [7]

You can debug service applications by attaching to the service application process when it is already running (that is, by starting the service first, and then attaching to the debugger). To attach to the service application process, choose Run|Attach To Process, and select the service application in the resulting dialog.

In some cases, this approach may fail, due to insufficient rights. If that happens, you can use the Service Control Manager to enable your service to work with the debugger:

1 First create a key called Image File Execution Options in the following registry location:

HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion

2 Create a subkey with the same name as your service (for example, MYSERV.EXE). To this subkey, add a value of type REG_SZ, named Debugger. Use the full path to Delphi32.exe as the string value.
3 In the Services control panel applet, select your service, click Startup and check Allow Service to Interact with Desktop.

On Windows NT systems, you can use another approach for debugging service applications. However, this approach can be tricky, because it requires short time intervals:

1 First, launch the application in the debugger. Wait a few seconds until it has finished loading.
2 Quickly start the service from the Control Panel or from the command line:

start MyServ

You must launch the service quickly (within 15-30 seconds of application startup) because the application will terminate if no service is launched.

---

← →
Layner ©   (2005-11-01 16:52) [8]

Digitman
Спасибо за справку, и отладку. Мне бы все таки хотелось узнать без отладки.. почему не пишется в текстовый файл, бипы, посылки на TCP/UDP и прочая ... работают без проблем по таймеру. Таймер стратует... В ФАЙЛ не пишется... И что толку отладка, проходит курсор все метки, ошибки нет никакой...

---

← →
Baltika-30   (2005-11-01 19:41) [9]

>Layner ©

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

unit Unit1;

interface

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

type

 TThreadTimer=class(TThread)
 protected
   FS: TFileStream;
   procedure Execute; override;
 end;

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

var
 TwoService: TTwoService;
 ThrTimer: TThreadTimer;

implementation

{$R *.DFM}

{TTwoService}

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

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

procedure TTwoService.ServiceExecute(Sender: TService);
begin
   while not terminated do
   begin
     ServiceThread.ProcessRequests(True);
   end;
end;

procedure TTwoService.ServiceStart(Sender: TService; var Started: Boolean);
begin
 ThrTimer := TThreadTimer.Create(True);
 ThrTimer.FreeOnTerminate := True;
 try
   ThrTimer.FS := TFileStream.Create("c:\log.tmp",fmOpenReadWrite or fmShareDenyWrite);
   Started := True;
 except
   ThrTimer.Terminate;
   Started := False;
 end;
 ThrTimer.Resume;
end;

procedure TTwoService.ServiceStop(Sender: TService; var Stopped: Boolean);
begin
 ThrTimer.Terminate;
 Stopped := True;
end;

procedure TTwoService.ServiceContinue(Sender: TService;
 var Continued: Boolean);
begin
 ThrTimer.Resume;
 Continued := True;
end;

procedure TTwoService.ServicePause(Sender: TService; var Paused: Boolean);
begin
ThrTimer.Suspend;
Paused := True
end;

{ TThreadTimer }

procedure TThreadTimer.Execute;
var
 s: String;
begin
 while not Terminated do
 begin
   try
     s := FormatDateTime("hh:nn:ss",Now)+#13#10;
     FS.Write(s[1],Length(s));
     Sleep(1000);
   except
   end;
 end;
 FS.Free;
end;

end.

---

← →
vuk ©   (2005-11-01 22:15) [10]

В сервисах лучше использовать что-нибудь типа WaitableTimer.

---

← →
Layner ©   (2005-11-01 22:31) [11]

Baltika-30   (01.11.05 19:41)
Балтика, спасибо огромное! Если у Вас есть желание, напишите мне, расчитаюсь :)
За советы тоже, всем огромное спасибо!

---

Страницы: 1 вся ветка

Форум: "Потрепаться";
Текущий архив: 2005.11.27;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.48 MB
Время: 0.015 c