fibdatasetlocate.inc

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

{***************************************************************}
{ FIBPlus - component library for direct access to Firebird and }
{ InterBase databases                                           }
{                                                               }
{    FIBPlus is based in part on the product                    }
{    Free IB Components, written by Gregory H. Deatz for        }
{    Hoagland, Longo, Moran, Dunst & Doukas Company.            }
{    mailto:[e-mail]                                    }
{                                                               }
{    Copyright (c) 1998-2007 Devrace Ltd.                       }
{    Written by Serge Buzadzhy ([e-mail])               }
{                                                               }
{ ------------------------------------------------------------- }
{    FIBPlus home page: http://www.fibplus.com/                 }
{    FIBPlus support  : http://www.devrace.com/support/         }
{ ------------------------------------------------------------- }
{                                                               }
{  Please see the file License.txt for full license information }
{***************************************************************}
{$IFDEF FIB_INTERFACE}
   procedure  GetFieldDataPointer(Field:TField;RecNumber:integer; var IsString:boolean;var OutRes:Pointer);

{$ENDIF}

{$IFDEF FIB_IMPLEMENT}



procedure TFIBCustomDataSet.GetFieldDataPointer(Field:TField;RecNumber:integer; var  IsString:boolean;var OutRes:Pointer);
var
   P1:Pointer;
   fi:PFIBFieldDescr;
   fn:Integer;
   c:Currency;
begin

 case  FCacheModelOptions.CacheModelKind of
   cmkStandard:
   begin
    if FRecordCount<=RecNumber then
     FetchNext(RecNumber-FRecordCount+1);
    if  Unidirectional then
     RecNumber:=RecNumber mod FCacheModelOptions.FBufferChunks
   end;
   cmkLimitedBufferSize:
   begin
     RecNumber:=RecNumber mod FCacheModelOptions.FBufferChunks
   end;
  end;
  fn:=Field.FieldNo;

  if
  (fn<=0) and (not vCalcFieldsSavedCache
    or    not GetBit(PSavedRecordData(FRecordsCache.PRecBuffer(RecNumber+1,False))^.rdFlags,7))
  then
  begin
// NeedRecalcFields
    vInspectRecno:=RecNumber;
    try
      vTypeDispositionField:=dfRRecNumber;
      IsString:=False;
      if not GetFieldData(Field,PChar(OutRes)) then // ForceCalculate
       OutRes:=nil
      else
      case Field.DataType of
       ftBCD:
       begin
        BCDToCurr(TBcd(OutRes^), c);
       {$IFDEF D6+}
        if TBCDField(Field).Size<=4 then
          PInt64(OutRes)^:=(PInt64(@c)^ div IE10[4-TBCDField(Field).Size])
        else
          PInt64(OutRes)^:=PInt64(@c)^ *IE10[TBCDField(Field).Size-4];
       {$ELSE} // D5
        PCurrency(OutRes)^:=c
       {$ENDIF}  
       end;
      end;
     finally
      vTypeDispositionField:=dfNormal
     end;
  end;


    if fn>0 then
    begin
      fi:=vFieldDescrList.List.List[fn-1];
      IsString:=fi^.fdStrIndex>-1;

      if  IsString then
      begin

       OutRes:=FRecordsCache.GetStringFieldData(RecNumber,fi^.fdStrIndex);
       if PString(OutRes)^='' then
       begin
       // May be null, may be empty str
        P1:=FRecordsCache.PRecBuffer(RecNumber+1,False);
        if PSavedRecordData(P1).rdFields[fn].fdIsNull then
         OutRes:=nil;
       end;
      end
      else
      begin
        OutRes:=FRecordsCache.GetNonStringFieldData(RecNumber,fi^.fdDataOfs-DiffSizesRecData,P1);
        if PSavedRecordData(P1).rdFields[fn].fdIsNull then
         OutRes:=nil;
      end;
    end
    else
    if vCalcFieldsSavedCache then
    begin // Calc
     OutRes:=FRecordsCache.GetNonStringFieldData(RecNumber, FBlockReadSize+Field.Offset,P1);
     if OutRes<>nil then
      if not PBoolean(OutRes)^ then
       OutRes:=nil
      else
      begin
        Inc(PChar(OutRes),SizeOf(Boolean));
        IsString:=False;
      end
    end;
end;


function TFIBCustomDataSet.InternalLocate(const KeyFields: string;
  KeyValues:array of Variant; Options: TExtLocateOptions;FromBegin:boolean = False;
  LocateKind:TLocateKind = lkStandard; ResyncToCenter:boolean =False
  ): Boolean;

type
  TArrow=(arForward,arBackward);
var
  fl: TList;
  fld_cnt: Integer;
  rc,rc1 :Integer;
  Arrow:TArrow;
  vIgnoreRecChecked:boolean;
  RecI: Integer;
  vDisableCalculateFields:boolean;
  vSortInfos     : array of TSortFieldInfo;
  FinishSearch:boolean;
  NowInFetched:boolean;

  s:string;
  ws:WideString;
  ws1:WideString;
  vCalcBuffer:PChar;
  
function IsVisibleRecord:boolean;
var
 vBuff:PChar;
begin

  if drsInMoveRecord in FRunState then
  begin
   Result := True;
   Exit;
  end;

  if Filtered then
  begin
   vBuff:=AllocRecordBuffer;
   try
    FCurrentRecord:=RecI;
    ReadRecordCache(RecI, vBuff, False);
    Result:=IsVisible(vBuff);
   finally
    FreeMem(vBuff);
   end;
  end
  else
  if FCacheModelOptions.FCacheModelKind=cmkStandard then
  begin
    if UniDirectional then
     vBuff :=FRecordsCache.PRecBuffer((RecI mod BufferChunks) +1,False)-DiffSizesRecData
    else
     vBuff :=FRecordsCache.PRecBuffer(RecI+1,False)-DiffSizesRecData;
    Result:=IsVisibleStat(vBuff);
  end
  else
    Result:=True;  
end;


procedure AdjustOrders(L, R: Integer);
var
  I, J: Integer;
  P: Integer;
  T: TSortFieldInfo;
  P1:Pointer;
  v :Variant;
begin
  repeat
    I := L;
    J := R;
    P := vSortInfos[(L + R) shr 1].InOrderIndex;
    repeat
      while vSortInfos[I].InOrderIndex< P do
        Inc(I);
      while vSortInfos[J].InOrderIndex> P do
        Dec(J);
      if I <= J then
      begin
        if I<>J then
        begin
          T := vSortInfos[I];
          vSortInfos[I] := vSortInfos[J];
          vSortInfos[J] := T;
          P1:=fl.List^[I];
          fl.List^[I]:=fl.List^[J];
          fl.List^[J]:=P1;
          v :=KeyValues[I];
          KeyValues[I]:=KeyValues[J];
          KeyValues[J]:=v;
        end;
        Inc(I);
        Dec(J);
      end;
    until I > J;
    if L < J then
      AdjustOrders( L, J);
    L := I;
  until I >= R;
end;

function  InitSortInfos:boolean;
var
   i:integer;
   NeedAdjustOrder:boolean;
   vCallAsSorted:boolean;
begin
  vCallAsSorted:=eloInSortedDS in Options;
  if not vCallAsSorted then
  begin
    Result := False;
    Exit;
  end; 
    
  NeedAdjustOrder:=False;
  SetLength(vSortInfos,fld_cnt);
  for i:=0 to fld_cnt-1 do
  begin
   if IsSortedField(TField(fl.List^[i]),vSortInfos[i]) then
   begin
    if vSortInfos[i].InOrderIndex<>Succ(i) then
       NeedAdjustOrder:=True;
   end
   else
   begin
     Result := False;
     Exit;
   end;
  end;

  if NeedAdjustOrder then
  begin
   AdjustOrders(0,fld_cnt-1);
  end;

  for i:=0 to fld_cnt-1 do
   if (vSortInfos[i].InOrderIndex<>Succ(i)) or
    ((TField(fl.List^[i]).DataType in [ftString,ftWideString,ftGuid]) and
      not (vCallAsSorted and not (eloCaseInsensitive in Options))
    )
   then
   begin
     Result := False;
     Exit;
   end;
  Result:=True;
end;

procedure  AdjustKeys;
var
      i:integer;
      CalcSize:integer;
begin
  vDisableCalculateFields:=True;
  CalcSize:=0;
  for i:=Pred(fl.Count) downto 0 do
  begin

     if TField(fl.List^[i]).FieldKind in [fkCalculated, fkLookup] then
     begin
        vDisableCalculateFields := False;
        Inc(CalcSize,TField(fl.List^[i]).DataSize)
     end;
     if VarIsNull(KeyValues[i]) or VarIsEmpty(KeyValues[i]) then
     begin
       KeyValues[i]:=null;
       Continue
     end
     else
     if VarType(KeyValues[i])= varBoolean then
      if KeyValues[i] then
       KeyValues[i]:=1
      else
       KeyValues[i]:=0;

     case TField(fl.List^[i]).DataType  of
      ftString  :
      begin
       if eloCaseInsensitive in Options then
        KeyValues[i]:=AnsiUpperCase(KeyValues[i])
       else
        KeyValues[i]:=VarAsType(KeyValues[i],varString);
      end;
      ftSmallint: KeyValues[i]:=VarAsType(KeyValues[i],varSmallInt);
      ftInteger : KeyValues[i]:=VarAsType(KeyValues[i],varInteger);
      ftBoolean : KeyValues[i]:=VarAsType(KeyValues[i],varByte);
      ftFloat   : KeyValues[i]:=VarAsType(KeyValues[i],varDouble);
      ftCurrency: KeyValues[i]:=VarAsType(KeyValues[i],varCurrency);
      ftWideString :
      begin
       if Database.NeedUnicodeFieldsTranslation then
       begin
         if eloCaseInsensitive in Options then
         begin
          KeyValues[i]:=WideUpperCase(KeyValues[i]);
         end
         else
         begin
          KeyValues[i]:=VarAsType(KeyValues[i],varOleStr);
          if Options-[eloInFetchedRecords,eloInSortedDS]=[] then
          begin
           KeyValues[i]:=Utf8Encode(KeyValues[i]) // 馏溴