Zeoslib Portal

Code: Select all

//-- (C) Ivan Rog - 2010 Russia
//-- Tested only for 8.3.10 PostgreSQL!
//-- version PGSQL <8.3.x not supperted now

unit ZPGEventAlerter;

{$I ..\dbc\ZDbc.inc}

interface

uses
  SysUtils, Classes, Math,
{$IFNDEF UNIX} 
  Windows, ExtCtrls, 
{$ELSE} 
  {$IFNDEF FPC} 
    libc, 
  {$ENDIF} 
{$ENDIF}
  ZDbcPostgreSQL, ZPlainPostgreSQLDriver, ZConnection, ZDbcIntfs,
  ZPlainPostgreSQL7, ZPlainPostgreSQL8;

//****************************************************************************//
//                  TZPGEventAlerter Object                                   //
//                  Asynchronous notifying                                    //
//****************************************************************************//
type

 //-- структура, возвращаемая сервером при получении оповещений
// typedef struct pgNotify {
//       char *relname;              /* notification condition name */
//       int  be_pid;                /* process ID of notifying server process */
//       char *extra;                /* notification parameter */
//   } PGnotify_my;

  //-- Define for PostgreSQL 8.3.x and above!
  TZPostgreSQLNotify_83x = record
    relname : PChar;   { name of relation containing data }
    be_pid  : Integer; { process id of backend }
    extra   : PChar;   { notification parameter }
  end;
  PZPostgreSQLNotify_83x =^TZPostgreSQLNotify_83x;

  TZPGNotifyEvent = procedure (Sender: TObject; Event: string; ProcessID : Integer) of object;

  TZPGEventAlerter = class (TComponent)
  private
    FActive      : Boolean;
    FEvents      : TStrings;
    FTimer       : TTimer;
    FConnection  : TZConnection;   //-- соединение
    FNotifyFired : TZPGNotifyEvent;
    res          : PGresult; //-- результат выполнения команд сервера

  protected
    procedure SetActive     (Value: Boolean);
    function  GetInterval   : Cardinal;
    procedure SetInterval   (Value: Cardinal);
    procedure SetEvents     (Value: TStrings);
    procedure SetConnection (Value: TZConnection);
    procedure TimerTick     (Sender: TObject);
    procedure CheckEvents;
    procedure OpenNotify;
    procedure CloseNotify;
  public
    constructor Create     (AOwner: TComponent); override;
    destructor  Destroy; override;
  published
    property Connection: TZConnection     read FConnection   write SetConnection;
    property Active:     Boolean          read FActive       write SetActive; 
    property Events:     TStrings         read FEvents       write SetEvents;
    property Interval:   Cardinal         read GetInterval   write SetInterval    default 250;
    property OnNotify:   TZPGNotifyEvent  read FNotifyFired  write FNotifyFired;
  end;

implementation

constructor TZPGEventAlerter.Create(AOwner: TComponent);
var I: integer;
begin
  inherited Create(AOwner);
  FEvents := TStringList.Create;
  with TStringList(FEvents) do
  begin
    Duplicates := dupIgnore;
  end;
  FTimer         := TTimer.Create(Self);
  FTimer.Enabled := False;
  SetInterval(250);
  FTimer.OnTimer := TimerTick;
  FActive        := False;
  if (csDesigning in ComponentState) and Assigned(AOwner) then
   for I := AOwner.ComponentCount - 1 downto 0 do
    if AOwner.Components[I] is TZConnection then
     begin
      Connection := AOwner.Components[I] as TZConnection;
      Break;
     end;
end;

destructor TZPGEventAlerter.Destroy;
begin
  CloseNotify;
  FEvents.Free;
  FTimer.Free;
  inherited Destroy;
end;

procedure TZPGEventAlerter.SetInterval(Value: Cardinal);
begin
  FTimer.Interval := Value;
end;

function TZPGEventAlerter.GetInterval;
begin
  Result := FTimer.Interval;
end;

procedure TZPGEventAlerter.SetEvents(Value: TStrings);
var
  I: Integer;
begin
  FEvents.Assign(Value);
  for I := 0 to FEvents.Count -1 do
    FEvents[I] := Trim(FEvents[I]);
end;

procedure TZPGEventAlerter.SetActive(Value: Boolean);
begin
  if FActive <> Value then
  begin
    if Value then
       OpenNotify else
       CloseNotify;
  end;
end;

procedure TZPGEventAlerter.SetConnection(Value: TZConnection);
begin
  if FConnection <> Value then
  begin
    CloseNotify;
    FConnection := Value;
  end;
end;

procedure TZPGEventAlerter.TimerTick(Sender: TObject);
begin
  if not Active then
   FTimer.Enabled := False
  else
   CheckEvents;
end;

procedure TZPGEventAlerter.OpenNotify;
var
  I   : Integer;
  tmp : array [0..255] of Char;
  Handle : PZPostgreSQLConnect;
begin
  if Active then Exit;
  if not Assigned(FConnection) then Exit;
  if ((csLoading in ComponentState) or (csDesigning in ComponentState)) then Exit;
  if not FConnection.Connected then Exit;
  Handle:=(FConnection.DbcConnection as IZPostgreSQLConnection).GetConnectionHandle;
  if Handle=nil then Exit;

  for I := 0 to FEvents.Count-1 do
  begin
   StrPCopy(tmp, 'listen '+FEvents.Strings[i]);
   res:=Zplainpostgresql8.PQexec(Handle,tmp);
   if (Zplainpostgresql8.PQresultStatus(res) <> Zplainpostgresql8.PGRES_COMMAND_OK)
   then
   begin
    //-- произошла ошибка! ошибка!!!
    Zplainpostgresql8.PQclear(res);
    Exit;
   end;
  end;
 Zplainpostgresql8.PQclear(res);
 FActive := True;
 FTimer.Enabled := True; //-- запуск таймера опроса
end;

procedure TZPGEventAlerter.CloseNotify;
var
  I: Integer;
  tmp : array [0..255] of Char;
  Handle : PZPostgreSQLConnect;
begin
  if not Active then Exit;
  FActive := False;
  FTimer.Enabled := False;
  Handle:=(FConnection.DbcConnection as IZPostgreSQLConnection).GetConnectionHandle;
  if Handle=nil then Exit;
  for I := 0 to FEvents.Count-1 do
  begin
   StrPCopy(tmp, 'unlisten '+FEvents.Strings[i]);
   res:=Zplainpostgresql8.PQexec(Handle,tmp);
   if (Zplainpostgresql8.PQresultStatus(res) <> Zplainpostgresql8.PGRES_COMMAND_OK)
   then
   begin
    //-- произошла ошибка! ошибка!!!
    Zplainpostgresql8.PQclear(res);
    Exit;
   end;
  end;
 Zplainpostgresql8.PQclear(res);
end;

procedure TZPGEventAlerter.CheckEvents;
var
  Pid    : Integer;
  notify : PZPostgreSQLNotify_83x;
  Handle : PZPostgreSQLConnect;
begin
 Handle:=(FConnection.DbcConnection as IZPostgreSQLConnection).GetConnectionHandle;
 if Handle=nil then Exit;
 if Zplainpostgresql8.PQconsumeInput(Handle)=1 then
 begin
  while true do
  begin
   ///!!!!!! НЕОБХОДИМО ПРЕОБРАЗОВАНИЕ ТИПОВ / NEEDS FOR TYPE CONVERT
   notify:=PZPostgreSQLNotify_83x(Zplainpostgresql8.PQnotifies(Handle));
   if Notify=nil then break;
   if Assigned(FNotifyFired) then FNotifyFired(Self, Notify.relname, Notify.be_pid);
  end;
  Zplainpostgresql8.PQFreemem(notify);
 end;
end;

end.

Code: Select all

  TZPostgreSQLNotify = packed record
    relname: PAnsiChar;   { name of relation containing data }
    be_pid:  Integer; { process id of backend }
  end;

  PZPostgreSQLNotify = ^TZPostgreSQLNotify;