pfibdataset.pas

FIBPlus is a component suite intended for work with InterBase. It is direct, fast and flexible Inter

begin
  FDefaultFormats.Free;
  vUpdates.Free;
  vDeletes.Free;
  vInserts.Free;
  FReceiveEvents.Free;

   if Assigned(FExecBlockStatement) then
    FExecBlockStatement.Free;
   if Assigned(FParams) then
    FParams.Free;
  if FGeneratorBeUsed then
   FreeHandleCachedQuery(Database,
    'select gen_id(' + FAutoUpdateOptions.GeneratorName + ', '
    + IntToStr(FAutoUpdateOptions.GeneratorStep) +') from RDB$DATABASE'
   );
  inherited Destroy;
end;


function TpFIBDataSet.GetVisibleRecno: Integer;
var
  R: integer;
begin
  R := inherited GetRecno;
  FFilteredCacheInfo.NonVisibleRecords.Find(R, Result);
  Result := R - Result;
end;

procedure TpFIBDataSet.SetVisibleRecno(Value: Integer);
var
  R, R1: integer;
  Diff, i: integer;
begin
  if (FFilteredCacheInfo.NonVisibleRecords.Count = 0) or
    (FFilteredCacheInfo.NonVisibleRecords[0] > Value)
  then
    inherited SetRecno(Value)
  else
  begin
    R := FFilteredCacheInfo.NonVisibleRecords[0];
    R1 := R - 1;
    for i := 1 to Pred(FFilteredCacheInfo.NonVisibleRecords.Count) do
    begin
      Diff := FFilteredCacheInfo.NonVisibleRecords[i] - R - 1;
      if Diff <> 0 then
      begin
        if R1 + Diff > Value then
          Diff := Value - R1;
        Inc(R1, Diff);
        if R1 = Value then
        begin
          R := FFilteredCacheInfo.NonVisibleRecords[i - 1] + Diff;
          Break
        end
      end;
      R := FFilteredCacheInfo.NonVisibleRecords[i];
    end;
    if R1 < Value then
    begin
      R := FFilteredCacheInfo.NonVisibleRecords.LastItem + Value - R1
    end;
    inherited SetRecno(R)
  end;
end;

function TpFIBDataSet.GetRecNo: Integer;
begin
  if poVisibleRecno in Options then
    Result := VisibleRecNo
  else
    Result := inherited GetRecNo
end;

procedure TpFIBDataSet.SetRecNo(Value: Integer);
begin
  if poVisibleRecno in Options then
    SetVisibleRecno(Value)
  else
    SetRealRecNo(Value);
end;

function TpFIBDataSet.VisibleRecordCount: Integer;
var
  Buff: PChar;
  i: integer;
  OldCurrentRec: integer;
begin
  if not Filtered then
    Result := RecordCount
  else
  begin
    Result := 0;
    Buff := AllocRecordBuffer;
    OldCurrentRec := FCurrentRecord;
    try
      if FFilteredCacheInfo.AllRecords <> FRecordCount then
      begin
        for i := 0 to Pred(FRecordCount) do
        begin
          FCurrentRecord := i;
          ReadRecordCache(FCurrentRecord, Buff, False);
          if IsVisible(Buff) then
            Inc(Result)
        end;
        FFilteredCacheInfo.AllRecords := FRecordCount;
        FFilteredCacheInfo.FilteredRecords := Result
      end
      else
      begin
        Result := FFilteredCacheInfo.FilteredRecords
      end
    finally
      FCurrentRecord := OldCurrentRec;
      FreeRecordBuffer(Buff);
    end;
  end;
end;

function TpFIBDataSet.VisibleRecnoToRecno(VisRN: integer): Integer;
var
  i: Integer;
  VisCount: integer;
  PredRN: integer;
begin
  with FFilteredCacheInfo do
    if NonVisibleRecords.Count = 0 then
      Result := VisRN
    else
    begin
      VisCount := 0;
      PredRN := 0;
      for i := 0 to NonVisibleRecords.Count - 1 do
      begin
        Inc(VisCount, NonVisibleRecords[i] - PredRN - 1);
        if VisCount > VisRN then
        begin
          Result := VisRN + i;
          Exit;
        end
        else
          PredRN := NonVisibleRecords[i];
      end;
      Result := VisRN + NonVisibleRecords.Count;
    end;
end;


procedure TpFIBDataSet.DoAfterEndUpdateTransaction(
 EndingTR:TFIBTransaction;Action: TTransactionAction;  Force: Boolean);
begin
  if (Action in [TACommit, TACommitRetaining]) then
  begin
    if (poProtectedEdit in Options) and not CachedUpdates  then
        CloseProtect;
    FHaveUncommitedChanges :=False
  end
  else
   FHaveRollbackedChanges :=FHaveUncommitedChanges;
  inherited DoAfterEndUpdateTransaction(EndingTR,Action,Force);
end;


function TpFIBDataSet.CanEdit: Boolean; //override;
begin
  Result := ((inherited CanEdit or ExistActiveUO(ukModify)
    or WillGenerateSQLs
    or (CachedUpdates and Assigned(OnUpdateRecord))

    )
    and (ukModify in FAllowedUpdateKinds)
    )
    or (drsInCacheRefresh in FRunState)
end;

function TpFIBDataSet.CanInsert: Boolean; //override;
begin
  Result := ((inherited CanInsert or ExistActiveUO(ukInsert)
    or WillGenerateSQLs
    or (CachedUpdates and Assigned(OnUpdateRecord))
    )
    and (ukInsert in FAllowedUpdateKinds)
    )
    or (drsInCacheRefresh in FRunState)
end;

function TpFIBDataSet.CanDelete: Boolean;
begin
  Result := (inherited CanDelete or ExistActiveUO(ukDelete)
    or WillGenerateSQLs
    or (CachedUpdates and Assigned(OnUpdateRecord))
    )
    and (ukDelete in FAllowedUpdateKinds)
end;

function TpFIBDataSet.IsSequenced: Boolean;         // Scroll bar
begin
  if (CacheModelOptions.CacheModelKind<>cmkStandard) then
    Result := False
  else
  begin
    Result := inherited IsSequenced;
    if not Result then
      if not Filtered or not (poVisibleRecno in Options) then
        Result := FAllRecordCount <> 0
      else
        Result := AllFetched
  end;
end;

// UpdateObjects support

function TpFIBDataSet.ListForUO(KindUpdate: TUpdateKind): TList;
begin
  Result := nil;
  case KindUpdate of
    ukModify: Result := vUpdates;
    ukInsert: Result := vInserts;
    ukDelete: Result := vDeletes;
  end;
end;

function TpFIBDataSet.ExistActiveUO(KindUpdate: TUpdateKind): boolean;
var
  List: TList;
  i, lc: integer;

begin
  List := ListForUO(KindUpdate);
  Result := False;
  if List = nil then
    Exit;
  lc := Pred(List.Count);
  for i := 0 to lc do
  begin
    Result := TpFIBUpdateObject(List[i]).Active;
    if Result then
      Exit;
  end;
end;

procedure TpFIBDataSet.SynchroOrdersUO(List: TList);
var
  i, lc: integer;
begin
  lc := Pred(List.Count);
  with List do
    for i := 0 to lc do
    begin
      TpFIBUpdateObject(List[i]).ChangeOrderInList(i);
    end;
end;

function TpFIBDataSet.AddUpdateObject(Value: TpFIBUpdateObject): integer;
var
  List: TList;
  OldPos: integer;
begin
  Result := -1;
  if Value = nil then
    Exit;
  List := ListForUO(Value.KindUpdate);
  if List = nil then
    Exit;
  with List do
  begin
    OldPos := IndexOf(Value);
    if OldPos = -1 then
    begin
      if Value.OrderInList < Count then
        Insert(Value.OrderInList, Value)
      else
        Add(Value);
    end
    else
    begin
      if Value.OrderInList < Count then
        Move(OldPos, Value.OrderInList)
      else
        Move(OldPos, Pred(Count))
    end;
  end;
  SynchroOrdersUO(List);
  Result := List.IndexOf(Value)
end;

procedure TpFIBDataSet.RemoveUpdateObject(Value: TpFIBUpdateObject);
var
  List: TList;
begin
  if Value = nil then
    Exit;
  List := ListForUO(Value.KindUpdate);
  if List <> nil then
  begin
    List.Remove(Value);
    SynchroOrdersUO(List);
  end;
end;

/// Execute UpdateObjects

procedure TpFIBDataSet.ExecUpdateObjects(KindUpdate: TUpdateKind; Buff: Pointer;
  aExecuteOrder: TFIBOrderExecUO
  );
var
  List: TList;
  i: integer;
begin
  List := ListForUO(KindUpdate);
  if List.Count > 0 then
  begin
    for i := 0 to Pred(List.Count) do
     with TpFIBUpdateObject(List[i]) do
      if
       Active and (ExecuteOrder = aExecuteOrder) and (not EmptyStrings(SQL))
       and (SQL[0]<>SNoAction)
      then
      begin
          AutoStartUpdateTransaction;
          SetQueryParams(TpFIBUpdateObject(List[i]), Buff);
          ExecQuery;
          FHaveUncommitedChanges:=True;
      end;
  end;
end;

procedure TpFIBDataSet.SetDataSet_ID(Value: Integer);
begin
  if FDataSet_Id = Value then
    Exit;
  CheckDataSetClosed(' change DataSetID ');
  FDataSet_Id := Value;
  FPrepared := False;
  if Value <> 0 then
    PrepareOptions := PrepareOptions + [psApplyRepositary]
end;

{$WARNINGS OFF}

procedure TpFIBDataSet.Prepare; //override;
var
  iCurScreenState: Integer;
  condApplied: boolean;
begin
  ChangeScreenCursor(iCurScreenState);
  try
    FBase.CheckDatabase;
    StartTransaction;
    FBase.CheckTransaction;
    if (psApplyRepositary in PrepareOptions)
      and (DataSet_ID <> 0)  and (FLoadedDataSet_ID <> FDataSet_Id)
    then
    begin
      condApplied := Conditions.Applied;
      ListDataSetInfo.LoadDataSetInfo(Self);
      FLoadedDataSet_ID := FDataSet_Id;
      if condApplied then
        Conditions.Apply;
    end
    else
     FLoadedDataSet_ID:=0;
    if not EmptyStrings(FQSelect.SQL) then
    begin
      if not FQSelect.Open then
        FQSelect.Prepare;
      if csDesigning in ComponentState then
      begin
        PrepareQuery(skModify);
        PrepareQuery(FIBDataSet.skInsert);
        PrepareQuery(FIBDataSet.skDelete);
      end;
      FPrepared := True;
      InternalInitFieldDefs;
    end
    else
      FIBError(feEmptyQuery, ['Prepare ' + CmpFullName(Self)]);
  finally
   RestoreScreenCursor(iCurScreenState);
  end;
end;
{$WARNINGS ON}

function TpFIBDataSet.GetRecordCount: Integer;
begin
  Result := inherited GetRecordCount;
  if Filtered and (poVisibleRecno in Options) then
    Result := VisibleRecordCount
  else
  if Result < FAllRecordCount - FDeletedRecords then
    Result := FAllRecordCount - FDeletedRecords
end;


procedure  TpFIBDataSet.InternalPostRecord(Qry: TFIBQuery; Buff: Pointer);
begin
  if Qry = QInsert then
    ExecUpdateObjects(ukInsert, Buff, oeBeforeDefault)
  else
    ExecUpdateObjects(ukModify, Buff, oeBeforeDefault);
  CheckDataSetOpen(' continue post ');
  if not EmptyStrings(Qry.SQL) and (Qry.SQL[0]<>SNoAction) then
  begin
    AutoStartUpdateTransaction;
    SetQueryParams(Qry, Buff);
    if Qry.Open then
      Qry.Close;
    Qry.ExecQuery;
    FHaveUncommitedChanges:=True;
    if Qry.SQLType in [SQLSelect, SQLExecProcedure, SQLSelectForUpdate] then
    begin
      WriteRecordCache(PRecordData(Buff)^.rdRecordNumber, Buff);
      InternalRefreshRow(Qry, Buff);
    end;
  end;
  if Qry = QInsert then
  begin
    if Assigned(FBlobsUpdate) and (FBlobsUpdate.Active) then
     FBlobsUpdate.KindUpdate  :=ukInsert;
    ExecUpdateObjects(ukInsert, Buff, oeAfterDefault)
  end
  else
  begin
    if Assigned(FBlobsUpdate) and (FBlobsUpdate.Active) then
     FBlobsUpdate.KindUpdate  :=ukModify;
    ExecUpdateObjects(ukModify, Buff, oeAfterDefault);
  end;
  PRecordData(Buff)^.rdFlags := Byte(cusUnmodified);
  SetModified(False);