Some improvements and bug fixes of TAbstractMem library

src/libraries/abstractmem/UAbstractBTree.pas

@@ -54,6 +54,7 @@ type
   TAbstractBTree<TIdentify, TData> = Class
   public
     type
+      TDataSource = TData;
       TIdentifyArray = Array of TIdentify;
       TDataArray = Array of TData;
       TAbstractBTreeNode = record
@@ -83,13 +84,11 @@ type
     function FindPrecessorExt(const ACircularProtectionList : TOrderedList<TIdentify>; var ANode : TAbstractBTreeNode; var iPos : Integer) : Boolean;
     function FindSuccessorExt(const ACircularProtectionList : TOrderedList<TIdentify>; var ANode : TAbstractBTreeNode; var iPos : Integer) : Boolean;
     procedure EraseTreeExt(var ANode : TAbstractBTreeNode);
-    function FindExt(const AData: TData; const ACircularProtectionList : TOrderedList<TIdentify>; out ANode : TAbstractBTreeNode; out iPos : Integer): Boolean;
     function FindLowestNodeExt(const ACircularProtectionList : TOrderedList<TIdentify>): TAbstractBTreeNode;
     function FindHighestNodeExt(const ACircularProtectionList : TOrderedList<TIdentify>): TAbstractBTreeNode;
   protected
     FCount: integer;
     FAbstractBTreeLock : TCriticalSection;
-    FIsFindingProcess : Boolean;
     function GetRoot: TAbstractBTreeNode; virtual; abstract;
     procedure SetRoot(var Value: TAbstractBTreeNode); virtual; abstract;
 
@@ -108,6 +107,9 @@ type
     function FindChildPos(const AIdent : TIdentify; const AParent : TAbstractBTreeNode) : Integer;
     procedure DisposeData(var AData : TData); virtual;
     function DoCompareData(const ALeftData, ARightData: TData): Integer; virtual;
+    procedure DoOnFindProcessStart; virtual;
+    procedure DoOnFindProcessEnd; virtual;
+    function DoFind(const AData: TData; const ACircularProtectionList : TOrderedList<TIdentify>; out ANode : TAbstractBTreeNode; out iPos : Integer): Boolean; virtual;
   public
     property AllowDuplicates : Boolean read FAllowDuplicates write FAllowDuplicates;
     function IsNil(const AIdentify : TIdentify) : Boolean; virtual; abstract;
@@ -194,7 +196,7 @@ begin
       LCircularProtectionList := TOrderedList<TIdentify>.Create(False,FOnCompareIdentify);
     end else LCircularProtectionList := Nil;
     Try
-      if (FindExt(AData,LCircularProtectionList,Lnode,iDataPos)) then begin
+      if (DoFind(AData,LCircularProtectionList,Lnode,iDataPos)) then begin
         if (Not FAllowDuplicates) then Exit(False);
         // Follow childs until leaf node
         while (Not Lnode.IsLeaf) do begin
@@ -405,7 +407,6 @@ end;
 
 constructor TAbstractBTree<TIdentify, TData>.Create(const AOnCompareIdentifyMethod: TComparison<TIdentify>; const AOnCompareDataMethod: TComparison<TData>; AAllowDuplicates : Boolean; AOrder: Integer);
 begin
-  FIsFindingProcess := False;
   FAbstractBTreeLock := TCriticalSection.Create;
   FOnCompareIdentify := AOnCompareIdentifyMethod;
   FOnCompareData := AOnCompareDataMethod;
@@ -435,7 +436,7 @@ begin
     end else LCircularProtectionList := Nil;
     try
 
-    if Not FindExt(AData,LCircularProtectionList,Lnode,iPos) then Exit(False);
+    if Not DoFind(AData,LCircularProtectionList,Lnode,iPos) then Exit(False);
 
     Assert(FCount<>0,'Cannot Delete when FCount = 0');
 
@@ -727,6 +728,37 @@ begin
   Result := FOnCompareData(ALeftData,ARightData);
 end;
 
+function TAbstractBTree<TIdentify, TData>.DoFind(const AData: TData;
+  const ACircularProtectionList: TOrderedList<TIdentify>;
+  out ANode: TAbstractBTreeNode; out iPos: Integer): Boolean;
+begin
+  DoOnFindProcessStart;
+  Try
+    ANode := GetRoot;
+    iPos := 0;
+    repeat
+      if Assigned(ACircularProtectionList) then begin
+        if ACircularProtectionList.Add(ANode.identify)<0 then raise EAbstractBTree.Create(ClassName+'.Find Circular T structure at Find for T='+ToString(ANode)+ ' searching for '+NodeDataToString(AData));
+      end;
+      if (BinarySearch(AData,ANode.data,iPos)) then Exit(True)
+      else if (Not ANode.IsLeaf) then ANode := GetNode( ANode.childs[ iPos ] )
+      else Exit(False);
+    until False;
+  Finally
+    DoOnFindProcessEnd;
+  End;
+end;
+
+procedure TAbstractBTree<TIdentify, TData>.DoOnFindProcessEnd;
+begin
+  //
+end;
+
+procedure TAbstractBTree<TIdentify, TData>.DoOnFindProcessStart;
+begin
+  //
+end;
+
 procedure TAbstractBTree<TIdentify, TData>.EraseTree;
 var Lnode : TAbstractBTreeNode;
 begin
@@ -809,7 +841,7 @@ begin
       LCircularProtectionList := TOrderedList<TIdentify>.Create(False,FOnCompareIdentify);
     end else LCircularProtectionList := Nil;
     Try
-      Result := FindExt(AData,LCircularProtectionList,ANode,iPos);
+      Result := DoFind(AData,LCircularProtectionList,ANode,iPos);
     Finally
       if Assigned(LCircularProtectionList) then LCircularProtectionList.Free;
     End;
@@ -826,27 +858,6 @@ begin
   raise EAbstractBTree.Create(Format('Child not found at %s',[ToString(AParent)]));
 end;
 
-function TAbstractBTree<TIdentify, TData>.FindExt(const AData: TData; const ACircularProtectionList: TOrderedList<TIdentify>;
-  out ANode: TAbstractBTreeNode; out iPos: Integer): Boolean;
-begin
-  Assert(Not FIsFindingProcess,'Is finding process');
-  FIsFindingProcess := True;
-  Try
-    ANode := GetRoot;
-    iPos := 0;
-    repeat
-      if Assigned(ACircularProtectionList) then begin
-        if ACircularProtectionList.Add(ANode.identify)<0 then raise EAbstractBTree.Create(ClassName+'.Find Circular T structure at Find for T='+ToString(ANode)+ ' searching for '+NodeDataToString(AData));
-      end;
-      if (BinarySearch(AData,ANode.data,iPos)) then Exit(True)
-      else if (Not ANode.IsLeaf) then ANode := GetNode( ANode.childs[ iPos ] )
-      else Exit(False);
-    until False;
-  Finally
-    FIsFindingProcess := False;
-  End;
-end;
-
 function TAbstractBTree<TIdentify, TData>.FindHighest(out AHighest : TData) : Boolean;
 var Lnode : TAbstractBTreeNode;
 begin
@@ -968,7 +979,7 @@ begin
     end else LCircularProtectionList := Nil;
     Try
       Result := False;
-      if Not FindExt(AData,LCircularProtectionList,Lnode,iPos) then Exit(False);
+      if Not DoFind(AData,LCircularProtectionList,Lnode,iPos) then Exit(False);
       if Assigned(LCircularProtectionList) then LCircularProtectionList.Clear;
       repeat
         Result := FindPrecessorExt(LCircularProtectionList,Lnode,iPos);
@@ -1052,7 +1063,7 @@ begin
     end else LCircularProtectionList := Nil;
     Try
       Result := False;
-      if Not FindExt(AData,LCircularProtectionList,Lnode,iPos) then Exit(False);
+      if Not DoFind(AData,LCircularProtectionList,Lnode,iPos) then Exit(False);
       if Assigned(LCircularProtectionList) then LCircularProtectionList.Clear;
       repeat
         Result := FindSuccessorExt(LCircularProtectionList,Lnode,iPos);

src/libraries/abstractmem/UAbstractMem.pas

@@ -112,9 +112,11 @@ Type
     FNextAvailablePos : Int64;
     FMaxAvailablePos : Int64;
     FMemLeaks : TAbstractMemMemoryLeaks;
-    FIs64Bytes : Boolean;
+    FIs64Bits : Boolean;
     FMemUnitsSize : Integer; // Multiple of 4 and >=4 and <=256
     //
+    function RoundSize(ASize : TAbstractMemSize) : TAbstractMemSize;
+    function IsValidUsedSize(ASize : TAbstractMemSize) : Boolean;
   protected
     FLock : TCriticalSection;
     function AbsoluteWrite(const AAbsolutePosition : Int64; const ABuffer; ASize : Integer) : Integer; virtual; abstract;
@@ -153,7 +155,7 @@ Type
     property NextAvailablePos : Int64 read FNextAvailablePos;
     property MaxAvailablePos : Int64 read FMaxAvailablePos;
     property HeaderInitialized : Boolean read FHeaderInitialized;
-    property Is64Bytes : Boolean read FIs64Bytes;
+    property Is64Bits : Boolean read FIs64Bits;
     function Initialize(ASetTo64Bytes : Boolean; AMemUnitsSize : Integer) : Boolean;
     function HeaderSize : Integer;
     function SizeOfAbstractMemPosition : TAbstractMemSize; inline;
@@ -164,6 +166,7 @@ Type
   TMem = Class(TAbstractMem)
   private
     FMem : TBytes;
+    FLastIncrease : Int64;
   protected
     function AbsoluteWrite(const AAbsolutePosition : Int64; const ABuffer; ASize : Integer) : Integer; override;
     function AbsoluteRead(const AAbsolutePosition : Int64; var ABuffer; ASize : Integer) : Integer; override;
@@ -172,6 +175,18 @@ Type
     Constructor Create(AInitialPosition : Int64; AReadOnly : Boolean); override;
   End;
 
+  TStreamMem = Class(TAbstractMem)
+  private
+    FStream : TStream;
+  protected
+    function AbsoluteWrite(const AAbsolutePosition : Int64; const ABuffer; ASize : Integer) : Integer; override;
+    function AbsoluteRead(const AAbsolutePosition : Int64; var ABuffer; ASize : Integer) : Integer; override;
+    procedure DoIncreaseSize(var ANextAvailablePos, AMaxAvailablePos : Int64; ANeedSize : Integer); override;
+  public
+    Constructor Create(const AStream : TStream; AInitialPosition : Int64; AReadOnly : Boolean); reintroduce;
+    Destructor Destroy; override;
+  End;
+
   TAbstractMemAVLTreeNodeInfo = record
     parentPosition,
     leftPosition,
@@ -349,7 +364,7 @@ begin
   ASource.FLock.Acquire;
   Self.FLock.Acquire;
   try
-    ClearContent(ASource.Is64Bytes,ASource.FMemUnitsSize);
+    ClearContent(ASource.Is64Bits,ASource.FMemUnitsSize);
 
     CheckInitialized(True);
     IncreaseSize(ASource.FNextAvailablePos);
@@ -386,7 +401,7 @@ begin
   FReadOnly := AReadOnly;
   LMemLeakRelativeRootPos := 0;
   FInitialPosition := AInitialPosition;
-  FIs64Bytes := False;
+  FIs64Bits := False;
   FMemUnitsSize := 4; // Warning: Multiple of 4 >=4 and <=256!
   //
   LNextAvailablePosAux := 0;
@@ -411,19 +426,19 @@ begin
             Move(LBuffer[12],LNextAvailablePosAux,4);
             //
             if (LNextAvailablePosAux >= CT_HeaderSize_32b) and (LMemLeakRelativeRootPos<LNextAvailablePosAux) then begin
-              FIs64Bytes := False;
+              Fis64Bits := False;
               FNextAvailablePos := LNextAvailablePosAux;
               LOk := True;
             end;
           end else if (LBuffer[7] = CT_Version_64b) then begin
-            FIs64Bytes := True;
+            Fis64Bits := True;
             SetLength(LBuffer,CT_HeaderSize_64b);
             FNextAvailablePos := CT_HeaderSize_64b; // At least v2 size
             if Read(0,LBuffer[0],CT_HeaderSize_64b)=CT_HeaderSize_64b then begin
               Move(LBuffer[8],LMemLeakRelativeRootPos,8);
               Move(LBuffer[16],LNextAvailablePosAux,8);
               LMemUnitsSizeAux := 0;
-              Move(LBuffer[17],LMemUnitsSizeAux,1);
+              Move(LBuffer[24],LMemUnitsSizeAux,1);
               if (LMemUnitsSizeAux>=4) and (LMemUnitsSizeAux<256) and ((LMemUnitsSizeAux MOD 4)=0)  // Multiple of 4
                  and (LNextAvailablePosAux >= CT_HeaderSize_32b) and (LMemLeakRelativeRootPos<LNextAvailablePosAux) then begin
                 FNextAvailablePos := LNextAvailablePosAux;
@@ -476,7 +491,7 @@ begin
   if (LZoneSize<>AAMZone.size) then raise EAbstractMem.Create(Format('Dispose: Invalid size %d (expected %d) at position %d',[LZoneSize,AAMZone.size,AAMZone.position]));
 
   // Check valid units based on size
-  if (LNewMemLeak.GetSize(Self)<>AAMZone.size+SizeOfAbstractMemPosition()) then raise EAbstractMem.Create(Format('Dispose: Invalid size %d at position %d',[AAMZone.size,AAMZone.position]));
+  if (LNewMemLeak.GetSize(Self)<>AAMZone.size+SizeOfAbstractMemPosition()) then raise EAbstractMem.Create(Format('Dispose: Invalid size %d (Found %d) at position %d',[AAMZone.size,LNewMemLeak.GetSize(Self),AAMZone.position]));
   FLock.Acquire;
   Try
     // Save mem leak to mem
@@ -507,7 +522,7 @@ begin
     AAMZone.Clear;
     AAMZone.position := APosition;
     if Read(APosition - SizeOfAbstractMemPosition(),AAMZone.size,SizeOfAbstractMemPosition())<>SizeOfAbstractMemPosition() then Exit(False);
-    Result := (AAMZone.position + AAMZone.size <= FNextAvailablePos)  And ( ((((AAMZone.size-1) DIV FMemUnitsSize)+1)*FMemUnitsSize) = AAMZone.size );
+    Result := (AAMZone.position + AAMZone.size <= FNextAvailablePos)  And (IsValidUsedSize(AAMZone.size));
   end;
 end;
 
@@ -519,7 +534,7 @@ begin
   AAMZone.Clear;
   AAMZone.position := APosition;
   AAMZone.size := 0;
-  LZone.position := (((APosition-1) DIV FMemUnitsSize)+1)*FMemUnitsSize;
+  LZone.position := RoundSize(APosition);
   LZone.size := 0;
   if (LZone.position <> APosition) or (LZone.position<HeaderSize)
     or (LZone.position>=FNextAvailablePos) then Exit;
@@ -530,7 +545,7 @@ begin
   if FMemLeaks.IsNil(LSearchedMemLeak) then begin
     if Read(APosition,LZone.size,SizeOfAbstractMemPosition())<>SizeOfAbstractMemPosition() then Exit;
     if (LZone.position + SizeOfAbstractMemPosition() + LZone.size <= FNextAvailablePos)
-      And ( ((((LZone.size-1) DIV FMemUnitsSize)+1)*FMemUnitsSize) = LZone.size ) then begin
+      And (IsValidUsedSize(LZone.size)) then begin
       Result := amzt_used;
       AAMZone.position := LZone.position + SizeOfAbstractMemPosition();
       AAMZone.size := LZone.size;
@@ -543,8 +558,9 @@ end;
 
 function TAbstractMem.HeaderSize: Integer;
 begin
-  if FIs64Bytes then Result := CT_HeaderSize_64b
+  if Fis64Bits then Result := CT_HeaderSize_64b
   else Result := CT_HeaderSize_32b;
+  Result := RoundSize(Result);
 end;
 
 procedure TAbstractMem.IncreaseSize(ANeedSize: TAbstractMemSize);
@@ -553,7 +569,7 @@ var LTmpNextAvailablePos, LTmpMaxAvailablePos : Int64;
 begin
   if FMaxAvailablePos-FNextAvailablePos+1 >= ANeedSize then Exit;
 
-  if Not FIs64Bytes then begin
+  if Not Fis64Bits then begin
     // Max 32 bits memory (4 Gb)
     if Int64(FNextAvailablePos + Int64(ANeedSize)) >= Int64($FFFFFFFF) then begin
       raise EAbstractMem.Create(Format('Cannot increase more size (Max 4Gb) current %d (max %d) needed %d overflow 0x%s',
@@ -577,18 +593,19 @@ end;
 function TAbstractMem.Initialize(ASetTo64Bytes: Boolean; AMemUnitsSize: Integer): Boolean;
 begin
   Result := False;
+  if ReadOnly then raise EAbstractMem.Create('Cannot initialize a Readonly AbstractMem');
   if HeaderInitialized then Exit;
-  FIs64Bytes := ASetTo64Bytes;
+  Fis64Bits := ASetTo64Bytes;
   FMemUnitsSize := 4; // By Default
-  if FIs64Bytes then begin
+  if Fis64Bits then begin
     if (AMemUnitsSize>=4) and (AMemUnitsSize<256) and ((AMemUnitsSize MOD 4)=0) then begin
       FMemUnitsSize := AMemUnitsSize;
     end;
-    FNextAvailablePos := CT_HeaderSize_64b;
     Result := True;
   end else begin
     Result := True;
   end;
+  FNextAvailablePos := HeaderSize;
 end;
 
 function TAbstractMem.IsAbstractMemInfoStable: Boolean;
@@ -596,6 +613,11 @@ begin
   Result := True;
 end;
 
+function TAbstractMem.IsValidUsedSize(ASize: TAbstractMemSize): Boolean;
+begin
+  Result := RoundSize(ASize + SizeOfAbstractMemPosition) = (ASize + SizeOfAbstractMemPosition);
+end;
+
 function TAbstractMem.New(AMemSize: TAbstractMemSize): TAMZone;
 var LNeededMemSize : TAbstractMemSize;
   LMemLeakToFind, LMemLeakFound : TAbstractMemMemoryLeaksNode;
@@ -609,7 +631,7 @@ begin
   // AMemSize must be a value stored in 4 bytes (32 bits) where each value is a "unit" of FMemUnitsSize bytes (FMemUnitsSize is multiple of 4 between 4..256)
   //
   LMaxMemSizePerUnits := Int64(256 * 256 * 256) * Int64(FMemUnitsSize); // 2^24 * FMemUnitsSize
-  if FIs64Bytes then begin
+  if Fis64Bits then begin
     LMaxMemSizePerUnits := LMaxMemSizePerUnits * 256; // On 64 bits is stored in 32 bits instead of 24 bits
   end;
   if (AMemSize<=0) or (AMemSize>(LMaxMemSizePerUnits - SizeOfAbstractMemPosition())) then raise EAbstractMem.Create('Invalid new size: '+AMemSize.ToString+' Max:'+LMaxMemSizePerUnits.ToString);
@@ -622,7 +644,7 @@ begin
     if LNeededMemSize<FMemLeaks.SizeOfMemoryLeak() then LNeededMemSize := FMemLeaks.SizeOfMemoryLeak()
     else LNeededMemSize := LNeededMemSize;
     // Round LMemSize to a FMemUnitsSize bytes packet
-    LNeededMemSize := (((LNeededMemSize-1) DIV FMemUnitsSize)+1)*FMemUnitsSize;
+    LNeededMemSize := RoundSize(LNeededMemSize);
 
     LMemLeakToFind.Clear;
     LMemLeakToFind.SetSize(Self,LNeededMemSize);
@@ -664,7 +686,7 @@ begin
   if FReadOnly then raise EAbstractMem.Create('Cannot save Header on a ReadOnly AbstractMem');
   // Write Header:
   SetLength(LBuffer,HeaderSize);
-  if FIs64Bytes then begin
+  if Fis64Bits then begin
     FillChar(LBuffer[0],Length(LBuffer),0);
     Move(CT_Magic[0],LBuffer[0],6);
     if IsAbstractMemInfoStable then begin
@@ -722,7 +744,7 @@ end;
 
 function TAbstractMem.SizeOfAbstractMemPosition: TAbstractMemSize;
 begin
-  if FIs64Bytes then Result := 8
+  if Fis64Bits then Result := 8
   else Result := 4;
 end;
 
@@ -773,6 +795,13 @@ begin
   end;
 end;
 
+function TAbstractMem.RoundSize(ASize: TAbstractMemSize): TAbstractMemSize;
+//  Rounds ASize to a FMemUnitsSize valid value
+begin
+  Assert(ASize>=0,Format('Invalid size:%d',[ASize]));
+  Result := ((((ASize-1) DIV Int64(FMemUnitsSize))+1)*FMemUnitsSize);
+end;
+
 function TAbstractMem.Write(const APosition: Int64; const ABuffer; ASize: Integer) : Integer;
 begin
   FLock.Acquire;
@@ -818,7 +847,7 @@ begin
   Self.Clear;
   Self.myPosition := AMyPosition;
   if Self.myPosition<=0 then Exit;
-  if AAbstractMem.Is64Bytes then begin
+  if AAbstractMem.Is64Bits then begin
     SetLength(LBuff,32);
     AAbstractMem.Read(AMyPosition,LBuff[0],32);
     Move(LBuff[0],Self.parentPosition,8);
@@ -864,7 +893,7 @@ procedure TAbstractMem.TAbstractMemMemoryLeaksNode.WriteToMem(AAbstractMem: TAbs
 var LBuff : TBytes;
 begin
   if Self.myPosition<=0 then Exit;
-  if (AAbstractMem.Is64Bytes) then begin
+  if (AAbstractMem.is64Bits) then begin
     SetLength(LBuff,32);
     Move(Self.parentPosition,LBuff[0],8);
     Move(Self.leftPosition,LBuff[8],8);
@@ -996,7 +1025,7 @@ end;
 
 function TAbstractMem.TAbstractMemMemoryLeaks.SizeOfMemoryLeak: TAbstractMemSize;
 begin
-  if FAbstractMem.Is64Bytes then Result := 32
+  if FAbstractMem.is64Bits then Result := 32
   else Result := 16;
 end;
 
@@ -1030,6 +1059,7 @@ end;
 constructor TMem.Create(AInitialPosition: Int64; AReadOnly: Boolean);
 begin
   SetLength(FMem,0);
+  FLastIncrease := 0;
   inherited;
 end;
 
@@ -1042,8 +1072,8 @@ begin
   AMaxAvailablePos := Length(FMem);
   if (AMaxAvailablePos-ANextAvailablePos+1 >= ANeedSize) then Exit;
 
-  ANeedSize := (((ANeedSize-1) DIV 256)+1)*256;
-
+  ANeedSize := RoundSize( ((((ANeedSize + FLastIncrease)-1) DIV 256)+1)*256 );
+  FLastIncrease := ANeedSize;
   SetLength(FMem, AMaxAvailablePos + ANeedSize);
   AMaxAvailablePos := AMaxAvailablePos + ANeedSize;
   //
@@ -1174,5 +1204,60 @@ begin
   end else raise EAbstractMem.Create(Format('Invalid position write TAbstractMemAVLTreeNodeInfo.WriteToMem(%d) for %s',[AMyPosition,ANodeInfo.ToString]));
 end;
 
+{ TStreamMem }
+
+function TStreamMem.AbsoluteRead(const AAbsolutePosition: Int64; var ABuffer;
+  ASize: Integer): Integer;
+begin
+  FStream.Position := AAbsolutePosition;
+  Result := FStream.Read(ABuffer,ASize);
+end;
+
+function TStreamMem.AbsoluteWrite(const AAbsolutePosition: Int64; const ABuffer;
+  ASize: Integer): Integer;
+begin
+  FStream.Position := AAbsolutePosition;
+  Result := FStream.Write(ABuffer,ASize);
+end;
+
+constructor TStreamMem.Create(const AStream : TStream; AInitialPosition : Int64; AReadOnly : Boolean);
+begin
+  FStream := AStream;
+  inherited Create(AInitialPosition,AReadOnly);
+end;
+
+destructor TStreamMem.Destroy;
+begin
+  inherited;
+  FStream := Nil;
+end;
+
+procedure TStreamMem.DoIncreaseSize(var ANextAvailablePos,
+  AMaxAvailablePos: Int64; ANeedSize: Integer);
+var LBuff : TBytes;
+begin
+  if (ANeedSize<=0) And (AMaxAvailablePos<=0) then begin
+    FStream.Seek(0,soFromEnd);
+    FStream.Size := 0;
+    Exit;
+  end;
+
+  FStream.Seek(0,soFromEnd);
+  // GoTo ANextAvailablePos
+  if (FStream.Position<ANextAvailablePos) then begin
+    SetLength(LBuff,ANextAvailablePos - FStream.Position);
+    FillChar(LBuff[0],Length(LBuff),0);
+    FStream.Write(LBuff[0],Length(LBuff));
+  end;
+  if (FStream.Position<ANextAvailablePos) then raise EAbstractMem.Create(Format('End stream position (%d) is less than next available pos %d',[FStream.Position,ANextAvailablePos]));
+  // At this time ANextAvailablePos <= FFileStream.Position
+  AMaxAvailablePos := ANextAvailablePos + ANeedSize;
+  if (FStream.Size<AMaxAvailablePos) then begin
+    SetLength(LBuff,AMaxAvailablePos - FStream.Position);
+    FillChar(LBuff[0],Length(LBuff),0);
+    FStream.Write(LBuff[0],Length(LBuff));
+  end else AMaxAvailablePos := FStream.Size;
+end;
+
 end.
 

src/libraries/abstractmem/UAbstractMemBTree.pas

@@ -54,7 +54,6 @@ type
     const
           CT_AbstractMemBTree_Magic = 'AMBT'; // DO NOT LOCALIZE MUST BE 4 BYTES LENGTH
     var
-    FInitialZone : TAMZone;
     FrootPosition : TAbstractMemPosition;
     procedure SaveHeader;
     Procedure CheckInitialized;
@@ -62,6 +61,7 @@ type
     procedure SaveNodeHeader(const ANode : TAbstractBTree<TAbstractMemPosition,TAbstractMemPosition>.TAbstractBTreeNode; const AChildsPosition : TAbstractMemPosition);
     function GetNodeHeaderSize : Integer;
   protected
+    FInitialZone : TAMZone;
     FAbstractMem : TAbstractMem;
     function GetRoot: TAbstractBTree<TAbstractMemPosition,TAbstractMemPosition>.TAbstractBTreeNode; override;
     procedure SetRoot(var Value: TAbstractBTree<TAbstractMemPosition,TAbstractMemPosition>.TAbstractBTreeNode); override;
@@ -88,34 +88,71 @@ type
     property Count;
     function NodeDataToString(const AData : TAbstractMemPosition) : String; override;
     function NodeIdentifyToString(const AIdentify : TAbstractMemPosition) : String; override;
+    property InitialZone : TAMZone read FInitialZone;
   End;
 
-  TAbstractMemBTreeData<TData> = Class(TAbstractMemBTree)
+  TAbstractMemBTreeDataAbstract<TBTreeData> = Class(TAbstractMemBTree)
   private
     // FLeft_ and FRight_ will be used as a cache for improvement calls on DoCompareData
     FLeft_Pos, FRight_Pos : TAbstractMemPosition;
-    FLeft_Data, FRight_Data : TData;
-    FSearchTarget : TData;
-    FOnCompareAbstractMemData: TComparison<TData>;
+    FLeft_Data, FRight_Data : TBTreeData;
+    FSearchTarget : TBTreeData;
+    FOnCompareAbstractMemData: TComparison<TBTreeData>;
   protected
-    function DoCompareData(const ALeftData, ARightData: TAbstractMemPosition): Integer; override;
+    function DoCompareData(const ALefTBTreeData, ARighTBTreeData: TAbstractMemPosition): Integer; override;
     //
-    function LoadData(const APosition : TAbstractMemPosition) : TData; virtual; abstract;
-    function SaveData(const AData : TData) : TAMZone; virtual; abstract;
+    function LoadData(const APosition : TAbstractMemPosition) : TBTreeData; virtual; abstract;
+    function SaveData(const AData : TBTreeData) : TAMZone; virtual; abstract;
+    procedure DoOnFindProcessStart; override;
+    procedure DoOnFindProcessEnd; override;
+    //
+    function AddInherited(const AAbstractMemPosition: TAbstractMemPosition) : Boolean;
+    function DeleteInherited(const AAbstractMemPosition: TAbstractMemPosition) : Boolean;
+  public
+    constructor Create(AAbstractMem : TAbstractMem; const AInitialZone: TAMZone; AAllowDuplicates : Boolean; AOrder : Integer; const AOnCompareAbstractMemDataMethod: TComparison<TBTreeData>);
+    procedure Add(); reintroduce;
+    procedure Delete(); reintroduce;
+    function FindData(const AData: TBTreeData; out APosition : TAbstractMemPosition; out AFoundData : TBTreeData) : Boolean; overload;
+    function FindData(const AData: TBTreeData; out APosition : TAbstractMemPosition) : Boolean; overload;
+    function FindDataPrecessor(const AData : TBTreeData; var APrecessor : TBTreeData) : Boolean;
+    function FindDataSuccessor(const AData : TBTreeData; var ASuccessor : TBTreeData) : Boolean;
+    function FindDataLowest(out ALowest : TBTreeData) : Boolean;
+    function FindDataHighest(out AHighest : TBTreeData) : Boolean;
+  End;
+
+  TAbstractMemBTreeDataIndex<TBTreeData> = Class;
+
+  TAbstractMemBTreeData<TBTreeData> = Class(TAbstractMemBTreeDataAbstract<TBTreeData>)
+  private
+    FIndexes : TList< TAbstractMemBTreeDataIndex<TBTreeData> >;
+  protected
+  public
+    constructor Create(AAbstractMem : TAbstractMem; const AInitialZone: TAMZone; AAllowDuplicates : Boolean; AOrder : Integer;
+      const AOnCompareAbstractMemDataMethod: TComparison<TBTreeData>);
+    destructor Destroy; override;
+    function CanAddData(const AData: TBTreeData) : Boolean;
+    function AddData(const AData: TBTreeData) : Boolean;
+    function DeleteData(const AData: TBTreeData) : Boolean;
+    property Indexes : TList< TAbstractMemBTreeDataIndex<TBTreeData> > read FIndexes;
+    procedure CheckConsistency; override;
+  End;
+
+  TAbstractMemBTreeDataIndex<TBTreeData> = Class(TAbstractMemBTreeDataAbstract<TBTreeData>)
+  protected
+    FIndexed : TAbstractMemBTreeData<TBTreeData>;
+    function LoadData(const APosition : TAbstractMemPosition) : TBTreeData; override;
   public
-    constructor Create(AAbstractMem : TAbstractMem; const AInitialZone: TAMZone; AAllowDuplicates : Boolean; AOrder : Integer; const AOnCompareAbstractMemDataMethod: TComparison<TData>);
-    function AddData(const AData: TData) : Boolean;
-    function FindData(const AData: TData; var APosition : TAbstractMemPosition) : Boolean;
-    function DeleteData(const AData: TData) : Boolean;
-    function FindDataPrecessor(const AData : TData; var APrecessor : TData) : Boolean;
-    function FindDataSuccessor(const AData : TData; var ASuccessor : TData) : Boolean;
-    function FindDataLowest(out ALowest : TData) : Boolean;
-    function FindDataHighest(out AHighest : TData) : Boolean;
+    constructor Create(AAbstractMemBTreeData : TAbstractMemBTreeData<TBTreeData>;
+      AInitialZone: TAMZone;
+      AAllowDuplicates : Boolean; AOrder : Integer;
+      const AOnCompareAbstractMemDataMethod: TComparison<TBTreeData>);
+    destructor Destroy; override;
+    procedure CheckConsistency; override;
   End;
 
 implementation
 
-{ TAbstractMemBTree<TData> }
+{ TAbstractMemBTree<TBTreeData> }
 
 procedure TAbstractMemBTree.CheckInitialized;
 begin
@@ -405,22 +442,23 @@ begin
   SaveHeader;
 end;
 
-{ TAbstractMemBTreeData<TData> }
+{ TAbstractMemBTreeDataAbstract<TBTreeData> }
 
-function TAbstractMemBTreeData<TData>.AddData(const AData: TData): Boolean;
-var Lzone : TAMZone;
+procedure TAbstractMemBTreeDataAbstract<TBTreeData>.Add;
 begin
-  Lzone := SaveData(AData);
-  Result := inherited Add(Lzone.position);
-  if Not Result then begin
-    // Dispose
-    FAbstractMem.Dispose(Lzone);
-  end;
+  raise EAbstractMemBTree.Create('Invalid use of Abstract function '+ClassName+'.Delete');
 end;
 
-constructor TAbstractMemBTreeData<TData>.Create(AAbstractMem: TAbstractMem;
-  const AInitialZone: TAMZone; AAllowDuplicates: Boolean; AOrder: Integer;
-  const AOnCompareAbstractMemDataMethod: TComparison<TData>);
+function TAbstractMemBTreeDataAbstract<TBTreeData>.AddInherited(
+  const AAbstractMemPosition: TAbstractMemPosition): Boolean;
+begin
+  Result := inherited Add(AAbstractMemPosition);
+end;
+
+constructor TAbstractMemBTreeDataAbstract<TBTreeData>.Create(
+  AAbstractMem: TAbstractMem; const AInitialZone: TAMZone;
+  AAllowDuplicates: Boolean; AOrder: Integer;
+  const AOnCompareAbstractMemDataMethod: TComparison<TBTreeData>);
 begin
   inherited Create(AAbstractMem,AInitialZone,AAllowDuplicates,AOrder);
   FOnCompareAbstractMemData := AOnCompareAbstractMemDataMethod;
@@ -428,62 +466,85 @@ begin
   FRight_Pos := 0;
 end;
 
-function TAbstractMemBTreeData<TData>.DeleteData(const AData: TData): Boolean;
-var LAbstractMemPos : TAbstractMemPosition;
+procedure TAbstractMemBTreeDataAbstract<TBTreeData>.Delete;
 begin
-  if FindData(AData,LAbstractMemPos) then begin
-    Delete(LAbstractMemPos);
-    FAbstractMem.Dispose(LAbstractMemPos);
-    Result := True;
-    if FLeft_Pos=LAbstractMemPos then FLeft_Pos := 0;
-    if FRight_Pos=LAbstractMemPos then FRight_Pos := 0;
-  end else Result := False;
+  raise EAbstractMemBTree.Create('Invalid use of Abstract function '+ClassName+'.Delete');
 end;
 
-function TAbstractMemBTreeData<TData>.DoCompareData(const ALeftData, ARightData: TAbstractMemPosition): Integer;
-var Ltmp : TData;
+function TAbstractMemBTreeDataAbstract<TBTreeData>.DeleteInherited(
+  const AAbstractMemPosition: TAbstractMemPosition): Boolean;
 begin
-  Assert((ALeftData<>0) and (ARightData<>0) and (ARightData<>1),Format('DoCompareData: Invalid Left %d or Right %d (data cannot be 0 neither 1)',[ALeftData,ARightData]));
-  if (ALeftData=ARightData) then begin
+  Result := Inherited Delete(AAbstractMemPosition);
+end;
+
+function TAbstractMemBTreeDataAbstract<TBTreeData>.DoCompareData(const ALefTBTreeData,
+  ARighTBTreeData: TAbstractMemPosition): Integer;
+var Ltmp : TBTreeData;
+begin
+  Assert((ALefTBTreeData<>0) and (ARighTBTreeData<>0) and (ARighTBTreeData<>1),Format('DoCompareData: Invalid Left %d or Right %d (data cannot be 0 neither 1)',[ALefTBTreeData,ARighTBTreeData]));
+  if (ALefTBTreeData=ARighTBTreeData) then begin
     // Comparing same data because stored on same position
     Exit(0);
   end;
-  Assert(ALeftData<>ARightData,Format('DoCompareData: Left (%d) and Right (%d) are equals',[ALeftData,ARightData]));
-  if (ALeftData=1) then begin
-    if (FRight_Pos=0) or (FRight_Pos<>ARightData) then begin
-      if (FLeft_Pos=ARightData) then begin
+  Assert(ALefTBTreeData<>ARighTBTreeData,Format('DoCompareData: Left (%d) and Right (%d) are equals',[ALefTBTreeData,ARighTBTreeData]));
+  if (ALefTBTreeData=1) then begin
+    if (FRight_Pos=0) or (FRight_Pos<>ARighTBTreeData) then begin
+      if (FLeft_Pos=ARighTBTreeData) then begin
         Result := FOnCompareAbstractMemData(FSearchTarget,FLeft_Data);
         Exit;
       end;
-      FRight_Pos := ARightData;
-      FRight_Data := LoadData(ARightData);
+      FRight_Pos := ARighTBTreeData;
+      FRight_Data := LoadData(ARighTBTreeData);
     end;
     Result := FOnCompareAbstractMemData(FSearchTarget,FRight_Data);
   end else begin
-    if (FLeft_Pos=0) or (FLeft_Pos<>ALeftData) then begin
-      if (FRight_Pos=ALeftData) then begin
+    if (FLeft_Pos=0) or (FLeft_Pos<>ALefTBTreeData) then begin
+      if (FRight_Pos=ALefTBTreeData) then begin
         // Use right as left
-        if (FLeft_Pos<>ARightData) then begin
+        if (FLeft_Pos<>ARighTBTreeData) then begin
           // Left is not right, reload
-          FLeft_Pos := ARightData;
-          FLeft_Data := LoadData(ARightData);
+          FLeft_Pos := ARighTBTreeData;
+          FLeft_Data := LoadData(ARighTBTreeData);
         end;
         Result := FOnCompareAbstractMemData(FRight_Data,FLeft_Data);
         Exit;
       end;
-      FLeft_Pos := ALeftData;
-      FLeft_Data := LoadData(ALeftData);
+      FLeft_Pos := ALefTBTreeData;
+      FLeft_Data := LoadData(ALefTBTreeData);
     end;
-    if (FRight_Pos=0) or (FRight_Pos<>ARightData) then begin
-      FRight_Pos := ARightData;
-      FRight_data := LoadData(ARightData);
+    if (FRight_Pos=0) or (FRight_Pos<>ARighTBTreeData) then begin
+      FRight_Pos := ARighTBTreeData;
+      FRight_data := LoadData(ARighTBTreeData);
     end;
     Result := FOnCompareAbstractMemData(FLeft_data,FRight_data);
   end;
 end;
 
-function TAbstractMemBTreeData<TData>.FindData(const AData: TData;
-  var APosition: TAbstractMemPosition): Boolean;
+procedure TAbstractMemBTreeDataAbstract<TBTreeData>.DoOnFindProcessEnd;
+begin
+  inherited;
+  FLeft_Pos  := 0;
+  FRight_Pos := 0;
+end;
+
+procedure TAbstractMemBTreeDataAbstract<TBTreeData>.DoOnFindProcessStart;
+begin
+  inherited;
+  FLeft_Pos  := 0;
+  FRight_Pos := 0;
+end;
+
+function TAbstractMemBTreeDataAbstract<TBTreeData>.FindData(const AData: TBTreeData;
+  out APosition: TAbstractMemPosition; out AFoundData : TBTreeData): Boolean;
+begin
+  if FindData(AData,APosition) then begin
+    Result := True;
+    AFoundData := LoadData(APosition);
+  end else Result := False;
+end;
+
+function TAbstractMemBTreeDataAbstract<TBTreeData>.FindData(
+  const AData: TBTreeData; out APosition: TAbstractMemPosition): Boolean;
 var Lnode : TAbstractBTree<TAbstractMemPosition,TAbstractMemPosition>.TAbstractBTreeNode;
   LiPosNode : Integer;
 begin
@@ -491,7 +552,7 @@ begin
   try
   FSearchTarget := AData;
   ClearNode(Lnode);
-  if Find(1,Lnode,LiPosNode) then begin
+  if inherited Find(1,Lnode,LiPosNode) then begin
     APosition := Lnode.data[LiPosNode];
     Result := True;
   end else begin
@@ -506,7 +567,8 @@ begin
   end;
 end;
 
-function TAbstractMemBTreeData<TData>.FindDataHighest(out AHighest: TData): Boolean;
+function TAbstractMemBTreeDataAbstract<TBTreeData>.FindDataHighest(
+  out AHighest: TBTreeData): Boolean;
 var Lpos : TAbstractMemPosition;
 begin
   if FindHighest(Lpos) then begin
@@ -515,7 +577,8 @@ begin
   end else Result := False;
 end;
 
-function TAbstractMemBTreeData<TData>.FindDataLowest(out ALowest: TData): Boolean;
+function TAbstractMemBTreeDataAbstract<TBTreeData>.FindDataLowest(
+  out ALowest: TBTreeData): Boolean;
 var Lpos : TAbstractMemPosition;
 begin
   if FindLowest(Lpos) then begin
@@ -524,7 +587,8 @@ begin
   end else Result := False;
 end;
 
-function TAbstractMemBTreeData<TData>.FindDataPrecessor(const AData: TData; var APrecessor: TData): Boolean;
+function TAbstractMemBTreeDataAbstract<TBTreeData>.FindDataPrecessor(
+  const AData: TBTreeData; var APrecessor: TBTreeData): Boolean;
 var Lnode : TAbstractBTree<TAbstractMemPosition,TAbstractMemPosition>.TAbstractBTreeNode;
   LiPosNode : Integer;
   Lpos : TAbstractMemPosition;
@@ -532,7 +596,7 @@ begin
   FAbstractBTreeLock.Acquire;
   try
   FSearchTarget := AData;
-  if Find(1,Lnode,LiPosNode) then begin
+  if inherited Find(1,Lnode,LiPosNode) then begin
     if FindPrecessor(Lnode.data[LiPosNode],Lpos) then begin
       Result := True;
       APrecessor := LoadData(Lpos);
@@ -543,7 +607,8 @@ begin
   end;
 end;
 
-function TAbstractMemBTreeData<TData>.FindDataSuccessor(const AData: TData; var ASuccessor: TData): Boolean;
+function TAbstractMemBTreeDataAbstract<TBTreeData>.FindDataSuccessor(
+  const AData: TBTreeData; var ASuccessor: TBTreeData): Boolean;
 var Lnode : TAbstractBTree<TAbstractMemPosition,TAbstractMemPosition>.TAbstractBTreeNode;
   LiPosNode : Integer;
   Lpos : TAbstractMemPosition;
@@ -551,7 +616,7 @@ begin
   FAbstractBTreeLock.Acquire;
   try
   FSearchTarget := AData;
-  if Find(1,Lnode,LiPosNode) then begin
+  if inherited Find(1,Lnode,LiPosNode) then begin
     if FindSuccessor(Lnode.data[LiPosNode],Lpos) then begin
       Result := True;
       ASuccessor := LoadData(Lpos);
@@ -562,6 +627,155 @@ begin
   end;
 end;
 
+{ TAbstractMemBTreeData<TBTreeData> }
+
+function TAbstractMemBTreeData<TBTreeData>.AddData(const AData: TBTreeData): Boolean;
+var Lzone, LindexZone : TAMZone;
+  i : Integer;
+  LIndexPosition : TAbstractMemPosition;
+begin
+  // Check in indexes
+  Result := True;
+  i := 0;
+  while (Result) and (i<FIndexes.Count) do begin
+    if (Not FIndexes.Items[i].AllowDuplicates) then begin
+      Result :=  Not (FIndexes.Items[i].FindData(AData,LIndexPosition));
+    end;
+    inc(i);
+  end;
+  if Result then begin
+    Lzone := SaveData(AData);
+    Try
+      Result := AddInherited(Lzone.position);
+      for i := 0 to FIndexes.Count-1 do begin
+        LindexZone := FAbstractMem.New(FAbstractMem.SizeOfAbstractMemPosition);
+        FAbstractMem.Write(LindexZone.position,Lzone.position,FAbstractMem.SizeOfAbstractMemPosition);
+        if Not FIndexes.Items[i].AddInherited(LindexZone.position) then raise EAbstractMemBTree.Create(Format('Fatal error adding index %d/%d with data at %s and %s',[i+1,FIndexes.Count,Lzone.ToString,LindexZone.ToString]));
+      end;
+    Finally
+      if Not Result then begin
+        // Dispose
+        FAbstractMem.Dispose(Lzone);
+      end;
+    End;
+  end;
+end;
+
+function TAbstractMemBTreeData<TBTreeData>.CanAddData(
+  const AData: TBTreeData): Boolean;
+var i : Integer;
+  LIndexPosition : TAbstractMemPosition;
+begin
+  // Check in indexes
+  Result := True;
+  i := 0;
+  while (Result) and (i<FIndexes.Count) do begin
+    if (Not FIndexes.Items[i].AllowDuplicates) then begin
+      Result :=  Not (FIndexes.Items[i].FindData(AData,LIndexPosition));
+    end;
+    inc(i);
+  end;
+  if (Result) And (Not AllowDuplicates) then begin
+    Result := Not FindData(AData,LIndexPosition);
+  end;
+end;
+
+procedure TAbstractMemBTreeData<TBTreeData>.CheckConsistency;
+var i : Integer;
+begin
+  inherited;
+  for i := 0 to FIndexes.Count-1 do begin
+    if (FIndexes.Items[i].Count <> Self.Count) then raise EAbstractMemBTree.Create(Format('Consistency error on index %d/%d count %d vs %d',[i+1,FIndexes.Count,Findexes.Items[i].Count,Self.Count]));
+    FIndexes.Items[i].CheckConsistency;
+  end;
+end;
+
+constructor TAbstractMemBTreeData<TBTreeData>.Create(AAbstractMem: TAbstractMem;
+  const AInitialZone: TAMZone; AAllowDuplicates: Boolean; AOrder: Integer;
+  const AOnCompareAbstractMemDataMethod: TComparison<TBTreeData>);
+begin
+  FIndexes := TList< TAbstractMemBTreeDataIndex<TBTreeData> >.Create;
+  inherited Create(AAbstractMem,AInitialZone,AAllowDuplicates,AOrder,AOnCompareAbstractMemDataMethod);
+end;
+
+function TAbstractMemBTreeData<TBTreeData>.DeleteData(const AData: TBTreeData): Boolean;
+var LAbstractMemPos, LindexPosition : TAbstractMemPosition;
+  i : Integer;
+begin
+  if FindData(AData,LAbstractMemPos) then begin
+    // Delete from indexes
+    for i := 0 to FIndexes.Count-1 do begin
+      if Not FIndexes.Items[i].FindData(AData,LindexPosition) then raise EAbstractMemBTree.Create(Format('Fatal error Data not found in index %d/%d to Delete from pos %s',[i+1,Findexes.Count,LAbstractMemPos.ToHexString]));
+      if not FIndexes.Items[i].DeleteInherited(LindexPosition) then raise EAbstractMemBTree.Create(Format('Fatal error Data not deleted in index %d/%d from pos %s at pos %s',[i+1,Findexes.Count,LAbstractMemPos.ToHexString,LindexPosition.ToHexString]));
+      FAbstractMem.Dispose(LindexPosition);
+    end;
+    //
+    DeleteInherited(LAbstractMemPos);
+    FAbstractMem.Dispose(LAbstractMemPos);
+    Result := True;
+    if FLeft_Pos=LAbstractMemPos then FLeft_Pos := 0;
+    if FRight_Pos=LAbstractMemPos then FRight_Pos := 0;
+  end else Result := False;
+end;
+
+destructor TAbstractMemBTreeData<TBTreeData>.Destroy;
+var i : Integer;
+begin
+  for i := 0 to FIndexes.Count-1 do begin
+    FIndexes.Items[i].FIndexed := Nil;
+  end;
+  FreeAndNil(Findexes);
+  inherited;
+end;
+
+{ TAbstractMemBTreeDataIndex<TBTreeData> }
+
+procedure TAbstractMemBTreeDataIndex<TBTreeData>.CheckConsistency;
+var i, nCount : Integer;
+ APreviousData, ACurrentData : TBTreeData;
+begin
+  inherited;
+  nCount := 0;
+  if FindDataLowest(APreviousData) then begin
+    nCount := 1;
+    while FindDataSuccessor(APreviousData,ACurrentData) do begin
+      inc(nCount);
+      i := FOnCompareAbstractMemData(APreviousData,ACurrentData);
+      if ((Not AllowDuplicates) and (i>=0)) or (i>0) then raise EAbstractMemBTree.Create(Format('Invalid consistency on Index comparing pos %d and %d result %d',[nCount-1,nCount,i]));
+      APreviousData := ACurrentData;
+    end;
+  end;
+end;
+
+constructor TAbstractMemBTreeDataIndex<TBTreeData>.Create(
+  AAbstractMemBTreeData: TAbstractMemBTreeData<TBTreeData>;
+  AInitialZone: TAMZone;
+  AAllowDuplicates: Boolean; AOrder: Integer;
+  const AOnCompareAbstractMemDataMethod: TComparison<TBTreeData>);
+begin
+  FIndexed := AAbstractMemBTreeData;
+  FIndexed.FIndexes.Add(Self);
+  inherited Create(FIndexed.FAbstractMem,AInitialZone,AAllowDuplicates,
+    AOrder,AOnCompareAbstractMemDataMethod)
+end;
+
+destructor TAbstractMemBTreeDataIndex<TBTreeData>.Destroy;
+begin
+  if Assigned(FIndexed) then begin
+    FIndexed.FIndexes.Remove(Self);
+  end;
+  inherited;
+end;
+
+function TAbstractMemBTreeDataIndex<TBTreeData>.LoadData(const APosition: TAbstractMemPosition): TBTreeData;
+var LDataPosition : TAbstractMemPosition;
+begin
+  LDataPosition := 0;
+  if FAbstractMem.Read(APosition,LDataPosition,FAbstractMem.SizeOfAbstractMemPosition)<>FAbstractMem.SizeOfAbstractMemPosition then
+    raise EAbstractMemBTree.Create('Cannot load Data from Index at position '+APosition.ToHexString);
+  Result := FIndexed.LoadData(LDataPosition);
+end;
+
 initialization
 
 finalization

src/libraries/abstractmem/UFileMem.pas

@@ -204,7 +204,7 @@ procedure TFileMem.DoIncreaseSize(var ANextAvailablePos, AMaxAvailablePos: Int64
 var LBuff : TBytes;
 begin
   if (ANeedSize<=0) And (AMaxAvailablePos<=0) then begin
-    FCache.Clear;
+    If Assigned(FCache) then FCache.Clear;
     FFileStream.Seek(0,soFromEnd);
     FFileStream.Size := 0;
     Exit;
@@ -275,7 +275,8 @@ end;
 {$IFDEF ABSTRACTMEM_ENABLE_STATS}
 function TFileMem.GetStatsReport(AClearStats : Boolean) : String;
 begin
-  Result := FStats.ToString + #10 + FCache.GetStatsReport(AClearStats);
+  Result := FStats.ToString;
+  if Assigned(FCache) then Result := Result + #10 + FCache.GetStatsReport(AClearStats);
   if AClearStats then FStats.Clear;
 end;
 {$ENDIF}

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

@@ -84,15 +84,16 @@ end;
 procedure TestTAbstractMem.Test_MemLeaksReuse;
 var LAM : TAbstractMem;
 begin
+  RandSeed := 0;
   LAM := TMem.Create(0,False);
   try
     LAM.Initialize(False,4);
     Test_MemLeaks(LAM);
     LAM.Initialize(True,4);
     Test_MemLeaks(LAM);
-    LAM.Initialize(True,16);
+    LAM.Initialize(True,160);
     Test_MemLeaks(LAM);
-    LAM.Initialize(True,64);
+    LAM.Initialize(True,256);
   finally
     LAM.Free;
   end;

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

@@ -7,7 +7,7 @@ unit UAbstractMemBTree.Tests;
 interface
 
 uses
-   SysUtils,
+   SysUtils, Classes,
    {$IFDEF FPC}
    fpcunit, testutils, testregistry,
    {$ELSE}
@@ -39,16 +39,12 @@ type
    public
      procedure SetUp; override;
      procedure TearDown; override;
-     procedure TestInfinite_Integer(AOrder : Integer; AAllowDuplicates : Boolean; A64Bytes : Boolean);
-     procedure TestInfinite_String(AOrder : Integer; AAllowDuplicates : Boolean; A64Bytes : Boolean);
-     procedure TestInfinite(AOrder : Integer; A64Bytes : Boolean);
+     procedure TestInfiniteExt(AMemUnitsSize, AOrder : Integer; AAllowDuplicates : Boolean; A64Bits : Boolean);
+     procedure TestInfinite_Integer(AMemUnitsSize, AOrder: Integer; AAllowDuplicates : Boolean; A64Bits : Boolean);
      procedure DoCheckAbstractMem(AAbstractMem : TAbstractMem; AUsedBytes : Integer);
    published
-     procedure TestInfiniteOrder_3;
-     procedure TestInfiniteOrder_4;
-     procedure TestInfiniteOrder_5;
-     procedure TestInfiniteOrder_6;
-     procedure TestInfiniteOrder_7;
+     procedure TestInfinite_TAbstractMemBTree;
+     procedure TestInfinite_TAbstractMemBTreeData;
    end;
 
 implementation
@@ -115,7 +111,8 @@ var
   LTotalUsedSize, LTotalUsedBlocksCount, LTotalLeaksSize, LTotalLeaksBlocksCount : TAbstractMemPosition;
 begin
   Assert(AAbstractMem.CheckConsistency(Nil,Nil,LTotalUsedSize, LTotalUsedBlocksCount, LTotalLeaksSize, LTotalLeaksBlocksCount));
-  Assert(LTotalUsedSize=AUsedBytes,Format('Total used %d bytes (%d blocks) different from expected %d bytes - Total free %d bytes (%d blocks)',[LTotalUsedSize, AUsedBytes, LTotalUsedBlocksCount, LTotalLeaksSize, LTotalLeaksBlocksCount]));
+  Assert(LTotalUsedSize=AUsedBytes,Format('Total used %d bytes (%d blocks) different from expected %d bytes - Total free %d bytes (%d blocks)',
+    [LTotalUsedSize, LTotalUsedBlocksCount, AUsedBytes, LTotalLeaksSize, LTotalLeaksBlocksCount]));
 end;
 
 procedure TestTAbstractMemBTree.SetUp;
@@ -126,15 +123,213 @@ procedure TestTAbstractMemBTree.TearDown;
 begin
 end;
 
-procedure TestTAbstractMemBTree.TestInfinite(AOrder: Integer; A64Bytes : Boolean);
+function TComparison_SumChars(const ALeft, ARight: String): Integer;
+  function SumChars(const AString : string) : Integer;
+  var i : Integer;
+  begin
+    Result := 0;
+    for i := 0 to AString.Length-1 do inc(Result,Ord(AString.Chars[i]));
+  end;
+begin
+  Result := SumChars(ALeft) - SumChars(ARight);
+  ALeft.GetHashCode
+end;
+
+function TComparison_HashCode(const ALeft, ARight: String): Integer;
+begin
+  Result := ALeft.GetHashCode - ARight.GetHashCode;
+end;
+
+procedure TestTAbstractMemBTree.TestInfinite_TAbstractMemBTree;
+var LOrder, LMemUnitsSize, LInitialRandSeed : Integer;
+  L64Bits, LAllowDuplicates : Boolean;
+  s64Bits, sAllowDuplicates : String;
+begin
+  LInitialRandSeed := RandSeed;
+  LOrder := 3;
+  LMemUnitsSize := 4;
+  L64Bits := False;
+  LAllowDuplicates := False;
+  try
+    repeat
+      LMemUnitsSize := ((Random(255) DIV 4)*4)+4;
+      LAllowDuplicates := Random(2)=0;
+      L64Bits := Random(2)=0;
+      TestInfinite_Integer(LMemUnitsSize,LOrder,LAllowDuplicates,L64Bits);
+      inc(LOrder);
+    until (LOrder>11);
+  Except
+    On E:Exception do begin
+      if L64Bits then s64Bits := '64bits' else s64Bits := '32bits';
+      if LAllowDuplicates then sAllowDuplicates := 'Duplicates' else sAllowDuplicates := 'Unique';
+
+      E.Message := Format('Seed:%d Order:%d MUS:%d %s %s Error(%s):%s',[LInitialRandSeed,LOrder,LMemUnitsSize,s64Bits,sAllowDuplicates,E.ClassName,E.Message]);
+      Raise;
+    end;
+  end;
+end;
+
+procedure TestTAbstractMemBTree.TestInfinite_TAbstractMemBTreeData;
+var LOrder, LMemUnitsSize, LInitialRandSeed : Integer;
+  L64Bits, LAllowDuplicates : Boolean;
+  s64Bits, sAllowDuplicates : String;
+begin
+  LInitialRandSeed := RandSeed;
+  LOrder := 3;
+  LMemUnitsSize := 4;
+  L64Bits := False;
+  LAllowDuplicates := False;
+  try
+    repeat
+      LMemUnitsSize := ((Random(255) DIV 4)*4)+4;
+      LAllowDuplicates := Random(2)=0;
+      L64Bits := Random(2)=0;
+      TestInfiniteExt(LMemUnitsSize,LOrder,LAllowDuplicates,L64Bits);
+      inc(LOrder);
+    until (LOrder>11);
+  Except
+    On E:Exception do begin
+      if L64Bits then s64Bits := '64bits' else s64Bits := '32bits';
+      if LAllowDuplicates then sAllowDuplicates := 'Duplicates' else sAllowDuplicates := 'Unique';
+
+      E.Message := Format('Seed:%d Order:%d MUS:%d %s %s Error(%s):%s',[LInitialRandSeed,LOrder,LMemUnitsSize,s64Bits,sAllowDuplicates,E.ClassName,E.Message]);
+      Raise;
+    end;
+  end;
+end;
+
+procedure TestTAbstractMemBTree.TestInfiniteExt(AMemUnitsSize, AOrder: Integer; AAllowDuplicates, A64Bits: Boolean);
+var
+  Lbt : TAbstractMemBTreeExampleString;
+
+  procedure ProcessTree(ATotalRounds : Integer);
+  var LzoneIndex : TAMZone;
+  j : TAbstractMemPosition;
+  intValue, nRounds, nAdds, nDeletes, i, intAux : Integer;
+  LCurr, LnextCurr : String;
+  begin
+    repeat
+      inc(nRounds);
+      intValue := Random(AOrder * 100);
+      if Random(5)>0 then begin
+        if (Lbt.AddData(intValue.ToString)) then begin
+          inc(nAdds);
+        end;
+      end else begin
+        if Lbt.DeleteData(intValue.ToString) then begin
+          inc(nDeletes);
+        end;
+      end;
+    until (nRounds>=ATotalRounds);
+    Lbt.CheckConsistency;
+    // Delete mode
+    while Lbt.Count>0 do begin
+      if not Lbt.FindDataLowest(LCurr) then raise Exception.Create('Cannot fint lowest but Count>0');
+      if not Lbt.FindData(LCurr,LzoneIndex.position) then raise Exception.Create(Format('"%s" Not Found %d',[LCurr,Lbt.Count]));
+      while (Random(50)>0) do begin
+        if Random(3)=0 then begin
+          if not Lbt.FindDataPrecessor(Lcurr,LnextCurr) then begin
+            break;
+          end;
+          LCurr := LnextCurr;
+        end else if Random(2)=0 then begin
+          if not Lbt.FindDataSuccessor(LCurr,LnextCurr) then begin
+            break;
+          end;
+          LCurr := LnextCurr;
+        end;
+      end;
+      If Not Lbt.DeleteData(LCurr) then raise Exception.Create(Format('"%s" Not Found to delete! %d',[LCurr,Lbt.Count]));
+      Lbt.CheckConsistency;
+    end;
+    Lbt.CheckConsistency;
+    // Try to re-use
+    i := 0;
+    intValue := 10;
+    repeat
+      inc(intValue);
+      if (Lbt.CanAddData(intValue.ToString)) then begin
+        inc(i);
+        Assert(Lbt.AddData(intValue.ToString),Format('Cannot re-use (round %d on order %d) and add %d',[i,AOrder,intValue]));
+        Assert(Lbt.FindIndex(i-1,j),Format('Cannot find %d on index %d on order %d',[intValue,i-1,AOrder]));
+        Assert(Not Lbt.FindIndex(i,j),Format('Found %d on index %d on order %d',[j,i-1,AOrder]));
+      end;
+    until Lbt.Count>(AOrder * 10);
+  end;
+
+  procedure ProcessSaveToStream(AAbstractMem : TAbstractMem);
+  var LStream : TStream;
+    LStreamMem : TStreamMem;
+  begin
+    LStream := TMemoryStream.Create;
+    Try
+      AAbstractMem.SaveToStream(LStream);
+      //
+      LStreamMem := TStreamMem.Create(LStream,0,True);
+      Try
+        Assert( LStreamMem.HeaderInitialized , 'No valid Stream');
+        LStreamMem.CheckConsistency;
+      Finally
+        LStreamMem.Free;
+      End;
+    Finally
+      LStream.Free;
+    End;
+  end;
+
+
+var
+  LzoneData,
+  LzoneIndex : TAMZone;
+  Lmem : TAbstractMem;
+  i : Integer;
 begin
-  TestInfinite_Integer(AOrder,(AOrder MOD 2)=0,A64Bytes);
-  TestInfinite_String(AOrder,(AOrder MOD 2)=0,A64Bytes);
+  Lmem := TMem.Create(0,False);
+  Try
+    LMem.Initialize(A64Bits,AMemUnitsSize);
+    LzoneData := Lmem.New(TAbstractMemBTree.MinAbstractMemInitialPositionSize(Lmem));
+    try
+      Lbt := TAbstractMemBTreeExampleString.Create(Lmem,LzoneData,AAllowDuplicates,AOrder,TComparison_String);
+      try
+        TAbstractMemBTreeDataIndex<String>.Create(Lbt,
+          Lmem.New(TAbstractMemBTree.MinAbstractMemInitialPositionSize(Lmem)),False,
+          AOrder+1,TComparison_SumChars);
+        TAbstractMemBTreeDataIndex<String>.Create(Lbt,
+          Lmem.New(TAbstractMemBTree.MinAbstractMemInitialPositionSize(Lmem)),True,
+          AOrder+1,TComparison_HashCode);
+        ProcessTree(AOrder * 1000);
+      finally
+        // Dispose indexes
+        for i := Lbt.Indexes.Count-1 downto 0 do begin
+          LzoneIndex := Lbt.Indexes.Items[i].InitialZone;
+          Lbt.Indexes.Items[i].EraseTree;
+          Lbt.Indexes.Items[i].Free;
+          Lmem.Dispose( LzoneIndex );
+        end;
+        Lbt.Free;
+      end;
+      Lbt := TAbstractMemBTreeExampleString.Create(Lmem,LzoneData,AAllowDuplicates,AOrder,TComparison_String);
+      try
+        Lbt.CheckConsistency;
+        Lbt.EraseTree;
+        Lbt.CheckConsistency;
+      finally
+        Lbt.Free;
+      end;
+    finally
+      Lmem.Dispose(LzoneData);
+    end;
+    //
+    DoCheckAbstractMem(Lmem,0);
+    //
+    ProcessSaveToStream(Lmem);
+  Finally
+    Lmem.Free;
+  End;
 end;
 
-procedure TestTAbstractMemBTree.TestInfinite_Integer(AOrder : Integer; AAllowDuplicates : Boolean; A64Bytes : Boolean);
+procedure TestTAbstractMemBTree.TestInfinite_Integer(AMemUnitsSize, AOrder: Integer; AAllowDuplicates : Boolean; A64Bits : Boolean);
 var Lbt : TAbstractMemBTreeExampleInteger;
-  Lbts : TAbstractMemBTreeExampleString;
   Lzone : TAMZone;
   intValue, nRounds, nAdds, nDeletes, i, intAux : Integer;
   j : TAbstractMemPosition;
@@ -144,8 +339,7 @@ var Lbt : TAbstractMemBTreeExampleInteger;
 begin
   Lmem := TMem.Create(0,False);
   Try
-    RandSeed := 0;
-    LMem.Initialize(A64Bytes,Random(64)+4);
+    LMem.Initialize(A64Bits,AMemUnitsSize);
     nRounds := 0;
     nAdds := 0;
     nDeletes := 0;
@@ -207,130 +401,6 @@ begin
   End;
 end;
 
-procedure TestTAbstractMemBTree.TestInfinite_String(AOrder: Integer; AAllowDuplicates : Boolean; A64Bytes : Boolean);
-var Lbt : TAbstractMemBTreeExampleString;
-  Lzone : TAMZone;
-  intValue, nRounds, nAdds, nDeletes, i : Integer;
-  Lnode : TAbstractMemBTreeExampleString.TAbstractBTreeNode;
-  Lmem : TAbstractMem;
-  LCurr : String;
-  LCurrData : String;
-begin
-  Lmem := TMem.Create(0,False);
-  Try
-    RandSeed := 0;
-    Lmem.Initialize(A64Bytes,Random(64)+4);
-    nRounds := 0;
-    nAdds := 0;
-    nDeletes := 0;
-    Lzone := Lmem.New(TAbstractMemBTree.MinAbstractMemInitialPositionSize(Lmem));
-    try
-    Lbt := TAbstractMemBTreeExampleString.Create(Lmem,Lzone,AAllowDuplicates,AOrder,TComparison_String);
-    try
-      repeat
-        inc(nRounds);
-        intValue := Random(AOrder * 100);
-        if Random(2)=0 then begin
-          if (Lbt.AddData(intValue.ToString)) then begin
-            inc(nAdds);
-          end;
-        end else begin
-          if Lbt.DeleteData(intValue.ToString) then begin
-            inc(nDeletes);
-          end;
-        end;
-      until (nRounds>=AOrder * 10000);
-      Lbt.CheckConsistency;
-      // Delete mode
-      while Lbt.Count>0 do begin
-        Lnode := Lbt.Root;
-        while (Not Lnode.IsLeaf) and (Random(5)>0) do begin
-          Lnode := Lbt.GetNode(Lnode.childs[Random(Lnode.Count)+1]);
-        end;
-        LCurrData := Lbt.LoadData(Lnode.data[Random(Lnode.Count)]);
-        if Not Lbt.DeleteData(LCurrData) then raise EAbstractMemBTree.Create('Not found to delete!');
-      end;
-      Lbt.CheckConsistency;
-      // Try to re-use
-      for i := 1 to AOrder do begin
-        intValue := i;
-        Assert(Lbt.AddData(intValue.ToString),Format('Cannot re-use %d/%d and add %d',[i,AOrder,intValue]));
-        Lbt.CheckConsistency;
-      end;
-    finally
-      Lbt.Free;
-    end;
-    Lbt := TAbstractMemBTreeExampleString.Create(Lmem,Lzone,AAllowDuplicates,AOrder,TComparison_String);
-    try
-      Lbt.CheckConsistency;
-      LCurr := Lbt.BTreeToString;
-      // SUCCESSOR
-      Assert(Lbt.FindDataLowest(LCurrData),'Not found Lowest');
-      Assert(LcurrData='1','Not valid lowest');
-      for i := 1 to AOrder do begin
-        Assert(i.ToString=LcurrData,Format('Not valid successor %d %s',[i,LcurrData]));
-        if i<AOrder then begin
-          Assert(Lbt.FindDataSuccessor(LcurrData,LCurrData),Format('Not found successor %d %s',[i,LcurrData]));
-        end else begin
-          Assert(Not Lbt.FindDataSuccessor(LCurrData,LCurrData),Format('Not valid last successor %s',[LCurrData]));
-        end;
-      end;
-      // PRECESSOR
-      Assert(Lbt.FindDataHighest(LCurrData),'Not found Highest');
-      Assert(LcurrData=IntToStr(AOrder),'Not valid highest');
-      for i := AOrder downto 1 do begin
-        Assert(i.ToString=LcurrData,Format('Not valid precessor %d %s',[i,LcurrData]));
-        if i>1 then begin
-          Assert(Lbt.FindDataPrecessor(LcurrData,LCurrData),Format('Not found precessor %d %s',[i,LcurrData]));
-        end else begin
-          Assert(Not Lbt.FindDataPrecessor(LCurrData,LCurrData),Format('Not valid last precessor %s',[LCurrData]));
-        end;
-      end;
-      Lbt.EraseTree;
-      Assert(Lbt.Count=0,'Not erased tree count 0');
-      Lbt.CheckConsistency;
-      Lbt.EraseTree;
-    finally
-      Lbt.Free;
-    end;
-    finally
-      Lmem.Dispose(Lzone);
-    end;
-    DoCheckAbstractMem(Lmem,0);
-  Finally
-    Lmem.Free;
-  End;
-end;
-
-procedure TestTAbstractMemBTree.TestInfiniteOrder_3;
-begin
-//  TestInfinite(3,False);
-  TestInfinite(3,True);
-end;
-
-procedure TestTAbstractMemBTree.TestInfiniteOrder_4;
-begin
-  TestInfinite(4,False);
-  TestInfinite(4,True);
-end;
-
-procedure TestTAbstractMemBTree.TestInfiniteOrder_5;
-begin
-  TestInfinite(5,False);
-  TestInfinite(5,True);
-end;
-
-procedure TestTAbstractMemBTree.TestInfiniteOrder_6;
-begin
-  TestInfinite(6,False);
-  TestInfinite(6,True);
-end;
-
-procedure TestTAbstractMemBTree.TestInfiniteOrder_7;
-begin
-  TestInfinite(7,False);
-  TestInfinite(7,True);
-end;
 
 initialization
   RegisterTest(TestTAbstractMemBTree{$IFNDEF FPC}.Suite{$ENDIF});