Home > Delphi > My own database engine – check it out

My own database engine – check it out

Clientdataset? Whos that?

Clientdataset? Whos that?

Right, you are probably going to think me mad, but yes — i have coded my own database engine. And the core engine is simple, effective and very very cool! Before you jump to conclusions let me warn you that I havent added SQL support yet, but the fundamental engine of records, record lists, file-block management and the rest is there.

You will need the latest version of Byterage to compile it — but give me a few days to clean it up and you can play around with it.

And it works in both memory and disk – since everything is handled by a normal stream. Here is how you post some data to it:

procedure TForm1.Button4Click(Sender: TObject);
var
  mTable: TSRLTable;
  x:  Integer;
  mStart: TDateTime;
begin
  mTable:=TSRLTable.Create;
  try
  mTable.FieldDefs.WriteStr('name','');
  mTable.FieldDefs.WriteInt('value',0);
  mTable.Open('c:\temp\mydb.dbx',baCreate);

  if mTable.Lock(lmAppend) then
  Begin
    try
      mStart:=now;
      for x:=1 to 10000 do
      Begin
        mTable.Cursor.WriteStr('name','This is very cool #' + IntToStr(x));
        mtable.Cursor.WriteInt('value',1200);
        mTable.Post;
      end;
    finally
      mTable.UnLock;
    end;
  end;

And here is the engine itself. A bit of a brain teaser, but fun to play with. Now to add SQL support and wrap it in a TDataset decendant.

  unit qtxdb;

  {.$INCLUDE srldef.inc}

  {.$DEFINE SRL_DB_DISKLIST}
  {$DEFINE SRL_DB_SEEKBUFFER}

  interface

  uses sysutils, classes, System.Generics.Collections,
  brage, qtxobj;

  //##########################################################################
  // Constants
  //##########################################################################

  Const

  SRL_PageFile_PageSize     = 1024;
  SRL_PageFile_BitsTotal    = 8000000; // maximum pages (can be set to 8xx}
  SRL_PageFile_BitsBytes    = SRL_PageFile_BitsTotal div 8;
  SRL_PageFile_BitsPages    = SRL_PageFile_BitsBytes div SRL_PageFile_PageSize;
  SRL_PageFile_InvalidPage  = 0;

  SRL_PageFile_SeekRange    = SRL_PageFile_PageSize * 4;

  ERR_SRL_PAGEFILE_NOTACTIVE
  = 'Invalid operation, file is not active error';

  ERR_SRL_PAGEFILE_FILENOTFOUND
  = 'Invalid file name (%s), file not found error';

  ERR_SRL_PAGEFILE_NOTWRITEMODE
  = 'Invalid access mode, write not permitted error';

  ERR_SRL_SEQFILE_InvalidWriteData
  = 'Failed to write sequence #%d, data object is empty or NIL error';

  ERR_SRL_SEQFILE_NotActive
  = 'Operation failed, file is not active error';

  //##########################################################################
  // Unit exceptions
  //##########################################################################

  type

  ESRLPageFile        = Class(Exception);
  ESRLSequenceFile    = Class(Exception);
  ESRLTable           = Class(Exception);

  //##########################################################################
  // Forward declarations
  //##########################################################################

  TSRLTable           = Class;
  TSRLPageFile        = Class;
  TSRLSequenceFile    = Class;

  (*
  TSRLRecordFieldDef = Class(TBRPersistent)
  Private
    FFieldClass:  TSRLRecordFieldClass;
    FFieldName:   AnsiString;
    FFieldLen:    TSRLInt;
    FReadOnly:    Boolean;
    Procedure     SetFieldClass(Const Value:TSRLRecordFieldClass);
    Procedure     SetFieldName(Value:AnsiString);
    Procedure     SetFieldLen(Const Value:TSRLInt);
  Protected
    Procedure     BeforeReadObject;Override;
    Procedure     ReadObject(Const Reader:TSRLReader);Override;
    Procedure     WriteObject(Const Writer:TSRLWriter);Override;
    Procedure     SetReadOnly(Const Value:TSRLBool);
  Public
    Property      FieldClass:TSRLRecordFieldClass
                  read FFieldClass write SetFieldClass;
    property      FieldName:AnsiString read FFieldName write SetFieldName;
    Property      Length:TSRLInt read FFieldLen write SetFieldLen;
    Constructor   Create(Const Owner:TSRLRecordFieldDefs);reintroduce;
  End;

  TSRLRecordFieldDefs = Class(TSRLPersistent,ISRLRecordFieldDefs)
  Private
    {$IFNDEF SRL_USE_LISTS}
    FObjects:   TSRLObjList;
    {$ELSE}
    FObjects:   TObjectList;
    {$ENDIF}
    FReadOnly:  Boolean;
    Function    GetItem(Const Index:TSRLInt):TSRLRecordFieldDef;
    Procedure   SetItem(Const Index:TSRLInt;
                Const Value:TSRLRecordFieldDef);
    Function    GetCount:TSRLInt;
  Protected
    Procedure   SetReadOnly(Const Value:TSRLBool);
    Procedure   BeforeReadObject;Override;
    Procedure   ReadObject(Const Reader:TSRLReader);Override;
    Procedure   WriteObject(Const Writer:TSRLWriter);Override;
  Public
    property    Count:TSRLInt read GetCount;
    Property    Items[Const Index:TSRLInt]:TSRLRecordFieldDef
                Read GetItem write SetItem;default;
    Function    Add(Const AFieldName:AnsiString;
                Const AFieldClass:TSRLRecordFieldClass;
                Const ALength:TSRLInt=0):TSRLRecordFieldDef;

    Function    IndexOf(Const Value:TSRLRecordFieldDef):Integer;
    Function    ObjectOf(AFieldName:String):TSRLRecordFieldDef;

    Procedure   Delete(Const Index:TSRLInt);overload;
    procedure   Delete(Const Value:TSRLRecordFieldDef);overload;
    Procedure   Clear;
    Constructor Create;override;
    Destructor  Destroy;Override;
  End;    *)

  //##########################################################################
  // Custom datatypes
  //##########################################################################

  TLongArray = Array of Longword;

  PSRLPageData = ^TSRLPageData;
  TSRLPageData = Packed Record
    pdUsedBytes:  Integer;
    pdPrevPage:   Longword;
    pdNextPage:   Longword;
    pdData:       Array[1..SRL_PageFile_PageSize-12] of Byte;
  End;

  TSRLSearchRec = Packed Record
    srId:         Integer;
    srCurrent:    Integer;
    srFieldName:  String;
    srKeyword:    String;
  End;

  TSRLBinaryAccessMode  = (baNone,baCreate,baRead,baReadWrite);
  TSRLBinaryRequirement = set of (brHeadWrite,brHeadRead);
  TSRLTableLockMode     = (lmNone,lmRead,lmWrite,lmAppend,lmInsert);
  TSRLTableOptions      = Set of (toCompress,toAutoCompact);

  //##########################################################################
  // Events
  //##########################################################################

  (* Pagefile events *)
  TSRLPageFileBeforeOpenEvent   = TNotifyevent;
  TSRLPageFileBeforeCloseEvent  = TNotifyevent;
  TSRLPageFileAfterOpenEvent    = TNotifyevent;
  TSRLPageFileAfterCloseEvent   = TNotifyevent;

  (* table events *)
  TSRLTableLockedEvent = Procedure
  (Const Sender:TObject;Const LockMode:TSRLTableLockMode) of Object;

  TSRLTableWriteDescriptorEvent = Procedure
  (Const Sender:TObject;Const Writer:TBRWriter) of Object;

  TSRLTableReadDescriptorEvent = Procedure
  (Const Sender:TObject;Const Reader:TBRReader) of Object;

  TSRLTableCompactingBeginsEvent  = TNotifyevent;
  TSRLTableCompactingEndsEvent    = TNotifyevent;
  TSRLTableCompactProgressEvent   = Procedure (Const Sender:TObject;
                                    BytesCompacted:Integer) of Object;

  //##########################################################################
  // TBRBitBuffer
  //##########################################################################

  TBRBitBuffer = Class(TBRPersistent)
  Private
    FData:      Pointer;
    FDataLng:   Integer;
    FDataLen:   Integer;
    FBitsMax:   Longword;
    FReadyByte: Longword;
    FAddr:      PByte;
    BitOfs:     0..255;
    FByte:      Byte;
    Function    GetByte(Const Index:Integer):Byte;
    Procedure   SetByte(Const Index:Integer;Const Value:Byte);
    Function    GetBit(Const Index:Longword):Boolean;
    Procedure   SetBit(Const Index:Longword;Const Value:Boolean);
  Protected
    Procedure   BeforeReadObject;Override;
    procedure   ReadObject(Const Reader:TBRReader);override;
    procedure   WriteObject(Const Writer:TBRWriter);override;
  Public
    Property    Data:Pointer read FData;
    Property    Size:Integer read FDataLen;
    Property    Count:Longword read FBitsMax;
    Property    Bytes[Const Index:Integer]:Byte
                Read GetByte write SetByte;
    Property    Bits[Const Index:Longword]:Boolean
                Read GetBit write SetBit;default;

    Procedure   Allocate(MaxBits:Integer);
    Procedure   Release;
    Function    Empty:Boolean;
    Procedure   Zero;
    Procedure   SetBitRange(First,Last:Longword;
                Const Bitvalue:Boolean);
    Procedure   SetBits(Const Value:Array of longword;
                Const BitValue:Boolean);
    Function    FindIdleBit(var Value:Longword;
                Const FromStart:Boolean=False):Boolean;
    Destructor  Destroy;Override;
  End;

  //##########################################################################
  // Class declarations
  //##########################################################################

  TSRLPageFile = Class(TBRPersistent)
  Private
    //FBitBuffer:     TBRBufferMemory;
    //FBitmap:        TBRBitAccess;
    FBitmap:        TBRBitBuffer;
    FFile:          TStream;
    FRequires:      TSRLBinaryRequirement;
    FFileMode:      TSRLBinaryAccessMode;
    FFilename:      AnsiString;
    FActive:        Boolean;
    FInMemory:      Boolean;
    FOnBeforeOpen:  TSRlPageFileBeforeOpenEvent;
    FOnBeforeClose: TSRlPageFileBeforeCloseEvent;
    FOnAfterOpen:   TSRlPageFileAfterOpenEvent;
    FOnAfterClose:  TSRlPageFileAfterCloseEvent;
  Private
    Function        GetCount:Longword;
    Procedure       WriteHeaderData;
    Procedure       ReadHeaderData;
    Procedure       WriteBitBuffer;
    Procedure       ReadBitBuffer;
  Protected
    Procedure   SetCurrentPage(Const Value:Longword);
    Function    GetCurrentPage:Longword;
    Function    GetPageCount:Longword;
    Function    GetIdlePage(Const AllowGrow:Boolean=True):Longword;
    Function    ReadPage(Const PageIndex:Longword;
                var Buffer:TSRLPageData):Longword;
    Procedure   WritePage(Const PageIndex:Longword;Const Buffer:TSRLPageData);
    Function    GrowPageFile(Value:Longword):Longword;
    Procedure   ShrinkPageFile(Value:Longword);
  Protected
    (* Event dispatchers *)
    Procedure   SignalBeforeOpen;
    Procedure   SignalBeforeClose;
    Procedure   SignalAfterOpen;
    Procedure   SignalAfterClose;
  Protected
    Procedure   DoBeforeOpen;virtual;
    procedure   DoAfterOpen;virtual;
    Procedure   DoBeforeClose;virtual;
    Procedure   DoAfterClose;virtual;
    Procedure   DoWriteHeader(Const Writer:TBRWriter);virtual;
    Procedure   DoReadHeader(Const Reader:TBRReader);virtual;
  Protected
    Procedure   AddRequirement(Const Value:TSRLBinaryRequirement);
    Procedure   DelRequirement(Const Value:TSRLBinaryRequirement);
    Procedure   ApplyRequirements;
  Protected
    Property    OnBeforeOpen:TSRlPageFileBeforeOpenEvent
                Read FOnBeforeOpen write FOnBeforeOpen;

    Property    OnBeforeClose:TSRlPageFileBeforeCloseEvent
                Read FOnBeforeClose write FOnBeforeClose;

    Property    OnAfterOpen:TSRlPageFileAfterOpenEvent
                Read FOnAfterOpen write FOnAfterOpen;

    Property    OnAfterClose:TSRlPageFileAfterCloseEvent
                Read FOnAfterClose write FOnAfterClose;

    Property    Filename:AnsiString read FFilename;
  Public
    //Property    Bitmap:TBRBitAccess read FBitmap;
    Property    Bitmap:TBRBitBuffer read FBitmap;
    Property    Active:Boolean read FActive;
    Property    AccessMode:TSRLBinaryAccessMode read FFileMode;
    Property    PageCount:Longword read GetCount;
    Property    InMemory:Boolean read FInMemory;

    Procedure   Open(Const Filename:AnsiString;
                Const AccessMode:TSRLBinaryAccessMode = baReadWrite);overload;
    Procedure   Open;overload;
    Procedure   Close;

    Procedure   SaveToFile(Const Filename:String);

    Procedure   BeforeDestruction;Override;
    Constructor Create;override;
    Destructor  Destroy;Override;
  End;

  TSRLSequenceFile = Class(TSRLPageFile)
  Private
    FSeqStart:    Longword;

    {$IFDEF SRL_DB_DISKLIST}
    FSeqList:     LongwordFileList;
    {$ELSE}
    FSeqList:     TList<Longword>;
    {$ENDIF}

    FOnCompBegins:    TSRLTableCompactingBeginsEvent;
    FOnCompEnds:      TSRLTableCompactingEndsEvent;
    FOnCompProgress:  TSRLTableCompactProgressEvent;

    Function      AppendSequenceEx(Const Data:TBRBuffer):Longword;
    Procedure     ReleaseSequenceEx(Const StartPage:Longword);
    Procedure     ReadSequenceEx(Const StartPage:Longword;
                  Const Data:TBRBuffer);
    Function      GetSequence(Const Index:Integer):Longword;
    Function      GetSequenceCount:Integer;
  Protected
    Procedure     SignalCompactingBegins;
    Procedure     SignalCompactingProgress(Value:Integer);
    Procedure     SignalCompactingEnds;
  Protected
    Procedure     DoWriteDescriptor(Const Writer:TBRWriter);Virtual;
    Procedure     DoReadDescriptor(Const Reader:TBRReader);Virtual;
    Procedure     DoWriteHeader(Const Writer:TBRWriter);override;
    Procedure     DoReadHeader(Const Reader:TBRReader);override;
    Procedure     DoAfterOpen;Override;
    Procedure     DoBeforeClose;Override;
    Procedure     DoBeforeOpen;Override;
    Procedure     DoAfterClose;Override;
  Protected
    Function      AppendSequence(Const Data:TBRBuffer):Integer;
    Procedure     ReplaceSequence(Const Index:Integer;Const Data:TBRBuffer);
    Procedure     ReadSequence(Const Sequence:Integer;Const Data:TBRBuffer);
    Procedure     WriteSequence(Const Index:Integer;Const Data:TBRBuffer);
    Procedure     ReleaseSequence(Const Sequence:Integer);

    Function      GetSequencePages(Sequence:Integer;
                  var Value:TLongArray):Boolean;
  Protected
    Property      Sequence[Const Index:Integer]:Longword read GetSequence;
    Property      Count:Integer read GetSequenceCount;
  Public
    Procedure     Compact;
    Constructor   Create;override;
    Destructor    Destroy;Override;
  Public
    Property      OnCompactingBegins:TSRLTableCompactingBeginsEvent
                  read FOnCompBegins write FOnCompBegins;
    Property      OnCompactingEnds:TSRLTableCompactingEndsEvent
                  read FOnCompEnds write FOnCompEnds;
    Property      OnCompactProgress:TSRLTableCompactProgressEvent
                  read FOnCompProgress write FOnCompProgress;
  End;

  TSRLTable = Class(TSRLSequenceFile)
  Private
    FRecNo:     Integer;
    FLockMode:  TSRLTableLockMode;
    FCurDat:    TBRBuffer;
    FCursor:    TBRRecord;
    FDefs:      TBRRecord;
    FOptions:   TSRLTableOptions;
    Procedure   SetOptions(Value:TSRLTableOptions);
    Procedure   SetFieldDefs(Value:TBRRecord);
  Private
    FOnLocked:      TSRLTableLockedEvent;
    FOnWriteHeader: TSRLTableWriteDescriptorEvent;
    FOnReadHeader:  TSRLTableReadDescriptorEvent;
  Private
    Function    GetRecordIndex:Integer;
    Procedure   SetRecordIndex(Const Value:Integer);
    Function    GetRecordCount:Integer;
  Protected
    Procedure   WriteRecord(Const Data:TBRBuffer;
                Const Disposable:Boolean=False);
    Procedure   ReadRecord(Const Data:TBRBuffer);
  Protected
    Procedure   SignalTableLocked;
    procedure   DoAfterOpen;override;
    Procedure   DoAfterClose;override;
    Procedure   DoWriteDescriptor(Const Writer:TBRWriter);override;
    Procedure   DoReadDescriptor(Const Reader:TBRReader);override;
  Public
    Property    Options:TSRLTableOptions
                read FOptions write SetOptions;
    Property    FieldDefs:TBRRecord
                read FDefs write SetFieldDefs;

    { Property    Reader:TSRLRecordReader read FRecRead;
    Property    Writer:TSRLRecordWriter read FRecWrite;  }

    Property    Cursor:TBRRecord read FCursor;

    Property    Filename;
    Property    LockMode:TSRLTableLockMode read FlockMode;
    Property    RecNo:Integer read GetRecordIndex write SetRecordIndex;
    Property    RecordCount:Integer read GetRecordCount;
    Function    BOF:Boolean;
    Function    EOF:Boolean;
    Function    First:Boolean;
    Function    Last:Boolean;
    Function    Next:Boolean;
    Function    Previous:Boolean;
    Procedure   Delete;

    Function    FindFirst(Keyword:String;FieldName:String;
                var SearchRec:TSRLSearchRec):Boolean;

    Function    FindNext(var SearchRec:TSRLSearchRec):Boolean;

    Procedure   Post(Const UnLockState:Boolean=False);

    Function    Lock(Const Value:TSRLTableLockMode):Boolean;
    Procedure   UnLock;

    Constructor Create;override;
    Destructor  Destroy;Override;
  Public
    Property    OnWriteDescriptor: TSRLTableWriteDescriptorEvent
                Read FOnWriteHeader write FOnWriteHeader;

    Property    OnReadDescriptor:TSRLTableReadDescriptorEvent
                Read FOnReadHeader write FOnReadHeader;

    Property    OnBeforeOpen;
    Property    OnBeforeClose;
    Property    OnAfterOpen;
    Property    OnAfterClose;
    Property    OnTableLocked:TSRLTableLockedEvent
                read FOnLocked write FOnLocked;
  End;

  implementation

  const

  ERR_SRLBitBuffer_InvalidBitIndex  =
  'Invalid bit index, expected 0..%d not %d';

  ERR_SRLBitBuffer_InvalidByteIndex =
  'Invalid byte index, expected 0..%d not %d';

  ERR_SRLBitBuffer_BitBufferEmpty =
  'Bitbuffer is empty error';

  //##########################################################################
  // TBRBitBuffer
  //##########################################################################

  Destructor TBRBitBuffer.Destroy;
  Begin
    If not Empty then
    Release;
    inherited;
  end;

  Procedure TBRBitBuffer.BeforeReadObject;
  Begin
    inherited;
    If FData<>NIL then
    Release;
  end;

  procedure TBRBitBuffer.ReadObject(Const Reader:TBRReader);
  Begin
    inherited;
    If Reader.ReadBool then
    Begin
      Allocate(Reader.ReadInt);
      Reader.Read(FData^,FDataLen);
    end;
  end;

  procedure TBRBitBuffer.WriteObject(Const Writer:TBRWriter);
  Begin
    inherited;
    Writer.WriteBool(Empty=False);
    If FData<>NIL then
    Begin
      Writer.WriteInt(FDataLen);
      Writer.Write(FData^,FDataLen);
    end;
  end;

  Function TBRBitBuffer.Empty:Boolean;
  Begin
    result:=FData=NIL;
  end;

  Function TBRBitBuffer.GetByte(Const Index:Integer):Byte;
  Begin
    If FData<>NIL then
    Begin
      If (index>=0) and (Index<FDataLen) then
      result:=PByte(PTR(FDataLng + index))^ else
      Raise Exception.CreateFmt
      (ERR_SRLBitBuffer_InvalidByteIndex,[FDataLen-1,index]);
    end else
    Raise Exception.Create(ERR_SRLBitBuffer_BitBufferEmpty);
  end;

  Procedure TBRBitBuffer.SetByte(Const Index:Integer;Const Value:Byte);
  Begin
    If FData<>NIL then
    Begin
      If (index>=0) and (Index<FDataLen) then
      PByte(PTR(FDataLng + index))^:=Value else
      Raise Exception.CreateFmt
      (ERR_SRLBitBuffer_InvalidByteIndex,[FDataLen-1,index]);
    end else
    Raise Exception.Create(ERR_SRLBitBuffer_BitBufferEmpty);
  end;

  Procedure TBRBitBuffer.SetBitRange(First,Last:Longword;
            Const Bitvalue:Boolean);

    procedure LSwap(var aFirst,aSecond:Longword);
    var
      mTemp:  Longword;
    Begin
      mTemp:=aSecond;
      aSecond:=aFirst;
      aFirst:=aSecond;
    end;

  Function  SRLDiff(Const Primary,Secondary:Longword;
            Const Exclusive:Boolean=False):Longword;
  Begin
    If Primary<>Secondary then
    Begin
      If Primary>Secondary then
      result:=Primary-Secondary else
      result:=Secondary-Primary;

      If Exclusive then
      If (Primary<1) or (Secondary<1) then
      inc(result);
    end else
    result:=0;
  end;

  var
    x:        Longword;
    FLongs:   Integer;
    FSingles: Integer;
    FCount:   Longword;
  Begin
    If FData<>NIL then
    Begin
      If  First<FBitsMax then
      Begin
        If Last<FBitsMax then
        Begin
          (* Conditional swap *)
          If First>Last then
          LSwap(First,Last);

          (* get totals, take ZERO into account *)
          FCount:=SRLDiff(First,Last,True);

          (* use refactoring & loop reduction *)
          FLongs:=Integer(FCount shr 3);

          x:=First;

          while FLongs>0 do
          Begin
            SetBit(x,Bitvalue);inc(x);
            SetBit(x,Bitvalue);inc(x);
            SetBit(x,Bitvalue);inc(x);
            SetBit(x,Bitvalue);inc(x);
            SetBit(x,Bitvalue);inc(x);
            SetBit(x,Bitvalue);inc(x);
            SetBit(x,Bitvalue);inc(x);
            SetBit(x,Bitvalue);inc(x);
            dec(FLongs);
          end;

          (* process singles *)
          FSingles:=Integer(FCount mod 8);
          while FSingles>0 do
          Begin
            SetBit(x,Bitvalue);inc(x);
            dec(FSingles);
          end;

        end else
        Begin
          If First=Last then
          SetBit(First,True) else
          Raise Exception.CreateFmt
          (ERR_SRLBitBuffer_InvalidBitIndex,[FBitsMax,Last]);
        end;
      end else
      Raise Exception.CreateFmt(ERR_SRLBitBuffer_InvalidBitIndex,
      [FBitsMax,First]);
    end else
    Raise Exception.Create(ERR_SRLBitBuffer_BitBufferEmpty);
  end;

  Procedure TBRBitBuffer.SetBits(Const Value:Array of longword;
            Const BitValue:Boolean);
  var
    x:      Integer;
    FCount: Integer;
  Begin
    If FData<>NIL then
    Begin
      FCount:=length(Value);
      If FCount>0 then
      Begin
        for x:=low(Value) to High(Value) do
        SetBit(Value[x],BitValue);
      end;
    end else
    Raise Exception.Create(ERR_SRLBitBuffer_BitBufferEmpty);
  end;

  Function  TBRBitBuffer.FindIdleBit(var Value:Longword;
            Const FromStart:Boolean=False):Boolean;
  var
    FOffset:  Longword;
    FBit:     Longword;
    FAddr:    PByte;
    x:        Integer;
  Begin
    result:=FData<>NIL;
    if result then
    Begin
      (* Initialize *)
      FAddr:=FData;
      FOffset:=0;

      If FromStart then
      FReadyByte:=0;

      If FReadyByte<1 then
      Begin
        (* find byte with idle bit *)
        While FOffset<Longword(FDataLen) do
        Begin
          If TBRBuffer.BitsSetInByte(FAddr^)=8 then
          Begin
            inc(FOffset);
            inc(FAddr);
          end else
          break;
        end;
      end else
      inc(FOffset,FReadyByte);

      (* Last byte exhausted? *)
      result:=FOffset<Longword(FDataLen);
      If result then
      Begin
        (* convert to bit index *)
        FBit:=FOffset shl 3;

        (* scan byte with free bit in it *)
        for x:=1 to 8 do
        Begin
          If not GetBit(FBit) then
          Begin
            Value:=FBit;

            (* more than 1 bit available in byte? remember that *)
            FAddr:=FData;
            inc(FAddr,FOffset);
            If TBRBuffer.BitsSetInByte(FAddr^)>7 then
            FReadyByte:=0 else
            FReadyByte:=FOffset;

            Break;
          end;
          inc(FBit);
        end;
      end;

    end;
  end;

  Function TBRBitBuffer.GetBit(Const Index:Longword):Boolean;
  begin
    If FData<>NIL then
    Begin
      If index<FBitsMax then
      Begin
        FAddr:=PTR(FDataLng + Integer(index shr 3));
        BitOfs:=Index mod 8;
        Result:=(FAddr^ and (1 shl (BitOfs mod 8))) <> 0;
      end else
      Raise Exception.CreateFmt
      (ERR_SRLBitBuffer_InvalidBitIndex,[Count-1,index]);
    end else
    Raise Exception.Create(ERR_SRLBitBuffer_BitBufferEmpty);
  end;

  Procedure TBRBitBuffer.SetBit(Const Index:Longword;Const Value:Boolean);
  begin
    If FData<>NIL then
    Begin
      If index<=FBitsMax then
      Begin
        FByte:=PByte(FDataLng + Integer(index shr 3))^;
        BitOfs:=Index mod 8;

        If Value then
        Begin
          (* set bit if not already set *)
          If (FByte and (1 shl (BitOfs mod 8)))=0 then
          Begin
            FByte:=(FByte or (1 shl (BitOfs mod 8)));
            PByte(FDataLng + Integer(index shr 3))^:=FByte;

            (* if this was the "ready" byte, then
               reset it to zero *)
            If (Index shr 3=FReadyByte)
            and (FReadyByte>0) then
            Begin
              If TBRBuffer.BitsSetInByte(FByte)>7 then
              FReadyByte:=0;
            end;

          end;
        end else
        Begin
          (* clear bit if not already clear *)
          If (FByte and (1 shl (BitOfs mod 8)))<>0 then
          Begin
            FByte:=(FByte and not (1 shl (BitOfs mod 8)));
            PByte(FDataLng + Integer(index shr 3))^:=FByte;

            (* remember this byte pos *)
            FReadyByte:=Index shr 3;
          end;
        end;

      end else
      Raise Exception.CreateFmt
      (ERR_SRLBitBuffer_InvalidBitIndex,[Count-1,index]);
    end else
    Raise Exception.Create(ERR_SRLBitBuffer_BitBufferEmpty);
  end;

  Procedure TBRBitBuffer.Allocate(MaxBits:Integer);

    Function SRLToNearest(Const Value,Factor:Integer):Integer;
    var
      FTemp: Integer;
    Begin
      Result:=Value;
      FTemp:=Value mod Factor;
      If FTemp>0 then
      inc(Result,Factor - FTemp);
    end;

  Begin
    (* release buffer if not empty *)
    If FData<>NIL then
    Release;

    If Maxbits>0 then
    Begin
      (* Round off to nearest byte *)
      MaxBits:=SRLToNearest(MaxBits,8);

      (* Allocate new buffer *)
      try
        FReadyByte:=0;
        FDataLen:=MaxBits shr 3;
        FData:=AllocMem(FDataLen);
        FDataLng:=Longword(FData);
        FBitsMax:=Longword(FDataLen shl 3);
      except
        on e: exception do
        Begin
          FData:=NIL;
          FDataLen:=0;
          FBitsMax:=0;
          FDataLng:=0;
          Raise;
        end;
      end;

    end;
  end;

  Procedure TBRBitBuffer.Release;
  Begin
    If FData<>NIL then
    Begin
      try
        FreeMem(FData);
      finally
        FReadyByte:=0;
        FData:=NIL;
        FDataLen:=0;
        FBitsMax:=0;
        FDataLng:=0;
      end;
    end;
  end;

  Procedure TBRBitBuffer.Zero;
  Begin
    If FData<>NIL then
    Fillchar(FData^,FDataLen,0) else
    Raise Exception.Create(ERR_SRLBitBuffer_BitBufferEmpty);
  end;

  //###########################################################################
  // TSRLTable
  //###########################################################################

  Constructor TSRLTable.Create;
  Begin
    inherited;
    FCurDat:=TBRBufferMemory.Create;
    FCursor:=TBRRecord.Create;
    //FCursor.Options:=[roExplicit];

    FOptions:=[]; //toCompress
    FDefs:=TBRRecord.Create;
    //FRecRead:=FCursor.Reader;
    //FRecWrite:=FCursor.Writer;
  end;

  Destructor TSRLTable.Destroy;
  Begin
    FDefs.free;
    FCursor.free;
    FCurDat.free;
    inherited;
  end;

  Function  TSRLTable.FindFirst(Keyword:String;FieldName:String;
            var SearchRec:TSRLSearchRec):Boolean;
  var
    FField: TBRRecordField;
    FText:  String;
  Begin
    (* initialize the search record *)
    Fillchar(SearchRec,SizeOf(TSRLSearchRec),#0);

    Result:=Active;
    If result then
    Begin

      If FLockmode=lmNone then
      Begin

      Keyword:=trim(Keyword);
      FieldName:=Trim(FieldName);
      Result:=length(Keyword)>0;
      If result then
      Begin

        Result:=Length(FieldName)>0;
        If result then
        Begin

          FField:=FieldDefs.ObjectOf(FieldName);
          Result:=FField<>NIL;
          If result then
          Begin
            SearchRec.srId:=$125F;
            SearchRec.srFieldName:=FieldName;
            SearchRec.srKeyword:=Keyword;

            result:=RecordCount>0;
            If result then
            Begin

              First;
              While not EOF do
              Begin
                SearchRec.srCurrent:=RecNo;
                Result:=Lock(lmRead);
                If result then
                Begin
                  try
                    FText:=FCursor.Fields[fieldname].asString;
                    //FText:=Reader.ReadString(FieldName);
                    Result:=pos(Keyword,FText)>=1;
                    If result then
                    Break;
                  finally
                    Unlock;
                  end;
                end;
                Next;
              end;

            end;

          end else
          Raise exception.Create('Search fieldname not found error');
        end else
        Raise exception.Create('Invalid search fieldname error');
      end else
      Raise exception.Create('Invalid search keyword error');

      end else
      Raise exception.Create('Invalid lock-mode for search operation error');

    end;
  end;

  Function  TSRLTable.FindNext(var SearchRec:TSRLSearchRec):Boolean;
  var
    FText:  String;
  Begin
    result:=SearchRec.srId=$125F;
    If result then
    Begin
      RecNo:=SearchRec.srCurrent;
      Next;
      While not EOF do
      Begin
        SearchRec.srCurrent:=RecNo;
        Result:=Lock(lmRead);
        If result then
        Begin
          try
            FText:=FCursor.Fields[SearchRec.srFieldName].asString;
            //FText:=Reader.ReadString(SearchRec.srFieldName);
            Result:=pos(SearchRec.srKeyword,FText)>=1;
            If result then
            Break;
          finally
            Unlock;
          end;
        end;
        Next;
      end;
    end;
  end;

  Procedure TSRLTable.SignalTableLocked;
  Begin
    If not QueryObjectState([osDestroying,osSilent])
    {If  not (osDestroying in ObjectState)
    and not (osSilent in ObjectState)    }
    and assigned(FOnLocked) then
    FOnLocked(Self,FLockMode);
  end;

  Procedure TSRLTable.DoReadDescriptor(Const Reader:TBRReader);
  var
    mAccess:  IBRPersistent;
  Begin
    inherited;
    FDefs.GetInterface(iBRPersistent,mAccess);
    mAccess.ObjectFrom(Reader);
    //IBRPersistent(FDefs).ObjectFrom(Reader);

    If assigned(FOnReadHeader) then
    FOnReadHeader(self,Reader);
  end;

  Procedure TSRLTable.DoWriteDescriptor(Const Writer:TBRWriter);
  var
    mAccess:  IBRPersistent;
  Begin
    inherited;
    FDefs.GetInterface(IBRPersistent,mAccess);
    mAccess.ObjectTo(Writer);
    //IBRPersistent(FDefs).ObjectTo(Writer);

    If assigned(FOnWriteHeader) then
    FOnWriteHeader(self,Writer);
  end;

  procedure TSRLTable.DoAfterOpen;
  Begin
    inherited;
    FRecNo:=-1;
    FCursor.Assign(FDefs);
    //FCursor.Allocate;
    //IBRRecordFieldDefs(FCursor.FieldDefs).SetReadOnly(True);
  end;

  Procedure TSRLTable.DoAfterClose;
  Begin
    inherited;
    FRecNo:=-1;
    //ISRLRecordFieldDefs(FCursor.FieldDefs).SetReadOnly(False);
    FCursor.Clear;
  end;

  Function TSRLTable.GetRecordCount:Integer;
  Begin
    If Active then
    result:=inherited GetSequenceCount else
    Raise exception.Create('Table is not active error');
  end;

  Function TSRLTable.GetRecordIndex:Integer;
  Begin
    result:=FRecNo;
  end;

  Procedure TSRLTable.SetFieldDefs(Value:TBRRecord);
  Begin
    If not Active then
    FDefs.Assign(Value);
  end;

  Procedure TSRLTable.SetOptions(Value:TSRLTableOptions);
  Begin
    If not Active then
    FOptions:=Value;
  end;

  Procedure TSRLTable.SetRecordIndex(Const Value:Integer);
  var
    FCount: Integer;
  Begin
    If Active then
    Begin
      If Value<>FRecNo then
      Begin
        If FLockmode=lmNone then
        Begin

          FCount:=GetSequenceCount;
          If  (Value>=0) and (Value<FCount) then
          FRecNo:=Value else

          If Value=-1 then
          FRecNo:=-1 else

          If Value=FCount then
          FRecNo:=Value else

          Raise exception.CreateFmt
          ('Invalid record index error: expected 0..%d, not %d',
          [FCount-1,Value]);

        end;

      end;
    end;
  end;

  Function TSRLTable.BOF:Boolean;
  Begin
    If Active then
    result:=FRecNo<0 else
    result:=False;
  end;

  Function TSRLTable.EOF:Boolean;
  Begin
    result:=not Active;
    if not result then
    Result:=FRecNo>GetSequenceCount-1;
  end;

  Function TSRLTable.First:Boolean;
  Begin
    Result:=active;
    If Result then
    Begin
      Result:=FLockMode=lmNone;
      If result then
      Begin
        Result:=GetSequenceCount>0;
        If Result then
        SetRecordIndex(0);
      end;
    end;
  end;

  Function TSRLTable.Last:Boolean;
  var
    FCount: Integer;
  Begin
    Result:=Active;
    If Result then
    Begin
      Result:=FLockMode=lmNone;
      If result then
      Begin
        FCount:=GetSequenceCount;
        Result:=FCount>0;
        If Result then
        SetRecordIndex(FCount-1);
      end;
    end;
  end;

  Function TSRLTable.Next:Boolean;
  Begin
    Result:=active;
    If Result then
    Begin

        Result:=(FLockMode in [lmNone,lmRead]);
        If result then
        Begin
          Result:=EOF=False;
          if result then
          Begin
            If BOF then
            SetRecordIndex(0) else

            SetRecordIndex(FRecNo + 1);
          end;
        end;

    end;
  end;

  Function TSRLTable.Previous:Boolean;
  Begin
    Result:=active;
    If Result then
    Begin
      Result:=GetSequenceCount>0;
      If Result then
      Begin
        Result:=FLockMode=lmNone;
        If result then
        Begin
          Result:=FRecNo>0;
          if result then
          SetRecordIndex(FRecNo - 1);
        end;
      end;
    end;
  end;

  Procedure TSRLTable.Delete;
  Begin
    If Active then
    Begin
      If FLockMode=lmNone then
      Begin
        (* Make sure accessmode supports a write-lock *)
        If (AccessMode in [baCreate,baReadWrite]) then
        Begin
          If (RecordCount>0) and (FRecNo>=0) then
          Begin
            ReleaseSequence(FRecNo);
            If FRecNo>=GetSequenceCount then
            dec(FRecNo);

            If toAutoCompact in FOptions then
            Compact;

          end else
          Raise Exception.Create('Invalid records number error');
        end else
        Raise Exception.Create('Invalid lock mode error, table does not allow modification');
      end else
      Raise Exception.Create('Invalid lock mode error');
    end;
  end;

  Function TSRLTable.Lock(Const Value:TSRLTableLockMode):Boolean;
  {var
    FTemp:  TSRLData;    }
  var
    mAccess:  IBRPersistent;
  Begin
    Result:=Active;
    if result then
    Begin
      Result:=FLockMode=lmNone;
      If result then
      Begin
        Result:=Value>lmNone;
        if result then
        Begin
          (* Make sure accessmode supports a write-lock *)
          If  (Value in [lmWrite,lmAppend,lmInsert]) then
          Result:=(AccessMode in [baCreate,baReadWrite]);

          If result then
          Begin
            (* make sure table can support a read-lock *)
            If (value=lmRead) then
            Result:=RecordCount>0;

            If result then
            Begin
              FLockmode:=Value;
              SignalTableLocked;

              If FLockMode=lmRead then
              Begin
                If (BOF=False) and (EOF=False) then
                Begin

                  try
                    ReadRecord(FCurDat);
                    if FCursor.GetInterface(IBRPersistent,mAccess) then
                    mAccess.ObjectFromData(FCurDat,false);
                    //(FCursor).ObjectFromData(FCurDat,false);
                  finally
                    FCurDat.Release;
                  end;

                end;
              end;
            end;

          end;
        end{ else
        Raise Exception.Create('Invalid lock mode error'); }
      end;
      //Raise Exception.Create('Table already in lock mode');
    end;
  end;

  Procedure TSRLTable.UnLock;
  Begin
    If Active then
    Begin
      If FLockMode>lmNone then
      Begin
        FLockMode:=lmNone;
        SignalTableLocked;
      end;
    end;
  end;

  Procedure TSRLTable.Post(Const UnLockState:Boolean=False);
  var
    mAccess: IBRPersistent;
  Begin
    If Active and (FLockmode in [lmAppend,lmInsert]) then
    Begin
      try
        FCurDat.Release;
        if FCursor.GetInterface(IBRPersistent,mAccess) then
        mAccess.ObjectToData(FCurDat);
        //IBRPersistent(FCursor).ObjectToData(FCurDat);
        WriteRecord(FCurDat,false);
      finally
        FCurDat.Release;
        If UnLockState then
        UnLock;
      end;
    end;
  end;

  Procedure TSRLTable.WriteRecord(Const Data:TBRBuffer;
            Const Disposable:Boolean=False);
  var
    FCount: Integer;
  Begin
    If Active then
    Begin
      If (FLockMode in [lmWrite,lmAppend,lmInsert]) then
      Begin
        If Data<>NIL then
        Begin

          try
            If toCompress in FOptions then
            Data.Compress;

            FCount:=GetSequenceCount;
            Case FLockMode of
            lmAppend:
              begin
                AppendSequence(Data);
                FRecNo:=FCount;
              end;
            lmWrite:
              begin
                If FCount>0 then
                WriteSequence(FRecNo,Data) else
                Begin
                  AppendSequence(Data);
                  FRecNo:=FCount;
                end;
              end;
            lmInsert:
              Begin
                If FCount<1 then
                Begin
                  AppendSequence(Data);
                  FRecNo:=FCount;
                end else
                ReplaceSequence(FRecNo,Data);
              end;
            end;

          finally
            If disposable then
            Data.free;
          end;

        end else
        Raise Exception.Create('Invalid record data error');
      end else
      Raise Exception.Create('table not in write mode error');
    end;
  end;

  Procedure TSRLTable.ReadRecord(Const Data:TBRBuffer);
  var
    FCount: Integer;
  Begin
    If Active then
    Begin
      If FLockMode=lmRead then
      Begin
        If Data<>NIL then
        Begin
          (* release current data if not empty *)
          If Data.Size>0 then
          Data.Release;

          (* read record data *)
          FCount:=GetSequenceCount;
          If FCount>0 then
          Begin
            ReadSequence(FRecNo,Data);

            If toCompress in FOptions then
            Data.DeCompress;
          end else
          Raise Exception.Create('Table is empty error');
        end else
        Raise Exception.Create('Invalid record data error');
      end else
      Raise Exception.Create('table not in write mode error');
    end;
  end;

  //###########################################################################
  //  TSRLSequenceFile
  //###########################################################################

  Const
  CNT_BINFILE_MAJOR = 1;
  CNT_BINFILE_MINOR = 0;

  Constructor TSRLSequenceFile.Create;
  Begin
    inherited;
    {$IFDEF SRL_DB_DISKLIST}
    FSeqList:=LongwordFileList.Create;
    {$ELSE}
    FSeqList:=TList<Longword>.Create;
    {$ENDIF}
  end;

  Destructor TSRLSequenceFile.Destroy;
  Begin
    FSeqList.free;
    inherited;
  end;

  Procedure TSRLSequenceFile.SignalCompactingBegins;
  Begin
    If not QueryObjectState([osDestroying,osSilent])
    {if  not (osDestroying in ObjectState)
    and not (osSilent in ObjectState)}
    and assigned(FOnCompBegins) then
    FOnCompBegins(self);
  end;

  Procedure TSRLSequenceFile.SignalCompactingProgress(Value:Integer);
  Begin
    {if  not (osDestroying in ObjectState)
    and not (osSilent in ObjectState)   }
    If not QueryObjectState([osDestroying,osSilent])
    and assigned(FOnCompProgress) then
    FOnCompProgress(self,Value * SizeOf(TSRLPageData));
  end;

  Procedure TSRLSequenceFile.SignalCompactingEnds;
  Begin
    If not QueryObjectState([osDestroying,osSilent])
    {if  not (osDestroying in ObjectState)
    and not (osSilent in ObjectState)}
    and assigned(FOnCompEnds) then
    FOnCompEnds(self);
  end;

  Procedure TSRLSequenceFile.Compact;
  var
    FPages: Longword;
    FFree:  Longword;

    FBack:  TSRLPageData;
    FThis:  TSRLPageData;
    FNext:  TSRLPageData;

    FIndex: Integer;

    FDone:  Integer;

  Begin
    If Active then
    Begin
      FPages:=GetPageCount;

      SignalCompactingBegins;
      FDone:=0;

      (* First, truncate file if the ending blocks
         are empty & not used *)

      //While GetPageIdleState(FPages-1)=False do
      While Bitmap.Bits[FPages-1]=False do
      Begin
        ShrinkPageFile(1);
        dec(FPages);
        inc(FDone);
        SignalCompactingProgress(FDone);
      end;

      While FBitmap.FindIdleBit(FFree,true) do
      Begin
        FPages:=GetPageCount;

        If (FFree<FPages)
        and (FFree>SRL_PageFile_BitsPages-1) then
        Begin
          try
            (* Read the current page *)
            ReadPage(FPages-1,FThis);

            (* Check for left-over blank page *)
            If (FThis.pdUsedBytes=0)
            and (FThis.pdPrevPage=0)
            and (FThis.pdNextPage=0) then
            Begin
              If FSeqlist.IndexOf(FPages-1)<0 then
              Begin
                ShrinkPageFile(1);
                //SetPageIdleState(FPages-1,false);
                Bitmap[FPages-1]:=False;

                inc(FDone);
                SignalCompactingProgress(FDone);

                Continue;
              end;
            end;

            (* read previous page if there *)
            If FThis.pdPrevPage>0 then
            ReadPage(FThis.pdPrevPage,FBack) else
            Begin
              (* This is a sequence-head. Look it up *)
              FIndex:=FSeqList.IndexOf(FPages-1);
              If FIndex>=0 then
              Begin
                FSeqList[FIndex]:=FFree;
              end;
            end;

            (* Read next page if there *)
            If FThis.pdNextPage>0 then
            ReadPage(FThis.pdNextPage,FNext);

            (* OK. Currentpage has moved *)
            If FThis.pdPrevPage>0 then
            FBack.pdNextPage:=FFree;
            If FThis.pdNextPage>0 then
            FNext.pdPrevPage:=FFree;

            (* write changes *)
            If FThis.pdPrevPage>0 then
            WritePage(FThis.pdPrevPage,FBack);
            If FThis.pdNextPage>0 then
            WritePage(FThis.pdNextPage,FNext);

            (* Now write page @ new location *)
            WritePage(FFree,FThis);

            (* Allocate new block *)
            Bitmap[FFree]:=True;
            //SetPageIdleState(FFree,True);

            (* Release current block *)
            Bitmap[FPages-1]:=False;
            //SetPageIdleState(FPages-1,False);

            (* shrink the database *)
            ShrinkPageFile(1);

            inc(FDone);
            SignalCompactingProgress(FDone);

          except
            on exception do
            Break;
          end;

        end else
        break;
      end;

      (* header needs to be re-written *)
      AddRequirement([brHeadWrite]);

      SignalCompactingEnds;

    end else
    Raise Exception.Create('Table is not active error');
  end;

  Function TSRLSequenceFile.AppendSequenceEx(Const Data:TBRBuffer):Longword;
  var
    FNeeded:  Integer;
    FItem:    Longword;
    FPages:   Array of Longword;
    FCount:   Integer;
    x:        Integer;
    FTemp:    TSRLPageData;
    FOffset:  Integer;
  Begin
    //result:=0;

    FNeeded:=Data.Size div SizeOf(Ftemp.pdData);
    If Data.Size mod SizeOf(Ftemp.pdData)> 0 then
    inc(FNeeded);

    (* reserve # of pages, grow if required *)
    FCount:=0;
    While FNeeded>0 do
    Begin
      (* locate a free page & mark as reserved *)
      FItem:=GetIdlePage;
      Bitmap[FItem]:=True;

      (* add reserved page to collection *)
      SetLength(FPages,FCount+1);
      FPages[FCount]:=FItem;

      inc(FCount);
      dec(FNeeded);
    end;

    FOffset:=0;
    //Fillchar(FTemp,SizeOf(FTemp),0);

    for x:=Low(FPages) to high(FPages) do
    Begin
      (* inter-link pages *)
      If x<High(FPages) then
      FTemp.pdNextPage:=FPages[x+1] else
      FTemp.pdNextPage:=0;

      If x>Low(FPages) then
      FTemp.pdPrevPage:=FPages[x-1] else
      FTemp.pdPrevPage:=0;

      (* get data into page *)
      FTemp.pdUsedBytes:=Data.Read
      (FOffset,SizeOf(Ftemp.pdData),FTemp.pdData);

      inc(FOffset,FTemp.pdUsedBytes);

      (* write page to disk *)
      WritePage(FPages[x],FTemp);
    end;
    result:=FPages[0];

    If Length(FPages)>0 then
    AddRequirement([brHeadWrite]);
  end;

  Procedure TSRLSequenceFile.WriteSequence(Const Index:Integer;
            Const Data:TBRBuffer);
  var
    FOffset:  Longword;
  Begin
    (* release current sequence data *)
    ReleaseSequenceEx(FSeqList[Index]);

    (* write new sequence content *)
    FOffset:=AppendSequenceEx(Data);

    (* insert new sequence start into list *)
    FSeqlist[index]:=FOffset;
  end;

  Procedure TSRLSequenceFile.ReplaceSequence(Const Index:Integer;
            Const Data:TBRBuffer);
  Begin
    (* register new data sequence and insert it @ new position *)
    FSeqList.Insert(Index,AppendSequenceEx(Data));

    (* header needs to be re-written *)
    AddRequirement([brHeadWrite]);
  end;

  Function TSRLSequenceFile.AppendSequence(Const Data:TBRBuffer):Integer;
  Begin
    result:=0;
    If Data<>NIL then
    Begin
      (* register sequence & return sequence number *)
      Result:=FSeqList.add(AppendSequenceEx(Data));

      (* header needs to be re-written *)
      AddRequirement([brHeadWrite]);
    end;
  end;

  Procedure TSRLSequenceFile.ReleaseSequenceEx(Const StartPage:Longword);
  var
    FStart: Longword;
    FTemp:  TSRLPageData;
    FDummy: TSRLPageData;
    FBits:  Array of longword;
    FCount: Integer;
    FNext:  Longword;
    mTok:   Longword;
  Begin
    (* Initialize *)
    FCount:=0;
    FStart:=StartPage;

    //Fillchar(FDummy,Sizeof(FDummy),'*');
    FDummy.pdUsedBytes:=0;
    FDummy.pdPrevPage:=0;
    FDummy.pdNextPage:=0;

    While FStart>1 do
    Begin
      (* get current page from disk *)
      FNext:=ReadPage(FStart,FTemp);

      (* Insert page into bits array *)
      SetLength(FBits,FCount+1);
      FBits[FCount]:=FStart;
      inc(FCount);

      (* write empty page back to disk *)
      WritePage(FStart,FDummy);

      (*  Do next page in sequence, we use swap so we can re-use the
          FNext variable after the loop *)
      mTok:=FNext;
      FNext:=FStart;
      FStart:=mTok;
      //SRLSwap(FStart,FNext);
    end;

    (* reset file bitmap bits *)
    If FCount>0 then
    FBitmap.SetBits(FBits,False) else
    FBitmap[FNext]:=False;
  end;

  Procedure TSRLSequenceFile.ReleaseSequence(Const Sequence:Integer);
  Begin
    ReleaseSequenceEx(FSeqlist[Sequence]);
    FSeqList.Delete(Sequence);
  end;

  Function TSRLSequenceFile.GetSequencePages(Sequence:Integer;
           var Value:TLongArray):Boolean;
  var
    FStart: Longword;
    FTemp:  TSRLPageData;
  Begin
    SetLength(Value,0);
    result:=(Sequence>0) and (Sequence<FSeqList.Count-1);

    If result then
    Begin
      FStart:=FSeqList[Sequence];

      SetLength(Value,1);
      Value[0]:=FStart;

      While FStart>1 do
      Begin
        (* read page content. Function returns PTR to next page *)
        FStart:=ReadPage(FStart,FTemp);
        If FStart>0 then
        Begin
          SetLength(Value,Length(Value)+1);
          Value[length(Value)-1]:=FStart;
        end;
      end;
    end;
  end;

  Procedure TSRLSequenceFile.ReadSequenceEx
            (Const StartPage:Longword;Const Data:TBRBuffer);
  var
    FStart: Longword;
    FTemp:  TSRLPageData;
  Begin
    FStart:=StartPage;
    While FStart>1 do
    Begin
      (* read page content. Function returns PTR to next page *)
      FStart:=ReadPage(FStart,FTemp);

      (* extract page data *)
      If FTemp.pdUsedBytes>0 then
      Data.Append(FTemp.pdData,FTemp.pdUsedBytes);
    end;
  end;

  Function TSRLSequenceFile.GetSequenceCount:Integer;
  Begin
    result:=FSeqList.Count;
  end;

  Function TSRLSequenceFile.GetSequence(Const Index:Integer):Longword;
  Begin
    result:=FSeqList[index];
  end;

  Procedure TSRLSequenceFile.ReadSequence
            (Const Sequence:Integer;Const Data:TBRBuffer);
  Begin
    ReadSequenceEx(FSeqList[Sequence],Data);
  end;

  Procedure TSRLSequenceFile.DoWriteDescriptor(Const Writer:TBRWriter);
  var
    x:  Integer;
  Begin
    Writer.WriteInt(FSeqList.count);
    for x:=0 to FSeqList.Count-1 do
    Writer.WriteLong(FSeqList[x]);
  end;

  Procedure TSRLSequenceFile.DoReadDescriptor(Const Reader:TBRReader);
  var
    mCount: Integer;
  Begin
    mCount:=Reader.ReadInt;
    FSeqList.clear;
    while mCount>0 do
    begin
      FSeqList.add(Reader.ReadLong);
      dec(mCount);
    end;
  end;

  Procedure TSRLSequenceFile.DoWriteHeader(Const Writer:TBRWriter);
  Begin
    With Writer do
    Begin
      WriteAsc('$DB8');                 (*  Identifier *)
      WriteWord(SizeOf(TSRLPageData));  (*  Page size *)
      WriteByte(CNT_BINFILE_MAJOR);     (*  Major version *)
      WriteByte(CNT_BINFILE_MINOR);     (*  Minor version *)
      WriteLong(FSeqStart);             (*  Sequence list pageIndex *)
      WriteAsc('SRL DB Engine, copyright JOLEAD EM');
    end;
  end;

  Procedure TSRLSequenceFile.DoReadHeader(Const Reader:TBRReader);
  {var
    FTemp:  AnsiString;  }
  Begin
    If Reader.ReadAsc='$DB8' then
    Begin
      If Reader.ReadWord=SizeOf(TSRLPageData) then
      Begin
        Reader.ReadByte;
        Reader.ReadByte;
        FSeqStart:=Reader.ReadLong; //  Get offset to record list

        {FTemp:=Reader.ReadAsc;
        FTemp:=Reader.ReadString; }
      end else
      Raise Exception.Create('Incompatible page size error');
    end else
    Raise Exception.Create('Unknown table format');
  end;

  Procedure TSRLSequenceFile.DoBeforeOpen;
  Begin
    inherited;
    FSeqStart:=0;
    FSeqList.Clear;
  end;

  Procedure TSRLSequenceFile.DoAfterOpen;
    var
      FBuff:    TBRBufferMemory;
      FReader:  TBRReaderBuffer;
    Begin
      If FSeqStart>0 then
      Begin
        FBuff:=TBRBufferMemory.Create;
        try
          ReadSequenceEx(FSeqStart,FBuff);

          FReader:=TBRReaderBuffer.Create(FBuff);
          try
            DoReadDescriptor(FReader);
          finally
            FReader.free;
          end;

          If (Accessmode in [baCreate,baReadWrite]) then
          ReleaseSequenceEx(FSeqStart);
        finally
          FBuff.free;
        end;
      end;
    Inherited;
  End;

  Procedure TSRLSequenceFile.DoBeforeClose;
  var
    FBuffer:  TBRBufferMemory;
    FWriter:  TBRWriterBuffer;
  Begin
    If (Accessmode in [baCreate,baReadWrite]) then
    Begin
      (* append list data to file *)
      FBuffer:=TBRBufferMemory.Create;
      try
        FWriter:=TBRWriterBuffer.Create(FBuffer);
        try
          DoWriteDescriptor(FWriter);
        finally
          FWriter.free;
        end;
        FSeqStart:=AppendSequenceEx(FBuffer);
      finally
        FBuffer.free;
      end;

      (* Header must be re-written *)
      AddRequirement([brHeadWrite]);
    end;
  end;

  Procedure TSRLSequenceFile.DoAfterClose;
  Begin
    Inherited;
    //If not (osDestroying in ObjectState) then
    If not QueryObjectState([osDestroying]) then
    FSeqList.Clear;
  end;

  //###########################################################################
  //  TSRLPageFile
  //###########################################################################

  Constructor TSRLPageFile.Create;
  Begin
    inherited;
    //FBitBuffer:=TBRBufferMemory.Create;
    //FBitmap:=TBRBitAccess.Create(FBitBuffer);
    FBitmap:=TBRBitBuffer.Create;
    FFileMode:=baNone;
    FRequires:=[];
  end;

  Destructor TSRLPageFile.Destroy;
  Begin
    FBitmap.free;
    //FBitBuffer.Free;
    inherited;
  end;

  Procedure TSRLPageFile.BeforeDestruction;
  Begin
    inherited;
    If FActive then
    Close;
  end;

  Procedure TSRLPageFile.WriteBitBuffer;
  var
    x:      Integer;
    FTemp:  PSRLPageData;
  Begin
    FTemp:=FBitmap.Data;
    ///FTemp:=PSRLPageData(FBitBuffer.Data);
    for x:=1 to SRL_PageFile_BitsPages do
    Begin
      WritePage(x,FTemp^);
      inc(FTemp);
    end;
  end;

  Procedure TSRLPageFile.ReadBitBuffer;
  var
    x:      Integer;
    FTemp:  PSRLPageData;
  Begin
    If FBitmap.Empty then
    //FBitBuffer.Size:=SRL_PageFile_BitsBytes;
    FBitmap.Allocate(SRL_PageFile_BitsTotal);

    x:=1;
    FTemp:=FBitmap.Data;
    //FTemp:=PSRLPageData(FBitBuffer.Data);
    While x<SRL_PageFile_BitsPages do
    Begin
      ReadPage(x,FTemp^);
      inc(FTemp);
      inc(x);
    end;
  end;

  Function TSRLPageFile.GetIdlePage(Const AllowGrow:Boolean=True):Longword;
  Begin
    {If FActive then
    Begin  }
      If not FBitmap.FindIdleBit(Result,false) then
      Begin
        If  AllowGrow then
        //and (FFileMode in [baCreate,baReadWrite]) then
        Result:=GrowPageFile(1) else
        result:=0;
      end;
    {end else
    Raise Exception.Create(ERR_SRL_PAGEFILE_NOTACTIVE);}
  end;

  {
  Function TSRLPageFile.GetPageIdleState(Const PageIndex:Longword):Boolean;
  Begin
    Result:=FBitmap[PageIndex];
  end;

  Procedure TSRLPageFile.SetPageIdleState(Const PageIndex:Longword;
            Const Value:Boolean);
  Begin
    FBitmap[PageIndex]:=Value;
    AddRequirement([brHeadWrite]);
  end;   }

  Procedure TSRLPageFile.AddRequirement(Const Value:TSRLBinaryRequirement);
  begin
    If FActive then
    FRequires:=FRequires + Value else
    Raise Exception.Create(ERR_SRL_PAGEFILE_NOTACTIVE);
  end;

  Procedure TSRLPageFile.DelRequirement(Const Value:TSRLBinaryRequirement);
  Begin
    If FActive then
    FRequires:=FRequires - Value else
    Raise Exception.Create(ERR_SRL_PAGEFILE_NOTACTIVE);
  end;

  Procedure TSRLPageFile.ApplyRequirements;
  Begin
    If FActive then
    Begin
      If (FFileMode in [baCreate,baRead,baReadWrite]) then
      Begin
        (* Read header if required *)
        If (brHeadRead in FRequires) then
        Begin
          ReadHeaderData;
          FRequires:=FRequires - [brHeadRead];
        end;

        (* write header if required *)
        If (brHeadWrite in FRequires) then
        Begin
          WriteHeaderData;
          FRequires:=FRequires - [brHeadWrite];
        end;
      end;
    end else
    Raise Exception.Create(ERR_SRL_PAGEFILE_NOTACTIVE);
  end;

  Procedure TSRLPageFile.Open;
  Begin
    If FActive then
    Close;

    SignalBeforeOpen;
    DoBeforeOpen;

    FActive:=True;
    FFileMode:=baCreate;
    //FBitBuffer.Size:=qtxdb.SRL_PageFile_BitsBytes;
    FBitmap.Allocate(SRL_PageFile_BitsTotal);

    try
      FFile:=TMemoryStream.Create;

      (* reserve header Page *)
      Bitmap[0]:=True;
      //SetPageIdleState(0,True);

      (* reserve pages for file-bitmap bits *)
      FBitmap.SetBitRange(1,SRL_PageFile_BitsPages,True);
      AddRequirement([brHeadWrite]);

      ApplyRequirements;
    except
      on e: exception do
      Begin
        FActive:=False;
        FFileMode:=baNone;
        FRequires:=[];
        FBitmap.Release;
        //FBitBuffer.Release;
        If FFile<>NIL then
        FreeAndNil(FFile);
        Raise Exception.Create(e.Message);
        //Raise Exception.Create(e.message);
      end;
    end;

    FInMemory:=True;
    FFilename:='';

    DoAfterOpen;
    SignalAfterOpen;
  end;

  Procedure TSRLPageFile.Open(Const Filename:AnsiString;
            Const AccessMode:TSRLBinaryAccessMode = baReadWrite);
  var
    FTemp:  Word;
  Begin
    If FActive then
    Close;

    If AccessMode>baNone then
    Begin
      SignalBeforeOpen;
      DoBeforeOpen;

      (* check that file exists & if read or write mode applies *)
      If (AccessMode in [baRead,baReadWrite]) then
      Begin
        if not FileExists(Filename) then
        Raise Exception.CreateFmt(ERR_SRL_PAGEFILE_FILENOTFOUND,[Filename]);
      end;

      FActive:=True;
      FFileMode:=AccessMode;
      FBitmap.Allocate(SRL_PageFile_BitsTotal);

      Case AccessMode of
      baCreate:     FTemp:=fmCreate;
      baRead:       FTemp:=fmOpenRead;
      baReadWrite:  FTemp:=fmOpenReadWrite;
      else
        FTemp:=fmOpenRead;
      End;

      try
        FFile:=TFileStream.Create(Filename,FTemp);
        If AccessMode=baCreate then
        Begin
          (* reserve pages for file-bitmap bits *)
          FBitmap.SetBitRange(0,SRL_PageFile_BitsPages,True);
          self.GrowPageFile(1); //Header
          self.GrowPageFile(SRL_PageFile_BitsPages);

          AddRequirement([brHeadWrite]);
        end else
        AddRequirement([brHeadRead]);
        ApplyRequirements;
      except
        on e: exception do
        Begin
          FActive:=False;
          FFileMode:=baNone;
          FRequires:=[];
          //FBitBuffer.Release;
          FBitmap.Release;
          If FFile<>NIL then
          FreeAndNil(FFile);
          Raise Exception.Create(e.message);
        end;
      end;

      FFilename:=Filename;

      DoAfterOpen;
      SignalAfterOpen;
    end;
  end;

  Procedure TSRLPageFile.SaveToFile(Const Filename:String);
  var
    FTemp:  TFileStream;
  Begin
    If FActive then
    Begin
      If FInMemory then
      Begin
        AddRequirement([brHeadWrite]);
        ApplyRequirements;

        FTemp:=TFileStream.Create(Filename,fmCreate);
        try
          FFile.Position:=0;
          FTemp.CopyFrom(FFile,FFile.Size);
        finally
          FTemp.free;
        end;

      end else
      raise Exception.Create('Only in-memory tables can be saved');

    end;
  end;

  Procedure TSRLPageFile.Close;
  Begin
    If FActive then
    Begin
      SignalBeforeClose;
      DoBeforeClose;

      try
        If FRequires<>[] then
        ApplyRequirements;
      finally
        FreeAndNil(FFile);
        FRequires:=[];
        FFileName:='';
        FFileMode:=baNone;
        FActive:=False;
        FInMemory:=False;
        FBitmap.Release;
        //FBitBuffer.Release;
        SignalAfterClose;
        DoAfterClose;
      end;
    end;
  end;

  Procedure TSRLPageFile.DoWriteHeader(Const Writer:TBRWriter);
  Begin
  end;

  Procedure TSRLPageFile.DoReadHeader(Const Reader:TBRReader);
  Begin
  end;

  Function TSRLPageFile.GetCurrentPage:Longword;
  Begin
    result:=Longword(FFile.Position Div SizeOf(TSRLPageData));
  end;

  Function TSRLPageFile.GetPageCount:Longword;
  Begin
    result:=Longword(FFile.Size Div SizeOf(TSRLPageData));
  end;

  Procedure TSRLPageFile.SetCurrentPage(Const Value:Longword);
  Begin
    FFile.Position:=Int64(Value * SizeOf(TSRLPageData));
  end;

  Procedure TSRLPageFile.WriteHeaderData;
  var
    FTemp:      TSRLPageData;
    FWriter:    TBRWriterMemory;
  begin
    If  (FFileMode in [baCreate,baReadWrite]) then
    Begin
      (*  The file header (page #0) is reserved and fixed.
          However, the content of the header page is not defined by this
          base class, decendant classes are free to write information to the
          header page - as long as it does not exceed the pagesize limit.
          NOTE: The content of the header will be clipped to the pagesize! *)
      Fillchar(FTemp,SizeOf(FTemp),0);

      FWriter:=TBRWriterMemory.Create(@FTemp,SizeOf(TSRLPageData));
      try
        DoWriteHeader(FWriter);

        (* write header content *)
        WritePage(0,FTemp);

        (* Immediatly following the header-page, is the file bitmap.
          Each page in the file is represented as one bit. If the bit is
          set this means the page is occupied. If the bit is 0 (zero)
          the page does not contain data.
          The number of pages reserved for the file bitmap depends on the
          pagesize and page limitation. By default the maximum number of pages
          is set to 131072 (in bits), resulting in 16384 bytes.
          If the pagesize is 1024, the file bitmap reserves 16 pages *)
        WriteBitBuffer;

      finally
        FWriter.free;
      end;

    end;
  end;

  Procedure TSRLPageFile.ReadHeaderData;
  var
    FTemp:    TSRLPageData;
    FReader:  TBRReaderMemory;
  Begin
    (* read raw data *)
    Fillchar(FTemp,SizeOf(FTemp),0);
    ReadPage(0,FTemp);

    (* allow decendants to decode header *)
    FReader:=TBRReaderMemory.Create(@FTemp,SizeOf(FTemp));
    try
      DoReadHeader(FReader);
    finally
      FReader.free;
    end;

    (* load file bitmap *)
    ReadBitBuffer;
  end;

  Function TSRLPageFile.GetCount:Longword;
  Begin
    If FActive then
    Result:=Longword( FFile.Size div SizeOf(TSRLPageData) ) else
    Raise Exception.Create(ERR_SRL_PAGEFILE_NOTACTIVE);
  end;

  Procedure TSRLPageFile.ShrinkPageFile(Value:Longword);
  var
    FCount: Longword;
    FBytes: Int64;
  Begin
    If FActive then
    Begin

      If (FFileMode in [baCreate,baReadWrite]) then
      Begin
        FCount:=GetCount;
        If (Value>0) and (Value<FCount) then
        Begin

          FBytes:=Value * SizeOf(TSRLPageData);
          FFile.Size:=FFile.Size - FBytes;

          (* reset pages *)
          While Value>0 do
          Begin
            Bitmap[FCount-1]:=False;
            dec(Value);
            dec(FCount);
          end;

          AddRequirement([brHeadWrite]);
        end;
      end else
      Raise Exception.Create(ERR_SRL_PAGEFILE_NOTWRITEMODE);

    end else
    Raise Exception.Create(ERR_SRL_PAGEFILE_NOTACTIVE);
  end;

  Function TSRLPageFile.GrowPageFile(Value:Longword):Longword;
  var
    FTemp:  TSRLPageData;
    FCount: Longword;
  Begin
    If FActive then
    Begin
      If (FFileMode in [baCreate,baReadWrite]) then
      Begin
        FCount:=GetCount;
        If (Value>0) and (FCount + Value < SRL_PageFile_BitsTotal) then
        Begin
          (* update count *)
          inc(FCount,Value);

          (* append empty blocks to file *)
          Fillchar(FTemp,SizeOf(FTemp),0);
          FFile.Position:=FFile.Size;
          While Value>0 do
          Begin
            FFile.WriteBuffer(FTemp,SizeOf(FTemp));
            dec(Value);
          end;

          (* return new page count *)
          Result:=FCount;

          AddRequirement([brHeadWrite]);
        end else
        result:=0;
      end else
      Raise Exception.Create(ERR_SRL_PAGEFILE_NOTWRITEMODE);
    end else
    Raise Exception.Create(ERR_SRL_PAGEFILE_NOTACTIVE);
  end;

  Function TSRLPageFile.ReadPage(Const PageIndex:Longword;
            var Buffer:TSRLPageData):Longword;
  {$IFDEF SRL_DB_SEEKBUFFER}
  var
    FNewPos:  Int64;
    FOldPos:  Int64;
    FDiff:    Int64;
  {$ENDIF}
  Begin
    If FActive then
    Begin
      {$IFDEF SRL_DB_SEEKBUFFER}
      FOldPos:=FFile.Position;
      FNewpos:=PageIndex * SizeOf(TSRLPageData);

      if FNewPos>FOldPos then
      Begin
        FDiff:=FNewPos - FOldPos;
        If FDiff<SRL_PageFile_SeekRange then
        FFile.Seek(FDiff,soCurrent) else
        FFile.Position:=FNewPos;
      end else

      if FNewpos<FOldPos then
      Begin
        FDiff:=FOldPos - FNewPos;
        If FDiff<SRL_PageFile_SeekRange then
        FFile.Seek(-FDiff,soCurrent) else
        FFile.Position:=FNewPos;
      end;
      {$ELSE}
      If Longword(FFile.Position Div SizeOf(TSRLPageData)) <> PageIndex then
      FFile.Position:=Int64(PageIndex * SizeOf(TSRLPageData));
      {$ENDIF}
      FFile.ReadBuffer(Buffer,SizeOf(Buffer));
      result:=Buffer.pdNextPage;
    end else
    Raise Exception.Create(ERR_SRL_PAGEFILE_NOTACTIVE);
  end;

  Procedure TSRLPageFile.WritePage(Const PageIndex:Longword;
            Const Buffer:TSRLPageData);
  {$IFDEF SRL_DB_SEEKBUFFER}
  var
    FNewPos:  Int64;
    FOldPos:  Int64;
    FDiff:    Int64;
  {$ENDIF}
  Begin
    If FActive then
    Begin
      {$IFDEF SRL_DB_SEEKBUFFER}
      FOldPos:=FFile.Position;
      FNewpos:=PageIndex * SizeOf(TSRLPageData);

      if FNewPos>FOldPos then
      Begin
        FDiff:=FNewPos - FOldPos;
        If FDiff<SRL_PageFile_SeekRange then
        FFile.Seek(FDiff,soCurrent) else
        FFile.Position:=FNewPos;
      end else

      if FNewpos<FOldPos then
      Begin
        FDiff:=FOldPos - FNewPos;
        If FDiff<SRL_PageFile_SeekRange then
        FFile.Seek(-FDiff,soCurrent) else
        FFile.Position:=FNewPos;
      end;
      {$ELSE}
      If Longword(FFile.Position Div SizeOf(TSRLPageData)) <> PageIndex then
      FFile.Position:=Int64(PageIndex * SizeOf(TSRLPageData));
      {$ENDIF}

      FFile.WriteBuffer(Buffer,SizeOf(Buffer));
    end else
    Raise Exception.Create(ERR_SRL_PAGEFILE_NOTACTIVE);
  end;

  Procedure TSRLPageFile.SignalBeforeOpen;
  Begin
    {If  not (osDestroying in ObjectState)
    and not (osSilent in ObjectState) then}
    If not QueryObjectState([osDestroying,osSilent])
    and assigned(FOnBeforeOpen) then
    FOnBeforeOpen(Self);
  end;

  Procedure TSRLPageFile.SignalBeforeClose;
  Begin
    {If  not (osDestroying in ObjectState)
    and not (osSilent in ObjectState)   }
    If not QueryObjectState([osDestroying,osSilent])
    and assigned(FOnBeforeClose) then
    FOnBeforeClose(Self);
  end;

  Procedure TSRLPageFile.SignalAfterOpen;
  Begin
    {If  not (osDestroying in ObjectState)
    and not (osSilent in ObjectState)         }
    If not QueryObjectState([osDestroying,osSilent])
    and assigned(FOnAfterOpen) then
    FOnAfterOpen(Self);
  end;

  Procedure TSRLPageFile.SignalAfterClose;
  Begin
    {If  not (osDestroying in ObjectState)
    and not (osSilent in ObjectState)}
    If not QueryObjectState([osDestroying,osSilent])
    and assigned(FOnAfterClose) then
    FOnAfterClose(Self);
  end;

  Procedure TSRLPageFile.DoBeforeOpen;
  Begin
  end;

  procedure TSRLPageFile.DoAfterOpen;
  Begin
  end;

  Procedure TSRLPageFile.DoBeforeClose;
  Begin
  end;

  Procedure TSRLPageFile.DoAfterClose;
  Begin
  end;

  end.

Advertisements
  1. May 28, 2015 at 5:26 am

    This is great. Check this out: http://forum.lazarus.freepascal.org/index.php?topic=6694.0

    It will give you great ideas in implementing and integrating SQL in your DB Engine!

  1. No trackbacks yet.

Leave a Reply

Please log in using one of these methods to post your comment:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s

%d bloggers like this: