pfibdataset.pas

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

                  Format(SFIBErrorAbortUpdates, [iifStr(Self.Owner <> nil,
                    Self.Owner.Name + '.', ''), Self.Name])
                  );
              uaSkip: bRecordsSkipped:=True
            end;
          end;
        end;

        while (UpdateAction in [uaApply, uaRetry]) do
        begin
          try
            vTypeDispositionField := dfRRecNumber;
            vInspectRecno := i;
            case TCachedUpdateStatus(rdFlags and 7) of
              cusModified:
                if CanEdit then
                begin
                 if  FAutoUpdateOptions.UseExecuteBlock then
                 begin
                  AddRecordToExecuteBlock(skModify);
                 end
                 else
                 begin
                  AutoGenerateSQLText(dsEdit);
                  InternalPostRecord(FQUpdate, Buff);
                 end;
                end;
              cusInserted:
                if CanInsert then
                begin
                 if  FAutoUpdateOptions.UseExecuteBlock then
                 begin
                  AddRecordToExecuteBlock(FIBDataSet.skInsert)
                 end
                 else
                 begin
                  AutoGenerateSQLText(dsInsert);
                  InternalPostRecord(FQInsert, Buff);
                 end
                end;
              cusDeleted:
                if CanDelete then
                 if  FAutoUpdateOptions.UseExecuteBlock then
                 begin
                  if not AddStatementToExecuteBlock(FIBDataSet.skDelete) then
                  begin
                    AddRecordToExecuteBlock(FIBDataSet.skDelete)
                  end;
                 end
                 else
                 begin
                  InternalDeleteRecord(FQDelete, Buff);
                 end
            end;
            if DontChangeCacheFlags and not FAutoUpdateOptions.UseExecuteBlock  then
            begin
             //        Restore CU status
             rdFlags:=Byte(cus);
             WriteRecordCache(i, Buff);
            end;
            UpdateAction := uaApplied;

            if Assigned(FAfterUpdateRecord) then
            begin
              vResume := True;
              FAfterUpdateRecord(Self, UpdateKind, vResume);
              if not vResume then
               Abort;
            end;

          except
            (*
             * If there is an exception, then allow the user
             * to intervene (decide what to do about it).
             *)
            on E: EFIBError do
            begin
              UpdateAction := uaFail;
              if Assigned(FOnUpdateError) then
                FOnUpdateError(Self, E, UpdateKind, UpdateAction);
              case UpdateAction of
                uaFail: raise;
                uaAbort: raise EAbort.Create(E.Message);
                uaSkip:  bRecordsSkipped := True;
              end;
            end;
          end;
        end;
      end;
    end;

    if  FAutoUpdateOptions.UseExecuteBlock and (FExecBlockStatement<>nil) and (FExecBlockStatement.Count>0)
    then
    begin
      FExecBlockStatement.Add('END');
      FQUpdate.SQL.Assign(FExecBlockStatement);
      UpdateAction:=uaApply;
      while (UpdateAction in [uaApply, uaRetry]) do      
      try
       FQUpdate.ExecQuery;
      except
            on E: EFIBError do
            begin
              UpdateAction := uaFail;
              if Assigned(FOnUpdateError) then
                FOnUpdateError(Self, E, UpdateKind, UpdateAction);
              case UpdateAction of
                uaFail: raise;
                uaAbort: raise EAbort.Create(E.Message);
                uaSkip:  bRecordsSkipped := True;
              end;
            end;
      end;

      FExecBlockStatement.Clear;
      SaveFlagsForRecordsInExecBlock
    end;

    FUpdatesPending := bRecordsSkipped;
    if not FUpdatesPending then
      AutoCommitUpdateTransaction;

  finally
    if Assigned(FExecBlockStatement) then
     FExecBlockStatement.Clear;
    FreeRecordBuffer(Buff);
    vTypeDispositionField := dfNormal;
    RefreshClientFields
  end;
end;

{$WARNINGS ON}

function TpFIBDataSet.RecordStatus(RecNumber: integer): TUpdateStatus;
var
  Buff: Pchar;
begin
  Buff := AllocRecordBuffer;
  try
    ReadRecordCache(RecNumber, Buff, False);
    with PRecordData(Buff)^ do
      if not (TCachedUpdateStatus(rdFlags and 7) in [cusUninserted, cusDeletedApplied]) then
        Result := TUpdateStatus(rdFlags and 7)
      else
        Result := usDeleted;
  finally
    FreeRecordBuffer(Buff);
  end
end;

procedure TpFIBDataSet.UpdateFieldsProps;
var
  i: integer;
  scale: Short;
  vFiAlias, vFi: TpFIBFieldInfo;
  RelTable, RelField: string;
  vModifyTable: string;
  vModifyTableAlias:string;
begin
  if  drsInClone in FRunState then
    Exit;

  if AutoUpdateOptions.AutoReWriteSqls then
  begin
   vModifyTable:=FAutoUpdateOptions.ModifiedTableName;
   vModifyTableAlias:=FAutoUpdateOptions.AliasModifiedTable
  end
  else
  begin
   if EmptyStrings(QUpdate.SQL) then
    vModifyTable:=QInsert.ModifyTable
   else
    vModifyTable:=QUpdate.ModifyTable;
   vModifyTableAlias:='';
  end;
  for i := 0 to Pred(FieldCount) do
  begin
    if poAutoFormatFields in FOptions then
    begin
  // Format Fields routine
      case Fields[i].DataType of
        ftDate:
          with TDateField(Fields[i]) do
          begin
            if DisplayFormat = '' then
              DisplayFormat := FDefaultFormats.DisplayFormatDate;
          end;
        ftTime:
          with TTimeField(Fields[i]) do
          begin
            if DisplayFormat = '' then
              DisplayFormat := FDefaultFormats.DisplayFormatTime;
          end;
        ftDateTime:
          with TDateTimeField(Fields[i]) do
          begin
            if DisplayFormat = '' then
              DisplayFormat := FDefaultFormats.DateTimeDisplayFormat;
          end;
        ftSmallint, ftInteger, ftFloat:
          with TNumericField(Fields[i]) do
          begin
            scale := GetFieldScale(TNumericField(Fields[i]));

            if scale < 0 then
            begin
              if DisplayFormat = '' then
                DisplayFormat :=
                  UseFormat(FDefaultFormats.NumericDisplayFormat, -scale);
              if EditFormat = '' then
                EditFormat :=
                  UseFormat(FDefaultFormats.NumericEditFormat, -scale)
            end;
          end;
        ftBCD:
          with TBCDField(Fields[i]) do
            if Size > 0 then
            begin
              if DisplayFormat = '' then
                DisplayFormat :=
                  UseFormat(FDefaultFormats.NumericDisplayFormat, Size);
              if EditFormat = '' then
                EditFormat :=
                  UseFormat(FDefaultFormats.NumericEditFormat, Size); 
            end;
      end;
    end; //end Format

    if
      (PrepareOptions *
       [pfSetRequiredFields, pfSetReadOnlyFields, pfImportDefaultValues,
        psUseBooleanField] <> []
      )
      or ((psApplyRepositary in PrepareOptions) and (urFieldsInfo in DataBase.UseRepositories))
      or (Fields[i] is TFIBMemoField) and (psSupportUnicodeBlobs in PrepareOptions)
    then
    begin
      RelTable := 'ALIAS';
      RelField := Fields[i].FieldName;
      vFiAlias :=
        ListTableInfo.GetFieldInfo(DataBase, RelTable, RelField,
        (psApplyRepositary in PrepareOptions) and (urFieldsInfo in DataBase.UseRepositories)
        );

      RelTable := GetRelationTableName(Fields[i]);
      RelField := GetRelationFieldName(Fields[i]);

      if not Fields[i].ReadOnly and (pfSetReadOnlyFields in PrepareOptions)
        and (Fields[i].FieldKind = fkData) then
      begin
        if AutoUpdateOptions.AutoReWriteSqls then
        begin
          RelTable := FormatIdentifier(Database.SQLDialect,RelTable);        
          Fields[i].ReadOnly := not EquelStrings(RelTable,vModifyTable, False);
          if not Fields[i].ReadOnly  and AutoUpdateOptions.ModifiedTableHaveAlias then
          begin
           Fields[i].ReadOnly :=
            not IsEquelSQLNames(TableAliasForField(Fields[i].FieldName),vModifyTableAlias);
          end;
        end
        else
        if not CachedUpdates or not Assigned(OnUpdateRecord) then
          Fields[i].ReadOnly :=(RelTable <> vModifyTable);
      end;
      if ((RelField = '') or (RelTable = '')) and (vFiAlias = nil) then
        Continue;
      vFi :=
        ListTableInfo.GetFieldInfo(DataBase, RelTable, RelField,
        (psApplyRepositary in PrepareOptions) and (urFieldsInfo in DataBase.UseRepositories)
        );
      if (vFi = nil) then
        vFi := vFiAlias;
      if (vFi = nil) then
        Continue;
      if (Fields[i] is TFIBMemoField) and
       ((psSupportUnicodeBlobs in PrepareOptions) or Database.NeedUTFEncodeDDL)
      then
       TFIBMemoField(Fields[i]).InternalSetCharSet(vFi.CharSetID);

      if pfImportDefaultValues in PrepareOptions then
        if (Fields[i] is TNumericField) then
        begin
          // Be sure to handle '1.0' with different DecSep!
          if (DecimalSeparator <> '.') then
            Fields[i].DefaultExpression := ReplaceStr(vFi.DefaultValue, '.',
              DecimalSeparator)
          else
          if IsNumericStr(vFi.DefaultValue) then
            Fields[i].DefaultExpression := vFi.DefaultValue;
        end
        else
        if (Fields[i] is TDateTimeField) and
         not StringIsDateTimeDefValue(FastUpperCase(FastTrim(vFi.DefaultValue)))
        then
        begin
          with Fields[i] do
            case DataType of
              ftDate: DefaultExpression := ToClientDateFmt(vFi.DefaultValue, 1);
              ftTime: DefaultExpression := ToClientDateFmt(vFi.DefaultValue, 2);
            else
              DefaultExpression := ToClientDateFmt(vFi.DefaultValue, 0)
            end
        end
        else
        begin
         if (Fields[i] is TFIBBooleanField) then
         begin
          if vFi.DefaultValue='1' then
           Fields[i].DefaultExpression:='T'
          else
          if vFi.DefaultValue='0' then          
           Fields[i].DefaultExpression:='F';
         end
         else
         if (Fields[i] is TDateTimeField) then
           Fields[i].DefaultExpression := FastTrim(vFi.DefaultValue)
         else
         if Fields[i] is TFIBStringField then
         begin
          TFIBStringField(Fields[i]).DefaultValueEmptyString := vFi.DefaultValueEmptyString;
          if Length(vFi.DefaultValue)>0 then
           Fields[i].DefaultExpression := ''''+vFi.DefaultValue+'''';
         end
         else
           Fields[i].DefaultExpression := vFi.DefaultValue;
        end;

      if (vFiAlias <> nil) then
       vFi := vFiAlias;

      if (Fields[i].FieldKind = fkData) then
      begin
        if not Fields[i].ReadOnly and not (psCanEditComputedFields in
          PrepareOptions) and (pfSetReadOnlyFields in PrepareOptions)
        then
        begin
          Fields[i].ReadOnly := vFi.IsComputed;
        end;

        if (pfSetRequiredFields in PrepareOptions) then
          Fields[i].Required :=
            not QSelect[Fields[i].FieldName].IsNullable and
            IsBlank(vFi.DefaultValue) and not vFi.IsTriggered;
      end;

      if psApplyRepositary in PrepareOptions then
      begin
        // Info from FIB$FIELDS_INFO
        if vFi.WithAdditionalInfo then
        begin
          if vFi.DisplayWidth <> 0 then
            Fields[i].DisplayWidth := vFi.DisplayWidth;
          if vFi.DisplayLabel <> '' then
            Fields[i].DisplayLabel := vFi.DisplayLabel;
          Fields[i].Visible := vFi.Visible;
          if (vFi.DisplayFormat <> '') then
            if (Fields[i] is TNumericField) then
              TNumericField(Fields[i]).DisplayFormat := vFi.DisplayFormat
            else
            if (Fields[i] is TDateTimeField) then
              TDateTimeField(Fields[i]).DisplayFormat := vFi.DisplayFormat;
          if (vFi.EditFormat <> '') then
            if (Fields[i] is TNumericField) then
              TNumericField(Fields[i]).EditFormat := vFi.EditFormat;
        end;

        if (GlobalContainer<>nil) and (FContainer<>GlobalContainer) then
         GlobalContainer.DoOnApplyFieldRepository(Self,Fields[i],vFI);
        if Assigned(FContainer) then
         FContainer.DoOnApplyFieldRepository(Self,Fields[i],vFI);
          
        if Assigned(FOnApplyFieldRepository) then
         FOnApplyFieldRepository(Self,Fields[i],vFI);
      end;
    end;
  end;
end;

procedure TpFIBDataSet.DoAfterOpen;
begin
  FDefaultsInited         := False;
  SetLength(FParamsForFields,FieldCount);
  FillChar(FParamsForFields[0],SizeOf(TFIBXSQLVAR)*FieldCount,0);
  FHaveRollbackedChanges := False;
  FHaveUncommitedChanges := False;
//  UpdateFieldsProps;
  if not (csDesigning in ComponentState) then
    if vSelectSQLTextChanged and FAutoUpdateOptions.AutoReWriteSqls then
      if not FAutoUpdateOptions.UpdateOnlyModifiedFields then
        GenerateSQLs
      else
        with FAutoUpdateOptions do
        if Length(UpdateTableName)>0 then
        begin
          if IsBlank(KeyFields) then
            KeyFields := PrimaryKeyFields(FAutoUpdateOptions.ModifiedTableName);
          if IsBlank(KeyFields) then
            KeyFields := AllKeyFields(FAutoUpdateOptions.ModifiedTableName);

          RefreshSQL.Text :=
            GenerateSQLText(UpdateTableName, KeyFields, skRefresh);
          DeleteSQL.Text :=
            GenerateSQLText(UpdateTableName, KeyFields, FIBDataSet.skDelete);
        end;


  FUpdatesPending := False;

  //
  if (GlobalContainer<>nil) and (FContainer<>GlobalContainer) then
   GlobalContainer.DataSetEvent(Self, deAfterOpen);
  if FContainer <> nil then
    FContainer.DataSetEvent(Self, deAfterOpen);

  if not (csDesigning in ComponentState) then
    if (AutoUpdateOptions.AutoParamsToFields) and
      (FSQLTextChanges < QSelect.SQLTextChangeCount) then
    begin
      FSQLTextChanges := QSelect.SQLTextChangeCount;
      ParseParamToFieldsLinks(AutoUpdateOptions.ParamsToFieldsLinks);
    end;
  inherited;
end;

// Filter works

procedure TpFIBDataSet.AddedFilterRecord(DataSet: TDataSet; var Accept:
  Boolean);
begi