0

Linuxで動作する必要があるFreePascalの「デーモンのような」プログラムにFirebirdイベントハンドラーを実装しようとしています。私はすべてを試したと思いますが、データベースから送信されたイベント (ログに登録する必要があります) をまだ登録できません。デーモンはクラッシュしておらず、アクティビティのログを保持しています。私が作成した 2 つの GUI (Windows と Ubuntu の Lazarus) は問題なく動作しています。

私は何を間違っていますか？イベントリスナーでデーモンプログラムを作ることはできますか? 多分それらの質問は最も賢明ではないかもしれませんが、私は絶対にアイデアがありません.

Program Daemon;

{$mode objfpc}{$H+}

uses
  {$DEFINE UseCThreads}
  {$IFDEF UNIX}{$IFDEF UseCThreads}
  cthreads,
  {$ENDIF}{$ENDIF}
  SysUtils, BaseUnix, sqldb, IBConnection, FBEventMonitor;

{ TMyEventAlert }                        {c}
type
  TMyEventAlert=class
class procedure OnFBEvent(Sender: TObject; EventName: string; EventCount: longint;
 var CancelAlerts: boolean);
end;

Var
   { vars for daemonizing }
   bHup,
   bTerm : boolean;
   textPolaczenia, textZdarzenia, config : text;
   SlogPolaczenia, SlogZdarzenia,  nazwaHosta, sciezkaBazaDanych, uzytkownik, haslo: string;

   aOld,
   aTerm,
   aHup : pSigActionRec;
   ps1  : psigset;
   sSet : cardinal;
   pid  : pid_t;
   secs : longint;

   zerosigs : sigset_t;
   EventAlert : TMyEventAlert;
   EventsM :TFBEventMonitor;
   //EventAlert: TMyEventAlert;
   BConnection : TIBConnection;
   SQLQuery1: TSQLQuery;
   SQLTransaction1: TSQLTransaction;


   { handle SIGHUP & SIGTERM }
   procedure DoSig(sig : longint);cdecl;
   begin
      case sig of
         SIGHUP : bHup := true;
         SIGTERM : bTerm := true;
      end;
   end;



class procedure TMyEventAlert.OnFBEvent(Sender: TObject; EventName: string;
   EventCount: longint; var CancelAlerts: boolean);
   begin
     //some basic do's
     SlogZdarzenia := 'SlogZdarzenia.log';
     AssignFile(textZdarzenia,SlogZdarzenia);
     Rewrite(textZdarzenia);
     Writeln(textZdarzenia,'Cos sie zdarzylo');
     CloseFile(textZdarzenia);
     end;


Procedure WpisPolaczenie;
Begin
   AssignFile(textPolaczenia,SLogPolaczenia);
   Append(textPolaczenia);
   Writeln(textPolaczenia,'Connected to database at ',formatdatetime('hh:nn:ss',now));
   CloseFile(textPolaczenia);
End;

procedure CreateConnection;

   begin
      BConnection := TIBConnection.Create(nil);


      BConnection.DataBaseName := '/home/pi/bazydanych/aaa';
      BConnection.Hostname := 'localhost';
      BConnection.UserName:='sysdba';
      BConnection.Password:='masterkey';


      EventsM:=TFBEventMonitor.create(nil);
      EventsM.Connection:=BConnection;
      EventsM.Events.Add('baba');
      EventsM.OnEventAlert:=@EventAlert.OnFBEvent;
      EventsM.RegisterEvents;



Begin

   SlogPolaczenia := 'SlogPolaczenia.log';                        {setting up 'connection variables'}
   SlogZdarzenia:= 'SlogZdarzenia.log';
   secs := 15;


   fpsigemptyset(zerosigs);

   { set global daemon booleans }
      bHup := true; { to open log file }
      bTerm := false;

      { block all signals except -HUP & -TERM }
      sSet := $ffffbffe;
      ps1 := @sSet;
      fpsigprocmask(sig_block,ps1,nil);

      { setup the signal handlers }
      new(aOld);
      new(aHup);
      new(aTerm);
      aTerm^.sa_handler{.sh} := SigactionHandler(@DoSig);

      aTerm^.sa_mask := zerosigs;
      aTerm^.sa_flags := 0;
      {$ifndef BSD}                {Linux'ism}
       aTerm^.sa_restorer := nil;
      {$endif}
      aHup^.sa_handler := SigactionHandler(@DoSig);
      aHup^.sa_mask := zerosigs;
      aHup^.sa_flags := 0;
      {$ifndef BSD}                {Linux'ism}
       aHup^.sa_restorer := nil;
      {$endif}
      fpSigAction(SIGTERM,aTerm,aOld);
      fpSigAction(SIGHUP,aHup,aOld);

      { daemonize }
      pid := fpFork;
      Case pid of
         0 : Begin { we are in the child }
            Close(input);  { close standard in }
            Close(output); { close standard out }
            Assign(output,'/dev/null');
            ReWrite(output);
            Close(stderr); { close standard error }
            Assign(stderr,'/dev/null');
            ReWrite(stderr);
         End;
         -1 : secs := 0;     { forking error, so run as non-daemon }
         Else Halt;          { successful fork, so parent dies }
      End;

      { begin processing loop }
      Repeat
         If bHup Then Begin
            {$I-}
            Close(textPolaczenia);
            {$I+}
            IOResult;
         {$I+}
          //UtworzLogi;
         {fggggggd}

         bHup := false;
      End;
      {----------------------}
                                               {'program' part of a daemon}
      CreateConnection;



      {----------------------}
      If bTerm Then
         BREAK
      Else
         { wait a while }
         fpSelect(0,nil,nil,nil,secs*1000);
   Until bTerm;
   End.

以前の回答とヘルプに対して、Abelisto と Nested Type に感謝します。

プログラムの「本体」は CncWare の無料サンプルに基づいており、正常に動作するかどうかを確認するために使用しています

tail -f SlogPolaczenie.log // アクティビティ ログ

tail -f SlogEvents.log // イベント ログ

ps斧 | grep nameofaprogram

kill -TERM processIDListedafterPsAXGrepNameoOfAprogram

4

1 に答える 1

1

OnFBEvent宣言が間違っているようです。グローバル プロシージャではなく、メソッドである必要があります。

procedure TSomething.OnFBEvent(Sender: TObject; EventName: string;EventCount: longint; var CancelAlerts: boolean); register;
begin
end;

したがって、そのようなクラスをどこかで宣言し、インスタンスを作成する必要があります。

type TSomething = class
  procedure OnFBEvent(Sender: TObject; EventName: string;EventCount: longint; var CancelAlerts: boolean); register;
end;

サンプルを見るとOnFBEvent、 の方法ですTForm1。したがって、GUI プログラムで例を再現する場合は、メイン フォームでメソッドを宣言することもできます。コンソールにいる場合は、前に説明したようなものです。

また、イベントに参加していない場合は、 を割り当てる必要があることに注意してください{$MODE DELPHI}。@

EventsM.OnEventAlert:= @Someting.OnFBEvent;
于 2015-08-10T03:31:10.880 に答える