ibevents.pas

多数代码可以直接在Delphi6和Delphi7环境下运行。部分涉及.NET技术内容的代码

  if (FThreads.Count > 0) then
  begin
    for i := (FThreads.Count - 1) downto 0 do
    begin
      Temp := TIBEventThread(FThreads[i]);
      FThreads.Delete(i);

      Temp.SignalTerminate;
      Temp.WaitFor;
      Temp.Free;
    end;
  end
end;

{ TIBEventThread }

procedure EventCallback(P: Pointer; Length: Short; Updated: PChar); cdecl;
begin
  if (Assigned(P) and Assigned(Updated)) then
  begin
    TIBEventThread(P).UpdateResultBuffer(Length, Updated);
    TIBEventThread(P).SignalEvent;
  end;
end;

procedure TIBEventThread.DoEvent;
begin
  Parent.FOnEventAlert(Parent, Parent.FEvents[((EventGroup * IB_MAX_EVENT_BLOCK) + WhichEvent)], StatusVectorArray[WhichEvent], FCancelAlerts)
end;

procedure TIBEventThread.UpdateResultBuffer(Length: UShort; Updated: PChar);
begin
  Move(Updated[0], ResultBuffer[0], Length);
end;

procedure TIBEventThread.QueueEvents;
begin
  EventsReceived := False;
  Signal.ResetEvent;
  Synchronize(SQueEvents);
end;

procedure TIBEventThread.ProcessEvents;
var
  i: Integer;
begin
  isc_event_counts(StatusVector, EventBufferLen, EventBuffer, ResultBuffer);
  if (Assigned(Parent.FOnEventAlert) and (not FirstTime)) then
  begin
    FCancelAlerts := false;
    for i := 0 to (EventCount - 1) do
    begin
        if (StatusVectorArray[i] <> 0) then
        begin
          WhichEvent := i;
          Synchronize(DoEvent)
        end;
    end;
  end;
  FirstTime := False;
end;

procedure TIBEventThread.UnRegisterEvents;
begin
  Parent.Database.Call(isc_cancel_events(StatusVector, @Parent.Database.Handle,
     @EventID), True);
  isc_free(EventBuffer);
  EventBuffer := nil;
  isc_free(ResultBuffer);
  ResultBuffer := nil;
end;

procedure TIBEventThread.RegisterEvents;

  function EBP(Index: Integer): PChar;
  begin
    Inc(Index, (EventGroup * IB_MAX_EVENT_BLOCK));
    if (Index > Parent.FEvents.Count) then
      Result := nil
    else
      Result := PChar(Parent.FEvents[Index - 1]);
  end;

begin
  EventBuffer := nil;
  ResultBuffer := nil;
  EventBufferLen := 0;
  FirstTime := True;
  EventCount := (Parent.FEvents.Count - (EventGroup * IB_MAX_EVENT_BLOCK));
  if (EventCount > IB_MAX_EVENT_BLOCK) then
    EventCount := IB_MAX_EVENT_BLOCK;
  EventBufferLen := Tsib_event_block(isc_event_block)(@EventBuffer,
    @ResultBuffer, EventCount, EBP(1), EBP(2), EBP(3), EBP(4), EBP(5), EBP(6),
    EBP(7), EBP(8), EBP(9), EBP(10), EBP(11), EBP(12), EBP(13), EBP(14), EBP(15));
end;

procedure TIBEventThread.SignalEvent;
begin
   EventsReceived := True;
   Signal.SetEvent;
end;

procedure TIBEventThread.SignalTerminate;
begin
   if not Terminated then
   begin
     Terminate;
     Signal.SetEvent;
   end;
end;

procedure TIBEventThread.DoHandleException;
begin
  SysUtils.ShowException(FExceptObject, FExceptAddr);
end;

function TIBEventThread.HandleException: Boolean;
begin
  if not Parent.ThreadException then
  begin
    Result := True;
    Parent.ThreadException := True;
    FExceptObject := ExceptObject;
    FExceptAddr := ExceptAddr;
    try
      if not (FExceptObject is EAbort) then
        Synchronize(DoHandleException);
    finally
      FExceptObject := nil;
      FExceptAddr := nil;
    end;
  end
  else
    Result := False;
end;

procedure TIBEventThread.Execute;
begin
  RegisterEvents;
  QueueEvents;
  Signal.WaitFor(INFINITE);
  ProcessEvents;
  QueueEvents;
  try
    repeat
      Signal.WaitFor(INFINITE);
      if EventsReceived then
      begin
        ProcessEvents;
        QueueEvents;
      end;
    until Terminated;
    ReturnValue := 0;
  except
    if HandleException then
      ReturnValue := 1
    else
      ReturnValue := 0;
  end;
end;

constructor TIBEventThread.Create(Owner: TIBEvents; EventGrp: Integer; TermEvent: TNotifyEvent);
begin
  inherited Create(True);
  FCancelAlerts := false;
  Signal := TSimpleEvent.Create;
  Parent := Owner;
  EventGroup := EventGrp;
  OnTerminate := TermEvent;
  Resume;
end;

destructor TIBEventThread.Destroy;
begin
  try
    UnRegisterEvents;
  except
    if HandleException then
      ReturnValue := 1
    else
      ReturnValue := 0;
  end;
  Signal.Free;
  inherited Destroy;
end;

procedure TIBEvents.EventChange(Sender: TObject);
var
  i: Integer;
  TooLong,
  AnyEmpty,
  WasRegistered: Boolean;
  ErrorStr: String;
begin
  ErrorStr := EmptyStr;
  WasRegistered := Registered;
  try
    if WasRegistered then
      UnRegisterEvents;
    TStringList(FEvents).OnChange := nil;
    try
      TooLong := False;
      AnyEmpty := False;
      for i := (FEvents.Count - 1) downto 0 do
      begin
        if (FEvents[i] = EmptyStr) then
        begin
          AnyEmpty := True;
          FEvents.Delete(i);
        end
        else
        if (Length(FEvents[i]) > (IB_MAX_EVENT_LENGTH - 1)) then
        begin
          TooLong := True;
          FEvents[i] := Copy(FEvents[i], 1, (IB_MAX_EVENT_LENGTH - 1));
        end;
      end;
      if AnyEmpty then
        IBError(ibxeInvalidEvent, []);
      if TooLong then
        IBError(ibxeInvalidEvent, []);
    finally
      TStringList(FEvents).OnChange := EventChange;
    end;
  finally
    if WasRegistered then
      RegisterEvents;
  end;
end;

function TIBEvents.GetRegistered: Boolean;
begin
  Result := FRegistered;
end;

procedure TIBEvents.ThreadEnded(Sender: TObject);
var
  ThreadIdx: Integer;
begin
  if (Sender is TIBEventThread) then
  begin
    ThreadIdx := FThreads.IndexOf(Sender);
    if (ThreadIdx > -1) then
      FThreads.Delete(ThreadIdx);
    if (TIBEventThread(Sender).ReturnValue = 1) then
    begin
      if Registered then
        UnRegisterEvents;
      ThreadException := False;
    end
  end;
end;

procedure TIBEvents.SetAutoRegister(const Value: Boolean);
begin
  if FAutoRegister <> Value then
  begin
    FAutoRegister := Value;
    if FAutoRegister and (not Registered) and
       Assigned(FDatabase) and FDatabase.Connected then
      RegisterEvents;
  end;
end;

function TIBEvents.GetAutoRegister: Boolean;
begin
  Result := FAutoRegister;
end;

procedure TIBEventThread.SQueEvents;
begin
  try
    Parent.Database.Call(isc_que_events(StatusVector, @Parent.Database.Handle,
      @EventID, EventBufferLen, EventBuffer, TISC_CALLBACK(@EventCallback),
      PVoid(Self)), True);
  except
    on E : Exception do
      if Assigned(Parent.OnError) then
        if E is EIBError then
          Parent.OnError(Parent, EIBError(E).IBErrorCode)
        else
          Parent.OnError(Parent, 0);
  end;
end;

end.