Archive
Archive for March, 2014
MyOwnDB – internal structure and layout
March 7, 2014
3 comments
Note: This post is a follow-up to My own database engine. Make sure you read that article first for context.
Also make sure you download and play with ByteRage, which can be downloaded from google code.
Basic database theory
Clientdataset? Who?
Stop and think about how a database works, not on the level of sql or anything like that, but in low level terms dealing with the actual database disk file and storage. If you ponder how a record is stored inside the database file you will immediately reach a point where you realize, that a single record of variable size cannot really be pre-calculated. If your records are fixed, so that you know that each post will take up exactly 2k of data, then writing the IO routines for a database file is quite simple. But the moment you introduce BLOBS, CLOBS and MEMO fields – being able to pre calculate the position of a record inside a file goes out the window.
I mean, if you know that each record is 1024 bytes in size, then finding the position of record #25 inside the file is just a matter of:
mFileOffset := SizeOf(TPageData) * 25; mFileStream.position:=mFileOffset;
But when each record can have a unique length, there is no way of pinpointing the location of a record using math alone. You need to keep track of where records starts in a list, and you also need some mechanism for re-using record space.
Break it down
The solution to “variable length records” is that you have to break the record data into smaller pieces, called pages (or “blocks”) of a fixed size. If you can store a record inside one block, then that is great – but when the data exceeds the size of a single page, then you have to figure out a clever way of chaining these blocks together inside the file. Such a chain of blocks is simply called a “sequence”.
But once you have divided a file into pages, you also introduce another problem. Namely how do you keep track of free blocks in the middle of a database file versus those containing record data. If you delete a record that is stored in the middle of a database file, you really dont want to truncate the entire file just to keep things linear (if your database file is 10 gigabytes in size, that can take forever, even with memory mapping).
First, lets look at how a page inside the database file looks like:
PSRLPageData = ^TSRLPageData;
TSRLPageData = Packed Record
pdUsedBytes: Integer;
pdPrevPage: Longword;
pdNextPage: Longword;
pdData: Array[1..SRL_PageFile_PageSize-12] of Byte;
End;
As you can see it has an array to contain data (which can be the whole record, or a part of a record). It also have two fields that contains a reference to the next block in the chain and the previous. This solves how you chain blocks of data together.
The problem now is keeping track of “free” pages, so we can recycle the space occupied by deleted records for new ones.
The “free block/page” problem
File structure
When you delete a sequence of pages (a record broken into X pieces), how will you keep track of the free pages? How will you re-cycle those pages for new records? Since the pages can be spread throughout the entire file (just like files on a disk can be fragmented) this can be tricky. You can’t use an array of bytes or integers since the datasize is hardly justified. You need something smaller, something small enough to be saved inside the table file without being unreasonable – yet effective and fast enough for practical use.
The answer is to represent each page in the file as a single BIT. If the bit is set, then you know that this page is in use. If the bit is zero, then you know this can be re-cycled. The maximum amount of pages a TFileStream can handle can thus be allocated straight away (!) And its reasonable in size for a database file that can span gigabytes.
TotalBits = (MaxSize / PageSize);
TotalBytes = TotalBits / 8;
Voila! We can now pack a lot of information into a very small storage medium (doesn’t get any smaller than bits!). This “bit map” of the file is isolated in the TSRLBitBuffer class.
In short: a single byte can now keep track of 8 pages of data. Meaning, that if the pagesize is set to 2048 bytes, and your database file is 10.000 pages in size, the full “map” of the file will only require 10.000 / 8 = 1250 bytes. When we add ZLib compression to the bit-buffer on saving, the number is even smaller. That is extremely cost-effective and very, very fast for looking up the state of a database page.
I mean, if you quickly want to find a “free bit”, you simply use a normal PByte and check for a value less than 255. If the value is less, you know that there is a free bit in that byte. This can be made very fast using loop expansion (reading 8 or 16 bytes in one go until you find a byte that is <255 in value).
NOTE: Like pointed out by a reader, it is also custom to keep track of free/
mAddr:=Pbyte(FBuffer);
mOffset:=0;
Repeat
if not (mAddr^=255) then
Begin
//We have a byte with a bit not set!
//Now figure out which bit, and calculate page number from that
Break;
end;
inc(mAddr);
inc(mOffset);
until mOffset:=FBytesInbuffer;
Now, when I create new technology, I don’t give a flying spaghetti monster about speed. The prototype is always about solving the problem. Once the prototype has been tested and verified, then I start to refactor the classes and tuning the code for better speed. The bitbuffer class would gain a few clock cycles if it was a part of TSRLPageFile, and even more if I re-wrote it in assembler.
Having said that, posting 10.000 records to the table takes less than a second – so I am actually quite pleased with the speed. Using TBRPersistent for storage is completely overkill, so it will be even faster once I have some time to work on it. And naturally it will be wrapped into TDataset.
Working with a stream as an array of pages
The base class for the database engine simply implements the basics: namely to read data from the table stream in pages (or blocks). So the class TSRLPageFile contains the code for creating, reading and writing to the stream in segments rather than at offset positions.
Reading and writing sequences of pages
Since a database record can span several pages we need to be able to read pages in sequence, glue them together using page-numbers, delete a complete sequence – and of course, re-cycle unused or deleted pages. The mechanisms for this is isolated in TSRLSequenceFile, which interhits from TSRLPageFile.
Working with a stream as an array of records
The actual table class, which adds stuff like storing the bit-map and list of record offsets to the file — is TSRLTable. This class also adds a rudimentary “cursor”, BOF/EOF/Next/Prev functions and so on. It is just a raw shell over the table system.
Indexing, the mother of all.. well, quite cool actually
As you probably have guessed, myOwnDB is just the “raw” storage engine. It takes care of breaking record data into pieces, storing them in sequence, keeping track of free pages inside the databasefile, and stuff like compacting the file and updating internal list information. In some ways you can say that it provides half a database, since there is no code for things like indexing, sql and other things.
I did implement a very crude, brute force search function. It allows you to search the database for a simple string value — but it’s no more effective than filters in TDataset (if not worse). It was just a bit of fun. It gives the same results as the HTML5 objective database would give, where you would insert an object with a key (GUID) and quickly get it back again.
Proper database indexing requires a much more detailed scheme. You would first need a clearly defined field-model, not just stuffing the equivalent of a Microsoft property-bag and calling it a record. String indexes usually have an array of “key phrases” that are either included or excluded – and from this you build a BTree node/lead structure which is updated on inserting data and removing data.
Indexing is very expensive in terms of storage space. If you index your database wrong, your index file can actually exceed your database file (!) So this is not something you slap together over the weekend.
Having said that, my database engine makes it very easy to store and handle indexing within a single file. It would be stored inside the database as a sequence of data just like the sequence-list, the bitmap and whatever else. It would be loaded into memory when you open the table-file, and stored when you close it (if changes has been made and write access to the file is allowed).
With indexing in place, writing a good SQL parser is all that is left (which is not a walk in the park, but more time consuming than technical challenging).
Imagine the speed of this thing if we added memory mapping to the equation 🙂 But better to keep it native Delphi so it’s 100% portable.
My own database engine – check it out
March 6, 2014
1 comment
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.
Fun with nested classes
March 4, 2014
Leave a comment
A bit overkill, but fun none the less. This post is in reply to georgba on facebook. Here is an example of how to use nested classes. When compiled and you ship the DCU, it will be harder to resource your code.
TBaseDoc = Class(TObject)
protected
type
TLoaderClass = Class(TObject)
public
function getFormatValue(aValue:Integer):String;virtual;
End;
strict protected
function getAdapter:TLoaderClass;virtual;
strict private
FAdapter: TLoaderClass;
public
Property Adapter:TLoaderClass read FAdapter;
Constructor Create;virtual;
Destructor Destroy;Override;
End;
TTextDoc = Class sealed(TBaseDoc)
protected
type
TLoaderClass = Class(TBaseDoc.TLoaderClass)
public
function getFormatValue(aValue:Integer):String;override;
End;
strict protected
function getAdapter:TBaseDoc.TLoaderClass;override;
end;
And ofcourse:
{ TBaseDoc }
constructor TBaseDoc.Create;
begin
inherited Create;
FAdapter:=getAdapter;
end;
destructor TBaseDoc.Destroy;
begin
FAdapter.Free;
inherited;
end;
Function TBaseDoc.TLoaderClass.getFormatValue(aValue: Integer):String;
begin
raise exception.Create('NOT IMPLEMENTED');
end;
function TBaseDoc.getAdapter:TLoaderClass;
begin
result:=TLoaderClass.Create;
end;
{ TTextDoc }
function TTextDoc.getAdapter:TBaseDoc.TLoaderClass;
begin
result:=TLoaderClass.Create;
end;
Function TTextDoc.TLoaderClass.getFormatValue(aValue: Integer):String;
begin
result:=IntToStr(aValue);
end;
Jon L. Aasenden 
You must be logged in to post a comment.