Создание службы

smartmaster · Сообщение **smartmaster** » 22.04.2019 09:26:57

Зравствуйте!
Не могли бы вы подсказать как прикрутить к сервису компоненты
TSimpleIPCClient
TSimpleIPCServer
чтобы сервис мог слушать мое приложение и отвечать ему.
У компонента TSimpleIPCServer есть метод MessageQueued который ловит сообщения от клиентов. Не пойму как сделать так, чтобы этот метод срабатывал в daemon?
Если добавить копоненты к проекту, то сервис падает на событии stop.
Спасибо.

smartmaster · Сообщение **smartmaster** » 24.04.2019 13:34:41

Устанавливаю службу.
Вручную запускаю службу- запускается.
Останавливаю- крутит около 2 минут и выдает сообщение об ошибке.
Что я делаю не так?
Вот код:

Код: Выделить всё

 { TDaemon1 }

  TDaemon1 = class(TDaemon)
    SimpleIPCClient1: TSimpleIPCClient;
    SimpleIPCServer1: TSimpleIPCServer;
    SQLite3Connection1: TSQLite3Connection;
    SQLQuery1: TSQLQuery;
    SQLTransaction1: TSQLTransaction;

    Timer1: TTimer;


    procedure DataModuleStart(Sender: TCustomDaemon; var OK: Boolean);
    procedure DataModuleStop(Sender: TCustomDaemon; var OK: Boolean);
    procedure SimpleIPCServer1MessageQueued(Sender: TObject);
  private
    { private declarations }
      flag1: boolean;
      i:integer;
      FF1:TextFile;
  public
    { public declarations }
  end;

type

{ TMyThread }

 TMyThread = Class(TThread)
  public
    procedure Execute; override;
end;

var
  Daemon1: TDaemon1;
  My:TMyThread;
  FF:TextFile;

implementation

procedure RegisterDaemon;
begin
  RegisterDaemonClass(TDaemon1)
end;

{$R *.lfm}

{ TMyThread }

procedure TMyThread.Execute;
var i:integer;

begin

  AssignFile(FF,'D:\log.txt');
  rewrite(FF);

  repeat
     writeln(FF,'OK '+IntToStr(I));
     inc(I);
     sleep(2000);
   //  ProcessRequests(False);


  until Terminated;
end;


{ TDaemon1 }


procedure TDaemon1.DataModuleStart(Sender: TCustomDaemon; var OK: Boolean);
begin
 // My:=TMyThread.Create(False);

  SimpleIPCServer1.StartServer(true);
  AssignFile(FF1,'D:\log.txt');
  rewrite(FF1);
  writeln(FF1,'SimpleIPCServer1 wait message ');
  OK:= true;
end;


procedure TDaemon1.DataModuleStop(Sender: TCustomDaemon; var OK: Boolean);
begin
 // My.Terminate;
 try
  SimpleIPCServer1.StopServer;
  CloseFile(FF1);
  OK:= true;

 except
 end;
end;

procedure TDaemon1.SimpleIPCServer1MessageQueued(Sender: TObject);
begin
try
   SimpleIPCServer1.PeekMessage(20, true);
   writeln(FF1,'OK read text ' + SimpleIPCServer1.StringMessage);

 except
 end;
end;

initialization
  RegisterDaemon;
end.

olegy123 · Сообщение **olegy123** » 24.04.2019 14:26:32

smartmaster писал(а):Останавливаю- крутит около 2 минут и выдает сообщение об ошибке.

это значит что система не поняла что произошло с твоим сервисом.
Можно посмотреть в журнале событий, какова ошибка..

Твой сервис должен сообщить что он завершен в
процедуре DataModuleStop
флагом OK:= true;

возможно он не выходит из DataModuleStop, где то там виснет.

Добавлено спустя 6 минут 20 секунд:
я бы тебе посоветовал поиграется на форме с запуском и остановкой всех объектов SimpleIPCClient1/SimpleIPCServer1/ .. /Timer1
когда там не будет ошибок и лично будет понятно как каждый объект работает и на что влияет при старте и остановки.

потом уже работать с сервисами.. там тоже есть свои особенности при автостарте (порядок запуска: драйвера,файловая система, сеть, права)

smartmaster · Сообщение **smartmaster** » 25.04.2019 06:22:58

Поменял в коде true на false

Код: Выделить всё

SimpleIPCServer1.StartServer(false);

сервис стал запускаться и останавливаться.
Теперь проблема в том, что когда посылаю сообщение серверу программа возвращает ошибку
что сервер с такимто id не активен.
Вроде при старте службы сервер активируется. Если тоже самое делаю в тестовом приложении сервер виден, а в службе нет.
Что может быть?

Код: Выделить всё

 { TDaemon1 }

  TDaemon1 = class(TDaemon)
    SimpleIPCClient1: TSimpleIPCClient;
    SimpleIPCServer1: TSimpleIPCServer;
    SQLite3Connection1: TSQLite3Connection;
    SQLQuery1: TSQLQuery;
    SQLTransaction1: TSQLTransaction;

    Timer1: TTimer;


    procedure DataModuleStart(Sender: TCustomDaemon; var OK: Boolean);
    procedure DataModuleStop(Sender: TCustomDaemon; var OK: Boolean);
    procedure SimpleIPCServer1MessageQueued(Sender: TObject);
  private
    { private declarations }
      flag1: boolean;
      i:integer;
      FF1:TextFile;
  public
    { public declarations }
  end;

type

{ TMyThread }

 TMyThread = Class(TThread)
  public
    procedure Execute; override;
end;

var
  Daemon1: TDaemon1;
  My:TMyThread;
  FF:TextFile;

implementation

procedure RegisterDaemon;
begin
  RegisterDaemonClass(TDaemon1)
end;

{$R *.lfm}

{ TMyThread }

procedure TMyThread.Execute;
var i:integer;

begin

  AssignFile(FF,'D:\log.txt');
  rewrite(FF);

  repeat
     writeln(FF,'OK '+IntToStr(I));
     inc(I);
     sleep(2000);
   //  ProcessRequests(False);


  until Terminated;
end;


{ TDaemon1 }


procedure TDaemon1.DataModuleStart(Sender: TCustomDaemon; var OK: Boolean);
begin
 // My:=TMyThread.Create(False);

  SimpleIPCServer1.StartServer(false);
  AssignFile(FF1,'D:\log.txt');
  rewrite(FF1);
  writeln(FF1,'SimpleIPCServer1 wait message ');
  OK:= true;
end;


procedure TDaemon1.DataModuleStop(Sender: TCustomDaemon; var OK: Boolean);
begin
 // My.Terminate;
 try
  SimpleIPCServer1.StopServer;
  writeln(FF1,'SimpleIPCServer1 stopped... ');
  CloseFile(FF1);
  OK:= true;

 except
 end;
end;

procedure TDaemon1.SimpleIPCServer1MessageQueued(Sender: TObject);
begin
try
   SimpleIPCServer1.PeekMessage(20, true);
   writeln(FF1,'SimpleIPCServer read text ' + SimpleIPCServer1.StringMessage);

 except
 end;
end;

initialization
  RegisterDaemon;
end.

smartmaster · Сообщение **smartmaster** » 26.04.2019 09:12:22

Максимально упростил
Запускается останавливается, но не принимает сообщения. Почему?

Код: Выделить всё

type
  { TServerThread }

  TServerThread = Class(TThread)
  private
    FServer: TSimpleIPCServer;
    FThreadTimeout: Integer;
    FSender: TCustomDaemon;
  Public
    constructor Create(ATimeout: integer; aowner: TCustomDaemon);
    procedure SimpleIPCServer1MessageQueued(Sender: TObject);
    procedure Execute; override;
    Property Server : TSimpleIPCServer Read FServer;
    Property ThreadTimeout : Integer Read FThreadTimeout;
  end;




  { TDaemon1 }

  TDaemon1 = class(TDaemon)
  private
    { private declarations }

  public
    { public declarations }  
    procedure DataModuleStart(Sender: TCustomDaemon; var OK: Boolean);
    procedure DataModuleStop(Sender: TCustomDaemon; var OK: Boolean);
  end;


var
  Daemon1: TDaemon1;
  My:TServerThread;
  FF1:TextFile;

implementation

procedure RegisterDaemon;
begin
  RegisterDaemonClass(TDaemon1)
end;

{$R *.lfm}


{ TServerThread }

constructor TServerThread.Create(ATimeout: integer; aowner: TCustomDaemon);
begin
  FSender:= aowner;
  FThreadTimeout:=ATimeOut;
  Inherited Create(False);
end;

procedure TServerThread.SimpleIPCServer1MessageQueued(Sender: TObject);
begin
  try
   FServer.ReadMessage;
   writeln(FF1,'SimpleIPCServer read text ' + FServer.StringMessage);

 except
 end;
end;

procedure TServerThread.Execute;
begin

   FServer:=TSimpleIPCServer.Create(FSender);
  FServer.Global:=true;
  FServer.MaxAction:= ipcmoaNone;
  FServer.MaxQueue:= 3;
  FServer.ServerID:= '244';
  FServer.OnMessageQueued:=@SimpleIPCServer1MessageQueued;

  FServer.StartServer();

  AssignFile(FF1,'D:\log.txt');
  rewrite(FF1);
  writeln(FF1,'SimpleIPCServer1 wait message ');


  While Not Terminated do
    FServer.PeekMessage(ThreadTimeout,False);

  FServer.StopServer;
  FServer.Free;

  writeln(FF1,'SimpleIPCServer1 stopped... ');
  CloseFile(FF1);

end;


{ TDaemon1 }


procedure TDaemon1.DataModuleStart(Sender: TCustomDaemon; var OK: Boolean);
begin
  My:=TServerThread.Create(50,Sender );
  My.Priority:=tpNormal;
  OK:= true;
end;


procedure TDaemon1.DataModuleStop(Sender: TCustomDaemon; var OK: Boolean);
begin
  My.Terminate;
  OK:= true;
end;

initialization
  RegisterDaemon;
end.

Лекс Айрин · 26.04.2019 11:00:19

smartmaster, судя по всему, просто нечем.

smartmaster · Сообщение **smartmaster** » 26.04.2019 11:18:27

Лекс Айрин писал(а):smartmaster, судя по всему, просто нечем.

Не понял, что значит нечем?

Вот проект приложения в нем все работает.

Код: Выделить всё

unit serviceTestIpc;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, simpleipc, FileUtil, Forms, Controls, Graphics, Dialogs,
  StdCtrls;

type

  { TServerThread }

  TServerThread = Class(TThread)
  private
    FServer: TSimpleIPCServer;
    FThreadTimeout: Integer;
    FSender: TForm;
     FF1:TextFile;
  Public
    constructor Create(ATimeout: integer; aowner: TForm);
    procedure SimpleIPCServer1MessageQueued(Sender: TObject);
    procedure Execute; override;
    Property Server : TSimpleIPCServer Read FServer;
    Property ThreadTimeout : Integer Read FThreadTimeout;
  end;


  { TForm1 }

  TForm1 = class(TForm)
    Label1: TLabel;
    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
    procedure FormCreate(Sender: TObject);
  private

  public

  end;

var
  Form1: TForm1;
   My:TServerThread;



implementation

{$R *.lfm}


{ TServerThread }

constructor TServerThread.Create(ATimeout: integer; aowner: TForm);
begin
  FSender:= aowner;
  FThreadTimeout:=ATimeOut;
  Inherited Create(False);
end;

procedure TServerThread.SimpleIPCServer1MessageQueued(Sender: TObject);
begin
  try
   FServer.ReadMessage;
   writeln(FF1,'SimpleIPCServer read text ' + FServer.StringMessage);

 except
 end;
end;

procedure TServerThread.Execute;
begin

  FServer:=TSimpleIPCServer.Create(FSender);
  FServer.Global:=true;
  FServer.MaxAction:= ipcmoaNone;
  FServer.MaxQueue:= 3;
  FServer.ServerID:= '244';
  FServer.OnMessageQueued:=@SimpleIPCServer1MessageQueued;

  FServer.StartServer();

  AssignFile(FF1,'D:\log.txt');
  rewrite(FF1);
  writeln(FF1,'SimpleIPCServer1 wait message ');


  While Not Terminated do
    FServer.PeekMessage(ThreadTimeout,False);

  FServer.StopServer;
  FreeAndNil(FServer);


  writeln(FF1,'SimpleIPCServer1 stopped... ');
  CloseFile(FF1);

end;


{ TForm1 }


procedure TForm1.FormCreate(Sender: TObject);
begin

  my:= TServerThread.Create(50,self);

end;

procedure TForm1.FormClose(Sender: TObject; var CloseAction: TCloseAction);
begin
  if Assigned(my) then
  begin
    my.Terminate;
    my.WaitFor;
    FreeAndNil(my);

  end;
end;

end.

Лекс Айрин · 26.04.2019 11:42:25

smartmaster, вот и смотри в чем разница.

smartmaster · Сообщение **smartmaster** » 30.04.2019 08:00:51

Разница в том, что у приложения есть объект Application, а у демона его нет.
Создание потока происходит в одном случае на FormCreate, а в другом DataModuleStart.
У класса TDaemon очень скудное описание.
Может ли TSimpleIPCServer работать с TDaemon? Может нужно в сервис добавить Application? Как?
Помогите!!!

Снег Север · 30.04.2019 10:49:01

smartmaster,
https://forum.lazarus.freepascal.org/in ... ic=31207.0
это не то, что вам надо?

Makhaon · Сообщение **Makhaon** » 30.04.2019 11:09:50

Скорее всего сообщения не обрабатываются, потому что нечему.

FreePascal.ru

Создание службы

Создание службы

Re: Создание службы

Re: Создание службы

Re: Создание службы

Re: Создание службы

Re: Создание службы

Re: Создание службы

Re: Создание службы

Re: Создание службы

Re: Создание службы

Re: Создание службы