zibsqlnotify.pas

控件名称：WINZEOS.ZIP 2002年08月03日 作者：CapellaDevelopment Zeos系列构件套件包含一组可直接存取Linux知名的免费数据库MySQL、Postgre

    for I := (FThreads.Count - 1) downto 0 do
    begin
      Temp := TZIbSqlNotifyTread(FThreads[I]);
      FThreads.Delete(I);
      Temp.SignalTerminate;
      Temp.WaitFor;
    end;

    //FTransact.Disconnect;//Faraj
  end
end;

procedure TZIbSqlNotify.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
        DataBaseError('Invalid Event');
      if TooLong then
        DatabaseError('Invalid Event');
    finally
      TStringList(FEvents).OnChange := EventChange;
    end;
  finally
    if WasRegistered then
      RegisterEvents;
  end;
end;

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

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

procedure TZIbSqlNotify.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 TZIbSqlNotify.GetAutoRegister: Boolean;
begin
 Result := FAutoRegister;
end;

{ TZIbSqlNotifyTread }

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

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

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

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

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


procedure TZIbSqlNotifyTread.UnRegisterEvents;
begin
  isc_cancel_events(@Parent.FStatusVector, @TDirIbSqlConnect(Parent.Database.Handle).Handle,
    @EventID);

  if (Parent.FStatusVector[0] = 1) and (Parent.FStatusVector[1] > 0) then
    raise EDatabaseError.Create(Parent.GetErrorMsg);

  isc_free(EventBuffer);
  EventBuffer := nil;
  isc_free(ResultBuffer);
  ResultBuffer := nil;
end;


procedure TZIbSqlNotifyTread.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 TZIbSqlNotifyTread.SignalEvent;
begin
  EventsReceived := True;
  Signal.SetEvent;
end;

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

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

function TZIbSqlNotifyTread.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 TZIbSqlNotifyTread.Execute;
begin
  try
    repeat
      Signal.WaitFor(0); //!! Doesn't compile under Linux INFINITE);
      if EventsReceived then
      begin
        ProcessEvents;
        QueueEvents;
      end;
    until Terminated;
    ReturnValue := 0;
  except
    if HandleException then
      ReturnValue := 1
    else ReturnValue := 0;
  end;
end;

constructor TZIbSqlNotifyTread.Create(Owner: TZIbSqlNotify; EventGrp: Integer; TermEvent: TNotifyEvent);
begin
  inherited Create(True);
  FCancelAlerts := false;
  Signal := TSimpleEvent.Create;
  Parent := Owner;
  EventGroup := EventGrp;
  OnTerminate := TermEvent;
  FreeOnTerminate := True;
  RegisterEvents;
  QueueEvents;
  Signal.WaitFor(0); //!! Doesn't compile under Linux INFINITE);
  ProcessEvents;
  QueueEvents;
  Resume;
end;

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

procedure TZIbSqlNotifyTread.SQueEvents;
begin
  try
    isc_que_events(@Parent.FStatusVector, @TDirIbSqlConnect(Parent.Database.Handle).Handle,
      @EventID, EventBufferLen, EventBuffer, TISC_CALLBACK(@EventCallback),
      PVoid(Self));
    if (Parent.FStatusVector[0] = 1) and (Parent.FStatusVector[1] > 0) then
      raise EDatabaseError.Create(Parent.GetErrorMsg);
  except
    on E: Exception do
      if Assigned(Parent.OnError) then
        if E is EDataBaseError then
          Parent.OnError(Parent, Parent.FStatusVector[1]) //faraj
        else
          Parent.OnError(Parent, 0);
  end;
end;

end.