fibcachemanage.pas

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

    FStringData.Capacity:=SourceCache.FStringData.Capacity;
    for i := 0 to Pred(SourceCache.FStringData.HighX) do
     for j := 0 to Pred(SourceCache.FStringData.CountY) do
     begin
      if i=0 then FStringData.Add;
      FStringData[i,j]:=SourceCache.FStringData[i,j];
     end;

    if Assigned(SourceCache.FLogStringData) then
    begin
     FLogStringData:=TStringCollection.Create(FStrFieldCount);
     FLogStringData.Capacity:=SourceCache.FLogStringData.Capacity;
      for i := 0 to Pred(SourceCache.FLogStringData.HighX) do
       for j := 0 to Pred(SourceCache.FLogStringData.CountY) do
       begin
        if i=0 then FLogStringData.Add;
        FLogStringData[i,j]:=SourceCache.FLogStringData[i,j];
       end;
    end;
      
  end
  else
  begin
   FStringData:=nil;
   FLogStringData:=nil;
  end;

  FInOutRecordSize:=SourceCache.FInOutRecordSize;
  FRecordSize     :=SourceCache.FRecordSize     ;
  FRecInBlock     :=SourceCache.FRecInBlock     ;
  FRecordCount    :=SourceCache.FRecordCount     ;
  ReallocMem(FOldBuffer , FInOutRecordSize);

end;

procedure TRecordsCache.SetBlockCount(NewCount: Integer);
begin
  if NewCount>=FBlocks.Capacity then
   FBlocks.Capacity:=NewCount+10;
  FBlocks.Count:=NewCount
end;

function  TRecordsCache.GetBlockCount:integer;
begin
 Result:=FBlocks.Count
end;

function  TRecordsCache.CreateNewBlock:integer;
begin
  SetBlockCount(BlockCount+1);
  FBlocks.List^[BlockCount-1]:=AllocMem(FBlockSize);
  Result:=BlockCount;
end;

function    TRecordsCache.MemoryPrepared(RecordNo:integer):boolean;
begin
 if Assigned(FMapRecords) then
   Result := (RecordNo<FMapRecords.Count)
 else
   Result := RecordNo<FRecordCount;
end;

function  TRecordsCache.PrepareMemory(RecordNo:integer):PChar;
var
 BlockNo:integer;
 IRecordNo,i,c     :integer;
begin
 if Assigned(FMapRecords) and (RecordNo>FMapRecords.Count) then
 begin
  c:=FMapRecords.Count;
  for i:=c to RecordNo-1 do
   FMapRecords.Add(Pointer(FRecordCount+1+i-c));
  FRecordCount:=FMapRecords.Count ;
  if Assigned(FStringData) then
   while (FStringData.CountY<FMapRecords.Count) do
    FStringData.Add
 end
 else
  if FRecordCount<RecordNo then   FRecordCount:=RecordNo;
 IRecordNo:=InternalRecordNo(RecordNo);
 BlockNo:=(IRecordNo-1) div FRecInBlock;
 if BlockNo=BlockCount then
  CreateNewBlock;
 Result:=PChar(FBlocks.List^[BlockNo])+RecordPosition(IRecordNo,True);
end;

function TRecordsCache.RecordPosition(const RecordNo: integer;IsInternalRecno:boolean=False): integer;
begin
  if IsInternalRecno then
   Result  := ((RecordNo-1) mod FRecInBlock)*FRecordSize  
  else
   Result  := ((InternalRecordNo(RecordNo)-1) mod FRecInBlock)*FRecordSize
end;


function TRecordsCache.Capacity:integer;
begin
 Result:= (FBlockSize div FRecordSize)*BlockCount;
end;

function TRecordsCache.RecordBlock(const RecordNo: integer;ForceAllocMem: boolean;IsInternalRecno:boolean=False): integer;
begin
 if ForceAllocMem then
 begin
  PrepareMemory(RecordNo);
  if (RecordNo>FRecordCount)  then
   FRecordCount:=RecordNo;
 end;
 if IsInternalRecno then
  Result    := (RecordNo-1) div FRecInBlock 
 else
  Result    := (InternalRecordNo(RecordNo)-1) div FRecInBlock;
end;


procedure TRecordsCache.ReadRecord(const RecordNo: integer; var Dest: PChar);
begin
 ReadRecordBuffer(RecordNo,  Dest,False);
end;

function TRecordsCache.PRecBuffer(const RecordNo:integer; Old: boolean):PChar;
var
   BlockIndex:integer;
   PosInBlock:integer;
   IRecordNo:integer;
begin
  IRecordNo:=InternalRecordNo(RecordNo);
  BlockIndex:=RecordBlock(IRecordNo,False,True);
  if BlockIndex>=BlockCount then
     raise EMemManagerError.Create('Can''t read Buffer.Incorrect RecordNo');
  PosInBlock:=RecordPosition(IRecordNo,True);
  Result :=PChar(FBlocks.List^[BlockIndex])+PosInBlock;
end;

procedure TRecordsCache.ReadRecordBuffer(RecordNo: integer;
  var Dest: PChar; Old: boolean);
var
   BlockIndex:integer;
   PosInBlock:integer;
   Cache:PChar;
   i,L:integer;
   IRecordNo:integer;
   p:PRecordPosition;
   ss:TStringCollection;
   ps:PString;
begin
  IRecordNo:=InternalRecordNo(RecordNo);
  if Old then
  begin
    p:=GetChangePosition(IRecordNo,False);
    if not Assigned(p) then
    begin
     ReadRecordBuffer(RecordNo, Dest,False);
     Exit;
    end;
    IRecordNo:=p^.InternalNo;
    ss:=FLogStringData;
    BlockIndex:=(IRecordNo-1) div FRecInBlock;
    if BlockIndex>=ChangesBlockCount then
     raise EMemManagerError.Create('Can''t read LogBuffer.Incorrect RecordNo');
   PosInBlock:= ((IRecordNo-1) mod FRecInBlock)*FRecordSize;
  end
  else
  begin
    ss:=FStringData;
    BlockIndex:=RecordBlock(IRecordNo,False,True);
    if BlockIndex>=BlockCount then
     raise EMemManagerError.Create('Can''t read Buffer.Incorrect RecordNo');
    PosInBlock:=RecordPosition(IRecordNo,True);
  end;
  if Old  then
   Cache:=PChar(FChangeLog.List^[BlockIndex])+PosInBlock
  else
   Cache:=PChar(FBlocks.List^[BlockIndex])+PosInBlock;
  if (FStrFieldCount=0) then
   Move(Cache^,Dest^,FRecordSize)
  else
  begin
    Move(Cache[0],Dest[0],FStringFieldOffsets^[1]);
    for i := 1 to FStrFieldCount do
    begin
      ps:=ss.PValue[i-1,IRecordNo-1];
      L:=Length(ps^);
      if L>FStringFieldSize^[i] then
      begin
       L:=FStringFieldSize^[i];
       SetLength(ps^,L);       
      end;
      PInteger(@Dest[FStringFieldOffsets^[i]])^:=L; // LengthExp
      if (L>0)  then
      begin
       Move(ps^[1],Dest[FStringFieldOffsets^[i]+SizeOf(Integer)],L);
      end;
      if L<FStringFieldSize^[i] then
       Dest[FStringFieldOffsets^[i]+L+SizeOf(Integer)]:=#0;
    end;
    if FRecordSize>FStringFieldOffsets^[1] then //Blobs
     Move(Cache[FStringFieldOffsets^[1]],
      Dest[FStringFieldOffsets^[FStrFieldCount]+SizeOf(Integer)+FStringFieldSize^[FStrFieldCount]],
      FRecordSize-FStringFieldOffsets^[1]
     );
  end;
end;

procedure TRecordsCache.WriteRecord(RecordNo: integer;
  const Source: PChar; ForceAllocMem: boolean );
var
   BlockIndex:integer;
   PosInBlock:integer;
   Cache:PChar;
   L,i:integer;
   ps:PString;
begin
  BlockIndex:=RecordBlock(RecordNo,ForceAllocMem);
  if BlockIndex<BlockCount then
  begin
    PosInBlock:=RecordPosition(RecordNo);
    Cache:=PChar(FBlocks.List^[BlockIndex])+PosInBlock;
    if Source=nil then
     FillChar(Cache^,FRecordSize,0)
    else
    begin
     if (FStrFieldCount=0) then
      Move(Source[0],Cache[0],FRecordSize)
     else
     begin
      Move(Source[0],Cache[0],FStringFieldOffsets^[1]);
      Move(Source[FStringFieldOffsets^[FStrFieldCount]+FStringFieldSize^[FStrFieldCount]+SizeOf(Integer)],
       Cache[FStringFieldOffsets^[1]],   FRecordSize-FStringFieldOffsets^[1]
      );
     end;
     if Assigned(FStringData) then
     begin
       RecordNo:=InternalRecordNo(RecordNo);
       for i := 1 to FStrFieldCount do
       begin
         if FStringData.CountY<=RecordNo then
          FStringData.Add;
         ps:=FStringData.PValue[i-1,RecordNo-1];
         L:=PInteger(@Source[FStringFieldOffsets^[i]])^;
         if L<>Length(ps^) then
          SetLength(ps^,L);
         if L>0 then
          Move(Source[FStringFieldOffsets^[i]+SizeOf(Integer)],ps^[1],L);
       end;
     end
    end;
  end
  else
   raise EMemManagerError.Create('Can''t write to Buffer.Incorrect RecordNo');
end;

function TRecordsCache.InternalRecordNo(const RecordNo: integer): integer;
begin
 if Assigned(FMapRecords) then
  if RecordNo<=FMapRecords.Count then
   Result :=Integer(FMapRecords.List^[RecordNo-1])
  else
   Result := -1
 else
  Result :=RecordNo
end;



function TRecordsCache.GetSize: integer;
begin
 Result:=BlockCount*FBlockSize;
end;

procedure TRecordsCache.SetStrOffset(Index, Offset,DataSize: integer);
begin
 if Assigned(FStringFieldOffsets) and Assigned(FStringData )then
 if (Index<=FStringData.HighX) and (Index>0) then
 begin
     FStringFieldOffsets^[Index]:=Offset;
     FStringFieldSize^[Index]   :=DataSize;
 end;
end;


procedure TRecordsCache.WriteField(RecordNo, FieldOffSet: integer;
  const Data: PChar; SizeData: integer);
var
 BlockIndex:integer;
 PosInBlock:integer;
 Cache:PChar;
begin
  BlockIndex:=RecordBlock(RecordNo,False);
  if BlockIndex<BlockCount then
  begin
    PosInBlock:=RecordPosition(RecordNo);
    Cache:=PChar(FBlocks.List^[BlockIndex])+PosInBlock+FieldOffSet;
    if Data=nil then
     FillChar(Cache^,SizeData,0)
    else
     Move(Data[0],Cache^,SizeData);
  end
  else
   raise EMemManagerError.Create('Can''t write to Field to Buffer.Incorrect RecordNo');
end;

function  TRecordsCache.GetStringFieldData(RecordNo,StrIndex:integer):Pointer;
begin
// 锐镱朦珞弪