0

两周以来，我正在尝试在 FreePascal 中为我的“类似守护进程”程序实现一个 Firebird 事件处理程序，该程序必须在 Linux 上运行。我想我已经尝试了一切，但我仍然无法注册数据库发送的任何事件（应该在日志中注册） - 守护进程没有崩溃，它保持记录它的活动。我创建的两个 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 回答