AbstractMem v1.8 - Added TAbstractStorage

src/libraries/abstractmem/ConfigAbstractMem.inc

@@ -75,9 +75,12 @@
   Version 1.7 - April 2023
   - Added TMemoryBTreeData<TData> structures that allows multiple indexes via "AddIndex" method creating TMemoryBTreeDataIndex<TBTreeData> objects
 
+  Version 1.8 - October 2023
+  - Added TAbstractStorage that helps in an easy to implement AbstractMemory structs in a formal way
+
 }
 
 const
-  CT_ABSTRACTMEM_VERSION = 1.7; // Each revision should increase this version...
+  CT_ABSTRACTMEM_VERSION = 1.8; // Each revision should increase this version...
 
 

src/libraries/abstractmem/UAbstractMemBTree.pas

@@ -95,6 +95,7 @@ type
     property InitialZone : TAMZone read FInitialZone;
     function GetNullData : TAbstractMemPosition; override;
     property BTreeCache : TAVLABTreeCache read FBTreeCache;
+    class function GetInfo(AAbstractMem : TAbstractMem; AInitialZone: TAMZone; out AAllowDuplicates : Boolean; out AOrder, ACount : Integer): Boolean;
   End;
 
   {$IFnDEF FPC}
@@ -295,6 +296,33 @@ begin
   end;
 end;
 
+class function TAbstractMemBTree.GetInfo(AAbstractMem: TAbstractMem;
+  AInitialZone: TAMZone; out AAllowDuplicates: Boolean;
+  out AOrder, ACount: Integer): Boolean;
+var LBuff : TBytes;
+ i : Integer;
+ amz : TAMZone;
+ ii : UInt64;
+begin
+  AAllowDuplicates := false;
+  AOrder := 0;
+  Result := False;
+  //
+  if Not AAbstractMem.GetUsedZoneInfo(AInitialZone.position,False,amz) then Exit(False);
+  if amz.position=0 then Exit(False);
+  if (amz.size<MinAbstractMemInitialPositionSize(AAbstractMem)) then Exit(False);
+  SetLength(LBuff,MinAbstractMemInitialPositionSize(AAbstractMem));
+  AAbstractMem.Read(amz.position,LBuff[0],Length(LBuff));
+  // Check magic
+  for i := 0 to CT_AbstractMemBTree_Magic.Length-1 do begin
+    if LBuff[i]<>Ord(CT_AbstractMemBTree_Magic.Chars[i]) then Exit;
+  end;
+  Move(LBuff[4],ii,AAbstractMem.SizeOfAbstractMemPosition);
+  Move(LBuff[4+AAbstractMem.SizeOfAbstractMemPosition],ACount,4);
+  Move(LBuff[8+AAbstractMem.SizeOfAbstractMemPosition],AOrder,4);
+  Result := (AOrder>=3) and (ACount>=0);
+end;
+
 function TAbstractMemBTree.GetNode(AIdentify: TAbstractMemPosition): TAbstractBTree<TAbstractMemPosition, TAbstractMemPosition>.TAbstractBTreeNode;
 var LBuff : TBytes;
   i, LChildsCount : Integer;

src/libraries/abstractmem/UAbstractStorage.pas

@@ -0,0 +1,581 @@
+unit UAbstractStorage;
+
+{
+  This file is part of AbstractMem framework
+
+  Copyright (C) 2023 Albert Molina - [email protected]
+
+  https://github.com/PascalCoinDev/
+
+  *** BEGIN LICENSE BLOCK *****
+
+  The contents of this files are subject to the Mozilla Public License Version
+  2.0 (the "License"); you may not use this file except in compliance with
+  the License. You may obtain a copy of the License at
+  http://www.mozilla.org/MPL
+
+  Software distributed under the License is distributed on an "AS IS" basis,
+  WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
+  for the specific language governing rights and limitations under the License.
+
+  The Initial Developer of the Original Code is Albert Molina.
+
+  See ConfigAbstractMem.inc file for more info
+
+  ***** END LICENSE BLOCK *****
+}
+
+{$IFDEF FPC}
+  {$MODE DELPHI}
+{$ENDIF}
+
+interface
+
+uses
+  Classes, SysUtils,
+  SyncObjs,
+  UAbstractMem,
+  UFileMem,
+  UAbstractMemTList,
+  UAbstractMemBTree;
+
+{$I ./ConfigAbstractMem.inc }
+
+type
+  EAbstractStorage = Class(Exception);
+
+  TStorageStructType = (
+    ss_Unknown,
+    ss_Buffer,
+    ss_TAbstractMemBTree,
+    ss_TAbstractMemBTreeData,
+    ss_TAbstractMemBTreeDataIndex,
+    ss_TAbstractMemTList,
+    ss_TAbstractMemTListT,
+    ss_TAbstractMemOrderedTListT
+    );
+
+  TStorageStructInfo = record
+    Name : String;
+    AMPosition : TAbstractMemPosition;
+    StructType : TStorageStructType;
+    ClassName : String;
+    procedure Clear;
+    function GetInformation(const AAbstractMem : TAbstractMem; out ACount : Integer; out AInfo : String) : Boolean;
+  end;
+
+  TAbstractStorage = Class
+  public
+    type
+      TIsStorage = (is_not_initialized, is_empty, is_initialized, is_not);
+      TOnInitalizeStorage = procedure(ASender : TAbstractStorage; ACurrentVersion, AUpdateToVersion : Integer) of object;
+      TStorageStructInformation = Class(TAbstractMemBTreeData<TStorageStructInfo>)
+      protected
+        function LoadData(const APosition : TAbstractMemPosition) : TStorageStructInfo; override;
+        function SaveData(const AData : TStorageStructInfo) : TAMZone; override;
+      public
+        procedure AddStorageStruct(const AName : String; AAMPosition : TAbstractMemPosition; AStructType : TStorageStructType; AObject : TObject);
+        function GetStorageStruct(const AName : String) : TStorageStructInfo;
+        function GetStorageStructAMZone(const AName : String) : TAMZone;
+        function HasStorageStruct(const AName : String; out AStorageStruct : TStorageStructInfo) : Boolean;
+      End;
+  private
+    FFileName : String;
+    FAbstractMem : TAbstractMem;
+    FStorageVersion: Integer;
+    FStorageName: String;
+    FStorageStructPosition : TAbstractMemPosition;
+    FStorageStructInformation : TStorageStructInformation;
+    FIsStorage : TIsStorage;
+  protected
+    procedure DoInitialize(AClearContent : Boolean; const ANewStorageName : String; ANewStorageVersion : Integer; AIs64Bits : Boolean; AMemUnitsSize : Integer; AOnInitalizeStorage : TOnInitalizeStorage);
+  public
+    Constructor Create(const AFileName : String; AReadOnly : Boolean; const AStorageName : String; const AStorageVersion : Integer; AOnInitalizeStorage : TOnInitalizeStorage);
+    Destructor Destroy; override;
+    property AbstractMem : TAbstractMem read FAbstractMem;
+    property StorageName : String read FStorageName;
+    property StorageVersion : Integer read FStorageVersion;
+    procedure Init(const AStorageName : String; AStorageVersion : Integer; AIs64Bits : Boolean; AMemUnitsSize : Integer; AOnInitalizeStorage : TOnInitalizeStorage);
+    property StorageStructInformation : TStorageStructInformation read FStorageStructInformation;
+    procedure Analize(const AInfo : TStrings);
+  End;
+
+  TBytesStorage = Class
+  private
+    FBytes: TBytes;
+    FPosition : Integer;
+    procedure CheckRead(ASize : Integer);
+    function CanRead(ASize : Integer) : Boolean;
+    procedure NeedWrite(AAmount : Integer);
+  public
+    Constructor Create(ALength : Integer); overload;
+    Constructor Create(ABytes : TBytes); overload;
+    Class Function Load(const AAbstractMem : TAbstractMem; const APosition : TAbstractMemPosition) : TBytesStorage;
+    Class Function ReadFirstData(const AAbstractMem : TAbstractMem) : TBytesStorage;
+    property Bytes : TBytes read FBytes;
+    property Position : Integer read FPosition write FPosition;
+    function Size : Integer;
+    //
+    function ReadString : String;
+    function ReadByte : Byte;
+    function ReadUInt16 : UInt16;
+    function ReadUInt32 : UInt32;
+    function ReadUInt64 : UInt64;
+    function ReadStringDef(const ADefault : String) : String;
+    function ReadIntDef(ABytesCount : Integer; ADefault : Int64) : Int64;
+    function ReadUIntDef(ABytesCount : Integer; ADefault : UInt64) : UInt64;
+    //
+    function WriteString(const AValue : String) : TBytesStorage;
+    function WriteByte(const AValue : Byte) : TBytesStorage;
+    function WriteUInt16(const AValue : UInt16) : TBytesStorage;
+    function WriteUInt32(const AValue : UInt32) : TBytesStorage;
+    function WriteUInt64(const AValue : UInt64) : TBytesStorage;
+    function Save(const AAbstractMem : TAbstractMem) : TAMZone;
+  End;
+
+implementation
+
+function TStorageStructInformation_Comparer(const ALeft, ARight: TStorageStructInfo): Integer;
+begin
+  Result := AnsiCompareText(ALeft.Name.Trim,ARight.Name.Trim);
+end;
+
+{ TAbstractStorage }
+
+procedure TAbstractStorage.Analize(const AInfo: TStrings);
+var s : string;
+  i : Integer;
+  ss, ssOld : TStorageStructInfo;
+begin
+  AInfo.BeginUpdate;
+  try
+    AInfo.Add(Format('%s name:"%s" version:%d',[ClassName,Self.StorageName,Self.StorageVersion]));
+    if AbstractMem.Is64Bits then s:='64bits' else s:='32bits';
+    AInfo.Add(Format('AbstractMem %s %d bytes per unit total size %d',[s,AbstractMem.MemUnitsSize,AbstractMem.MaxAvailablePos]));
+    AInfo.Add(Format('StorageStructs: %d',[StorageStructInformation.Count]));
+    if StorageStructInformation.FindDataLowest(ss) then begin
+      repeat
+        if ss.GetInformation(AbstractMem,i,s) then begin
+          AInfo.Add(Format('StorageStruct: %s class %s count %d %s',[ss.Name,ss.ClassName,i,s]));
+        end;
+        ssOld := ss;
+      until not StorageStructInformation.FindDataSuccessor(ssOld,ss);
+    end;
+  finally
+    AInfo.EndUpdate;
+  end;
+end;
+
+constructor TAbstractStorage.Create(const AFileName : String; AReadOnly : Boolean;
+  const AStorageName : String; const AStorageVersion : Integer; AOnInitalizeStorage : TOnInitalizeStorage);
+begin
+  FIsStorage := is_not_initialized;
+  FAbstractMem := Nil;
+  FFileName := AFileName;
+  FStorageVersion := 0;
+  FStorageName := '';
+  FStorageStructPosition := 0;
+  FStorageStructInformation := Nil;
+  if (FFileName<>'') then begin
+    FAbstractMem := TFileMem.Create(FFileName,AReadOnly);
+  end else FAbstractMem := TMem.Create(0,AReadOnly);
+  DoInitialize(False,AStorageName,AStorageVersion,False,0,AOnInitalizeStorage);
+end;
+
+destructor TAbstractStorage.Destroy;
+begin
+  FStorageStructInformation.Free;
+  FAbstractMem.Free;
+  inherited;
+end;
+
+procedure TAbstractStorage.DoInitialize(AClearContent : Boolean; const ANewStorageName : String; ANewStorageVersion : Integer;
+  AIs64Bits : Boolean; AMemUnitsSize : Integer; AOnInitalizeStorage : TOnInitalizeStorage);
+const
+  CT_HEADER = 'TAbstractStorage';
+  CT_VERSION = 1;
+
+var LfdZone, LssZone : TAMZone;
+  i : Integer;
+  LBytesStorage : TBytesStorage;
+  s : String;
+begin
+  if AClearContent then begin
+    FreeAndNil(FStorageStructInformation);
+    AbstractMem.ClearContent(AIs64Bits,AMemUnitsSize);
+    //
+    LfdZone := AbstractMem.New(Length(CT_HEADER)+Length(ANewStorageName)+50);
+    LssZone := AbstractMem.New(TStorageStructInformation.MinAbstractMemInitialPositionSize(AbstractMem));
+    FStorageStructPosition := LssZone.position;
+    LBytesStorage := TBytesStorage.Create(LfdZone.size);
+    try
+      LBytesStorage.WriteString(CT_HEADER).WriteUInt32(CT_VERSION).WriteUInt64(FStorageStructPosition).
+        WriteString(ANewStorageName).WriteUInt32(ANewStorageVersion);
+      AbstractMem.Write(LfdZone.position,LBytesStorage.Bytes[0],LBytesStorage.Size);
+    finally
+      LBytesStorage.Free;
+    end;
+    FStorageStructInformation := TStorageStructInformation.Create(AbstractMem,LssZone,False,7,TStorageStructInformation_Comparer);
+    FStorageStructInformation.AddStorageStruct(FStorageStructInformation.ClassName,FStorageStructPosition,ss_TAbstractMemBTreeData,FStorageStructInformation);
+    if Assigned(AOnInitalizeStorage) then begin
+      AOnInitalizeStorage(Self,0,ANewStorageVersion);
+    end;
+  end;
+  //
+  FreeAndNil(FStorageStructInformation);
+  //
+  FIsStorage := is_not_initialized;
+  LBytesStorage := TBytesStorage.ReadFirstData(AbstractMem);
+  Try
+    if LBytesStorage.Size>0 then begin
+      FIsStorage := is_not;
+      s := LBytesStorage.ReadStringDef('');
+      i := LBytesStorage.ReadIntDef(4,0);
+      FIsStorage := is_not;
+      if (s=CT_HEADER) and (i = CT_VERSION) then begin
+        FStorageStructPosition := LBytesStorage.ReadUInt64;
+        if FAbstractMem.GetUsedZoneInfo(FStorageStructPosition,True,LfdZone) then begin
+          FStorageName := LBytesStorage.ReadString;
+          FStorageVersion := LBytesStorage.ReadUInt32;
+          FStorageStructInformation := TStorageStructInformation.Create(FAbstractMem,LfdZone,False,7,
+            TStorageStructInformation_Comparer);
+          FIsStorage := is_initialized;
+          if Assigned(AOnInitalizeStorage) and (Not AbstractMem.ReadOnly) and (FStorageName=ANewStorageName) and (FStorageVersion<ANewStorageVersion) then begin
+            AOnInitalizeStorage(Self,FStorageVersion,ANewStorageVersion);
+          end;
+        end else FStorageStructPosition := 0;
+      end;
+    end else begin
+      FIsStorage := is_empty;
+    end;
+  Finally
+    LBytesStorage.Free;
+  End;
+end;
+
+
+procedure TAbstractStorage.Init(const AStorageName: String;
+  AStorageVersion: Integer; AIs64Bits : Boolean; AMemUnitsSize : Integer; AOnInitalizeStorage : TOnInitalizeStorage);
+begin
+  DoInitialize(True,AStorageName,AStorageVersion,AIs64Bits,AMemUnitsSize,AOnInitalizeStorage);
+end;
+
+{ TAbstractStorage.TStorageStructInformation }
+
+procedure TAbstractStorage.TStorageStructInformation.AddStorageStruct(
+  const AName: String; AAMPosition: TAbstractMemPosition;
+  AStructType: TStorageStructType; AObject : TObject);
+var ss : TStorageStructInfo;
+begin
+  ss.Clear;
+  ss.Name := AName;
+  ss.AMPosition := AAMPosition;
+  ss.StructType := AStructType;
+  if Assigned(AObject) then ss.ClassName := AObject.ClassName;
+  if not Self.AddData(ss) then raise EAbstractStorage.Create(Format('Cannot add StorageStruct "%s"',[AName]));
+end;
+
+function TAbstractStorage.TStorageStructInformation.GetStorageStruct(
+  const AName: String): TStorageStructInfo;
+begin
+  if not HasStorageStruct(AName,Result) then raise EAbstractStorage.Create(Format('Cannot find storage struct "%s"',[AName]));
+end;
+
+function TAbstractStorage.TStorageStructInformation.GetStorageStructAMZone(
+  const AName: String): TAMZone;
+var ss : TStorageStructInfo;
+begin
+  ss := GetStorageStruct(AName);
+  if not Self.AbstractMem.GetUsedZoneInfo(ss.AMPosition,True,Result) then raise EAbstractStorage.Create(Format('Cannot find AMZone for %s',[AName]));
+end;
+
+function TAbstractStorage.TStorageStructInformation.HasStorageStruct(
+  const AName: String; out AStorageStruct: TStorageStructInfo): Boolean;
+var ss : TStorageStructInfo;
+begin
+  ss.Clear;
+  ss.Name := AName;
+  Result := FindData(ss,AStorageStruct);
+end;
+
+function TAbstractStorage.TStorageStructInformation.LoadData(
+  const APosition: TAbstractMemPosition): TStorageStructInfo;
+var LBytesStorage : TBytesStorage;
+begin
+  Result.Clear;
+  LBytesStorage := TBytesStorage.Load(AbstractMem,APosition);
+  Try
+    Result.Name := LBytesStorage.ReadString;
+    Result.AMPosition := LBytesStorage.ReadUInt64;
+    Result.StructType := TStorageStructType(LBytesStorage.ReadByte);
+    Result.ClassName := LBytesStorage.ReadString;
+  Finally
+    LBytesStorage.Free;
+  End;
+end;
+
+function TAbstractStorage.TStorageStructInformation.SaveData(
+  const AData: TStorageStructInfo): TAMZone;
+var LBytesStorage : TBytesStorage;
+begin
+  LBytesStorage := TBytesStorage.Create(0);
+  try
+    LBytesStorage.WriteString(AData.Name);
+    LBytesStorage.WriteUInt64(AData.AMPosition);
+    LBytesStorage.WriteByte(Byte(AData.StructType));
+    LBytesStorage.WriteString(AData.ClassName);
+    Result := LBytesStorage.Save(AbstractMem);
+  finally
+    LBytesStorage.Free;
+  end;
+end;
+
+{ TStorageStructInfo }
+
+procedure TStorageStructInfo.Clear;
+begin
+  Self.Name := '';
+  Self.AMPosition := 0;
+  Self.StructType := ss_Unknown;
+  Self.ClassName := '';
+end;
+
+function TStorageStructInfo.GetInformation(const AAbstractMem: TAbstractMem;
+  out ACount: Integer; out AInfo : String): Boolean;
+var amz : TAMZone;
+  obj : TObject;
+  allowduplicates : boolean;
+  order : Integer;
+begin
+  Result := False;
+  ACount := 0;
+  AInfo := '';
+  if not AAbstractMem.GetUsedZoneInfo(self.AMPosition,true,amz) then Exit;
+  case Self.StructType of
+    ss_Buffer: begin
+      ACount := amz.size;
+      Result := True;
+    end;
+    ss_TAbstractMemBTree, ss_TAbstractMemBTreeData, ss_TAbstractMemBTreeDataIndex : begin
+      if TAbstractMemBTree.GetInfo(AAbstractMem,amz,allowduplicates,order,ACount) then begin
+        AInfo := Format('Order %d',[order]);
+        if allowduplicates then AInfo := AInfo + ' with duplicates' else AInfo := AInfo + ' without duplicates';
+        Result := True;
+      end;
+    end;
+    ss_TAbstractMemTList: begin
+      obj := TAbstractMemTList.Create(AAbstractMem,amz,3,false);
+      try
+        ACount := TAbstractMemTList(obj).Count;
+        Result := True;
+      finally
+        obj.Free;
+      end;
+    end;
+    ss_TAbstractMemTListT, ss_TAbstractMemOrderedTListT: begin
+      obj := TAbstractMemTListBaseAbstract<Integer>.Create(AAbstractMem,amz,3,false);
+      try
+        ACount := TAbstractMemTListBaseAbstract<Integer>(obj).Count;
+        Result := True;
+      finally
+        obj.Free;
+      end;
+    end
+  end;
+
+end;
+
+{ TBytesStorage }
+
+function TBytesStorage.CanRead(ASize: Integer): Boolean;
+begin
+  Result := (ASize>=0) and ((FPosition + ASize)<Length(FBytes));
+end;
+
+procedure TBytesStorage.CheckRead(ASize: Integer);
+begin
+  if (ASize<=0) or ((FPosition + ASize)>Length(FBytes)) then raise EAbstractStorage.Create(Format('Canot %s.Read %d bytes (pos %d/%d)',[Self.ClassName,ASize,FPosition,Length(FBytes)]));
+end;
+
+constructor TBytesStorage.Create(ABytes: TBytes);
+begin
+  SetLength(FBytes,Length(ABytes));
+  FPosition := 0;
+  Move(ABytes[0],FBytes[0],Length(ABytes));
+end;
+
+constructor TBytesStorage.Create(ALength : Integer);
+begin
+  if ALength<0 then ALength := 0;
+  SetLength(FBytes,ALength);
+  FPosition := 0;
+end;
+
+class function TBytesStorage.Load(const AAbstractMem: TAbstractMem;
+  const APosition: TAbstractMemPosition): TBytesStorage;
+var LZone : TAMZone;
+begin
+  if Not AAbstractMem.GetUsedZoneInfo( APosition, False, LZone) then
+    raise EAbstractStorage.Create(Format('%s.Load Inconsistency error used zone info not found at pos %d',[Self.ClassName,APosition]));
+  Result := TBytesStorage.Create(LZone.size);
+  Try
+    if AAbstractMem.Read(LZone.position, Result.FBytes[0], LZone.size )<>LZone.size then
+      raise EAbstractStorage.Create(Format('%s.Load Inconsistency error cannot read %d bytes at pos %d',[Self.ClassName,LZone.size,APosition]));
+  Except
+    Result.Free;
+    Raise;
+  End;
+end;
+
+procedure TBytesStorage.NeedWrite(AAmount: Integer);
+begin
+  if FPosition+AAmount > Length(FBytes) then begin
+    SetLength(FBytes,FPosition+AAmount);
+  end;
+end;
+
+function TBytesStorage.ReadByte: Byte;
+begin
+  Result := 0;
+  CheckRead(1);
+  Move(FBytes[FPosition],Result,1);
+  inc(FPosition,1);
+end;
+
+class function TBytesStorage.ReadFirstData(
+  const AAbstractMem: TAbstractMem): TBytesStorage;
+var LfdZone : TAMZone;
+begin
+  Result := TBytesStorage.Create(0);
+  if not AAbstractMem.ReadFirstData(LfdZone,Result.FBytes) then Exit;
+end;
+
+function TBytesStorage.ReadIntDef(ABytesCount: Integer;
+  ADefault: Int64): Int64;
+begin
+  if CanRead(ABytesCount) then begin
+    Result := 0;
+    Move(FBytes[FPosition],Result,ABytesCount);
+    inc(FPosition,ABytesCount);
+  end else Result := ADefault;
+end;
+
+function TBytesStorage.ReadString: String;
+var LPos : Integer;
+  l : Integer;
+begin
+  LPos := FPosition;
+  try
+    l := ReadUInt16;
+    if (l<0) then raise EAbstractStorage.Create(Format('%s.ReadString Invalid Length %d for String',[Self.ClassName, l]));
+    CheckRead(l);
+    Result := TEncoding.ANSI.GetString(FBytes,FPosition,l);
+    inc(FPosition,l);
+  Except
+    FPosition := LPos;
+    Raise;
+  end;
+end;
+
+function TBytesStorage.ReadStringDef(const ADefault: String): String;
+var LPos : Integer;
+  l : Int64;
+begin
+  LPos := FPosition;
+  l := Integer(ReadIntDef(2,-1));
+  if (l<0) or (Not CanRead(l)) then begin
+    Result := ADefault;
+    FPosition := LPos;
+  end else begin
+    Result := TEncoding.ANSI.GetString(FBytes,FPosition,Integer(l));
+    inc(FPosition,Integer(l));
+  end;
+end;
+
+function TBytesStorage.ReadUInt16: UInt16;
+begin
+  Result := 0;
+  CheckRead(2);
+  Move(FBytes[FPosition],Result,2);
+  inc(FPosition,2);
+end;
+
+function TBytesStorage.ReadUInt32: UInt32;
+begin
+  Result := 0;
+  CheckRead(4);
+  Move(FBytes[FPosition],Result,4);
+  inc(FPosition,4);
+end;
+
+function TBytesStorage.Save(const AAbstractMem: TAbstractMem): TAMZone;
+begin
+  Result := AAbstractMem.New(Self.Size);
+  AAbstractMem.Write(Result.position,Self.FBytes[0],Self.Size);
+end;
+
+function TBytesStorage.Size: Integer;
+begin
+  Result := Length(FBytes);
+end;
+
+function TBytesStorage.ReadUInt64: UInt64;
+begin
+  Result := 0;
+  CheckRead(8);
+  Move(FBytes[FPosition],Result,8);
+  inc(FPosition,8);
+end;
+
+function TBytesStorage.ReadUIntDef(ABytesCount: Integer;
+  ADefault: UInt64): UInt64;
+begin
+  Result := ReadIntDef(ABytesCount,ADefault);
+end;
+
+function TBytesStorage.WriteByte(const AValue: Byte) : TBytesStorage;
+begin
+  NeedWrite(1);
+  Move(AValue,FBytes[FPosition],1);
+  inc(FPosition,1);
+  Result := Self;
+end;
+
+function TBytesStorage.WriteString(const AValue: String) : TBytesStorage;
+var Lb : TBytes;
+begin
+  WriteUInt16(AValue.Length);
+  if Length(AValue)>0 then begin
+    NeedWrite(Length(AValue));
+    Lb := TEncoding.ANSI.GetBytes(AValue);
+    Move(Lb[0],FBytes[FPosition],Length(AValue));
+    inc(FPosition,Length(AValue));
+  end;
+  Result := Self;
+end;
+
+function TBytesStorage.WriteUInt16(const AValue: UInt16) : TBytesStorage;
+begin
+  NeedWrite(2);
+  Move(AValue,FBytes[FPosition],2);
+  inc(FPosition,2);
+  Result := Self;
+end;
+
+function TBytesStorage.WriteUInt32(const AValue: UInt32) : TBytesStorage;
+begin
+  NeedWrite(4);
+  Move(AValue,FBytes[FPosition],4);
+  inc(FPosition,4);
+  Result := Self;
+end;
+
+function TBytesStorage.WriteUInt64(const AValue: UInt64) : TBytesStorage;
+begin
+  NeedWrite(8);
+  Move(AValue,FBytes[FPosition],8);
+  inc(FPosition,8);
+  Result := Self;
+end;
+
+end.

src/libraries/abstractmem/tests/AbstractMem.Tests.dpr

@@ -35,12 +35,14 @@ uses
   UCacheMem in '..\UCacheMem.pas',
   UFileMem in '..\UFileMem.pas',
   UOrderedList in '..\UOrderedList.pas',
+  UAbstractStorage in '..\UAbstractStorage.pas',
   UCacheMem.Tests in 'src\UCacheMem.Tests.pas',
   UAbstractMem.Tests in 'src\UAbstractMem.Tests.pas',
   UAbstractBTree.Tests in 'src\UAbstractBTree.Tests.pas',
   UAbstractMemBTree.Tests in 'src\UAbstractMemBTree.Tests.pas',
   UAbstractMemTList.Tests in 'src\UAbstractMemTList.Tests.pas',
   UFileMem.Tests in 'src\UFileMem.Tests.pas',
+  UAbstractStorage.Tests in 'src\UAbstractStorage.Tests.pas',
   UMemoryBTreeData.Tests in 'src\UMemoryBTreeData.Tests.pas';
 
 {$IF Defined(FPC) and (Defined(CONSOLE_TESTRUNNER))}

src/libraries/abstractmem/tests/AbstractMem.Tests.lpi

@@ -1,11 +1,13 @@
 <?xml version="1.0" encoding="UTF-8"?>
 <CONFIG>
   <ProjectOptions>
-    <Version Value="11"/>
+    <Version Value="12"/>
     <PathDelim Value="\"/>
     <General>
+      <Flags>
+        <CompatibilityMode Value="True"/>
+      </Flags>
       <SessionStorage Value="InProjectDir"/>
-      <MainUnit Value="0"/>
       <Title Value="fpcunitproject1"/>
       <ResourceType Value="res"/>
       <UseXPManifest Value="True"/>
@@ -19,7 +21,6 @@
     </PublishOptions>
     <RunParams>
       <FormatVersion Value="2"/>
-      <Modes Count="0"/>
     </RunParams>
     <RequiredPackages Count="3">
       <Item1>
@@ -32,7 +33,7 @@
         <PackageName Value="FCL"/>
       </Item3>
     </RequiredPackages>
-    <Units Count="16">
+    <Units Count="18">
       <Unit0>
         <Filename Value="AbstractMem.Tests.dpr"/>
         <IsPartOfProject Value="True"/>
@@ -97,6 +98,14 @@
         <Filename Value="src\UAbstractMemTList.Tests.pas"/>
         <IsPartOfProject Value="True"/>
       </Unit15>
+      <Unit16>
+        <Filename Value="..\UMemoryBTreeData.pas"/>
+        <IsPartOfProject Value="True"/>
+      </Unit16>
+      <Unit17>
+        <Filename Value="src\UMemoryBTreeData.Tests.pas"/>
+        <IsPartOfProject Value="True"/>
+      </Unit17>
     </Units>
   </ProjectOptions>
   <CompilerOptions>

src/libraries/abstractmem/tests/src/UAbstractMemTList.Tests.pas

@@ -18,6 +18,32 @@ uses
    UAbstractMemTList;
 
 type
+  TTestRecord = record
+    i : Integer;
+    s : String;
+    procedure Clear;
+    procedure RandomData;
+  end;
+
+  TAbstractMemTList_TTestRecord = class(TAbstractMemTList<TTestRecord>)
+  protected
+    procedure LoadFrom(const ABytes : TBytes; var AItem : TTestRecord); override;
+    procedure SaveTo(const AItem : TTestRecord; AIsAddingItem : Boolean; var ABytes : TBytes); override;
+  public
+    procedure AddRandom;
+    procedure AddValues(i : Integer; s : String);
+  end;
+
+  TAbstractMemOrderedTList_TTestRecord = class(TAbstractMemOrderedTList<TTestRecord>)
+  protected
+    procedure LoadFrom(const ABytes : TBytes; var AItem : TTestRecord); override;
+    procedure SaveTo(const AItem : TTestRecord; AIsAddingItem : Boolean; var ABytes : TBytes); override;
+    function Compare(const ALeft, ARight : TTestRecord) : Integer; override;
+  public
+    procedure AddRandom;
+    procedure AddValues(i : Integer; s : String);
+  end;
+
    TestTAbstractMemTList = class(TTestCase)
    strict private
    public
@@ -29,10 +55,12 @@ type
      procedure Test_32b_Cache;
      procedure Test_64b_NoCache;
      procedure Test_64b_Cache;
+     procedure Test_TTestRecord;
    end;
 
 implementation
 
+uses UAbstractStorage;
 
 { TestTAbstractMemTList }
 
@@ -50,8 +78,10 @@ procedure TestTAbstractMemTList.TestInfinite(A64Bytes, AUseCache,
   AUseCacheAuto: Boolean; AElementsPerBlock: Integer);
 var LMem : TMem;
   LAMList : TAbstractMemTList;
+  LAMList_TR : TAbstractMemTList_TTestRecord;
   LAMZone : TAMZone;
   i : Integer;
+  LTR : TTestRecord;
 begin
   RandSeed:=0;
   LMem := TMem.Create(0,False);
@@ -59,10 +89,14 @@ begin
     LMem.Initialize(A64Bytes,4);
     LAMZone := LMem.New(TAbstractMemTList.MinAbstractMemTListHeaderSize(LMem));
     LAMList := TAbstractMemTList.Create(LMem,LAMZone,AElementsPerBlock,AUseCache);
+    LAMList_TR := TAbstractMemTList_TTestRecord.Create(LMem,LMem.New(TAbstractMemTList.MinAbstractMemTListHeaderSize(LMem)),5,True);
     Try
       LAMList.UseCacheAuto := AUseCacheAuto;
       // Start process
       repeat
+        LTR.RandomData;
+        LAMList_TR.Add(LTR);
+        //
         LAMList.Add(LMem.New((Random(50)+1)*4).position);
         if (Random(5)=0) and (LAMList.Count>0) then begin
           i := Random(LAMList.Count);
@@ -89,6 +123,7 @@ begin
       //
     Finally
       LAMList.Free;
+      LAMList_TR.Free;
     End;
   Finally
     LMem.Free;
@@ -115,6 +150,134 @@ begin
   TestInfinite(True,False,False,10);
 end;
 
+procedure TestTAbstractMemTList.Test_TTestRecord;
+begin
+
+end;
+
+{ TTestRecord }
+
+procedure TTestRecord.Clear;
+begin
+  Self.i := 0;
+  Self.s := '';
+end;
+
+procedure TTestRecord.RandomData;
+var i,j : Integer;
+begin
+  Self.s := '';
+  Self.i := Random(100000);
+  j := Random(25)+5;
+  for i := 1 to j do begin
+    Self.s := Self.s + Char(Random(ord('Z')-ord('A'))+ord('A'));
+  end;
+end;
+
+{ TAbstractMemTList_TTestRecord }
+
+procedure TAbstractMemTList_TTestRecord.AddRandom;
+var tr : TTestRecord;
+begin
+  tr.Clear;
+  tr.RandomData;
+  Add(tr);
+end;
+
+procedure TAbstractMemTList_TTestRecord.AddValues(i: Integer; s: String);
+var tr : TTestRecord;
+begin
+  tr.Clear;
+  tr.i := i;
+  tr.s := s;
+  Add(tr);
+end;
+
+procedure TAbstractMemTList_TTestRecord.LoadFrom(const ABytes: TBytes;
+  var AItem: TTestRecord);
+var bs : TBytesStorage;
+begin
+  bs := TBytesStorage.Create(ABytes);
+  try
+    AItem.Clear;
+    AItem.i := bs.ReadUInt32;
+    AItem.s := bs.ReadString;
+  finally
+    bs.Free;
+  end;
+end;
+
+procedure TAbstractMemTList_TTestRecord.SaveTo(const AItem: TTestRecord;
+  AIsAddingItem: Boolean; var ABytes: TBytes);
+var bs : TBytesStorage;
+begin
+  bs := TBytesStorage.Create(0);
+  try
+    bs.WriteUInt32(AItem.i);
+    bs.WriteString(AItem.s);
+    ABytes := Copy(bs.Bytes,0,bs.Size);
+  finally
+    bs.Free;
+  end;
+end;
+
+{ TAbstractMemOrderedTList_TTestRecord }
+
+procedure TAbstractMemOrderedTList_TTestRecord.AddRandom;
+var tr : TTestRecord;
+begin
+  tr.Clear;
+  tr.RandomData;
+  Add(tr);
+end;
+
+procedure TAbstractMemOrderedTList_TTestRecord.AddValues(i: Integer;
+  s: String);
+var tr : TTestRecord;
+begin
+  tr.Clear;
+  tr.i := i;
+  tr.s := s;
+  Add(tr);
+end;
+
+function TAbstractMemOrderedTList_TTestRecord.Compare(const ALeft,
+  ARight: TTestRecord): Integer;
+begin
+  Result := ALeft.i - ARight.i;
+  if (Result=0) then begin
+    Result := AnsiCompareStr(ALeft.s,ARight.s);
+  end;
+end;
+
+procedure TAbstractMemOrderedTList_TTestRecord.LoadFrom(const ABytes: TBytes;
+  var AItem: TTestRecord);
+var bs : TBytesStorage;
+begin
+  bs := TBytesStorage.Create(ABytes);
+  try
+    AItem.Clear;
+    AItem.i := bs.ReadUInt32;
+    AItem.s := bs.ReadString;
+  finally
+    bs.Free;
+  end;
+end;
+
+procedure TAbstractMemOrderedTList_TTestRecord.SaveTo(const AItem: TTestRecord;
+  AIsAddingItem: Boolean; var ABytes: TBytes);
+var bs : TBytesStorage;
+begin
+  bs := TBytesStorage.Create(0);
+  try
+    bs.WriteUInt32(AItem.i);
+    bs.WriteString(AItem.s);
+    ABytes := Copy(bs.Bytes,0,bs.Size);
+  finally
+    bs.Free;
+  end;
+end;
+
 initialization
   RegisterTest(TestTAbstractMemTList{$IFNDEF FPC}.Suite{$ENDIF});
 end.

src/libraries/abstractmem/tests/src/UAbstractStorage.Tests.pas

@@ -0,0 +1,199 @@
+unit UAbstractStorage.Tests;
+
+{$IFDEF FPC}
+  {$MODE Delphi}
+{$ENDIF}
+
+interface
+
+ uses
+   SysUtils, Classes,
+   {$IFDEF FPC}
+   fpcunit, testutils, testregistry,
+   {$ELSE}
+   TestFramework,
+   System.IOUtils,
+   {$ENDIF}
+   {$IFNDEF FPC}System.Generics.Collections,System.Generics.Defaults,{$ELSE}Generics.Collections,Generics.Defaults,{$ENDIF}
+   UAbstractStorage, UAbstractMem, UAbstractMemBTree, UAbstractMemTList;
+
+{$I ./../../ConfigAbstractMem.inc }
+
+type
+   TestTAbstractStorage = class(TTestCase)
+   strict private
+   private
+     procedure InitializeStorage(ASender : TAbstractStorage; ACurrentVersion, AUpdateToVersion : Integer);
+     procedure AddData(ASender: TAbstractStorage);
+     procedure CheckAddedData(ASender: TAbstractStorage);
+   public
+     procedure SetUp; override;
+     procedure TearDown; override;
+   published
+     procedure Test_TAbstractStorage;
+   end;
+
+implementation
+
+uses UOrderedList, UAbstractMemTList.Tests, UAbstractMemBTree.Tests;
+
+{ TestTAbstractStorage }
+
+procedure TestTAbstractStorage.AddData(ASender: TAbstractStorage);
+var  i : Integer;
+  aml_1 : TAbstractMemTList;
+  aml_int : TAbstractMemTList_TTestRecord;
+  aml_int_ord : TAbstractMemOrderedTList_TTestRecord;
+  ambt_1 : TAbstractMemBTree;
+  ambt_int : TAbstractMemBTreeDataExampleInteger;
+  ambt_index : TAbstractMemBTreeDataIndex<Integer>;
+begin
+  aml_1 := TAbstractMemTList.Create(ASender.AbstractMem,ASender.StorageStructInformation.GetStorageStructAMZone('TAbstractMemTList'),5,True);
+  aml_int := TAbstractMemTList_TTestRecord.Create(ASender.AbstractMem,ASender.StorageStructInformation.GetStorageStructAMZone('TAbstractMemTList<>'),5,True);
+  aml_int_ord := TAbstractMemOrderedTList_TTestRecord.Create(ASender.AbstractMem,ASender.StorageStructInformation.GetStorageStructAMZone('TAbstractMemOrderedTList<>'),5,True,True);
+  ambt_1 := TAbstractMemBTree.Create(ASender.AbstractMem,ASender.StorageStructInformation.GetStorageStructAMZone('TAbstractMemBTree'),False,5);
+  ambt_int := TAbstractMemBTreeDataExampleInteger.Create(ASender.AbstractMem,ASender.StorageStructInformation.GetStorageStructAMZone('TAbstractMemBTreeData<Integer>'),False,5,TComparison_Integer);
+  ambt_index := TAbstractMemBTreeDataIndex<Integer>.Create(ambt_int,ASender.StorageStructInformation.GetStorageStructAMZone('TAbstractMemBTreeDataAbstract<Integer>'),False,5,TComparison_Integer);
+  try
+    for i := 1 to 100 do begin
+      aml_1.Add(ASender.AbstractMem.New(50).position);
+      aml_int.AddRandom;
+      aml_int_ord.AddRandom;
+      ambt_1.Add(ASender.AbstractMem.New(50).position);
+      ambt_int.AddData(Random(5000));
+    end;
+  finally
+    aml_1.Free;
+    aml_int.Free;
+    aml_int_ord.Free;
+    ambt_1.Free;
+    ambt_int.Free;
+    ambt_index.Free;
+  end;
+end;
+
+procedure TestTAbstractStorage.CheckAddedData(ASender: TAbstractStorage);
+var  i : Integer;
+  aml_1 : TAbstractMemTList;
+  aml_int : TAbstractMemTList_TTestRecord;
+  aml_int_ord : TAbstractMemOrderedTList_TTestRecord;
+  ambt_1 : TAbstractMemBTree;
+  ambt_int : TAbstractMemBTreeDataExampleInteger;
+  ambt_index : TAbstractMemBTreeDataIndex<Integer>;
+begin
+  aml_1 := TAbstractMemTList.Create(ASender.AbstractMem,ASender.StorageStructInformation.GetStorageStructAMZone('TAbstractMemTList'),5,True);
+  aml_int := TAbstractMemTList_TTestRecord.Create(ASender.AbstractMem,ASender.StorageStructInformation.GetStorageStructAMZone('TAbstractMemTList<>'),5,True);
+  aml_int_ord := TAbstractMemOrderedTList_TTestRecord.Create(ASender.AbstractMem,ASender.StorageStructInformation.GetStorageStructAMZone('TAbstractMemOrderedTList<>'),5,True,True);
+  ambt_1 := TAbstractMemBTree.Create(ASender.AbstractMem,ASender.StorageStructInformation.GetStorageStructAMZone('TAbstractMemBTree'),False,5);
+  ambt_int := TAbstractMemBTreeDataExampleInteger.Create(ASender.AbstractMem,ASender.StorageStructInformation.GetStorageStructAMZone('TAbstractMemBTreeData<Integer>'),False,5,TComparison_Integer);
+  ambt_index := TAbstractMemBTreeDataIndex<Integer>.Create(ambt_int,ASender.StorageStructInformation.GetStorageStructAMZone('TAbstractMemBTreeDataAbstract<Integer>'),False,5,TComparison_Integer);
+  try
+    Assert(aml_1.Count=100);
+    Assert(aml_int.Count=100);
+    Assert(aml_int_ord.Count=100);
+    Assert(ambt_1.Count=100);
+    Assert(ambt_int.Count=100);
+    Assert(ambt_index.Count=100);
+  finally
+    aml_1.Free;
+    aml_int.Free;
+    aml_int_ord.Free;
+    ambt_1.Free;
+    ambt_int.Free;
+    ambt_index.Free;
+  end;
+end;
+
+procedure TestTAbstractStorage.InitializeStorage(ASender: TAbstractStorage; ACurrentVersion, AUpdateToVersion: Integer);
+var amz : TAMZone;
+  aml_1 : TAbstractMemTList;
+  aml_int : TAbstractMemTList_TTestRecord;
+  aml_int_ord : TAbstractMemOrderedTList_TTestRecord;
+  ambt_1 : TAbstractMemBTree;
+  ambt_int : TAbstractMemBTreeDataExampleInteger;
+  ambt_index : TAbstractMemBTreeDataIndex<Integer>;
+  i : Integer;
+begin
+  if ACurrentVersion>=AUpdateToVersion then raise EAbstractStorage.Create('Invalid update version');
+  aml_1 := Nil;
+  aml_int := Nil;
+  aml_int_ord := Nil;
+  ambt_1 := Nil;
+  ambt_int := Nil;
+  ambt_index := Nil;
+  try
+    if ACurrentVersion<1 then begin
+      amz := ASender.AbstractMem.New(TAbstractMemTList.MinAbstractMemTListHeaderSize(ASender.AbstractMem));
+      aml_1 := TAbstractMemTList.Create(ASender.AbstractMem,amz,5,True);
+      ASender.StorageStructInformation.AddStorageStruct('TAbstractMemTList',amz.position,ss_TAbstractMemTList,aml_1);
+      //
+      amz := ASender.AbstractMem.New(TAbstractMemTList.MinAbstractMemTListHeaderSize(ASender.AbstractMem));
+      aml_int := TAbstractMemTList_TTestRecord.Create(ASender.AbstractMem,amz,5,True);
+      ASender.StorageStructInformation.AddStorageStruct('TAbstractMemTList<>',amz.position,ss_TAbstractMemTListT,aml_int);
+      //
+      amz := ASender.AbstractMem.New(TAbstractMemTList.MinAbstractMemTListHeaderSize(ASender.AbstractMem));
+      aml_int_ord := TAbstractMemOrderedTList_TTestRecord.Create(ASender.AbstractMem,amz,5,True,True);
+      ASender.StorageStructInformation.AddStorageStruct('TAbstractMemOrderedTList<>',amz.position,ss_TAbstractMemOrderedTListT,aml_int_ord);
+      //
+      amz := ASender.AbstractMem.New(TAbstractMemBTree.MinAbstractMemInitialPositionSize(ASender.AbstractMem));
+      ambt_1 := TAbstractMemBTree.Create(ASender.AbstractMem,amz,False,5);
+      ASender.StorageStructInformation.AddStorageStruct('TAbstractMemBTree',amz.position,ss_TAbstractMemBTree,ambt_1);
+      //
+      amz := ASender.AbstractMem.New(TAbstractMemBTreeDataAbstract<Integer>.MinAbstractMemInitialPositionSize(ASender.AbstractMem));
+      ambt_int := TAbstractMemBTreeDataExampleInteger.Create(ASender.AbstractMem,amz,False,5,TComparison_Integer);
+      ASender.StorageStructInformation.AddStorageStruct('TAbstractMemBTreeData<Integer>',amz.position,ss_TAbstractMemBTree,ambt_int);
+      //
+      amz := ASender.AbstractMem.New(TAbstractMemBTreeDataAbstract<Integer>.MinAbstractMemInitialPositionSize(ASender.AbstractMem));
+      ambt_index := TAbstractMemBTreeDataIndex<Integer>.Create(ambt_int,amz,False,5,TComparison_Integer);
+      ASender.StorageStructInformation.AddStorageStruct('TAbstractMemBTreeDataAbstract<Integer>',amz.position,ss_TAbstractMemBTree,ambt_index);
+    end;
+  finally
+    aml_1.Free;
+    aml_int.Free;
+    aml_int_ord.Free;
+    ambt_1.Free;
+    ambt_int.Free;
+    ambt_index.Free;
+  end;
+
+end;
+
+procedure TestTAbstractStorage.SetUp;
+begin
+  inherited;
+
+end;
+
+procedure TestTAbstractStorage.TearDown;
+begin
+  inherited;
+
+end;
+
+procedure TestTAbstractStorage.Test_TAbstractStorage;
+var Las : TAbstractStorage;
+ lines: TStrings;
+ s : String;
+begin
+  Las := TAbstractStorage.Create('',False,'TEST',1,InitializeStorage);
+  try
+    Las.Init('TEST',2,Las.AbstractMem.Is64Bits,Las.AbstractMem.MemUnitsSize,InitializeStorage);
+    lines := TStringList.Create;
+    try
+      AddData(Las);
+      Las.Analize(lines);
+      CheckAddedData(Las);
+      s := lines.Text;
+      if s='' then Abort;
+
+    finally
+      lines.Free;
+    end;
+  finally
+    Las.Free;
+  end;
+end;
+
+initialization
+  RegisterTest(TestTAbstractStorage{$IFNDEF FPC}.Suite{$ENDIF});
+end.