pfibdataset.pas

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

      AutoReWriteSqls and CanChangeSQLs and
      (KeyFields <> '') and (UpdateTableName <> '');
end;

procedure TpFIBDataSet.SaveToStream(Stream: TStream; SeekBegin: boolean);
var
  i, fc, fs: integer;
  Version: integer;
begin
  with Stream do
  begin
    if SeekBegin then
      Seek(0, soFromBeginning);
    //
    WriteBuffer(StreamSignature[1], Length(StreamSignature));

    Version := 6;
    WriteBuffer(Version, SizeOf(Integer));
    fc := FieldCount;
    WriteBuffer(fc, SizeOf(Integer));
    for i := 0 to Pred(FieldCount) do
    begin
      fs := Fields[i].DataSize;
      WriteBuffer(fs, SizeOf(Integer));
      WriteBuffer(Fields[i].DataType, SizeOf(TFieldType));
    end;

    vFieldDescrList.SaveToStream(Stream);
    WriteBuffer(FRecordCount, SizeOf(Integer));
    WriteBuffer(FDeletedRecords, SizeOf(Integer));
    FRecordsCache.SaveToStream(Stream, False);
  end;
end;

procedure TpFIBDataSet.LoadFromStream(Stream: TStream; SeekBegin: boolean);
var
  fc: integer;
  i, fs: integer;
  Version: integer;
  ft: TFieldType;
  s: string;
  procedure RaizeErrStream;
  begin
    raise Exception.Create(
      Format(SFIBErrorUnableStreamLoad, [CmpFullName(Self)])
      );
  end;

begin
  with Stream do
  begin
    if SeekBegin then
      Seek(0, soFromBeginning);
    SetString(s, nil, Length(StreamSignature));
    ReadBuffer(s[1], Length(StreamSignature));
    if s <> StreamSignature then
      raise Exception.Create('Can''t load cache from Stream.');

    ReadBuffer(Version, SizeOf(Integer));
    if Version < 5 then
     raise
        Exception.Create('Can''t load cache from Stream.Incorrect version.');

    ReadBuffer(fc, SizeOf(Integer));
    if fc <> FieldCount then
      RaizeErrStream;
    for i := 0 to Pred(FieldCount) do
    begin
      ReadBuffer(fs, SizeOf(Integer));
      if fs <> Fields[i].DataSize then
        RaizeErrStream;
      ReadBuffer(ft, SizeOf(TFieldType));
      if ft <> Fields[i].DataType then
        RaizeErrStream;
    end;
    try
      vFieldDescrList.LoadFromStream(Stream,Version);
      ReadBuffer(FRecordCount, SizeOf(Integer));
      ReadBuffer(FDeletedRecords, SizeOf(Integer));
      FRecordsCache.LoadFromStream(Stream, False);
    except
      Close;
      raise;
    end
  end;
//  RefreshClientFields;
  First;
end;

procedure TpFIBDataSet.SaveToFile(const FileName: string);
var
  Stream: TFileStream;
begin
  Stream := TFileStream.Create(FileName, fmCreate);
  try
    SaveToStream(Stream, True);
  finally
    Stream.Free;
  end;
end;

procedure TpFIBDataSet.LoadFromFile(const FileName: string);
var
  Stream: TFileStream;
begin
  Stream := TFileStream.Create(FileName, fmOpenRead);
  try
    First;
    LoadFromStream(Stream, True);
  finally
    Stream.Free;
  end;
end;

function
  TpFIBDataSet.RaiseLockError(LockError: TLockStatus; ExceptMessage: string):
  TDataAction;
begin
  Result := daFail;
  if Assigned(FOnLockError) then
    FOnLockError(Self, LockError, ExceptMessage, Result);
  case Result of
    daFail: raise Exception.Create(ExceptMessage);
    daAbort: Abort
  end
end;

procedure TpFIBDataSet.DoBeforeEdit;
var
  oldUM: boolean;
begin
  if not CanEdit then
    Abort;
{  if not CachedUpdates
    and not (FAutoUpdateOptions.UpdateOnlyModifiedFields)
    and not (drsInCacheRefresh in FRunState) then
  begin
    PrepareQuery(skModify);
    if not CanEdit then
      Abort; // Not Granted privileges
  end;
}
  if (poProtectedEdit in Options) then
    with AutoUpdateOptions do
      if UpdateStatus = usUnModified then
      begin
        LockRecord(True);      
        if EmptyStrings(RefreshSQL) and
          (AutoReWriteSqls or UpdateOnlyModifiedFields)
        then
        begin
         QRefresh.SQL.Text := GenerateSQLText(UpdateTableName, KeyFields, skRefresh);
        end;
        InternalRefresh;
        if EmptyStrings(UpdateSQL) and
          (AutoReWriteSqls or UpdateOnlyModifiedFields)
        then
        begin
          oldUM := UpdateOnlyModifiedFields;
          UpdateOnlyModifiedFields := False;
          QUpdate.SQL.Text         := GenerateSQLText(UpdateTableName, KeyFields,skModify);
          UpdateOnlyModifiedFields := oldUM;
        end;
      end;
  if (GlobalContainer<>nil) and (FContainer<>GlobalContainer) then
   GlobalContainer.DataSetEvent(Self, deBeforeEdit);
  if FContainer <> nil then
    FContainer.DataSetEvent(Self, deBeforeEdit);
  inherited;
end;

procedure TpFIBDataSet.InternalDoBeforeOpen;
begin
  if psAskRecordCount in PrepareOptions then
    FAllRecordCount := RecordCountFromSrv   
  else
    FAllRecordCount := 0;
end;

procedure TpFIBDataSet.DoBeforeOpen;
begin
  StartTransaction;
  FFilteredCacheInfo.NonVisibleRecords.Clear;
  if DisableCOCount > 0 then
    Exit;
  if (GlobalContainer<>nil) and (FContainer<>GlobalContainer) then
   GlobalContainer.DataSetEvent(Self, deBeforeOpen);
  if FContainer <> nil then
    FContainer.DataSetEvent(Self, deBeforeOpen);
  inherited DoBeforeOpen;
end;

procedure TpFIBDataSet.DoAfterClose; // override;
begin
  SetLength(FParamsForFields,0);
  if DisableCOCount > 0 then
    Exit;
  if (GlobalContainer<>nil) and (FContainer<>GlobalContainer) then
   GlobalContainer.DataSetEvent(Self, deAfterClose);
  if FContainer <> nil then
    FContainer.DataSetEvent(Self, deAfterClose);
  inherited DoAfterClose;
  FSQLTextChanges := QSelect.SQLTextChangeCount;
end;

function TpFIBDataSet.GetSelectSQL: TStrings;
begin
  Result := inherited SelectSQL
end;

procedure TpFIBDataSet.SetSelectSQL(Value: TStrings);
begin
  if Active and (csDesigning in ComponentState) then
    Close;
  inherited SelectSQL := Value
end;

procedure TpFIBDataSet.SetPrepareOptions(Value: TpPrepareOptions);
var
  NeedUpdateFieldsProps: boolean;
begin
  NeedUpdateFieldsProps := (psApplyRepositary in Value - FPrepareOptions);
  inherited;
  if NeedUpdateFieldsProps then
    UpdateFieldsProps
end;

function TpFIBDataSet.ParamNameCount(const aParamName: string): integer;
var
  i: integer;
begin
  Result := 0;
  with Params do
  begin
    for i := Pred(Count) downto 0 do
      if Params[i].Name = aParamName then
        Inc(Result)
  end;
end;

function TpFIBDataSet.ParamCount: integer;
begin
  Result := Params.Count
end;

function TpFIBDataSet.FindParam(const ParamName: string): TFIBXSQLVAR;
begin
  StartTransaction;
  Result := Params.ByName[ParamName];
end;

function TpFIBDataSet.ParamByName(const ParamName: string): TFIBXSQLVAR;
begin
  Result := Params.ByName[ParamName];
  if Result = nil then
    raise Exception.Create(
      Format(SFIBErrorParamNotExist, [ParamName, CmpFullName(Self)])
      );
end;

{$WARNINGS OFF}
procedure TpFIBDataSet.ApplyUpdates;
begin
 ApplyUpdToBase(False);
end;
{$WARNINGS ON}

procedure TpFIBDataSet.ClearModifFlags(Kind: byte; NeedRefreshFields:boolean=True);
var
  i: integer;
  Buff: Pchar;
begin
  // Commit Updates
  Buff := AllocRecordBuffer;
  try
    for i := 0 to Pred(FRecordCount) do
    begin
      ReadRecordCache(i, Buff, False);
      with PRecordData(Buff)^ do
      begin
        case Kind of
          0:
          case TCachedUpdateStatus(rdFlags and 7) of
            cusDeleted:
               rdFlags  := Byte(cusDeletedApplied);
            cusInserted, cusModified:
               rdFlags  := Byte(cusUnmodified);
          else
              Continue
          end;
          1:
          if (TCachedUpdateStatus(rdFlags and 7) in [cusUnModified, cusDeletedApplied]) then
            Continue
          else
             rdFlags := Byte(cusUnmodified);
        end;
        WriteRecordCache(i, Buff);
      end;
    end;
    FUpdatesPending := False;
    FCountUpdatesPending := 0;
  finally
    FreeRecordBuffer(Buff);
  end;
//  RefreshClientFields(NeedRefreshFields);
  if NeedRefreshFields then
   RefreshClientFields;
  SaveOldBuffer(GetActiveBuf);
end;

procedure TpFIBDataSet.CloseProtect;
begin
  if Active then
    ClearModifFlags(1,False)
end;

procedure TpFIBDataSet.CommitUpdToCach;
begin
  ClearModifFlags(0);
end;

{$WARNINGS OFF}
procedure TpFIBDataSet.ApplyUpdToBase(DontChangeCacheFlags:boolean=True);
var
  i: integer;
  Buff: PChar;
  UpdateKind: TUpdateKind;
  UpdateAction: TFIBUpdateAction;
  cus: TCachedUpdateStatus;
  vResume:Boolean;
  bRecordsSkipped:boolean;
  RecordsInExecBlock:array of Integer;

procedure SaveFlagsForRecordsInExecBlock;
var
 j:integer;
begin
  if not DontChangeCacheFlags then
  begin
   for j:=0 to Pred(Length(RecordsInExecBlock)) do
   begin
    ReadRecordCache(RecordsInExecBlock[j], Buff, False);
    PRecordData(Buff)^.rdFlags:=Byte(cusUnmodified);
    WriteRecordCache(RecordsInExecBlock[j], Buff);
   end;
   SetLength(RecordsInExecBlock,1);
   RecordsInExecBlock[0]:=i;
  end
end;

procedure AddRecordToListInExecBlock;
begin
  if not DontChangeCacheFlags then
  begin
   SetLength(RecordsInExecBlock,Length(RecordsInExecBlock)+1);
   RecordsInExecBlock[Length(RecordsInExecBlock)-1]:=i;
  end;
end;

procedure AddRecordToExecuteBlock(Kind:TpSQLKind);
begin
  if not AddStatementToExecuteBlock(Kind) then
  begin
    FQUpdate.SQL.Assign(FExecBlockStatement);
    FQUpdate.ExecQuery;
    FExecBlockStatement.Clear;
    AddStatementToExecuteBlock(skModify);
    SaveFlagsForRecordsInExecBlock;
  end
  else
   AddRecordToListInExecBlock;
end;

begin
  if State in [dsEdit, dsInsert] then
    Post;
  if FRecordCount = 0 then
    Exit;
  AutoStartUpdateTransaction;
  Buff := AllocRecordBuffer;
  try
    bRecordsSkipped:=False;
    for i := 0 to Pred(FRecordCount) do
    begin
      ReadRecordCache(i, Buff, False);
      with PRecordData(Buff)^ do
      begin
        if TCachedUpdateStatus(rdFlags) in [cusUnmodified, cusUnInserted,cusDeletedApplied]
        then
          Continue;
        cus := TCachedUpdateStatus(rdFlags and 7);
        FUpdatesPending := True;
        case TCachedUpdateStatus(rdFlags and 7) of
          cusModified:
            UpdateKind := ukModify;
          cusInserted:
            UpdateKind := ukInsert;
          cusDeleted :
            UpdateKind :=ukDelete;
        else
          Continue
        end;
        try
          vTypeDispositionField := dfRRecNumber;
          vInspectRecno := i;
          if (Assigned(FOnUpdateRecord)) then
          begin
            UpdateAction := uaFail;
            FOnUpdateRecord(Self, UpdateKind, UpdateAction);
          end
          else
            UpdateAction := uaApply;
          vTypeDispositionField := dfNormal;
        except
          on E: EFIBError do
          begin
            UpdateAction := uaFail;
            if Assigned(FOnUpdateError) then
              FOnUpdateError(Self, E, UpdateKind, UpdateAction);
            vTypeDispositionField := dfNormal;
            case UpdateAction of
              uaFail: raise;
              uaAbort: raise EAbort.Create(E.Message);
            end;
            case UpdateAction of
              uaFail:
                FIBError(feUserAbort, [nil]);
              uaAbort:
                raise EAbort.Create(