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

Вниз

Сервис не позволяет завершить работу.   Найти похожие ветки 

← →
KarlovAF   (2002-05-06 05:46) [0]

Написал программу, которая работает как сервис. Работает она вполне сносно, но вот одна проблемма: пока сервис запущен я не могу завершить работу компьютера (перезагрузить, выйти из системы, выключиться и т.д.). При завершении работы выгружаются все приложения, а как доходит дело до моего сервиса, так на этом все и заканчивается. И можно работать дальше...
Подскажите как изменить ситуацию к лучшему?
Заранее благодарен...

---

← →
cdaDMITRIY   (2002-05-06 08:37) [1]

Я думаю у ВАС проблема с сервисом ( он не правильно написан )

приведи код

---

← →
Alex M.A.   (2002-05-06 10:01) [2]

Однажды у меня была подобная проблема...
В обработчике OnCloseQuery работала строка CanClose:=False; при RegisterServiceProcess(1);
но выхода из положения так и не искал.

---

← →
KarlovAF   (2002-05-07 05:20) [3]

Дело в том, что в программе присутствуют формы. Вчера проверил: создал пустой сервис, который при запуске показывает пустую форму. Так вот, при закрытии формы процесс зависает и также не дает завершать работу.
Что можете еще посоветовать?

---

← →
Севостьянов Игорь   (2002-05-07 13:41) [4]

А здесь у тебя что ?

procedure TTestService.ServiceStop(Sender: TService; var Stopped: Boolean);
begin
{ Tell the service thread to terminate }
ServiceThread.Terminate;
{ Tell the OS that we"re stopping }
Stopped := TRUE;
{ Alert the user }
ShowMessage("Stop");
end;

---

← →
Севостьянов Игорь   (2002-05-07 14:04) [5]

Ладно лови пустой...
При Start сервиса создаем форму
При Stop сервиса удаляем
При Execute если еще не открыта то открываем...
===================================
program TstService;

uses
SvcMgr,
Unit1 in "Unit1.pas" {TestService: TService},
Main in "Main.pas" {frmMain};

{$R *.RES}

begin
Application.Initialize;
Application.CreateForm(TTestService, TestService);
Application.Run;
end.

===================================
unit Main;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;

type
TfrmMain = class(TForm)
private
{ Private declarations }
public
{ Public declarations }
end;

var
frmMain: TfrmMain;

implementation

{$R *.DFM}

end.
===================================
unit Unit1;
(*
A simple service application that can be started, paused, continued, and stopped.
Beeps once every two seconds when executing. Install by running
"service /install" from the command line, then manipulate the service with:

START) net start "test service"
STOP) net stop "test service"
PAUSE) net pause "test service"
CONTINUE) net continue "test service"

To uninstall, run "service /uninstall"

*)
interface

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

type
TTestService = class(TService)
procedure ServiceStart(Sender: TService; var Started: Boolean);
procedure ServiceExecute(Sender: TService);
procedure ServiceBeforeInstall(Sender: TService);
procedure ServiceAfterInstall(Sender: TService);
procedure ServiceAfterUninstall(Sender: TService);
procedure ServiceBeforeUninstall(Sender: TService);
procedure ServiceStop(Sender: TService; var Stopped: Boolean);
procedure ServiceShutdown(Sender: TService);
procedure ServicePause(Sender: TService; var Paused: Boolean);
procedure ServiceContinue(Sender: TService; var Continued: Boolean);
private
{ Private declarations }
fPaused : boolean;
public
function GetServiceController: TServiceController; override;
{ Public declarations }
end;

var
TestService: TTestService;

implementation

uses Main;

{$R *.DFM}

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

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

procedure TTestService.ServiceStart(Sender: TService; var Started: Boolean);
begin
{ Alert the user }
ShowMessage("OnStart");
{ tell the OS that we"re starting }
Started := TRUE;
Application.CreateForm(TfrmMain, frmMain);
end;

procedure TTestService.ServiceExecute(Sender: TService);
begin
ShowMessage("OnExecute");
{ Execute until we"re told to stop }
while not Terminated do begin
{ Only act if we"re not paused }
if not fPaused then begin
{ wait 2 seconds }
//Sleep(2000);
{ beep }
//MessageBeep(0);
if not frmMain.Visible then frmMain.Show;
end; { if not ServiceThread.Suspended }
{ Let other threads execute }
ServiceThread.ProcessRequests(FALSE);
end; { while not Terminated }
end;

procedure TTestService.ServiceBeforeInstall(Sender: TService);
begin
ShowMessage("BeforeInstall");
end;

procedure TTestService.ServiceAfterInstall(Sender: TService);
begin
ShowMessage("After Install");
end;

procedure TTestService.ServiceAfterUninstall(Sender: TService);
begin
ShowMessage("After Uninstall");
end;

procedure TTestService.ServiceBeforeUninstall(Sender: TService);
begin
ShowMessage("Before Uninstall");
end;

procedure TTestService.ServiceStop(Sender: TService; var Stopped: Boolean);
begin
{ Tell the service thread to terminate }
ServiceThread.Terminate;
{ Tell the OS that we"re stopping }
Stopped := TRUE;
//Stopped := False;
{ Alert the user }
ShowMessage("Stop");
frmMain.Free;
end;

procedure TTestService.ServiceShutdown(Sender: TService);
begin
ShowMessage("Shutdown");
end;

procedure TTestService.ServicePause(Sender: TService; var Paused: Boolean);
begin
{ tell OS that pause was successful }
Paused := True;
//Paused := False;
{ set are pause flag so Execute loop doesn"t do anything }
fPaused := TRUE;
{ Alert the user visually }
ShowMessage("Pause");
end;

procedure TTestService.ServiceContinue(Sender: TService;
var Continued: Boolean);
begin
{ Tell the OS that the Continue was successful }
Continued := True;
{ Turn our internal pause flag off }
fPaused := FALSE;
{ alert the user visually }
ShowMessage("Continue");
end;

end.
===================================
install.bat -> TstService.exe /INSTALL
start.bat -> net start "test service"
stop.bat -> net stop "test service"
uninstall.bat -> TstService.exe /UNINSTALL
===================================

Вопросы по мылу

---

← →
KarlovAF   (2002-05-31 11:56) [6]

Спасибо за все ответы. Но видно что-то я делаю не так. Пришлите пожалуйста мне на мыло готовый пример...

---

← →
Севостьянов Игорь   (2002-05-31 12:19) [7]

Ну что ж лови

---

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

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

Наверх

Память: 0.47 MB
Время: 0.007 c