pfibclientdataset.pas

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

  Params[ParamIndex].Value:=aValue;
end;

{ TpFIBClientBCDField }

procedure TpFIBClientBCDField.Assign(Source: TPersistent);
begin
  if Source = nil then
    Clear
  else
  if Source is TField then
    Value := TField(Source).Value
  else
    inherited Assign(Source);
end;

{$IFNDEF NO_USE_COMP}
function TpFIBClientBCDField.GetAsComp: Comp;
begin
 Result:=GetAsExtended
end;

procedure TpFIBClientBCDField.SetAsComp(Value: comp);
begin
 SetData(@Value,False)
end;

{$ENDIF}

function TpFIBClientBCDField.GetAsCurrency: Currency;
begin
 Result:=GetAsExtended
end;

function TpFIBClientBCDField.GetAsExtended: Extended;
var C:Int64;
begin
 if GetData(@C, False) then
  Result:=C*E10[-Size]
 else
  Result:=0
end;

function TpFIBClientBCDField.GetAsFloat: Double;
var C:Comp;
begin
 if GetData(@C, False) then
  Result:=C*E10[-Size]
 else
  Result:=0
end;

function TpFIBClientBCDField.GetAsInt64: Int64;
begin
 if GetData(@Result, False) then
  if Size<>0 then
     Result:=Round(Result*E10[-Size])
  else   
 else
  Result:=0
end;

function TpFIBClientBCDField.GetAsString: string;
var C:Int64;
begin
 if GetData(@C, False) then
  Result := CompWithScaleToStr(C,Size,DecimalSeparator) else Result := '';
end;

function TpFIBClientBCDField.GetAsVariant: Variant;
begin
 case Size of
 0:
  {$IFDEF D6+}
   Result:= asInt64;
  {$ELSE}
   {$IFDEF NO_USE_COMP}
    Result:= asInteger ;
   {$ELSE}
    Result:= asComp ;
   {$ENDIF}

  {$ENDIF}
 4:
  Result:= asCurrency
 else
  Result:= asExtended
 end 
end;

procedure TpFIBClientBCDField.GetText(var Text: string;
  DisplayText: Boolean);
var
  Format: TFloatFormat;
  Digits: Integer;
  FmtStr: string;
  C: Int64;
begin
  try
    if GetData(@C, False) then
    begin
      if DisplayText or (EditFormat = '') then
        FmtStr := DisplayFormat else
        FmtStr := EditFormat;
      if FmtStr = '' then
      begin
        if currency then
        begin
         Digits := CurrencyDecimals;
         if DisplayText then Format := ffCurrency else Format := ffFixed;
         Text := CurrToStrF(C*E10[-Size], Format, Digits);
        end
        else
        begin
          Digits := Size;
          Text := CompWithScaleToStr(C,Digits,DecimalSeparator)
        end;
      end
      else
      if Size=4 then
       Text := FormatCurr(FmtStr, C*E10[-Size])
      else
      begin
        {$IFNDEF D6+}
          Text := FormatFloat(FmtStr, RoundExtend(C*E10[-Size],Size));
        {$ELSE}
          Text := FormatNumericString(FmtStr,CompWithScaleToStr(C,Size,DecimalSeparator));
        {$ENDIF}
      end;
    end
    else
      Text := '';
  except
    on E: Exception do
      Text := SBCDOverflow;
  end;
end;


procedure TpFIBClientBCDField.SetAsCurrency(Value: Currency);
begin
  SetAsExtended(Value)
end;

procedure TpFIBClientBCDField.SetAsExtended(Value: Extended);
var
 RndComp :Comp;
begin
  try
   RndComp :=Value*E10[Size];
   SetData(@RndComp,False);   
  except
   raise 
  end;
end;

procedure TpFIBClientBCDField.SetAsFloat(Value: Double);
begin
  SetAsExtended(Value);
end;

procedure TpFIBClientBCDField.SetAsInt64(Value: Int64);
begin
  SetData(@Value,False)
end;

procedure TpFIBClientBCDField.SetAsString(const Value: string);
begin
 if Value = '' then Clear else
  if (Size=0) then
   SetAsInt64(StrToInt64(Value))
  else
   SetAsExtended(StrToFloat(Value))
end;

procedure TpFIBClientBCDField.SetVarValue(const Value: Variant);
begin
 case VarType(Value) of
  varEmpty,varNull      : Clear;
  varString,varOleStr   : AsString :=Value;
  varSmallint,varInteger: AsInteger:=Value;
  {$IFDEF D6+}
    varInt64            : AsInt64  :=Value
  {$ENDIF}
 else
  AsExtended :=Value;
 end
end;

{ TpFIBDataSetProvider }

function TpFIBDataSetProvider.CreateResolver: TCustomResolver;
begin
  if ResolveToDataSet then
    Result := TpFIBDataSetResolver.Create(Self) else
    Result := TSQLResolver.Create(Self);
end;

type TUnprotectedPacketDataSet =class(TPacketDataSet);

function TpFIBDataSetProvider.FindRecord(Source, Delta: TDataSet;
  UpdateMode: TUpdateMode): Boolean;

  procedure GetFieldList(DataSet: TDataSet; UpdateMode: TUpdateMode; List: TList);
  var
    i: Integer;
  begin
    for i := 0 to DataSet.FieldCount - 1 do
      with DataSet.Fields[i] do
      begin
        if (DataType in [ftBytes, ftVarBytes]) or IsBlob or
           (DataSet.Fields[i] is TObjectField) then continue;
        case UpdateMode of
          upWhereKeyOnly:
            if pfInKey in ProviderFlags then List.Add(DataSet.Fields[i]);
          upWhereAll:
            if pfInWhere in ProviderFlags then List.Add(DataSet.Fields[i]);
          upWhereChanged:
            if (pfInKey in ProviderFlags) or (not VarIsEmpty(NewValue)) then
              List.Add(DataSet.Fields[i]);
        end;
      end;
  end;

var
  i: Integer;
  KeyValues: Variant;
  Fields: string;
  FieldList: TList;
  IsDelta: LongBool;
begin
  Result := False;
  TUnprotectedPacketDataSet(Delta).DSBase.GetProp(DSPROPISDELTA, @IsDelta);
  FieldList := TList.Create;
  try
    GetFieldList(Delta, UpdateMode, FieldList);
    if FieldList.Count > 1 then
    begin
      KeyValues := VarArrayCreate([0, FieldList.Count - 1], varVariant);
      Fields := '';
      for i := 0 to FieldList.Count - 1 do
        with TField(FieldList[i]) do
        begin
         if (TField(FieldList[i]) is TBCDField) and
           (TBCDField(FieldList[i]).Size<>4)
         then
            KeyValues[i] := BCDFieldAsString(TField(FieldList[i]),IsDelta)
         else
          if IsDelta then
            KeyValues[i] := OldValue else
            KeyValues[i] := Value;
          if Fields <> '' then Fields := Fields + ';';
          Fields := Fields + FieldName;
        end;
      Result := Source.Locate(Fields, KeyValues, []);
    end
    else
    if FieldList.Count = 1 then
    begin
      with TField(FieldList[0]) do
        if IsDelta then
          Result := Source.Locate(FieldName, OldValue, [])
        else
          Result := Source.Locate(FieldName, Value, []);
    end
    else
      DatabaseError(SNoKeySpecified);
  finally
    FieldList.Free;
  end;
end;

procedure TpFIBDataSetProvider.UpdateRecord(Source, Delta: TDataSet;
  BlobsOnly, KeyOnly: Boolean);
var
  Field: TField;
  i: Integer;
  UseUpMode: TUpdateMode;
  BcdValue:TBcd;
begin
  if KeyOnly then
    UseUpMode := upWhereKeyOnly
  else
    UseUpMode := UpdateMode;
  if not FindRecord(Source, Delta, UseUpMode) then
    DatabaseError(SRecordChanged);
  begin
    if not FindRecord(Source, Delta, upWhereKeyOnly) then
      DatabaseError(SRecordChanged);
    with Delta do
    begin
      Edit;
      for i := 0 to FieldCount - 1 do
      begin
        Field := Source.FindField(Fields[i].FieldName);
        if (Field <> nil) and (not BlobsOnly or (Field.IsBlob and VarIsNull(Fields[i].NewValue)))
        then
         if Fields[i].DataType<>ftBcd then
          Fields[i].Assign(Field)
         else
         begin
// 朽滂