fibcachemanage.pas

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 }
{***************************************************************}

unit FIBCacheManage;


interface
 uses SysUtils,pFIBLists,Classes;

{$I FIBPlus.inc}
type

  TBlockArray =array[0..0] of PChar;
  PBlockArray =^TBlockArray;
  TIntArray   =array[1..1] of integer;
  PIntArray   =^TIntArray;

  TRecordPosition = record
   RecordNo  :integer;
   InternalNo:integer;
  end;
  PRecordPosition=^TRecordPosition;
  TRecPositions = array[1..1] of TRecordPosition;
  PRecPositions =^TRecPositions;

  TRecordsCache = class
  private
   FMapRecords    :TList;
   FStringData    :TStringCollection;
   FLogStringData :TStringCollection;
   FBlocks     :TList;
   FChangeLog  :TList;
   FChangesPositions: PRecPositions;
   FOldBufRecordNumber:integer;
   FOldBuffer  :PChar;
   FBlockSize  :integer;
   FRecordSize :Integer;
   FInOutRecordSize:integer;
   FRecordCount :integer;
   FChangesCount:integer;
   FStringFieldOffsets :PIntArray;
   FStringFieldSize    :PIntArray;
   FRecInBlock    :Integer;
   FStrFieldCount :Word;
   FSaveChangeLog :boolean;
   procedure   SetBlockCount(NewCount: Integer);
   function    GetBlockCount:integer;
   procedure   SetChangeLogBlockCount(NewCount: Integer);
   function    InternalRecordNo(const RecordNo: integer):integer;
   function    GetSize: integer;
   function    GetChangePosition(aRecordNo: integer; Force:boolean):PRecordPosition;
//   procedure   ReadRecordBuffer(RecordNo:integer;var Dest:PChar;Old:boolean);
   function    FindChangeRecNo(const ARecno:integer; var Index:integer):boolean ;
   procedure   InitializeMap;
   function    GetChangesBlockCount: integer;
  public
   constructor Create(aBlockRecCount,aRecordSize,aBlockReadSize,aStrCount:integer);
   destructor  Destroy; override;
   procedure   ShiftMapValues(Distance:integer);
   procedure   Assign(SourceCache:TRecordsCache);
   function    CreateNewBlock:integer;
   function    PrepareMemory(RecordNo:integer):PChar;
   function    MemoryPrepared(RecordNo:integer):boolean;
   function    PRecBuffer(const RecordNo:integer; Old: boolean):PChar;
   function    RecordPosition(const RecordNo:integer;IsInternalRecno:boolean=False):integer;
   function    RecordBlock(const RecordNo:integer;ForceAllocMem: boolean;IsInternalRecno:boolean=False):integer;
   procedure   SetStrOffset(Index:integer;Offset,DataSize:integer);
   function    Capacity:integer;
   procedure   ReadRecord(const RecordNo:integer;var Dest:PChar);
   procedure   ReadRecordBuffer(RecordNo:integer;var Dest:PChar;Old:boolean);
   function    GetFieldData(RecordNo,FieldOffSet,StrIndex:integer;Var RecordData:Pointer):Pointer;
   function    GetStringFieldData(RecordNo,StrIndex:integer):Pointer;
   function    GetNonStringFieldData(RecordNo,FieldOffSet:integer;Var RecordData:Pointer):Pointer;

   function    GetNextRecordData(CurRec:Pointer;var CurBlock:integer):Pointer;

   procedure   WriteRecord(RecordNo:integer;const Source:PChar;ForceAllocMem: boolean);
   procedure   WriteField(RecordNo,FieldOffSet:integer;const Data:PChar;SizeData:integer);
   procedure   SetStringValue(Index,RecordNo:integer; const Value:string);
   procedure   SetStringFromPChar(Index,RecordNo:integer; const Value:PChar; Len:integer;Triming:boolean);
   procedure   SaveOldBuffer  (RecordNo:integer);
   procedure   ClearOldBuffer;
   procedure   SaveToChangeLog(aRecordNo:integer);
   function    OldBuffer(RecordNo:integer):PChar;
   function    pRecBuff(RecordNo:integer):PChar;
   procedure   RevertRecord(aRecordNo:integer);
   procedure   ClearLog;
                       
   procedure   SwapRecords(OldRecordNo,NewRecordNo:integer);
   procedure   MoveRecord(OldRecno,NewRecno:integer);


   procedure   SaveToStream(Stream:TStream; SeekBegin :boolean );
   procedure   LoadFromStream(Stream:TStream; SeekBegin :boolean );
   procedure   Insert(RecordNo:integer);
   procedure   CancelInsert(RecordNo:integer);
   function    BookMarkByRecord(RecordNo:integer):integer;
   function    RecordByBookMark(BookMark:integer):integer;
   function    BookMarkValid(BookMark:integer):boolean;
   property    ChangesBlockCount:integer read GetChangesBlockCount write SetChangeLogBlockCount; 
  public
   property    RecordSize:Integer read FRecordSize;
   property    BlockCount:integer read GetBlockCount write SetBlockCount;
   property    RecordCount:integer read FRecordCount;
   property    Size:integer read GetSize;
   property    SaveChangeLog :boolean read FSaveChangeLog  write FSaveChangeLog;
  end;

  EMemManagerError=class(Exception);

const
  MinBlockSize=1024;

implementation

uses StdFuncs,StrUtil;
{ TRecordsCache }

{$IFNDEF D6+}
type
 PInteger=^Integer;
{$ENDIF}
constructor TRecordsCache.Create(aBlockRecCount,aRecordSize,aBlockReadSize,aStrCount:integer);
var
    aBlockSize:integer;
begin

 FOldBufRecordNumber:=-1;
 FRecordSize      :=aBlockReadSize;
 FInOutRecordSize :=aRecordSize;
 aBlockSize       :=aBlockRecCount*FRecordSize ;
 if aBlockSize<MinBlockSize then
   aBlockSize:=MinBlockSize+ aRecordSize-(MinBlockSize mod aRecordSize);

 if (aBlockSize < FRecordSize) then
  raise EMemManagerError.Create('Incompatible Sizes');
 FBlocks        :=nil;
 FBlocks        :=TList.Create;
 FBlockSize     :=aBlockSize;
 FRecordCount:=0;
 FRecInBlock :=FBlockSize div FRecordSize;
 FLogStringData :=nil;
 if aStrCount>0 then
 begin
   FStrFieldCount :=aStrCount;
   FStringData    :=TStringCollection.Create(aStrCount);
   GetMem(FStringFieldOffsets , aStrCount * SizeOf(Integer));
   GetMem(FStringFieldSize    , aStrCount * SizeOf(Integer));
 end
 else
 begin
   FStrFieldCount :=0;
   FStringData :=nil;
   FStringFieldOffsets:=nil;
 end;

 GetMem(FOldBuffer , FInOutRecordSize);
 if FInOutRecordSize>0 then
  FillChar(FOldBuffer[0],FInOutRecordSize,1); // NullValues

 FChangeLog    :=nil;
 FChangesPositions:=nil;

 FChangesCount :=0;
 FSaveChangeLog:=False;
 FMapRecords  :=nil;
end;

destructor TRecordsCache.Destroy;
var
  i:integer;
begin
  for i := 0 to BlockCount - 1 do
   FreeMem(FBlocks.List^[i]);
  for i := 0 to ChangesBlockCount - 1 do
   FreeMem(FChangeLog.List^[i]);

  ReallocMem(FStringFieldOffsets,0);
  ReallocMem(FChangesPositions,0);
  ReallocMem(FStringFieldSize,0);
  FreeMem(FOldBuffer);

  FStringData    .Free;
  FLogStringData .Free;

  FBlocks    .Free;
  if FChangeLog<>nil then
   FChangeLog .Free;
  FMapRecords.Free;
  inherited;
end;



procedure TRecordsCache.Assign(SourceCache: TRecordsCache);
var
    i,j:integer;
    ExistingBlockCount:integer;
    ExistingCheckBlockCount:integer;
    p:Pointer;
begin
  if FBlockSize<>SourceCache.FBlockSize then
  begin
    for i := 0 to BlockCount - 1 do
    begin
      FreeMem(FBlocks.List^[i]);
    end;
    for i := 0 to ChangesBlockCount - 1 do
    begin
      FreeMem(FChangeLog.List^[i]);
    end;

    FBlocks.Clear;
    if FChangeLog<>nil then
     FChangeLog.Clear;
  end;

  if BlockCount>=SourceCache.BlockCount then
  begin
    for i := BlockCount-1 downto SourceCache.BlockCount do
      FreeMem(FBlocks.List^[i]);
    FBlocks.Count:=SourceCache.BlockCount;
    ExistingBlockCount:=SourceCache.BlockCount
  end
  else
   ExistingBlockCount:=BlockCount;


  if ChangesBlockCount>=SourceCache.ChangesBlockCount then
  begin
    for i := ChangesBlockCount-1 downto SourceCache.ChangesBlockCount  do
      FreeMem(FChangeLog.List^[i]);
    ExistingCheckBlockCount:=SourceCache.ChangesBlockCount
  end
  else
   ExistingCheckBlockCount:=ChangesBlockCount;

    FBlockSize:=SourceCache.FBlockSize;
    FBlocks.Count:=SourceCache.BlockCount;
    ChangesBlockCount:=SourceCache.ChangesBlockCount;

    for i := 0 to BlockCount - 1 do
    begin
      if i>=ExistingBlockCount then
       FBlocks.List^[i]:=nil;
      if Assigned(FBlocks.List^[i]) then
      begin
        p:=FBlocks.List^[i];
        ReallocMem(p,FBlockSize);
        FBlocks.List^[i]:=p;
      end
      else
       FBlocks.List^[i]:=AllocMem(FBlockSize);
      Move(SourceCache.FBlocks.List^[i]^,FBlocks.List^[i]^,FBlockSize);
    end;

    for i := 0 to ChangesBlockCount - 1 do
    begin
      if i>=ExistingCheckBlockCount then FChangeLog.List^[i]:=nil;
      p:=FChangeLog.List^[i];
      ReallocMem(p,FBlockSize);
      FChangeLog.List^[i]:=p;
      Move(SourceCache.FChangeLog.List^[i]^,FChangeLog.List^[i]^,FBlockSize);
    end;

  FChangesCount:=SourceCache.FChangesCount;
  ReallocMem(FChangesPositions,FChangesCount* SizeOf(TRecordPosition));
  for i := 1 to FChangesCount do
  begin
   FChangesPositions^[i].RecordNo:=SourceCache.FChangesPositions^[i].RecordNo;
   FChangesPositions^[i].InternalNo:=SourceCache.FChangesPositions^[i].InternalNo;
  end;

  FStrFieldCount :=SourceCache.FStrFieldCount;
  ReallocMem(FStringFieldOffsets , FStrFieldCount * SizeOf(Integer));
  ReallocMem(FStringFieldSize    , FStrFieldCount * SizeOf(Integer));


  FStringData.Free;
  FLogStringData .Free;
  if FStrFieldCount>0 then
  begin
    for i := 1 to FStrFieldCount do
    begin
      FStringFieldOffsets^[i]:=SourceCache.FStringFieldOffsets^[i];
      FStringFieldSize^[i]   :=SourceCache.FStringFieldSize^[i];
    end;
    FStringData   :=TStringCollection.Create(FStrFieldCount);