fibdataset.pas

FIBPlus version 6-96. This is somewhat usefull interbase database components. TFIBDatabase, TFIBTab

   end;
 end;
 Result:=FSqlSubType;
end;

function TFIBStringField.CharacterSet:string;
var
 F:TFIBXSQLVAR;
begin
 Result:=UnknownStr;
if FieldKind<>fkData then
  Exit;
 with TFibDataSet(DataSet),TFibDataSet(DataSet).QSelect do
 try
  F:=QSelect[Self.FieldName];
  if F<>nil then
   Result:=F.CharacterSet;
 except
 end;
end;

function TFIBStringField.GetAsString:string;
begin
  if not GetValue(Result) then
   Result:= ''
  else
  if (FieldKind=fkData ) and (DataSet is TFIBDataset) then
  with TFIBDataSet(DataSet).Database do
  begin
   if NeedUnicodeFieldTranslation(Byte(SqlSubType))
    and (Byte(SqlSubType) in UnicodeCharSets)
   then
     Result:=UTF8ToString(Result)
   else

{$IFDEF SUPPORT_KOI8_CHARSET}
      if IsKOI8Connect
       and not (Byte(SqlSubType) in [1,0]) //OCTETS,NONE
      then
        Result:=ConvertFromCodePage(Result,CodePageKOI8R);
{$ENDIF}

  end;
end;

function TFIBStringField.GetAsVariant:Variant;
var S:String;
begin
  if not GetValue(S) then
   Result:= Null
  else
  if (FieldKind=fkData ) and (DataSet is TFIBDataset) then
  begin

{$IFDEF SUPPORT_KOI8_CHARSET}
      if TFIBDataSet(DataSet).Database.IsKOI8Connect
       and not (Byte(SqlSubType) in [1,0]) //OCTETS,NONE
      then
        Result:=ConvertFromCodePage(S,CodePageKOI8R)
      else
{$ENDIF}

     Result:=S
  end
  else
     Result:=S
end;

function TFIBStringField.GetValue(var Value:string):Boolean;
begin
  if IsDBKEY then
  begin
   Value:= GetAsDB_KEY;
   Result:=Value<>''
  end
  else
  begin
    if not Assigned(FReservedBuffer) then
    begin
     GetMem(FReservedBuffer, DataSize);
     FReservedBuffer[Size]:=#0;
    end;
    Result:= GetData(FReservedBuffer);
    if Result then
     if FReservedBuffer[0]=#0 then
      Value:=''
     else
// Value:=string(AnsiString(FReservedBuffer));
      Value:=string(AnsiString(FReservedBuffer));
  end;
end;

procedure TFIBStringField.SetSize(Value:Integer);
begin
  inherited SetSize(Value);
  FreeMem(FReservedBuffer);
  FReservedBuffer:=nil;
end;

function TFIBStringField.GetDataSize:Integer;
begin
  Result:= inherited;
{$IFDEF UNICODE_TO_STRING_FIELDS}
   if (FieldKind=fkData) and
     TFIBDataSet(DataSet).Database.NeedUnicodeFieldTranslation(Byte(SqlSubType))
   then
    Result:=(Result-1)*
     TFIBDataSet(DataSet).Database.BytesInUnicodeChar(Byte(sqlsubtype))+1
{$ENDIF}
end;

procedure TFIBStringField.Clear;
begin
    SetData(nil);
end;

const
  vEmptyStrBuffer:PAnsiChar = #0;

procedure TFIBStringField.SetAsString(const Value:string);

procedure InternalSetAsString(const vValue:Ansistring);
begin
   FValueLength:=Length(vValue);
   if FValueLength>0 then
   begin
    SetData(@vValue[1])
   end
   else
    SetData(vEmptyStrBuffer)
end;

begin
 vInSetAsString:=True;
 try
   if TFIBDataSet(DataSet).Database.NeedUnicodeFieldTranslation(SqlSubType) then
    InternalSetAsString(UTF8Encode(Value))
   else
{$IFDEF SUPPORT_KOI8_CHARSET}
      if TFIBDataSet(DataSet).Database.IsKOI8Connect and not (Byte(SqlSubType) in [0,1]) //OCTETS,NONE
      then
        InternalSetAsString(ConvertToCodePage(Value,CodePageKOI8R))
      else
{$ENDIF}
    InternalSetAsString(Value);
 finally
  vInSetAsString:=False;
 end;
end;

function TFIBWideStringField.GetDataSize:Integer;
var
 F:TFIBXSQLVAR;
begin
 if FieldKind in [fkCalculated,fkLookUp] then
  Result:=(Size*3)+1
 else
 with TFIBDataSet(DataSet) do
 begin
  if not QSelect.Prepared then
   QSelect.Prepare;
  F:=QSelect[Self.FieldName];
  if F<>nil then
  begin
   if Byte(F.SQLSubtype) in Database.UnicodeCharSets then
     Result:=(Size*Database.BytesInUnicodeChar(Byte(F.SQLSubtype)))+1
   else
     Result:=(Size*3)+1
  end
  else
   Result:=(Size*3)+1;
 end;
end;

function TFIBWideStringField.GetValue(var Value:string):Boolean;
begin
    SetLength(Value,Size);
    Result:= GetData(@Value[1]);
    if Result then
     if Value[1]=#0 then
      Value:=''
     else
      Value:=PWideChar(Value);
end;

{function TFIBWideStringField.GetAsString:string;
begin
  if not GetValue(Result) then
   Result:= ''
  else
  if (FieldKind=fkData ) and (DataSet is TFIBDataset) then
  begin
   if TFIBDataSet(DataSet).Database.NeedUnicodeFieldsTranslation
   then
     Result:=UTF8ToString(Result);
  end;
end;
}
procedure TFIBWideStringField.SetAsString(const Value:string);

procedure InternalSetAsString(const vValue:Ansistring);
begin
   if Length(vValue)>0 then
   begin
    SetData(@vValue[1])
   end
   else
    SetData(vEmptyStrBuffer)
end;

begin
   if TFIBDataSet(DataSet).Database.NeedUnicodeFieldsTranslation then
    InternalSetAsString(UTF8Encode(Value))
   else
    InternalSetAsString(Value);
end;

function TFIBWideStringField.GetAsVariant:Variant;
var S:String;
begin
  if not GetValue(S) then
   Result:= Null
  else
   Result:=S
end;

procedure TFIBWideStringField.SetAsWideString(const Value:UnicodeString);
begin
// SetAsString(Value)
  inherited
end;

procedure TFIBWideStringField.Clear;
begin
    SetData(nil);
end;

function TFIBWideStringField.CharacterSet:string;
var
 F:TFIBXSQLVAR;
begin
 Result:=UnknownStr;
if FieldKind<>fkData then
  Exit;
 with TFibDataSet(DataSet),TFibDataSet(DataSet).QSelect do
 try
  F:=QSelect[Self.FieldName];
  if F<>nil then
   Result:=F.CharacterSet;
 except
 end;
end;

function TFIBWideStringField.CollateNumber:Byte;
var
 F:TFIBXSQLVAR;
 st:Short;

begin
 Result:=0;
 if FieldKind<>fkData then
  Exit;
 with TFibDataSet(DataSet),TFibDataSet(DataSet).QSelect do
 try
  F:=QSelect[Self.FieldName];
  if F<>nil then
  begin
   st:=F.SQLSubtype;
   Result:=PByte(Integer(@st)+1)^
  end
 except
 end;
end;

(*
 * TFIBLargeIntField-implementation
 *)

function TFIBLargeIntField.GetOldAsInt64:Int64;
var
  SaveState:TDataSetState;
begin
  if FieldKind in [fkData, fkInternalCalc] then
  begin
    SaveState:= DataSet.State;
    TFIBCustomDataSet(DataSet).SetTempState(dsOldValue);
    try
      Result:= AsLargeInt;
    finally
     TFIBCustomDataSet(DataSet).RestoreState(SaveState);
    end;
  end
  else
    Result:= 0;
end;

procedure TFIBLargeIntField.SetVarValue(const Value:Variant);
begin
 {$IFNDEF D6+}
    inherited SetVarValue(Value)
 {$ELSE}
    if VarIsNull(Value) or VarIsEmpty(Value) then
     Clear
    else
     SetAsLargeInt(Value);
 {$ENDIF}
end;
(*
 * TFIBIntegerField-implementation
 *)

 constructor TFIBIntegerField.Create(AOwner:TComponent); //override;
 begin
  inherited Create(AOwner);
 end;

 function TFIBIntegerField.GetAsBoolean:Boolean;
 begin
   Result:=AsInteger>0
 end;

 procedure TFIBIntegerField.SetAsBoolean(Value:Boolean);
 begin
  if Value then AsInteger:=1 else AsInteger:=0
 end;

 procedure TFIBIntegerField.Clear;
 begin
  SetData(nil);
 end;

(*
 * TFIBDateField-implementation
 *)

(*
 * TFIBTimeField-implementation
 *)
procedure TFIBTimeField.GetText(var Text:string; DisplayText:Boolean);
var
    Data:integer;
begin
   inherited GetText(Text,DisplayText);
   if FShowMsec then
   begin
    if Dataset.GetFieldData(Self,@Data) then
    begin
       Data:= Data mod 1000;
       if Data >0 then
        Text:=Text+'.'+IntToStr(Data)
    end
   end;
 end;

(*
 * TFIBDateTimeField-implementation
 *)

 procedure TFIBDateTimeField.GetText(var Text:string; DisplayText:Boolean);
 var
    Data:Double;
    ts:TTimeStamp;

 begin
   inherited GetText(Text,DisplayText);
   if FShowMsec then
   begin
    if Dataset.GetFieldData(Self,@Data) then
    begin
       ts:=MSecsToTimeStamp(Data);
       ts.Time:= ts.Time mod 1000;
       if ts.Time >0 then
        Text:=Text+'.'+IntToStr(ts.Time)
    end
   end;
 end;

 function TFIBDateTimeField.GetAsTimeStamp:TTimeStamp;
 var
    Data:Double;
 begin
    if Dataset.GetFieldData(Self,@Data) then
     Result:=MSecsToTimeStamp(Data)
    else
    begin
     Result.Tim