Merge pull request #57 from PascalCoinDev/master

Improvements and Bug fixes for AbstractMem library v1.5 with +2Gb files support

src/core/UBlockChain.pas

@@ -25,7 +25,7 @@ unit UBlockChain;
 interface
 
 uses
-  Classes, UCrypto, UAccounts, ULog, UThread, SyncObjs, UBaseTypes, SysUtils,
+  Classes,{$IFnDEF FPC}Windows,{$ENDIF}UCrypto, UAccounts, ULog, UThread, SyncObjs, UBaseTypes, SysUtils,
   {$IFNDEF FPC}System.Generics.Collections{$ELSE}Generics.Collections{$ENDIF},
   {$IFDEF USE_ABSTRACTMEM}UPCAbstractMem,{$ENDIF}
   UPCDataTypes, UChunk;
@@ -421,6 +421,7 @@ Type
     Property OperationBlock: TOperationBlock read FOperationBlock;
     Class Function OperationBlockToText(const OperationBlock: TOperationBlock) : String;
     Class Function SaveOperationBlockToStream(Const OperationBlock: TOperationBlock; Stream: TStream) : Boolean;
+    class Function LoadOperationBlockFromStream(AStream : TStream; var Asoob : Byte; var AOperationBlock : TOperationBlock) : Boolean;
     Property AccountKey: TAccountKey read GetAccountKey write SetAccountKey;
     Property nonce: Cardinal read GetnOnce write SetnOnce;
     Property timestamp: Cardinal read Gettimestamp write Settimestamp;
@@ -484,25 +485,20 @@ Type
 
   TStorage = Class(TComponent)
   private
-    FOrphan: TOrphan;
     FBank : TPCBank;
     FReadOnly: Boolean;
     procedure SetBank(const Value: TPCBank);
   protected
     FIsMovingBlockchain : Boolean;
-    procedure SetOrphan(const Value: TOrphan); virtual;
     procedure SetReadOnly(const Value: Boolean); virtual;
     Function DoLoadBlockChain(Operations : TPCOperationsComp; Block : Cardinal) : Boolean; virtual; abstract;
     Function DoSaveBlockChain(Operations : TPCOperationsComp) : Boolean; virtual; abstract;
     Function DoMoveBlockChain(StartBlock : Cardinal; Const DestOrphan : TOrphan; DestStorage : TStorage) : Boolean; virtual; abstract;
-    Function DoSaveBank : Boolean; virtual; abstract;
-    Function DoRestoreBank(max_block : Int64; restoreProgressNotify : TProgressNotify) : Boolean; virtual; abstract;
     Procedure DoDeleteBlockChainBlocks(StartingDeleteBlock : Cardinal); virtual; abstract;
     Function DoBlockExists(Block : Cardinal) : Boolean; virtual; abstract;
     function GetFirstBlockNumber: Int64; virtual; abstract;
     function GetLastBlockNumber: Int64; virtual; abstract;
     function DoInitialize:Boolean; virtual; abstract;
-    Function DoOpenSafeBoxCheckpoint(blockCount : Cardinal) : TCheckPointStruct; virtual; abstract;
     Procedure DoEraseStorage; virtual; abstract;
     Procedure DoSavePendingBufferOperations(OperationsHashTree : TOperationsHashTree); virtual; abstract;
     Procedure DoLoadPendingBufferOperations(OperationsHashTree : TOperationsHashTree); virtual; abstract;
@@ -511,19 +507,13 @@ Type
     Function SaveBlockChainBlock(Operations : TPCOperationsComp) : Boolean;
     Function MoveBlockChainBlocks(StartBlock : Cardinal; Const DestOrphan : TOrphan; DestStorage : TStorage) : Boolean;
     Procedure DeleteBlockChainBlocks(StartingDeleteBlock : Cardinal);
-    Function SaveBank(forceSave : Boolean) : Boolean;
-    Function RestoreBank(max_block : Int64; restoreProgressNotify : TProgressNotify = Nil) : Boolean;
     Constructor Create(AOwner : TComponent); Override;
-    Property Orphan : TOrphan read FOrphan write SetOrphan;
     Property ReadOnly : Boolean read FReadOnly write SetReadOnly;
     Property Bank : TPCBank read FBank write SetBank;
     Procedure CopyConfiguration(Const CopyFrom : TStorage); virtual;
     Property FirstBlock : Int64 read GetFirstBlockNumber;
     Property LastBlock : Int64 read GetLastBlockNumber;
     Function Initialize : Boolean;
-    Function OpenSafeBoxCheckpoint(blockCount : Cardinal) : TCheckPointStruct;
-    Function HasUpgradedToVersion2 : Boolean; virtual; abstract;
-    Procedure CleanupVersion1Data; virtual; abstract;
     Procedure EraseStorage; // Erase Blockchain storage
     Procedure SavePendingBufferOperations(OperationsHashTree : TOperationsHashTree);
     Procedure LoadPendingBufferOperations(OperationsHashTree : TOperationsHashTree);
@@ -541,13 +531,14 @@ Type
     FLastBlockCache : TPCOperationsComp;
     FLastOperationBlock: TOperationBlock;
     FIsRestoringFromFile: Boolean;
-    FUpgradingToV2: Boolean;
     FOnLog: TPCBankLog;
     FBankLock: TPCCriticalSection;
     FNotifyList : TList<TPCBankNotify>;
     FStorageClass: TStorageClass;
+    FOrphan: TOrphan;
     function GetStorage: TStorage;
     procedure SetStorageClass(const Value: TStorageClass);
+    Function DoSaveBank : Boolean;
   public
     Constructor Create(AOwner: TComponent); Override;
     Destructor Destroy; Override;
@@ -572,10 +563,18 @@ Type
     Property StorageClass : TStorageClass read FStorageClass write SetStorageClass;
     Function IsReady(Var CurrentProcess : String) : Boolean;
     Property LastBlockFound : TPCOperationsComp read FLastBlockCache;
-    Property UpgradingToV2 : Boolean read FUpgradingToV2;
+    Function OpenSafeBoxCheckpoint(ABlockCount : Cardinal) : TCheckPointStruct;
+    Class Function GetSafeboxCheckpointingFileName(Const ABaseDataFolder : String; ABlock : Cardinal) : String;
+    Class Function GetStorageFolder(Const AOrphan : String) : String;
+    Function RestoreBank(AMax_block : Int64; AOrphan : String; ARestoreProgressNotify : TProgressNotify) : Boolean;
+    Function LoadBankFileInfo(Const AFilename : String; var ASafeBoxHeader : TPCSafeBoxHeader) : Boolean;
+    Property Orphan : TOrphan read FOrphan write FOrphan;
+    Function SaveBank(forceSave : Boolean) : Boolean;
   End;
 
 Const
+  CT_Safebox_Extension = {$IFDEF USE_ABSTRACTMEM}'.am_safebox'{$ELSE}'.safebox'{$ENDIF};
+
   CT_TOperationPayload_NUL : TOperationPayload = (payload_type:0;payload_raw:Nil);
   CT_TOperationResume_NUL : TOperationResume = (valid:false;Block:0;NOpInsideBlock:-1;OpType:0;OpSubtype:0;time:0;AffectedAccount:0;SignerAccount:-1;n_operation:0;DestAccount:-1;SellerAccount:-1;newKey:(EC_OpenSSL_NID:0;x:Nil;y:Nil);OperationTxt:'';Amount:0;Fee:0;Balance:0;OriginalPayload:(payload_type:0;payload_raw:nil);PrintablePayload:'';DecodedEPasaPayload:'';OperationHash:Nil;OperationHash_OLD:Nil;errors:'';isMultiOperation:False;Senders:Nil;Receivers:Nil;changers:Nil);
   CT_TMultiOpSender_NUL : TMultiOpSender =  (Account:0;Amount:0;N_Operation:0;Payload:(payload_type:0;payload_raw:Nil);Signature:(r:Nil;s:Nil));
@@ -591,7 +590,8 @@ uses
   Variants,
   UTime, UConst, UOpTransaction, UPCOrderedLists,
   UPCOperationsSignatureValidator,
-  UPCOperationsBlockValidator;
+  UPCOperationsBlockValidator,
+  UNode;
 
 { TPCOperationsStorage }
 
@@ -899,7 +899,6 @@ begin
   FNotifyList := TList<TPCBankNotify>.Create;
   FLastBlockCache := TPCOperationsComp.Create(Nil);
   FIsRestoringFromFile:=False;
-  FUpgradingToV2:=False;
   Clear;
 end;
 
@@ -948,7 +947,6 @@ begin
   LStartProcessTC := tc;
   TPCThread.ProtectEnterCriticalSection(Self,FBankLock);
   try
-    FUpgradingToV2 := NOT Storage.HasUpgradedToVersion2;
     FIsRestoringFromFile := true;
     try
       Clear;
@@ -956,7 +954,7 @@ begin
       If (max_block<Storage.LastBlock) or (Storage.LastBlock<0) then n := max_block
       else n := Storage.LastBlock;
 
-      Storage.RestoreBank(n,restoreProgressNotify);
+      RestoreBank(n,Orphan,restoreProgressNotify);
       // Restore last blockchain
       if (BlocksCount>0) And (SafeBox.CurrentProtocol=CT_PROTOCOL_1) then begin
         if Not Storage.LoadBlockChainBlock(FLastBlockCache,BlocksCount-1) then begin
@@ -972,7 +970,7 @@ begin
         FLastOperationBlock.initial_safe_box_hash := TPCSafeBox.InitialSafeboxHash; // Genesis hash
       end;
 
-      NewLog(Nil, ltinfo,'Start restoring from disk operations (Max '+inttostr(max_block)+') BlockCount: '+inttostr(BlocksCount)+' Orphan: ' +Storage.Orphan);
+      NewLog(Nil, ltinfo,'Start restoring from disk operations (Max '+inttostr(max_block)+') BlockCount: '+inttostr(BlocksCount)+' Orphan: ' +Orphan);
       LBlocks := TList<TPCOperationsComp>.Create;
       try
         LProgressBlock := 0;
@@ -1022,7 +1020,7 @@ begin
                 // To prevent continuous saving...
                 if ((BlocksCount+(CT_BankToDiskEveryNBlocks*2)) >= Storage.LastBlock ) or
                    ((BlocksCount MOD (CT_BankToDiskEveryNBlocks*10))=0) then begin
-                  Storage.SaveBank(False);
+                  SaveBank(False);
                 end;
                 if (Assigned(restoreProgressNotify)) And (TPlatform.GetElapsedMilliseconds(tc)>1000) then begin
                   tc := TPlatform.GetTickCount;
@@ -1042,13 +1040,11 @@ begin
 
       finally
         LBlocks.Free;
-        if FUpgradingToV2 then Storage.CleanupVersion1Data;
-        NewLog(Nil, ltinfo,'End restoring from disk operations (Max '+inttostr(max_block)+') Orphan: ' + Storage.Orphan+' Restored '+Inttostr(BlocksCount)+' blocks in '+IntToStr(TPlatform.GetElapsedMilliseconds(LStartProcessTC))+' milliseconds');
+        NewLog(Nil, ltinfo,'End restoring from disk operations (Max '+inttostr(max_block)+') Orphan: ' + Orphan+' Restored '+Inttostr(BlocksCount)+' blocks in '+IntToStr(TPlatform.GetElapsedMilliseconds(LStartProcessTC))+' milliseconds');
       end;
 
     finally
       FIsRestoringFromFile := False;
-      FUpgradingToV2 := false;
       for i := 0 to FNotifyList.Count - 1 do begin
         TPCBankNotify(FNotifyList.Items[i]).NotifyNewBlock;
       end;
@@ -1061,6 +1057,60 @@ begin
   end;
 end;
 
+function TPCBank.DoSaveBank: Boolean;
+var fs: TFileStream;
+    LBankfilename,Laux_newfilename: AnsiString;
+    ms : TMemoryStream;
+  LTC : TTickCount;
+begin
+  Result := true;
+  LBankfilename := GetSafeboxCheckpointingFileName(GetStorageFolder(Orphan),BlocksCount);
+  if (LBankfilename<>'') then begin
+    LTC := TPlatform.GetTickCount;
+    {$IFDEF USE_ABSTRACTMEM}
+    SafeBox.SaveCheckpointing(LBankfilename);
+    {$ELSE}
+    fs := TFileStream.Create(bankfilename,fmCreate);
+    try
+      fs.Size := 0;
+      fs.Position:=0;
+      if LowMemoryUsage then begin
+        Bank.SafeBox.SaveSafeBoxToAStream(fs,0,Bank.SafeBox.BlocksCount-1);
+      end else begin
+        ms := TMemoryStream.Create;
+        try
+          Bank.SafeBox.SaveSafeBoxToAStream(ms,0,Bank.SafeBox.BlocksCount-1);
+          ms.Position := 0;
+          fs.CopyFrom(ms,0);
+        finally
+          ms.Free;
+        end;
+      end;
+    finally
+      fs.Free;
+    end;
+    {$ENDIF}
+    TLog.NewLog(ltInfo,ClassName,Format('Saving Safebox blocks:%d file:%s in %.2n seconds',[BlocksCount,LBankfilename,TPlatform.GetElapsedMilliseconds(LTC)/1000]));
+    // Save a copy each 10000 blocks (aprox 1 month) only when not an orphan
+    if (Orphan='') And ((BlocksCount MOD (CT_BankToDiskEveryNBlocks*100))=0) then begin
+      Laux_newfilename := GetStorageFolder('') + PathDelim+'checkpoint_'+ inttostr(BlocksCount)+CT_Safebox_Extension;
+      try
+        {$IFDEF FPC}
+        DoCopyFile(bankfilename,aux_newfilename);
+        {$ELSE}
+        CopyFile(PWideChar(LBankfilename),PWideChar(Laux_newfilename),False);
+        {$ENDIF}
+      Except
+        On E:Exception do begin
+          TLog.NewLog(lterror,ClassName,'Exception copying extra safebox file '+Laux_newfilename+' ('+E.ClassName+'):'+E.Message);
+        end;
+      end;
+    end;
+  end;
+
+
+end;
+
 procedure TPCBank.UpdateValuesFromSafebox;
 Var aux : String;
   i : Integer;
@@ -1181,6 +1231,21 @@ begin
   end;
 end;
 
+Const CT_SafeboxsToStore = 10;
+
+class function TPCBank.GetSafeboxCheckpointingFileName(
+  const ABaseDataFolder: String; ABlock: Cardinal): String;
+begin
+  Result := '';
+  If not ForceDirectories(ABaseDataFolder) then exit;
+  if TPCSafeBox.MustSafeBoxBeSaved(ABlock) then begin
+    // We will store checkpointing
+    Result := ABaseDataFolder + PathDelim+'checkpoint'+ inttostr((ABlock DIV CT_BankToDiskEveryNBlocks) MOD CT_SafeboxsToStore)+CT_Safebox_Extension;
+  end else begin
+    Result := ABaseDataFolder + PathDelim+'checkpoint_'+inttostr(ABlock)+CT_Safebox_Extension;
+  end;
+end;
+
 function TPCBank.GetStorage: TStorage;
 begin
   if Not Assigned(FStorage) then begin
@@ -1191,18 +1256,41 @@ begin
   Result := FStorage;
 end;
 
+class function TPCBank.GetStorageFolder(const AOrphan: String): String;
+var Lbase : String;
+begin
+  Lbase := TNode.GetPascalCoinDataFolder + PathDelim + 'Data';
+  if Lbase = '' then raise Exception.Create('No Database Folder');
+  if AOrphan<>'' then Result := Lbase + PathDelim+AOrphan
+  else Result := Lbase;
+  if not ForceDirectories(Result) then raise Exception.Create('Cannot create storage folder: '+Result);
+end;
+
 function TPCBank.IsReady(var CurrentProcess: String): Boolean;
 begin
   Result := false;
   CurrentProcess := '';
   if FIsRestoringFromFile then begin
-    if FUpgradingToV2 then
-      CurrentProcess := 'Migrating to version 2 format'
-    else
-      CurrentProcess := 'Restoring from file'
+    CurrentProcess := 'Restoring from file';
   end else Result := true;
 end;
 
+function TPCBank.LoadBankFileInfo(const AFilename: String;
+  var ASafeBoxHeader: TPCSafeBoxHeader): Boolean;
+var fs: TFileStream;
+begin
+  Result := false;
+  ASafeBoxHeader := CT_PCSafeBoxHeader_NUL;
+  If Not FileExists(AFilename) then exit;
+  fs := TFileStream.Create(AFilename,fmOpenRead);
+  try
+    fs.Position:=0;
+    Result := SafeBox.LoadSafeBoxStreamHeader(fs,ASafeBoxHeader);
+  finally
+    fs.Free;
+  end;
+end;
+
 function TPCBank.LoadBankFromChunks(AChunks : TPCSafeboxChunks;
   checkSafeboxHash: TRawBytes; previousCheckedSafebox: TPCSafebox;
   progressNotify: TProgressNotify; var errors: String): Boolean;
@@ -1324,6 +1412,132 @@ begin
     FOnLog(Self, Operations, Logtype, Logtxt);
 end;
 
+function TPCBank.OpenSafeBoxCheckpoint(ABlockCount: Cardinal): TCheckPointStruct;
+var fn : TFilename;
+  err : AnsiString;
+begin
+  Result := Nil;
+  fn := GetSafeboxCheckpointingFileName(GetStorageFolder(''),ABlockCount);
+  If (fn<>'') and (FileExists(fn)) then begin
+    {$IFDEF USE_ABSTRACTMEM}
+    Result := TPCAbstractMem.Create(fn,True);
+    {$ELSE}
+    Result := TFileStream.Create(fn,fmOpenRead+fmShareDenyWrite);
+    {$ENDIF}
+  end;
+  If Not Assigned(Result) then begin
+    err := 'Cannot load SafeBoxStream (block:'+IntToStr(ABlockCount)+') file:'+fn;
+    TLog.NewLog(ltError,ClassName,err);
+  end;
+end;
+
+function TPCBank.RestoreBank(AMax_block: Int64; AOrphan : String;
+  ARestoreProgressNotify: TProgressNotify): Boolean;
+var
+    sr: TSearchRec;
+    FileAttrs: Integer;
+    folder : AnsiString;
+    Lfilename,auxfn : AnsiString;
+    fs : TFileStream;
+    errors : String;
+    LBlockscount : Cardinal;
+    sbHeader, goodSbHeader : TPCSafeBoxHeader;
+    {$IFDEF USE_ABSTRACTMEM}
+    LTempBlocksCount : Integer;
+    LSafeboxFileName : String;
+    {$ELSE}
+    {$ENDIF}
+begin
+  FBankLock.Acquire;
+  Try
+    {$IFDEF USE_ABSTRACTMEM}
+    Lfilename := '';
+    LSafeboxFileName := GetStorageFolder(AOrphan)+PathDelim+'safebox'+CT_Safebox_Extension;
+    if TPCAbstractMem.AnalyzeFile(LSafeboxFileName,LTempBlocksCount) then begin
+      LBlockscount := LTempBlocksCount;
+    end else begin
+      LBlockscount := 0;
+    end;
+    //
+    FileAttrs := faArchive;
+    folder := GetStorageFolder(''); /// Without Orphan folder
+    if SysUtils.FindFirst(folder+PathDelim+'checkpoint*'+CT_Safebox_Extension, FileAttrs, sr) = 0 then begin
+      repeat
+        if (sr.Attr and FileAttrs) = FileAttrs then begin
+          auxfn := folder+PathDelim+sr.Name;
+          if TPCAbstractMem.AnalyzeFile(auxfn,LTempBlocksCount) then begin
+            if (((AMax_block<0) Or (LTempBlocksCount<=AMax_block)) AND (LTempBlocksCount>LBlockscount)) then begin
+              Lfilename := auxfn;
+              LBlockscount := LTempBlocksCount;
+            end;
+          end;
+        end;
+      until FindNext(sr) <> 0;
+      FindClose(sr);
+    end;
+    if (Lfilename='') then begin
+      SafeBox.SetSafeboxFileName(LSafeboxFileName);
+    end else begin
+      SafeBox.SetSafeboxFileName(Lfilename);
+      SafeBox.UpdateSafeboxFileName(LSafeboxFileName);
+    end;
+    {$ELSE}
+    LBlockscount := 0;
+    {$ENDIF}
+    FileAttrs := faArchive;
+    folder := GetStorageFolder(AOrphan);
+    Lfilename := '';
+    if SysUtils.FindFirst(folder+PathDelim+'*.safebox', FileAttrs, sr) = 0 then begin
+      repeat
+        if (sr.Attr and FileAttrs) = FileAttrs then begin
+          auxfn := folder+PathDelim+sr.Name;
+          If LoadBankFileInfo(auxfn,sbHeader) then begin
+            if (((AMax_block<0) Or (sbHeader.endBlock<=AMax_block)) AND (sbHeader.blocksCount>LBlockscount)) And
+              (sbHeader.startBlock=0) And (sbHeader.endBlock=sbHeader.startBlock+sbHeader.blocksCount-1) then begin
+              Lfilename := auxfn;
+              LBlockscount := sbHeader.blocksCount;
+              goodSbHeader := sbHeader;
+            end;
+          end;
+        end;
+      until FindNext(sr) <> 0;
+      FindClose(sr);
+    end;
+    if (Lfilename<>'') then begin
+      TLog.NewLog(ltinfo,Self.ClassName,'Loading SafeBox protocol:'+IntToStr(goodSbHeader.protocol)+' with '+inttostr(LBlockscount)+' blocks from file '+Lfilename);
+      fs := TFileStream.Create(Lfilename,fmOpenRead);
+      try
+        fs.Position := 0;
+        if not LoadBankFromStream(fs,False,Nil,Nil,ARestoreProgressNotify,errors) then begin
+          TLog.NewLog(lterror,ClassName,'Error reading bank from file: '+Lfilename+ ' Error: '+errors);
+        end;
+      finally
+        fs.Free;
+      end;
+    end;
+  Finally
+    FBankLock.Release;
+  End;
+end;
+
+function TPCBank.SaveBank(forceSave: Boolean): Boolean;
+begin
+  Result := true;
+  If Storage.FIsMovingBlockchain then Exit;
+  if (Not forceSave) AND (Not TPCSafeBox.MustSafeBoxBeSaved(BlocksCount)) then exit; // No save
+  Try
+    Result := DoSaveBank;
+    {$IFnDEF USE_ABSTRACTMEM}
+    SafeBox.CheckMemory;
+    {$ENDIF}
+  Except
+    On E:Exception do begin
+      TLog.NewLog(lterror,Classname,'Error saving Bank: '+E.Message);
+      Raise;
+    end;
+  End;
+end;
+
 procedure TPCBank.SetStorageClass(const Value: TStorageClass);
 begin
   if FStorageClass=Value then exit;
@@ -1707,8 +1921,12 @@ begin
       errors := 'Invalid protocol structure. Check application version!';
       exit;
     end;
-    soob := 255;
-    Stream.Read(soob,1);
+
+    if Not LoadOperationBlockFromStream(Stream,soob,FOperationBlock) then begin
+      errors := 'Cannot load operationBlock';
+      Exit;
+    end;
+
     // About soob var:
     // In build prior to 1.0.4 soob only can have 2 values: 0 or 1
     // In build 1.0.4 soob can has 2 more values: 2 or 3
@@ -1736,32 +1954,10 @@ begin
       exit;
     end;
 
-    if (soob in [2,3,4,5]) then begin
-      Stream.Read(FOperationBlock.protocol_version, Sizeof(FOperationBlock.protocol_version));
-      Stream.Read(FOperationBlock.protocol_available, Sizeof(FOperationBlock.protocol_available));
-    end else begin
-      // We assume that protocol_version is 1 and protocol_available is 0
-      FOperationBlock.protocol_version := 1;
-      FOperationBlock.protocol_available := 0;
-    end;
-
-    if Stream.Read(FOperationBlock.block, Sizeof(FOperationBlock.block))<0 then exit;
-
-    if TStreamOp.ReadAnsiString(Stream, raw) < 0 then exit;
-    FOperationBlock.account_key := TAccountComp.RawString2Accountkey(raw);
-    if Stream.Read(FOperationBlock.reward, Sizeof(FOperationBlock.reward)) < 0 then exit;
-    if Stream.Read(FOperationBlock.fee, Sizeof(FOperationBlock.fee)) < 0 then exit;
-    if Stream.Read(FOperationBlock.timestamp, Sizeof(FOperationBlock.timestamp)) < 0 then exit;
-    if Stream.Read(FOperationBlock.compact_target, Sizeof(FOperationBlock.compact_target)) < 0 then exit;
-    if Stream.Read(FOperationBlock.nonce, Sizeof(FOperationBlock.nonce)) < 0 then exit;
-    if TStreamOp.ReadAnsiString(Stream, FOperationBlock.block_payload) < 0 then exit;
-    if TStreamOp.ReadAnsiString(Stream, FOperationBlock.initial_safe_box_hash) < 0 then exit;
-    if TStreamOp.ReadAnsiString(Stream, FOperationBlock.operations_hash) < 0 then exit;
-    if TStreamOp.ReadAnsiString(Stream, FOperationBlock.proof_of_work) < 0 then exit;
     if FOperationBlock.protocol_version>=CT_PROTOCOL_5 then begin
-      if TStreamOp.ReadAnsiString(Stream, FOperationBlock.previous_proof_of_work) < 0 then exit;
       load_protocol_version := FOperationBlock.protocol_version;
     end;
+
     If FIsOnlyOperationBlock then begin
       Result := true;
       exit;
@@ -1803,6 +1999,41 @@ begin
   end;
 end;
 
+class function TPCOperationsComp.LoadOperationBlockFromStream(AStream: TStream; var Asoob : Byte;
+  var AOperationBlock: TOperationBlock): Boolean;
+var Lraw : TBytes;
+begin
+  Result := False;
+  AStream.Read(Asoob,1);
+  if (Asoob in [2,3,4,5]) then begin
+    if AStream.Read(AOperationBlock.protocol_version, Sizeof(AOperationBlock.protocol_version)) < 0 then Exit;
+    AStream.Read(AOperationBlock.protocol_available, Sizeof(AOperationBlock.protocol_available));
+  end else begin
+    // We assume that protocol_version is 1 and protocol_available is 0
+    AOperationBlock.protocol_version := 1;
+    AOperationBlock.protocol_available := 0;
+  end;
+
+  if AStream.Read(AOperationBlock.block, Sizeof(AOperationBlock.block))<=0 then exit;
+
+  if TStreamOp.ReadAnsiString(AStream, Lraw) < 0 then exit;
+  AOperationBlock.account_key := TAccountComp.RawString2Accountkey(Lraw);
+
+  if AStream.Read(AOperationBlock.reward, Sizeof(AOperationBlock.reward)) < 0 then exit;
+  if AStream.Read(AOperationBlock.fee, Sizeof(AOperationBlock.fee)) < 0 then exit;
+  if AStream.Read(AOperationBlock.timestamp, Sizeof(AOperationBlock.timestamp)) < 0 then exit;
+  if AStream.Read(AOperationBlock.compact_target, Sizeof(AOperationBlock.compact_target)) < 0 then exit;
+  if AStream.Read(AOperationBlock.nonce, Sizeof(AOperationBlock.nonce)) < 0 then exit;
+  if TStreamOp.ReadAnsiString(AStream, AOperationBlock.block_payload) < 0 then exit;
+  if TStreamOp.ReadAnsiString(AStream, AOperationBlock.initial_safe_box_hash) < 0 then exit;
+  if TStreamOp.ReadAnsiString(AStream, AOperationBlock.operations_hash) < 0 then exit;
+  if TStreamOp.ReadAnsiString(AStream, AOperationBlock.proof_of_work) < 0 then exit;
+  if AOperationBlock.protocol_version>=CT_PROTOCOL_5 then begin
+    if TStreamOp.ReadAnsiString(AStream, AOperationBlock.previous_proof_of_work) < 0 then exit;
+  end;
+  Result := True;
+end;
+
 class function TPCOperationsComp.OperationBlockToText(const OperationBlock: TOperationBlock): String;
 begin
   Result := Format('Block:%d Timestamp:%d Reward:%d Fee:%d Target:%d PoW:%s Payload:%s Nonce:%d OperationsHash:%s SBH:%s',[operationBlock.block,
@@ -3004,13 +3235,11 @@ end;
 
 procedure TStorage.CopyConfiguration(const CopyFrom: TStorage);
 begin
-  Orphan := CopyFrom.Orphan;
 end;
 
 constructor TStorage.Create(AOwner: TComponent);
 begin
   inherited;
-  FOrphan := '';
   FReadOnly := false;
   FIsMovingBlockchain := False;
 end;
@@ -3026,11 +3255,6 @@ begin
   Result := DoInitialize;
 end;
 
-function TStorage.OpenSafeBoxCheckpoint(blockCount: Cardinal): TCheckPointStruct;
-begin
-  Result := DoOpenSafeBoxCheckpoint(blockCount);
-end;
-
 procedure TStorage.EraseStorage;
 begin
   TLog.NewLog(ltInfo,ClassName,'Executing EraseStorage');
@@ -3061,29 +3285,6 @@ begin
   Result := DoMoveBlockChain(StartBlock,DestOrphan,DestStorage);
 end;
 
-function TStorage.RestoreBank(max_block: Int64; restoreProgressNotify : TProgressNotify = Nil): Boolean;
-begin
-  Result := DoRestoreBank(max_block,restoreProgressNotify);
-end;
-
-function TStorage.SaveBank(forceSave : Boolean): Boolean;
-begin
-  Result := true;
-  If FIsMovingBlockchain then Exit;
-  if (Not forceSave) AND (Not TPCSafeBox.MustSafeBoxBeSaved(Bank.BlocksCount)) then exit; // No save
-  Try
-    Result := DoSaveBank;
-    {$IFnDEF USE_ABSTRACTMEM}
-    FBank.SafeBox.CheckMemory;
-    {$ENDIF}
-  Except
-    On E:Exception do begin
-      TLog.NewLog(lterror,Classname,'Error saving Bank: '+E.Message);
-      Raise;
-    end;
-  End;
-end;
-
 function TStorage.SaveBlockChainBlock(Operations: TPCOperationsComp): Boolean;
 begin
   Try
@@ -3102,11 +3303,6 @@ begin
   FBank := Value;
 end;
 
-procedure TStorage.SetOrphan(const Value: TOrphan);
-begin
-  FOrphan := Value;
-end;
-
 procedure TStorage.SetReadOnly(const Value: Boolean);
 begin
   FReadOnly := Value;

src/core/UFileStorage.pas

@@ -41,55 +41,41 @@ Type
 
   TFileStorage = Class(TStorage)
   private
-    FLowMemoryUsage: Boolean;
     FStorageLock : TPCCriticalSection;
     FBlockChainStream : TFileStream;
     FPendingBufferOperationsStream : TFileStream;
     FStreamFirstBlockNumber : Int64;
     FStreamLastBlockNumber : Int64;
     FBlockHeadersFirstBytePosition : TArrayOfInt64;
-    FDatabaseFolder: AnsiString;
     FBlockChainFileName : AnsiString;
     Function StreamReadBlockHeader(Stream: TStream; iBlockHeaders : Integer; BlockHeaderFirstBlock, Block: Cardinal; CanSearchBackward : Boolean; var BlockHeader : TBlockHeader): Boolean;
     Function StreamBlockRead(Stream : TStream; iBlockHeaders : Integer; BlockHeaderFirstBlock, Block : Cardinal; Operations : TPCOperationsComp) : Boolean;
     Function StreamBlockSave(Stream : TStream; iBlockHeaders : Integer; BlockHeaderFirstBlock : Cardinal; Operations : TPCOperationsComp) : Boolean;
-    Function GetFolder(Const AOrphan : TOrphan): AnsiString;
     Function GetBlockHeaderFirstBytePosition(Stream : TStream; Block : Cardinal; CanInitialize : Boolean; var iBlockHeaders : Integer; var BlockHeaderFirstBlock : Cardinal) : Boolean;
     Function GetBlockHeaderFixedSize : Int64;
-    procedure SetDatabaseFolder(const Value: AnsiString);
     Procedure ClearStream;
     Procedure GrowStreamUntilPos(Stream : TStream; newPos : Int64; DeleteDataStartingAtCurrentPos : Boolean);
     Function GetPendingBufferOperationsStream : TFileStream;
   protected
     procedure SetReadOnly(const Value: Boolean); override;
-    procedure SetOrphan(const Value: TOrphan); override;
     Function DoLoadBlockChain(Operations : TPCOperationsComp; Block : Cardinal) : Boolean; override;
     Function DoSaveBlockChain(Operations : TPCOperationsComp) : Boolean; override;
     Function DoMoveBlockChain(Start_Block : Cardinal; Const DestOrphan : TOrphan; DestStorage : TStorage) : Boolean; override;
-    Function DoSaveBank : Boolean; override;
-    Function DoRestoreBank(max_block : Int64; restoreProgressNotify : TProgressNotify) : Boolean; override;
     Procedure DoDeleteBlockChainBlocks(StartingDeleteBlock : Cardinal); override;
     Function DoBlockExists(Block : Cardinal) : Boolean; override;
     Function LockBlockChainStream : TFileStream;
     Procedure UnlockBlockChainStream;
-    Function LoadBankFileInfo(Const Filename : AnsiString; var safeBoxHeader : TPCSafeBoxHeader) : Boolean;
     function GetFirstBlockNumber: Int64; override;
     function GetLastBlockNumber: Int64; override;
     function DoInitialize : Boolean; override;
-    Function DoOpenSafeBoxCheckpoint(blockCount : Cardinal) : TCheckPointStruct; override;
     Procedure DoEraseStorage; override;
     Procedure DoSavePendingBufferOperations(OperationsHashTree : TOperationsHashTree); override;
     Procedure DoLoadPendingBufferOperations(OperationsHashTree : TOperationsHashTree); override;
   public
     Constructor Create(AOwner : TComponent); Override;
     Destructor Destroy; Override;
-    Class Function GetSafeboxCheckpointingFileName(Const BaseDataFolder : AnsiString; block : Cardinal) : AnsiString;
-    Property DatabaseFolder : AnsiString read FDatabaseFolder write SetDatabaseFolder;
     Procedure CopyConfiguration(Const CopyFrom : TStorage); override;
     Procedure SetBlockChainFile(BlockChainFileName : AnsiString);
-    Function HasUpgradedToVersion2 : Boolean; override;
-    Procedure CleanupVersion1Data; override;
-    property LowMemoryUsage : Boolean read FLowMemoryUsage write FLowMemoryUsage;
   End;
 
 implementation
@@ -192,7 +178,7 @@ Var fs : TFileStream;
   fm : Word;
 begin
   If Not Assigned(FPendingBufferOperationsStream) then begin
-    fn := GetFolder(Orphan)+PathDelim+'pendingbuffer.ops';
+    fn := Bank.GetStorageFolder(Bank.Orphan)+PathDelim+'pendingbuffer.ops';
     If FileExists(fn) then fm := fmOpenReadWrite+fmShareExclusive
     else fm := fmCreate+fmShareExclusive;
     Try
@@ -210,16 +196,11 @@ end;
 procedure TFileStorage.CopyConfiguration(const CopyFrom: TStorage);
 begin
   inherited;
-  if CopyFrom is TFileStorage then begin
-    DatabaseFolder := TFileStorage(CopyFrom).DatabaseFolder;
-  end;
 end;
 
 constructor TFileStorage.Create(AOwner: TComponent);
 begin
   inherited;
-  FLowMemoryUsage := False;
-  FDatabaseFolder := '';
   FBlockChainFileName := '';
   FBlockChainStream := Nil;
   SetLength(FBlockHeadersFirstBytePosition,0);
@@ -278,25 +259,6 @@ begin
   End;
 end;
 
-function TFileStorage.DoOpenSafeBoxCheckpoint(blockCount: Cardinal): TCheckPointStruct;
-var fn : TFilename;
-  err : AnsiString;
-begin
-  Result := Nil;
-  fn := GetSafeboxCheckpointingFileName(GetFolder(Orphan),blockCount);
-  If (fn<>'') and (FileExists(fn)) then begin
-    {$IFDEF USE_ABSTRACTMEM}
-    Result := TPCAbstractMem.Create(fn,True);
-    {$ELSE}
-    Result := TFileStream.Create(fn,fmOpenRead+fmShareDenyWrite);
-    {$ENDIF}
-  end;
-  If Not Assigned(Result) then begin
-    err := 'Cannot load SafeBoxStream (block:'+IntToStr(blockCount)+') file:'+fn;
-    TLog.NewLog(ltError,ClassName,err);
-  end;
-end;
-
 procedure TFileStorage.DoEraseStorage;
 Var stream : TStream;
 begin
@@ -389,12 +351,12 @@ function TFileStorage.DoMoveBlockChain(Start_Block: Cardinal; const DestOrphan:
     sourcefn,destfn : AnsiString;
   begin
     FileAttrs := faArchive;
-    folder := GetFolder(Orphan);
-    if SysUtils.FindFirst(GetFolder(Orphan)+PathDelim+'checkpoint*'+CT_Safebox_Extension, FileAttrs, sr) = 0 then begin
+    folder := Bank.GetStorageFolder(Bank.Orphan);
+    if SysUtils.FindFirst(Bank.GetStorageFolder(Bank.Orphan)+PathDelim+'checkpoint*'+CT_Safebox_Extension, FileAttrs, sr) = 0 then begin
       repeat
         if (sr.Attr and FileAttrs) = FileAttrs then begin
-          sourcefn := GetFolder(Orphan)+PathDelim+sr.Name;
-          destfn := GetFolder('')+PathDelim+sr.Name;
+          sourcefn := Bank.GetStorageFolder(Bank.Orphan)+PathDelim+sr.Name;
+          destfn := Bank.GetStorageFolder('')+PathDelim+sr.Name;
           TLog.NewLog(ltInfo,ClassName,'Copying safebox file '+sourcefn+' to '+destfn);
           Try
             DoCopyFile(sourcefn,destfn);
@@ -420,9 +382,7 @@ begin
     try
       if Not assigned(db) then begin
         db := TFileStorage.Create(Nil);
-        db.DatabaseFolder := Self.DatabaseFolder;
         db.Bank := Self.Bank;
-        db.Orphan := DestOrphan;
         db.FStreamFirstBlockNumber := Start_Block;
       end;
       if db is TFileStorage then TFileStorage(db).LockBlockChainStream;
@@ -433,15 +393,15 @@ begin
           b := Start_Block;
           while LoadBlockChainBlock(ops,b) do begin
             inc(b);
-            TLog.NewLog(ltDebug,Classname,'Moving block from "'+Orphan+'" to "'+DestOrphan+'" '+TPCOperationsComp.OperationBlockToText(ops.OperationBlock));
+            TLog.NewLog(ltDebug,Classname,'Moving block from "'+Bank.Orphan+'" to "'+DestOrphan+'" '+TPCOperationsComp.OperationBlockToText(ops.OperationBlock));
             db.SaveBlockChainBlock(ops);
           end;
-          TLog.NewLog(ltdebug,Classname,'Moved blockchain from "'+Orphan+'" to "'+DestOrphan+'" from block '+inttostr(Start_Block)+' to '+inttostr(b-1));
+          TLog.NewLog(ltdebug,Classname,'Moved blockchain from "'+Bank.Orphan+'" to "'+DestOrphan+'" from block '+inttostr(Start_Block)+' to '+inttostr(b-1));
         finally
           ops.Free;
         end;
         // If DestOrphan is empty, then copy possible updated safebox (because, perhaps current saved safebox is from invalid blockchain)
-        if (DestOrphan='') And (Orphan<>'') then begin
+        if (DestOrphan='') And (Bank.Orphan<>'') then begin
           DoCopySafebox;
         end;
       finally
@@ -459,160 +419,6 @@ begin
   End;
 end;
 
-function TFileStorage.DoRestoreBank(max_block: Int64; restoreProgressNotify : TProgressNotify): Boolean;
-var
-    sr: TSearchRec;
-    FileAttrs: Integer;
-    folder : AnsiString;
-    Lfilename,auxfn : AnsiString;
-    fs : TFileStream;
-    ms : TMemoryStream;
-    errors : String;
-    LBlockscount : Cardinal;
-    sbHeader, goodSbHeader : TPCSafeBoxHeader;
-    {$IFDEF USE_ABSTRACTMEM}
-    LTempBlocksCount : Integer;
-    LSafeboxFileName : String;
-    {$ELSE}
-    {$ENDIF}
-begin
-  LockBlockChainStream;
-  Try
-    {$IFDEF USE_ABSTRACTMEM}
-    Lfilename := '';
-    LSafeboxFileName := GetFolder(Orphan)+PathDelim+'safebox'+CT_Safebox_Extension;
-    if TPCAbstractMem.AnalyzeFile(LSafeboxFileName,LTempBlocksCount) then begin
-      LBlockscount := LTempBlocksCount;
-    end else begin
-      LBlockscount := 0;
-    end;
-    //
-    FileAttrs := faArchive;
-    folder := GetFolder(''); /// Without Orphan folder
-    if SysUtils.FindFirst(folder+PathDelim+'checkpoint*'+CT_Safebox_Extension, FileAttrs, sr) = 0 then begin
-      repeat
-        if (sr.Attr and FileAttrs) = FileAttrs then begin
-          auxfn := folder+PathDelim+sr.Name;
-          if TPCAbstractMem.AnalyzeFile(auxfn,LTempBlocksCount) then begin
-            if (((max_block<0) Or (LTempBlocksCount<=max_block)) AND (LTempBlocksCount>LBlockscount)) then begin
-              Lfilename := auxfn;
-              LBlockscount := LTempBlocksCount;
-            end;
-          end;
-        end;
-      until FindNext(sr) <> 0;
-      FindClose(sr);
-    end;
-    if (Lfilename='') then begin
-      Bank.SafeBox.SetSafeboxFileName(LSafeboxFileName);
-    end else begin
-      Bank.SafeBox.SetSafeboxFileName(Lfilename);
-      Bank.SafeBox.UpdateSafeboxFileName(LSafeboxFileName);
-    end;
-    {$ELSE}
-    LBlockscount := 0;
-    {$ENDIF}
-    FileAttrs := faArchive;
-    folder := GetFolder(Orphan);
-    Lfilename := '';
-    if SysUtils.FindFirst(folder+PathDelim+'*.safebox', FileAttrs, sr) = 0 then begin
-      repeat
-        if (sr.Attr and FileAttrs) = FileAttrs then begin
-          auxfn := folder+PathDelim+sr.Name;
-          If LoadBankFileInfo(auxfn,sbHeader) then begin
-            if (((max_block<0) Or (sbHeader.endBlock<=max_block)) AND (sbHeader.blocksCount>LBlockscount)) And
-              (sbHeader.startBlock=0) And (sbHeader.endBlock=sbHeader.startBlock+sbHeader.blocksCount-1) then begin
-              Lfilename := auxfn;
-              LBlockscount := sbHeader.blocksCount;
-              goodSbHeader := sbHeader;
-            end;
-          end;
-        end;
-      until FindNext(sr) <> 0;
-      FindClose(sr);
-    end;
-    if (Lfilename<>'') then begin
-      TLog.NewLog(ltinfo,Self.ClassName,'Loading SafeBox protocol:'+IntToStr(goodSbHeader.protocol)+' with '+inttostr(LBlockscount)+' blocks from file '+Lfilename+' LowMemoryUsage:'+LowMemoryUsage.ToString(True));
-      fs := TFileStream.Create(Lfilename,fmOpenRead);
-      try
-        fs.Position := 0;
-        if LowMemoryUsage then begin
-          if not Bank.LoadBankFromStream(fs,False,Nil,Nil,restoreProgressNotify,errors) then begin
-            TLog.NewLog(lterror,ClassName,'Error reading bank from file: '+Lfilename+ ' Error: '+errors);
-          end;
-        end else begin
-          ms := TMemoryStream.Create;
-          Try
-            ms.CopyFrom(fs,0);
-            ms.Position := 0;
-            if not Bank.LoadBankFromStream(ms,False,Nil,Nil,restoreProgressNotify,errors) then begin
-              TLog.NewLog(lterror,ClassName,'Error reading bank from file: '+Lfilename+ ' Error: '+errors);
-            end;
-          Finally
-            ms.Free;
-          End;
-        end;
-      finally
-        fs.Free;
-      end;
-    end;
-  Finally
-    UnlockBlockChainStream;
-  End;
-end;
-
-function TFileStorage.DoSaveBank: Boolean;
-var fs: TFileStream;
-    bankfilename,aux_newfilename: AnsiString;
-    ms : TMemoryStream;
-  LTC : TTickCount;
-begin
-  Result := true;
-  bankfilename := GetSafeboxCheckpointingFileName(GetFolder(Orphan),Bank.BlocksCount);
-  if (bankfilename<>'') then begin
-    LTC := TPlatform.GetTickCount;
-    {$IFDEF USE_ABSTRACTMEM}
-    Bank.SafeBox.SaveCheckpointing(bankfilename);
-    {$ELSE}
-    fs := TFileStream.Create(bankfilename,fmCreate);
-    try
-      fs.Size := 0;
-      fs.Position:=0;
-      if LowMemoryUsage then begin
-        Bank.SafeBox.SaveSafeBoxToAStream(fs,0,Bank.SafeBox.BlocksCount-1);
-      end else begin
-        ms := TMemoryStream.Create;
-        try
-          Bank.SafeBox.SaveSafeBoxToAStream(ms,0,Bank.SafeBox.BlocksCount-1);
-          ms.Position := 0;
-          fs.CopyFrom(ms,0);
-        finally
-          ms.Free;
-        end;
-      end;
-    finally
-      fs.Free;
-    end;
-    {$ENDIF}
-    TLog.NewLog(ltInfo,ClassName,Format('Saving Safebox blocks:%d file:%s in %.2n seconds',[Bank.BlocksCount,bankfilename,TPlatform.GetElapsedMilliseconds(LTC)/1000]));
-    // Save a copy each 10000 blocks (aprox 1 month) only when not an orphan
-    if (Orphan='') And ((Bank.BlocksCount MOD (CT_BankToDiskEveryNBlocks*100))=0) then begin
-      aux_newfilename := GetFolder('') + PathDelim+'checkpoint_'+ inttostr(Bank.BlocksCount)+CT_Safebox_Extension;
-      try
-        {$IFDEF FPC}
-        DoCopyFile(bankfilename,aux_newfilename);
-        {$ELSE}
-        CopyFile(PWideChar(bankfilename),PWideChar(aux_newfilename),False);
-        {$ENDIF}
-      Except
-        On E:Exception do begin
-          TLog.NewLog(lterror,ClassName,'Exception copying extra safebox file '+aux_newfilename+' ('+E.ClassName+'):'+E.Message);
-        end;
-      end;
-    end;
-  end;
-end;
-
 function TFileStorage.DoSaveBlockChain(Operations: TPCOperationsComp): Boolean;
 Var stream : TStream;
   iBlockHeaders : Integer;
@@ -634,23 +440,11 @@ begin
   Finally
     UnlockBlockChainStream;
   End;
-  if Assigned(Bank) then SaveBank(False);
+  if Assigned(Bank) then Bank.SaveBank(False);
 end;
 
 Const CT_SafeboxsToStore = 10;
 
-class function TFileStorage.GetSafeboxCheckpointingFileName(const BaseDataFolder: AnsiString; block: Cardinal): AnsiString;
-begin
-  Result := '';
-  If not ForceDirectories(BaseDataFolder) then exit;
-  if TPCSafeBox.MustSafeBoxBeSaved(block) then begin
-    // We will store checkpointing
-    Result := BaseDataFolder + PathDelim+'checkpoint'+ inttostr((block DIV CT_BankToDiskEveryNBlocks) MOD CT_SafeboxsToStore)+CT_Safebox_Extension;
-  end else begin
-    Result := BaseDataFolder + PathDelim+'checkpoint_'+inttostr(block)+CT_Safebox_Extension;
-  end;
-end;
-
 function TFileStorage.GetBlockHeaderFirstBytePosition(Stream : TStream; Block: Cardinal; CanInitialize : Boolean; var iBlockHeaders : Integer; var BlockHeaderFirstBlock: Cardinal): Boolean;
 var iPos,start, nCurrBlock : Cardinal;
   bh : TBlockHeader;
@@ -750,34 +544,11 @@ begin
   Result := FStreamFirstBlockNumber;
 end;
 
-function TFileStorage.GetFolder(const AOrphan: TOrphan): AnsiString;
-begin
-  if FDatabaseFolder = '' then raise Exception.Create('No Database Folder');
-  if AOrphan<>'' then Result := FDatabaseFolder + PathDelim+AOrphan
-  else Result := FDatabaseFolder;
-  if not ForceDirectories(Result) then raise Exception.Create('Cannot create database folder: '+Result);
-end;
-
 function TFileStorage.GetLastBlockNumber: Int64;
 begin
   Result := FStreamLastBlockNumber;
 end;
 
-function TFileStorage.LoadBankFileInfo(const Filename: AnsiString; var safeBoxHeader : TPCSafeBoxHeader) : Boolean;
-var fs: TFileStream;
-begin
-  Result := false;
-  safeBoxHeader := CT_PCSafeBoxHeader_NUL;
-  If Not FileExists(Filename) then exit;
-  fs := TFileStream.Create(Filename,fmOpenRead);
-  try
-    fs.Position:=0;
-    Result := Bank.SafeBox.LoadSafeBoxStreamHeader(fs,safeBoxHeader);
-  finally
-    fs.Free;
-  end;
-end;
-
 function TFileStorage.LockBlockChainStream: TFileStream;
   function InitStreamInfo(Stream : TStream; var errors : String) : Boolean;
   Var mem : TStream;
@@ -909,7 +680,7 @@ begin
       if FBlockChainFileName<>'' then begin
         fn := FBlockChainFileName
       end else begin
-        fn := GetFolder(Orphan)+PathDelim+'BlockChainStream.blocks';
+        fn := Bank.GetStorageFolder(Bank.Orphan)+PathDelim+'BlockChainStream.blocks';
       end;
       exists := FileExists(fn);
       if ReadOnly then begin
@@ -941,19 +712,6 @@ begin
   FBlockChainFileName := BlockChainFileName;
 end;
 
-procedure TFileStorage.SetDatabaseFolder(const Value: AnsiString);
-begin
-  if FDatabaseFolder=Value then exit;
-  FDatabaseFolder := Value;
-  ClearStream;
-end;
-
-procedure TFileStorage.SetOrphan(const Value: TOrphan);
-begin
-  inherited;
-  ClearStream;
-end;
-
 procedure TFileStorage.SetReadOnly(const Value: Boolean);
 begin
   inherited;
@@ -1135,24 +893,4 @@ begin
   FStorageLock.Release;
 end;
 
-function TFileStorage.HasUpgradedToVersion2: Boolean;
-var searchRec: TSearchRec;
-begin
-  HasUpgradedToVersion2 := SysUtils.FindFirst( GetFolder(Orphan)+PathDelim+'*'+CT_Safebox_Extension, faArchive, searchRec) = 0;
-  FindClose(searchRec);
-end;
-
-procedure TFileStorage.CleanupVersion1Data;
-var
-  folder : AnsiString;
-  searchRec : TSearchRec;
-begin
-  folder := GetFolder(Orphan);
-  if SysUtils.FindFirst( folder+PathDelim+'*.bank', faArchive, searchRec) = 0 then
-  repeat
-    SysUtils.DeleteFile(folder+PathDelim+searchRec.Name);
-  until FindNext(searchRec) <> 0;
-  FindClose(searchRec);
-end;
-
 end.

src/core/UNetProtocol.pas

@@ -1658,7 +1658,7 @@ Const CT_LogSender = 'GetNewBlockChainFromClient';
     Bank := TPCBank.Create(Nil);
     try
       Bank.StorageClass := TNode.Node.Bank.StorageClass;
-      Bank.Storage.Orphan := TNode.Node.Bank.Storage.Orphan;
+      Bank.Orphan := TNode.Node.Bank.Orphan;
       Bank.Storage.ReadOnly := true;
       Bank.Storage.CopyConfiguration(TNode.Node.Bank.Storage);
 
@@ -1670,18 +1670,18 @@ Const CT_LogSender = 'GetNewBlockChainFromClient';
           Bank.UpdateValuesFromSafebox;
           IsUsingSnapshot := True;
 
-          Bank.Storage.Orphan := FormatDateTime('yyyymmddhhnnss',DateTime2UnivDateTime(now));
+          Bank.Orphan := FormatDateTime('yyyymmddhhnnss',DateTime2UnivDateTime(now));
           Bank.Storage.ReadOnly := false;
 
         end else begin
           {$IFDEF USE_ABSTRACTMEM}
-          Bank.Storage.Orphan := FormatDateTime('yyyymmddhhnnss',DateTime2UnivDateTime(now));
+          Bank.Orphan := FormatDateTime('yyyymmddhhnnss',DateTime2UnivDateTime(now));
           Bank.Storage.ReadOnly := false;
           {$ENDIF}
 
           // Restore a part from disk
           Bank.DiskRestoreFromOperations(start_block-1);
-          Bank.Storage.SaveBank(True);
+          Bank.SaveBank(True);
           if (Bank.BlocksCount<start_block) then begin
             TLog.NewLog(lterror,CT_LogSender,Format('No blockchain found start block %d, current %d',[start_block-1,Bank.BlocksCount]));
             start_block := Bank.BlocksCount;
@@ -1695,7 +1695,7 @@ Const CT_LogSender = 'GetNewBlockChainFromClient';
       end;
       start_c := start;
       if Bank.Storage.ReadOnly then begin
-        Bank.Storage.Orphan := FormatDateTime('yyyymmddhhnnss',DateTime2UnivDateTime(now));
+        Bank.Orphan := FormatDateTime('yyyymmddhhnnss',DateTime2UnivDateTime(now));
         Bank.Storage.ReadOnly := false;
       end;
       // Receive new blocks:
@@ -1772,7 +1772,7 @@ Const CT_LogSender = 'GetNewBlockChainFromClient';
               end;
             end;
             TNode.Node.Bank.Storage.MoveBlockChainBlocks(start_block,Inttostr(start_block)+'_'+FormatDateTime('yyyymmddhhnnss',DateTime2UnivDateTime(now)),Nil);
-            Bank.Storage.MoveBlockChainBlocks(start_block,TNode.Node.Bank.Storage.Orphan,TNode.Node.Bank.Storage);
+            Bank.Storage.MoveBlockChainBlocks(start_block,TNode.Node.Bank.Orphan,TNode.Node.Bank.Storage);
             //
             If IsUsingSnapshot then begin
               TLog.NewLog(ltInfo,CT_LogSender,'Commiting new chain to Safebox');
@@ -1971,7 +1971,7 @@ Const CT_LogSender = 'GetNewBlockChainFromClient';
             If Not IsMyBlockchainValid then begin
               TNode.Node.Bank.Storage.EraseStorage;
             end;
-            TNode.Node.Bank.Storage.SaveBank(False);
+            TNode.Node.Bank.SaveBank(False);
             Connection.Send_GetBlocks(TNode.Node.Bank.BlocksCount,100,request_id);
             Result := true;
           end else begin
@@ -2014,16 +2014,16 @@ Const CT_LogSender = 'GetNewBlockChainFromClient';
         newTmpBank := TPCBank.Create(Nil);
         try
           newTmpBank.StorageClass := TNode.Node.Bank.StorageClass;
-          newTmpBank.Storage.Orphan := TNode.Node.Bank.Storage.Orphan;
+          newTmpBank.Orphan := TNode.Node.Bank.Orphan;
           newTmpBank.Storage.ReadOnly := true;
           newTmpBank.Storage.CopyConfiguration(TNode.Node.Bank.Storage);
-          newTmpBank.Storage.Orphan := FormatDateTime('yyyymmddhhnnss',DateTime2UnivDateTime(now));
+          newTmpBank.Orphan := FormatDateTime('yyyymmddhhnnss',DateTime2UnivDateTime(now));
           newTmpBank.Storage.ReadOnly := false;
           If newTmpBank.LoadBankFromChunks(LChunks,LSafeboxLastOperationBlock.initial_safe_box_hash,TNode.Node.Bank.SafeBox,OnReadingNewSafeboxProgressNotify,errors) then begin
             TNode.Node.DisableNewBlocks;
             try
               TLog.NewLog(ltInfo,ClassName,'Received new safebox!');
-              newTmpBank.Storage.SaveBank(True); // Saving bank
+              newTmpBank.SaveBank(True); // Saving bank
               // Receive at least 1 new block
               blocksList := TList<TPCOperationsComp>.Create;
               try
@@ -3182,7 +3182,7 @@ begin
   responseStream := TMemoryStream.Create;
   try
     {$IFDEF USE_ABSTRACTMEM}
-    Labstracmem := TNode.Node.Bank.Storage.OpenSafeBoxCheckpoint(_blockcount);
+    Labstracmem := TNode.Node.Bank.OpenSafeBoxCheckpoint(_blockcount);
     try
       If Not Assigned(Labstracmem) then begin
         SendError(ntp_response,HeaderData.operation,CT_NetError_SafeboxNotFound,HeaderData.request_id,Format('Safebox stream file for block %d not found',[_blockcount]));

src/core/UPCAbstractMem.pas

@@ -388,12 +388,12 @@ begin
           //
           if (Not FAbstractMem.ReadOnly) then begin
             if (LZoneAccountsOrderedByUpdatedBlock.position=0) then begin
-              LZoneAccountsOrderedByUpdatedBlock := FAbstractMem.New(TAbstractMemBTree.MinAbstractMemInitialPositionSize);
+              LZoneAccountsOrderedByUpdatedBlock := FAbstractMem.New(TAbstractMemBTree.MinAbstractMemInitialPositionSize(FAbstractMem));
               Move(LZoneAccountsOrderedByUpdatedBlock.position,LHeader[40],4);
               FAbstractMem.Write(LZone.position,LHeader[0],Length(LHeader));
             end;
             if (LZoneAccountsOrderedBySalePrice.position=0) then begin
-              LZoneAccountsOrderedBySalePrice := FAbstractMem.New(TAbstractMemBTree.MinAbstractMemInitialPositionSize);
+              LZoneAccountsOrderedBySalePrice := FAbstractMem.New(TAbstractMemBTree.MinAbstractMemInitialPositionSize(FAbstractMem));
               Move(LZoneAccountsOrderedBySalePrice.position,LHeader[44],4);
               FAbstractMem.Write(LZone.position,LHeader[0],Length(LHeader));
             end;
@@ -404,7 +404,7 @@ begin
   end;
   if (Not FAbstractMem.ReadOnly) and (AIsNewStructure) then begin
     // Initialize struct
-    FAbstractMem.ClearContent(FAbstractMem.Is64Bytes);
+    FAbstractMem.ClearContent(FAbstractMem.Is64Bits);
     LZone := FAbstractMem.New( CT_HEADER_MIN_SIZE );  // Header zone
     SetLength(LHeader,100);
     FillChar(LHeader[0],Length(LHeader),0);
@@ -413,16 +413,16 @@ begin
     Move(LBuffer[0],LHeader[0],14);
     w := CT_PCAbstractMem_FileVersion;
     Move(w,LHeader[14],2);
-    LZoneBlocks := FAbstractMem.New( CT_AbstractMemTList_HeaderSize );
-    LZoneAccounts := FAbstractMem.New( CT_AbstractMemTList_HeaderSize );
-    LZoneAccountsNames := FAbstractMem.New( CT_AbstractMemTList_HeaderSize );
+    LZoneBlocks := FAbstractMem.New( TAbstractMemTList.MinAbstractMemTListHeaderSize(FAbstractMem) );
+    LZoneAccounts := FAbstractMem.New( TAbstractMemTList.MinAbstractMemTListHeaderSize(FAbstractMem) );
+    LZoneAccountsNames := FAbstractMem.New( TAbstractMemTList.MinAbstractMemTListHeaderSize(FAbstractMem) );
     LZoneAccountKeys := FAbstractMem.New( 100 );
     FZoneAggregatedHashrate := FAbstractMem.New(100); // Note: Enough big to store a BigNum
     LZoneBuffersBlockHash := LZone.position+36;
     LZoneAccountsOrderedByUpdatedBlock := FAbstractMem.New(
-      TAbstractMemBTree.MinAbstractMemInitialPositionSize);
+      TAbstractMemBTree.MinAbstractMemInitialPositionSize(FAbstractMem));
     LZoneAccountsOrderedBySalePrice := FAbstractMem.New(
-      TAbstractMemBTree.MinAbstractMemInitialPositionSize);
+      TAbstractMemBTree.MinAbstractMemInitialPositionSize(FAbstractMem));
 
     Move(LZoneBlocks.position,       LHeader[16],4);
     Move(LZoneAccounts.position,     LHeader[20],4);
@@ -482,7 +482,7 @@ var
   LIsNewStructure : Boolean;
 begin
   FlushCache;
-  FAbstractMem.ClearContent(FAbstractMem.Is64Bytes);
+  FAbstractMem.ClearContent(FAbstractMem.Is64Bits);
   DoInit(LIsNewStructure);
 end;
 
@@ -1022,6 +1022,7 @@ var
   LPointer: TAbstractMemPosition;
   LIndex: integer;
 begin
+  LPointer := 0;
   AItem.accumulatedWork := 0;
   Move(ABytes[0], AItem.operationBlock.block, 4);
   Move(ABytes[4], LPointer, 4);

src/core/UPCAbstractMemAccountKeys.pas

@@ -394,7 +394,7 @@ begin
     LZone.Clear;
     if (LNode.accounts_using_this_key_position=0) then begin
       // Create
-      LZone := FAbstractMem.New( CT_AbstractMemTList_HeaderSize );
+      LZone := FAbstractMem.New( TAbstractMemTList.MinAbstractMemTListHeaderSize(FAbstractMem) );
       LNode.accounts_using_this_key_position := LZone.position;
       LNode.WriteToMem( FAbstractMem ); // Save update:
     end else LZone.position := LNode.accounts_using_this_key_position;

src/core/UPCDataTypes.pas

@@ -47,6 +47,7 @@ type
      function FromSerialized(const AStream : TStream) : Boolean; overload;
      function LoadFromTBytes(const ABytes : TBytes; var AStartIndex : Integer) : Boolean;
      function IsEqualTo(const ACompareTo : TECDSA_Public) : Boolean;
+     function GetCopy : TECDSA_Public;
   end;
 
   { TECDSA_Public_Raw is a TECDSA_Public stored in a single TRawBytes
@@ -65,6 +66,7 @@ type
   TECDSA_SIG = record
      r: TRawBytes;
      s: TRawBytes;
+     function GetCopy : TECDSA_SIG;
   end;
   PECDSA_Public = ^TECDSA_Public; // Pointer to a TECDSA_SIG
 
@@ -91,6 +93,7 @@ type
     function ToSerialized : TBytes;
     function FromSerialized(const ASerialized : TBytes) : Boolean;
     function LoadFromTBytes(const ABytes : TBytes; var AStartIndex : Integer) : Boolean;
+    function GetCopy : TAccountInfo;
   end;
 
   TOperationBlock = Record
@@ -108,6 +111,7 @@ type
     operations_hash: TRawBytes; // RAW sha256 (32 bytes) of Operations
     proof_of_work: TRawBytes;   // RAW 32 bytes
     previous_proof_of_work: TRawBytes; // RAW 32 bytes
+    function GetCopy : TOperationBlock;
   end;
 
   { TAccount }
@@ -125,6 +129,7 @@ type
     account_seal : TRawBytes;  // Protocol 5. PIP-0029 seal of data changes
     procedure Clear;
     function GetLastUpdatedBlock : Cardinal;
+    function GetCopy : TAccount;
   End;
   PAccount = ^TAccount;
 
@@ -199,6 +204,13 @@ begin
   Result := LoadFromTBytes(ASerialized,i);
 end;
 
+function TECDSA_Public.GetCopy: TECDSA_Public;
+begin
+  Result.EC_OpenSSL_NID := Self.EC_OpenSSL_NID;
+  Result.x := Copy(Self.x);
+  Result.y := Copy(Self.y);
+end;
+
 function TECDSA_Public.FromSerialized(const AStream: TStream): Boolean;
 begin
   if AStream.Read(Self.EC_OpenSSL_NID,2)<>2 then Exit(False);
@@ -301,6 +313,14 @@ begin
   Result := LoadFromTBytes(ASerialized,i);
 end;
 
+function TAccountInfo.GetCopy: TAccountInfo;
+begin
+  Result := Self;
+  Result.accountKey         := Self.accountKey.GetCopy;
+  Result.new_publicKey      := Self.new_publicKey.GetCopy;
+  Result.hashed_secret      := Copy(Self.hashed_secret);
+end;
+
 function TAccountInfo.LoadFromTBytes(const ABytes: TBytes; var AStartIndex: Integer): Boolean;
 var w : Word;
 begin
@@ -394,6 +414,15 @@ begin
   Self := CT_Account_NUL;
 end;
 
+function TAccount.GetCopy: TAccount;
+begin
+  Result := Self;
+  Result.accountInfo        := Self.accountInfo.GetCopy;
+  Result.name               := Copy(Self.name);
+  Result.account_data       := Copy(Self.account_data);
+  Result.account_seal       := Copy(Self.account_seal);
+end;
+
 function TAccount.GetLastUpdatedBlock: Cardinal;
 begin
   if (Self.updated_on_block_passive_mode>Self.updated_on_block_active_mode) then Result := Self.updated_on_block_passive_mode
@@ -438,5 +467,26 @@ end;
 
 
 
+{ TOperationBlock }
+
+function TOperationBlock.GetCopy: TOperationBlock;
+begin
+  Result := Self;
+  Result.account_key              := Self.account_key.GetCopy;
+  Result.block_payload            := Copy(Self.block_payload);
+  Result.initial_safe_box_hash    := Copy(Self.initial_safe_box_hash);
+  Result.operations_hash          := Copy(Self.operations_hash);
+  Result.proof_of_work            := Copy(Self.proof_of_work);
+  Result.previous_proof_of_work   := Copy(Self.previous_proof_of_work);
+end;
+
+{ TECDSA_SIG }
+
+function TECDSA_SIG.GetCopy: TECDSA_SIG;
+begin
+  Result.r := Copy(Self.r);
+  Result.s := Copy(Self.s);
+end;
+
 end.
 

src/core/UPCRPCFileUtils.pas

@@ -68,7 +68,7 @@ begin
 {$IFDEF USE_ABSTRACTMEM}
   LFileName := AInputParams.AsString('filename', '').Trim;
   if (LFileName='') then begin
-    LFileName := TFileStorage.GetSafeboxCheckpointingFileName(TFileStorage(TNode.Node.Bank.Storage).DatabaseFolder,TNode.Node.Bank.BlocksCount);
+    LFileName := TPCBank.GetSafeboxCheckpointingFileName(TNode.Node.Bank.GetStorageFolder(''),TNode.Node.Bank.BlocksCount);
   end;
   TNode.Node.Bank.SafeBox.SaveCheckpointing(LFileName);
   AJSONResponse.GetAsObject('result').GetAsVariant('filename').Value := LFileName;
@@ -148,7 +148,7 @@ begin
 
   LFileName := AInputParams.AsString('filename', '').Trim;
   if (LFileName='') then begin
-    LFileName := TFileStorage.GetSafeboxCheckpointingFileName(TFileStorage(TNode.Node.Bank.Storage).DatabaseFolder,TNode.Node.Bank.BlocksCount);
+    LFileName := TPCBank.GetSafeboxCheckpointingFileName(TNode.Node.Bank.GetStorageFolder(''),TNode.Node.Bank.BlocksCount);
     LFileName := ChangeFileExt(LFileName,'.safebox');
   end;
   LFs := TFileStream.Create(LFileName,fmCreate);

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;
@@ -127,6 +129,7 @@ type
     function FillList(AStartIndex, ACount : Integer; const AList : TList<TData>) : Integer;
     function Add(const AData: TData) : Boolean;
     function Delete(const AData: TData) : Boolean;
+    function NodeIdentifyToString(const AIdentify : TIdentify) : String; virtual;
     function NodeDataToString(const AData : TData) : String; virtual;
     constructor Create(const AOnCompareIdentifyMethod: TComparison<TIdentify>; const AOnCompareDataMethod: TComparison<TData>; AAllowDuplicates : Boolean; AOrder: Integer);
     destructor Destroy; override;
@@ -143,6 +146,8 @@ type
     property CircularProtection : Boolean read FCircularProtection write FCircularProtection;
     procedure Lock;
     procedure Unlock;
+    function FindExt(const AData: TData; out ADataEqualOrPrecessorFound : TData) : Boolean;
+    function GetNullData : TData; virtual;
   End;
 
   TMemoryBTree<TData> = Class( TAbstractBTree<Integer,TData> )
@@ -193,7 +198,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
@@ -376,7 +381,10 @@ begin
       iRight := -1;
     end;
     Lchild := GetNode(ANode.childs[i]);
-    if Not AreEquals(Lchild.parent,ANode.identify) then raise EAbstractBTree.Create(Format('Inconsistent Identify child %d/%d %s invalid pointer to parent at %s',[i+1,Length(ANode.childs),ToString(Lchild),ToString(ANode)]));
+    if Not AreEquals(Lchild.parent,ANode.identify) then begin
+        raise EAbstractBTree.Create(Format('Inconsistent Identify child %d/%d %s invalid pointer to parent %s (%s)',
+          [i+1,Length(ANode.childs),ToString(Lchild),NodeIdentifyToString(ANode.identify),NodeIdentifyToString(Lchild.parent)]));
+    end;
     CheckConsistencyEx(Lchild,
       ((AIsGoingDown) and (i=0)),iLeft,iRight,
       ADatas,AIdents,
@@ -401,7 +409,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;
@@ -431,7 +438,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');
 
@@ -723,6 +730,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
@@ -805,7 +843,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;
@@ -822,25 +860,43 @@ 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;
+function TAbstractBTree<TIdentify, TData>.FindExt(const AData: TData; out ADataEqualOrPrecessorFound: TData): Boolean;
+var Lnode : TAbstractBTreeNode;
+  LiPosNode : Integer;
+  LCircularProtectionList : TOrderedList<TIdentify>;
+  LPrecessorFound : 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));
+  FAbstractBTreeLock.Acquire;
+  try
+    ClearNode(Lnode);
+    if Find(AData,Lnode,LiPosNode) then begin
+      ADataEqualOrPrecessorFound := Lnode.data[LiPosNode];
+      Result := True;
+    end else begin
+      // At this point Lnode is a leaf OR a NIL (no root available at tree)
+      // Lnode.Count = 0  -> NIL (no root/tree available)
+      if Lnode.Count=0 then begin
+        ADataEqualOrPrecessorFound := GetNullData;
+      end else if Lnode.Count=LiPosNode then begin
+        dec(LiPosNode);
+        ADataEqualOrPrecessorFound := Lnode.data[LiPosNode];
+      end else begin
+        // Will find previous valid value by climbing tree
+        LCircularProtectionList := TOrderedList<TIdentify>.Create(False,FOnCompareIdentify);
+        try
+          LCircularProtectionList.Clear;
+          LPrecessorFound := FindPrecessorExt(LCircularProtectionList,Lnode,LiPosNode);
+          if LPrecessorFound then ADataEqualOrPrecessorFound := Lnode.data[LiPosNode]
+          else ADataEqualOrPrecessorFound := GetNullData;
+        finally
+          LCircularProtectionList.Free;
+        end;
       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;
+      Result := False;
+    end;
+  finally
+    FAbstractBTreeLock.Release;
+  end;
 end;
 
 function TAbstractBTree<TIdentify, TData>.FindHighest(out AHighest : TData) : Boolean;
@@ -964,7 +1020,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);
@@ -1048,7 +1104,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);
@@ -1140,6 +1196,11 @@ begin
   end;
 end;
 
+function TAbstractBTree<TIdentify, TData>.GetNullData: TData;
+begin
+  raise EAbstractBTree.Create('function '+Self.ClassName+'.GetNullData: TData; Not overrided');
+end;
+
 procedure TAbstractBTree<TIdentify, TData>.Lock;
 begin
   FAbstractBTreeLock.Acquire;
@@ -1240,6 +1301,12 @@ begin
   Result := IntToStr(SizeOf(AData));
 end;
 
+function TAbstractBTree<TIdentify, TData>.NodeIdentifyToString(
+  const AIdentify: TIdentify): String;
+begin
+  Result := IntToStr(SizeOf(AIdentify));
+end;
+
 procedure TAbstractBTree<TIdentify, TData>.SetCount(const ANewCount: Integer);
 begin
   FCount := ANewCount;
@@ -1294,7 +1361,7 @@ begin
     if Result<>'' then Result := Result + ',';
     Result := Result + NodeDataToString(ANode.data[i]);
   end;
-  Result := '['+Result+']';
+  Result := NodeIdentifyToString(ANode.identify)+'@'+NodeIdentifyToString(ANode.parent)+'['+Result+']';
 end;
 
 procedure TAbstractBTree<TIdentify, TData>.Unlock;

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,15 +155,19 @@ 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;
+    property MemUnitsSize : Integer read FMemUnitsSize;
     function Initialize(ASetTo64Bytes : Boolean; AMemUnitsSize : Integer) : Boolean;
     function HeaderSize : Integer;
     function SizeOfAbstractMemPosition : TAbstractMemSize; inline;
   End;
 
+  { TMem }
+
   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;
@@ -170,6 +176,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,
@@ -347,7 +365,7 @@ begin
   ASource.FLock.Acquire;
   Self.FLock.Acquire;
   try
-    ClearContent(ASource.Is64Bytes,ASource.FMemUnitsSize);
+    ClearContent(ASource.Is64Bits,ASource.FMemUnitsSize);
 
     CheckInitialized(True);
     IncreaseSize(ASource.FNextAvailablePos);
@@ -384,7 +402,7 @@ begin
   FReadOnly := AReadOnly;
   LMemLeakRelativeRootPos := 0;
   FInitialPosition := AInitialPosition;
-  FIs64Bytes := False;
+  FIs64Bits := False;
   FMemUnitsSize := 4; // Warning: Multiple of 4 >=4 and <=256!
   //
   LNextAvailablePosAux := 0;
@@ -409,19 +427,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;
@@ -454,7 +472,7 @@ begin
   LZone.Clear;
   // @[APosition] - SizeOfAbstractMemPosition() = position to size
   LZone.position := APosition;
-  if Read(APosition - SizeOfAbstractMemPosition(),LZone.size,SizeOfAbstractMemPosition()) <> SizeOfAbstractMemPosition() then raise EAbstractMem.Create('Dispose: Cannot read size');
+  if Read(APosition - Int64(SizeOfAbstractMemPosition()),LZone.size,SizeOfAbstractMemPosition()) <> SizeOfAbstractMemPosition() then raise EAbstractMem.Create('Dispose: Cannot read size');
   Dispose(LZone);
 end;
 
@@ -474,7 +492,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
@@ -504,8 +522,8 @@ begin
   end else 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 );
+    if Read(APosition - Int64(SizeOfAbstractMemPosition()),AAMZone.size,SizeOfAbstractMemPosition())<>SizeOfAbstractMemPosition() then Exit(False);
+    Result := (AAMZone.position + AAMZone.size <= FNextAvailablePos)  And (IsValidUsedSize(AAMZone.size));
   end;
 end;
 
@@ -517,7 +535,8 @@ begin
   AAMZone.Clear;
   AAMZone.position := APosition;
   AAMZone.size := 0;
-  LZone.position := (((APosition-1) DIV FMemUnitsSize)+1)*FMemUnitsSize;
+  if APosition<0 then Exit;
+  LZone.position := RoundSize(APosition);
   LZone.size := 0;
   if (LZone.position <> APosition) or (LZone.position<HeaderSize)
     or (LZone.position>=FNextAvailablePos) then Exit;
@@ -528,7 +547,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;
@@ -541,8 +560,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);
@@ -551,7 +571,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',
@@ -575,18 +595,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;
-      FNextAvailablePos := CT_HeaderSize_64b;
-      Result := True;
     end;
+    Result := True;
   end else begin
     Result := True;
   end;
+  FNextAvailablePos := HeaderSize;
 end;
 
 function TAbstractMem.IsAbstractMemInfoStable: Boolean;
@@ -594,6 +615,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;
@@ -607,7 +633,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);
@@ -620,7 +646,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);
@@ -642,7 +668,7 @@ begin
       SaveHeader; // NextAvailablePos updated, save changes
     end;
     // Save size at first position
-    Write(Result.position - SizeOfAbstractMemPosition(),Result.size,SizeOfAbstractMemPosition());
+    Write(Result.position - Int64(SizeOfAbstractMemPosition()),Result.size,SizeOfAbstractMemPosition());
   Finally
     FLock.Release;
   End;
@@ -659,10 +685,10 @@ var LBuffer : TBytes;
   LUInt64 : UInt64;
   LByte : Byte;
 begin
-  if FReadOnly then raise EAbstractMem.Create('Cannot save Haeder on a ReadOnly AbstractMem');
+  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
@@ -698,7 +724,7 @@ end;
 
 procedure TAbstractMem.SaveToStream(AStream: TStream);
 var LBuffer : TBytes;
-  i : Integer;
+  i : Int64;
   LNextStart : Int64;
 begin
   CheckInitialized(False);
@@ -720,7 +746,7 @@ end;
 
 function TAbstractMem.SizeOfAbstractMemPosition: TAbstractMemSize;
 begin
-  if FIs64Bytes then Result := 8
+  if Fis64Bits then Result := 8
   else Result := 4;
 end;
 
@@ -771,6 +797,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;
@@ -816,7 +849,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);
@@ -862,7 +895,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);
@@ -994,7 +1027,7 @@ end;
 
 function TAbstractMem.TAbstractMemMemoryLeaks.SizeOfMemoryLeak: TAbstractMemSize;
 begin
-  if FAbstractMem.Is64Bytes then Result := 32
+  if FAbstractMem.is64Bits then Result := 32
   else Result := 16;
 end;
 
@@ -1007,7 +1040,7 @@ end;
 
 function TMem.AbsoluteRead(const AAbsolutePosition: Int64; var ABuffer; ASize: Integer): Integer;
 begin
-  if AAbsolutePosition>=Length(FMem) then Exit(0)
+  if (AAbsolutePosition>=Length(FMem)) or (AAbsolutePosition<0) then Exit(0)
   else begin
     if AAbsolutePosition + ASize > Length(FMem) then Result := Length(FMem) - AAbsolutePosition
     else Result := ASize;
@@ -1018,7 +1051,7 @@ end;
 function TMem.AbsoluteWrite(const AAbsolutePosition: Int64; const ABuffer; ASize: Integer): Integer;
 begin
   if ASize=0 then Exit(0);
-  if (AAbsolutePosition + ASize > Length(FMem)) or (ASize<0) then
+  if (AAbsolutePosition + ASize > Length(FMem)) or (ASize<0) or (AAbsolutePosition<0) then
     raise EAbstractMem.Create(Format('Write out of mem range from %d to %d (max %d)',
     [AAbsolutePosition,AAbsolutePosition+ASize,High(FMem)]));
   Move(ABuffer,FMem[AAbsolutePosition],ASize);
@@ -1028,6 +1061,7 @@ end;
 constructor TMem.Create(AInitialPosition: Int64; AReadOnly: Boolean);
 begin
   SetLength(FMem,0);
+  FLastIncrease := 0;
   inherited;
 end;
 
@@ -1040,8 +1074,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;
   //
@@ -1172,5 +1206,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

@@ -51,16 +51,17 @@ type
     // Internal search process will convert TData pointer to final TData value for
     // comparisions
   private
-    const CT_MIN_INITIAL_POSITION_SIZE = 16;
+    const
           CT_AbstractMemBTree_Magic = 'AMBT'; // DO NOT LOCALIZE MUST BE 4 BYTES LENGTH
     var
-    FInitialZone : TAMZone;
     FrootPosition : TAbstractMemPosition;
     procedure SaveHeader;
     Procedure CheckInitialized;
     procedure LoadNodeHeader(const APosition : TAbstractMemPosition; var ANode : TAbstractBTree<TAbstractMemPosition,TAbstractMemPosition>.TAbstractBTreeNode; var AChildsCount : Integer; var AChildsPosition : TAbstractMemPosition);
     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;
@@ -82,38 +83,95 @@ type
     constructor Create(AAbstractMem : TAbstractMem; const AInitialZone: TAMZone; AAllowDuplicates : Boolean; AOrder : Integer); virtual;
     destructor Destroy; override;
     function GetNode(AIdentify : TAbstractMemPosition) : TAbstractBTree<TAbstractMemPosition,TAbstractMemPosition>.TAbstractBTreeNode; override;
-    class function MinAbstractMemInitialPositionSize : Integer;
+    class function MinAbstractMemInitialPositionSize(AAbstractMem : TAbstractMem) : Integer;
     property AbstractMem : TAbstractMem read FAbstractMem;
     property Count;
+    function NodeDataToString(const AData : TAbstractMemPosition) : String; override;
+    function NodeIdentifyToString(const AIdentify : TAbstractMemPosition) : String; override;
+    property InitialZone : TAMZone read FInitialZone;
+    function GetNullData : TAbstractMemPosition; override;
   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) : TBTreeData; virtual; abstract;
+    function SaveData(const AData : TBTreeData) : TAMZone; virtual; abstract;
+    procedure DoOnFindProcessStart; override;
+    procedure DoOnFindProcessEnd; override;
     //
-    function LoadData(const APosition : TAbstractMemPosition) : TData; virtual; abstract;
-    function SaveData(const AData : TData) : TAMZone; virtual; abstract;
+    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;
+
+  {$IFnDEF FPC}
+  TAbstractMemBTreeDataIndex<TBTreeData> = Class;
+  {$ENDIF}
+
+  TAbstractMemBTreeData<TBTreeData> = Class(TAbstractMemBTreeDataAbstract<TBTreeData>)
+  private
+//    Ref: 20211111-1
+//    FreePascal issue: Does not allow recursive Generics...
+//    due to this issue (on Delphi is allowed) then I must use TList< TOjbect > instead
+//    last FreePascal version with this issue: 3.2.0  (will need to check on future versions)
+    {$IFDEF FPC}
+    FIndexes : TList< TObject >;
+    {$ELSE}
+//    Ref: 20211111-1 I can't use this... in Delphi it works! Not in FreePascal... SHIT!
+    FIndexes : TList< TAbstractMemBTreeDataIndex<TBTreeData> >;
+    {$ENDIF}
+  protected
+    procedure DeletedData(const AData: TBTreeData); virtual;
   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(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;
+    function IndexesCount : Integer;
+//    See ref: 20211111-1
+    {$IFDEF FPC}
+    function GetIndex(AIndex : Integer) : TObject;
+    {$ELSE}
+    function GetIndex(AIndex : Integer) : TAbstractMemBTreeDataIndex<TBTreeData>;
+    {$ENDIF}
+    procedure CheckConsistency; override;
   End;
 
+  TAbstractMemBTreeDataIndex<TBTreeData> = Class(TAbstractMemBTreeDataAbstract<TBTreeData>)
+  protected
+    FIndexed : TAbstractMemBTreeData<TBTreeData>;
+    function LoadData(const APosition : TAbstractMemPosition) : TBTreeData; override;
+  public
+    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
@@ -141,20 +199,20 @@ begin
   end else begin
     if FInitialZone.position=0 then Exit;
   end;
-  if (FInitialZone.size<MinAbstractMemInitialPositionSize) then begin
+  if (FInitialZone.size<MinAbstractMemInitialPositionSize(AAbstractMem)) then begin
     raise EAbstractMemBTree.Create(Format('Invalid size %d for initialize',[FInitialZone.size]));
   end;
-  SetLength(LBuff,CT_MIN_INITIAL_POSITION_SIZE);
+  SetLength(LBuff,MinAbstractMemInitialPositionSize(AAbstractMem));
   FAbstractMem.Read(FInitialZone.position,LBuff[0],Length(LBuff));
   try
     // 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],FrootPosition,4);
-    Move(LBuff[8],FCount,4);
+    Move(LBuff[4],FrootPosition,FAbstractMem.SizeOfAbstractMemPosition);
+    Move(LBuff[4+FAbstractMem.SizeOfAbstractMemPosition],FCount,4);
     LOrder := 0;
-    Move(LBuff[12],LOrder,4);
+    Move(LBuff[8+FAbstractMem.SizeOfAbstractMemPosition],LOrder,4);
     if LOrder<>Order then raise EAbstractMemBTree.Create(Format('Invalid Order %d expected %d',[LOrder,Order]));
     if (((FrootPosition=0) and (FCount>0))) then raise EAbstractMemBTree.Create(Format('Invalid initial root %d vs count %d',[FrootPosition,FCount]));
   finally
@@ -197,10 +255,10 @@ begin
   LoadNodeHeader(AIdentify,Result,LChildsCount,LChildsPosition);
   if LChildsCount>0 then begin
     SetLength(Result.childs,LChildsCount);
-    SetLength(LBuff,(LChildsCount*4));
+    SetLength(LBuff,(LChildsCount*FAbstractMem.SizeOfAbstractMemPosition));
     FAbstractMem.Read(LChildsPosition,LBuff[0],Length(LBuff));
     for i := 0 to LChildsCount-1 do begin
-      Move(LBuff[i*4],Result.childs[i],4);
+      Move(LBuff[i*FAbstractMem.SizeOfAbstractMemPosition],Result.childs[i],FAbstractMem.SizeOfAbstractMemPosition);
     end;
   end;
   if ((Result.Count=0) and (Result.parent=0) and (LChildsCount=0)) then begin
@@ -218,6 +276,16 @@ begin
   end;
 end;
 
+function TAbstractMemBTree.GetNodeHeaderSize: Integer;
+begin
+  Result := ((FAbstractMem.SizeOfAbstractMemPosition*2)+4) + (FAbstractMem.SizeOfAbstractMemPosition*MaxItemsPerNode);
+end;
+
+function TAbstractMemBTree.GetNullData: TAbstractMemPosition;
+begin
+  Result := 0;
+end;
+
 function TAbstractMemBTree.GetRoot: TAbstractBTree<TAbstractMemPosition, TAbstractMemPosition>.TAbstractBTreeNode;
 begin
   if FrootPosition>0 then begin
@@ -237,6 +305,7 @@ var LBuff : TBytes;
 begin
   // Node is stored in zone 2 positions:
   //
+  // In 32 bits
   // Zone 1: Header
   //   Size = (4+2+2+4) + (4*MaxItemsPerNode)
   // 4 Bytes [0..3] : Parent
@@ -251,51 +320,71 @@ begin
   // For each children:
   //   4 Bytes : Children AbstractMem position
   //
-  SetLength(LBuff, 8 + (4 * MaxItemsPerNode) + 4 );
+  // In 64 bits
+  // Same but using 8 bytes (instead of 4) for position
+  //   Size = (8+2+2+8) + (8*MaxItemsPerNode)
+  //
+  // Use FAbstractMem.SizeOfAbstractMemPosition (will return 4 or 8)
+  //   Size = ((FAbstractMem.SizeOfAbstractMemPosition*2)+4) + (FAbstractMem.SizeOfAbstractMemPosition*MaxItemsPerNode)
+  //
+  SetLength(LBuff,GetNodeHeaderSize);
+
   FAbstractMem.Read(APosition,LBuff[0],Length(LBuff));
   ClearNode(ANode);
   LItemsCount := 0;
   AChildsCount := 0;
   AChildsPosition := 0;
   ANode.identify := APosition;
-  Move(LBuff[0],ANode.parent,4);
-  Move(LBuff[4],LItemsCount,1);
-  Move(LBuff[5],AChildsCount,1);
-  Move(LBuff[8],AChildsPosition,4);
+  Move(LBuff[0],ANode.parent , FAbstractMem.SizeOfAbstractMemPosition);
+  Move(LBuff[FAbstractMem.SizeOfAbstractMemPosition],LItemsCount,1);
+  Move(LBuff[FAbstractMem.SizeOfAbstractMemPosition+1],AChildsCount,1);
+  Move(LBuff[FAbstractMem.SizeOfAbstractMemPosition+4],AChildsPosition,FAbstractMem.SizeOfAbstractMemPosition);
   SetLength(ANode.data,LItemsCount);
   for i := 0 to LItemsCount-1 do begin
-    Move(LBuff[12 + (i*4)], ANode.data[i], 4);
+    Move(LBuff[(FAbstractMem.SizeOfAbstractMemPosition*2)+4 + (i*FAbstractMem.SizeOfAbstractMemPosition)],
+      ANode.data[i], FAbstractMem.SizeOfAbstractMemPosition);
   end;
 end;
 
-class function TAbstractMemBTree.MinAbstractMemInitialPositionSize: Integer;
+class function TAbstractMemBTree.MinAbstractMemInitialPositionSize(AAbstractMem : TAbstractMem) : Integer;
 begin
-  Result := CT_MIN_INITIAL_POSITION_SIZE;
+  Result := (AAbstractMem.SizeOfAbstractMemPosition) + 12 ;
 end;
 
 function TAbstractMemBTree.NewNode: TAbstractBTree<TAbstractMemPosition, TAbstractMemPosition>.TAbstractBTreeNode;
 begin
   CheckInitialized;
   ClearNode(Result);
-  Result.identify := FAbstractMem.New( 8 + (4 * MaxItemsPerNode) + 4 ).position;
+  Result.identify := FAbstractMem.New( GetNodeHeaderSize ).position;
   SaveNodeHeader(Result,0);
 end;
 
+function TAbstractMemBTree.NodeDataToString(const AData: TAbstractMemPosition): String;
+begin
+  Result := '0x'+AData.ToHexString;
+end;
+
+function TAbstractMemBTree.NodeIdentifyToString(
+  const AIdentify: TAbstractMemPosition): String;
+begin
+  Result := '0x'+AIdentify.ToHexString;
+end;
+
 procedure TAbstractMemBTree.SaveHeader;
 var LBuff : TBytes;
  i : Integer;
  LOrder : Integer;
 begin
   CheckInitialized;
-  SetLength(LBuff,16);
+  SetLength(LBuff,MinAbstractMemInitialPositionSize(FAbstractMem));
   for i := 0 to CT_AbstractMemBTree_Magic.Length-1 do begin
     LBuff[i] := Byte(Ord(CT_AbstractMemBTree_Magic.Chars[i]));
   end;
-  Move(FrootPosition,LBuff[4],4);
-  Move(FCount,LBuff[8],4);
+  Move(FrootPosition,LBuff[4],FAbstractMem.SizeOfAbstractMemPosition);
+  Move(FCount,LBuff[4+FAbstractMem.SizeOfAbstractMemPosition],4);
   LOrder := Order;
-  Move(LOrder,LBuff[12],4);
-  FAbstractMem.Write(FInitialZone.position,LBuff[0],16);
+  Move(LOrder,LBuff[8+FAbstractMem.SizeOfAbstractMemPosition],4);
+  FAbstractMem.Write(FInitialZone.position,LBuff[0],Length(LBuff));
 end;
 
 procedure TAbstractMemBTree.SaveNode(var ANode: TAbstractBTree<TAbstractMemPosition, TAbstractMemPosition>.TAbstractBTreeNode);
@@ -316,38 +405,43 @@ begin
     // Node wasn't a leaf previously
     Assert(LChildsPosition<>0,'Old childs position<>0');
     FAbstractMem.Dispose(LChildsPosition);
+    LChildsPosition := 0;
   end else if (LChildsCount=0) And (Not ANode.IsLeaf) then begin
     // Node was a leaf previously, now not
-    LZone := FAbstractMem.New( MaxChildrenPerNode * 4 );
+    LZone := FAbstractMem.New( MaxChildrenPerNode * FAbstractMem.SizeOfAbstractMemPosition );
     LChildsPosition := LZone.position;
   end;
   LChildsCount := Length(ANode.childs);
   //
   SaveNodeHeader(ANode,LChildsPosition);
   //
-  SetLength(LBuff, MaxChildrenPerNode * 4 );
-  FillChar(LBuff[0],Length(LBuff),0);
-  for i := 0 to LChildsCount-1 do begin
-    Move(ANode.childs[i],LBuff[i*4],4);
+  if LChildsCount>0 then begin
+    SetLength(LBuff, MaxChildrenPerNode * FAbstractMem.SizeOfAbstractMemPosition );
+    FillChar(LBuff[0],Length(LBuff),0);
+    for i := 0 to LChildsCount-1 do begin
+      Move(ANode.childs[i],LBuff[i*FAbstractMem.SizeOfAbstractMemPosition],FAbstractMem.SizeOfAbstractMemPosition);
+    end;
+    FAbstractMem.Write(LChildsPosition,LBuff[0],LChildsCount*FAbstractMem.SizeOfAbstractMemPosition);
   end;
-  FAbstractMem.Write(LChildsPosition,LBuff[0],LChildsCount*4);
 end;
 
 procedure TAbstractMemBTree.SaveNodeHeader(
   const ANode: TAbstractBTree<TAbstractMemPosition, TAbstractMemPosition>.TAbstractBTreeNode; const AChildsPosition : TAbstractMemPosition);
 var LBuff : TBytes;
-  i, LItemsCount, LChildsCount : Integer;
+  i, LItemsCount, LChildsCount: Integer;
 begin
-  SetLength(LBuff, 8 + (4 * MaxItemsPerNode) + 4 );
+  SetLength(LBuff, GetNodeHeaderSize );
+
   FillChar(LBuff[0],Length(LBuff),0);
-  Move(ANode.parent,LBuff[0],4);
+  Move(ANode.parent,LBuff[0],FAbstractMem.SizeOfAbstractMemPosition);
   LItemsCount := ANode.Count;
-  Move(LItemsCount,LBuff[4],1);
+  Move(LItemsCount,LBuff[FAbstractMem.SizeOfAbstractMemPosition],1);
   LChildsCount := Length(ANode.childs);
-  Move(LChildsCount,LBuff[5],1);
-  Move(AChildsPosition,LBuff[8],4);
+  Move(LChildsCount,LBuff[FAbstractMem.SizeOfAbstractMemPosition+1],1);
+  Move(AChildsPosition,LBuff[FAbstractMem.SizeOfAbstractMemPosition+4],FAbstractMem.SizeOfAbstractMemPosition);
   for i := 0 to LItemsCount-1 do begin
-    Move(ANode.data[i], LBuff[12 + (i*4)], 4);
+    Move(ANode.data[i], LBuff[(FAbstractMem.SizeOfAbstractMemPosition*2)+4 + (i*FAbstractMem.SizeOfAbstractMemPosition)],
+      FAbstractMem.SizeOfAbstractMemPosition);
   end;
   FAbstractMem.Write(ANode.identify,LBuff[0],Length(LBuff));
 end;
@@ -372,22 +466,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;
@@ -395,85 +490,101 @@ 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;
-var Lnode : TAbstractBTree<TAbstractMemPosition,TAbstractMemPosition>.TAbstractBTreeNode;
-  LiPosNode : Integer;
+procedure TAbstractMemBTreeDataAbstract<TBTreeData>.DoOnFindProcessEnd;
 begin
-  FAbstractBTreeLock.Acquire;
-  try
-  FSearchTarget := AData;
-  ClearNode(Lnode);
-  if Find(1,Lnode,LiPosNode) then begin
-    APosition := Lnode.data[LiPosNode];
+  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 begin
-    // if Node exists will set APosition of previous value, otherwise will set 0
-    if Lnode.Count>LiPosNode then APosition := Lnode.data[LiPosNode]
-    else if Lnode.Count>0 then APosition := Lnode.data[Lnode.Count-1]
-    else APosition := 0;
+    if IsNil(APosition) then FindDataLowest(AFoundData)
+    else AFoundData := LoadData(APosition);
     Result := False;
   end;
+end;
+
+function TAbstractMemBTreeDataAbstract<TBTreeData>.FindData(
+  const AData: TBTreeData; out APosition: TAbstractMemPosition): Boolean;
+begin
+  FAbstractBTreeLock.Acquire;
+  try
+    FSearchTarget := AData;
+    Result := FindExt(1,APosition);
   finally
     FAbstractBTreeLock.Release;
   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
@@ -482,7 +593,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
@@ -491,7 +603,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;
@@ -499,7 +612,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);
@@ -510,7 +623,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;
@@ -518,7 +632,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);
@@ -529,6 +643,200 @@ begin
   end;
 end;
 
+{ TAbstractMemBTreeData<TBTreeData> }
+
+function TAbstractMemBTreeData<TBTreeData>.AddData(const AData: TBTreeData): Boolean;
+var Lzone, LindexZone : TAMZone;
+  i : Integer;
+  LIndexPosition : TAbstractMemPosition;
+  LBTreeIndex : TAbstractMemBTreeDataIndex<TBTreeData>;
+begin
+  // Check in indexes
+  Result := True;
+  i := 0;
+  while (Result) and (i<FIndexes.Count) do begin
+    LBTreeIndex := TAbstractMemBTreeDataIndex<TBTreeData>(FIndexes.Items[i]);
+    if (Not LBTreeIndex.AllowDuplicates) then begin
+      Result :=  Not (LBTreeIndex.FindData(AData,LIndexPosition));
+    end;
+    inc(i);
+  end;
+  if Result then begin
+    Lzone := SaveData(AData);
+    Try
+      Result := AddInherited(Lzone.position);
+      if Result then begin
+        for i := 0 to FIndexes.Count-1 do begin
+          LindexZone := FAbstractMem.New(FAbstractMem.SizeOfAbstractMemPosition);
+          FAbstractMem.Write(LindexZone.position,Lzone.position,FAbstractMem.SizeOfAbstractMemPosition);
+          LBTreeIndex := TAbstractMemBTreeDataIndex<TBTreeData>(FIndexes.Items[i]);
+          if Not LBTreeIndex.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;
+      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;
+  LBTreeIndex : TAbstractMemBTreeDataIndex<TBTreeData>;
+begin
+  // Check in indexes
+  Result := True;
+  i := 0;
+  while (Result) and (i<FIndexes.Count) do begin
+    LBTreeIndex := TAbstractMemBTreeDataIndex<TBTreeData>(FIndexes.Items[i]);
+    if (Not LBTreeIndex.AllowDuplicates) then begin
+      Result :=  Not (LBTreeIndex.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;
+ LBTreeIndex : TAbstractMemBTreeDataIndex<TBTreeData>;
+begin
+  inherited;
+  for i := 0 to FIndexes.Count-1 do begin
+    LBTreeIndex := TAbstractMemBTreeDataIndex<TBTreeData>(FIndexes.Items[i]);
+    if (LBTreeIndex.Count <> Self.Count) then raise EAbstractMemBTree.Create(Format('Consistency error on index %d/%d count %d vs %d',[i+1,FIndexes.Count,LBTreeIndex.Count,Self.Count]));
+    LBTreeIndex.CheckConsistency;
+  end;
+end;
+
+constructor TAbstractMemBTreeData<TBTreeData>.Create(AAbstractMem: TAbstractMem;
+  const AInitialZone: TAMZone; AAllowDuplicates: Boolean; AOrder: Integer;
+  const AOnCompareAbstractMemDataMethod: TComparison<TBTreeData>);
+begin
+  {$IFDEF FPC}
+  FIndexes := TList< TObject >.Create;
+  {$ELSE}
+  FIndexes := TList< TAbstractMemBTreeDataIndex<TBTreeData> >.Create;
+  {$ENDIF}
+  inherited Create(AAbstractMem,AInitialZone,AAllowDuplicates,AOrder,AOnCompareAbstractMemDataMethod);
+end;
+
+function TAbstractMemBTreeData<TBTreeData>.DeleteData(const AData: TBTreeData): Boolean;
+var LAbstractMemPos, LindexPosition : TAbstractMemPosition;
+  i : Integer;
+  LBTreeIndex : TAbstractMemBTreeDataIndex<TBTreeData>;
+begin
+  if FindData(AData,LAbstractMemPos) then begin
+    // Delete from indexes
+    for i := 0 to FIndexes.Count-1 do begin
+      LBTreeIndex := TAbstractMemBTreeDataIndex<TBTreeData>(FIndexes.Items[i]);
+      if Not LBTreeIndex.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 LBTreeIndex.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;
+    //
+    DeletedData(AData);
+  end else Result := False;
+end;
+
+procedure TAbstractMemBTreeData<TBTreeData>.DeletedData(
+  const AData: TBTreeData);
+begin
+  //
+end;
+
+destructor TAbstractMemBTreeData<TBTreeData>.Destroy;
+var i : Integer;
+ LBTreeIndex : TAbstractMemBTreeDataIndex<TBTreeData>;
+begin
+  for i := 0 to FIndexes.Count-1 do begin
+    LBTreeIndex := TAbstractMemBTreeDataIndex<TBTreeData>(FIndexes.Items[i]);
+    LBTreeIndex.FIndexed := Nil;
+  end;
+  FreeAndNil(Findexes);
+  inherited;
+end;
+
+{$IFDEF FPC}
+function TAbstractMemBTreeData<TBTreeData>.GetIndex(AIndex: Integer): TObject;
+begin
+  Result := FIndexes.Items[AIndex];
+end;
+{$ELSE}
+function TAbstractMemBTreeData<TBTreeData>.GetIndex(
+  AIndex: Integer): TAbstractMemBTreeDataIndex<TBTreeData>;
+begin
+  Result := FIndexes.Items[AIndex];
+end;
+{$ENDIF}
+
+function TAbstractMemBTreeData<TBTreeData>.IndexesCount: Integer;
+begin
+  Result := FIndexes.Count;
+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/UAbstractMemTList.pas

@@ -55,7 +55,7 @@ type
 
     FElementsOfEachBlock : Integer;
     FFirstBlockPointer : TAbstractMemPosition;
-    FNextElementPosition : Integer;
+    FNextElementIndex : Integer;
 
     FUseCache : Boolean;
     FUseCacheAuto : Boolean;
@@ -100,6 +100,7 @@ type
     property UseCacheAuto : Boolean read FUseCacheAuto write FUseCacheAuto;
     procedure LockList;
     procedure UnlockList;
+    class function MinAbstractMemTListHeaderSize(AAbstractMem : TAbstractMem) : Integer;
   End;
 
   TAbstractMemTListBaseAbstract<T> = Class
@@ -158,13 +159,6 @@ type
     function Get(index : Integer) : T;
   End;
 
-const
-  CT_AbstractMemTList_HeaderSize = 16;
-    // [0] 4 for magic
-    // [4] 4 for elements of each block
-    // [8] 4 for next element (counter)
-    // [12] 4 for first block position
-
 implementation
 
 { TAbstractMemTList }
@@ -176,8 +170,8 @@ function TAbstractMemTList.Add(const APosition: TAbstractMemPosition): Integer;
 begin
   FAbstractMemTListLock.Acquire;
   Try
-  Result := FNextElementPosition;
-  Insert(FNextElementPosition,APosition);
+  Result := FNextElementIndex;
+  Insert(FNextElementIndex,APosition);
   Finally
     FAbstractMemTListLock.Release;
   End;
@@ -189,18 +183,20 @@ var LElements : TBytes;
   LIndexInBlock, i, j, n : Integer;
 begin
   CheckInitialized;
-  if (AIndexStart<0) or (AInsertCount<=0) or (AIndexStart>FNextElementPosition) then raise EAbstractMemTList.Create(Format('%s AddRange %d..%d out of range 0..%d',[ClassName,AIndexStart,AIndexStart+AInsertCount,FNextElementPosition-1]));
+  if (AIndexStart<0) or (AInsertCount<=0) or (AIndexStart>FNextElementIndex) then raise EAbstractMemTList.Create(Format('%s AddRange %d..%d out of range 0..%d',[ClassName,AIndexStart,AIndexStart+AInsertCount,FNextElementIndex-1]));
   if (UseCacheData(True)) then begin
-    if (Length(FCacheData)-FCacheDataUsedBytes)< (AInsertCount*4) then begin
+    if (Length(FCacheData)-FCacheDataUsedBytes)< (AInsertCount*FAbstractMem.SizeOfAbstractMemPosition) then begin
       // Increase
       if (FElementsOfEachBlock>AInsertCount) then i := FElementsOfEachBlock
       else i := AInsertCount;
-      SetLength(FCacheData,Length(FCacheData) + (i * 4));
+      SetLength(FCacheData,Length(FCacheData) + (i * FAbstractMem.SizeOfAbstractMemPosition));
     end;
     FCacheUpdated := True;
-    Inc(FCacheDataUsedBytes,(AInsertCount*4));
-    Move(FCacheData[AIndexStart*4],FCacheData[(AIndexStart+AInsertCount)*4],FCacheDataUsedBytes-((AIndexStart+AInsertCount)*4));
-    Inc(FNextElementPosition,AInsertCount);
+    Inc(FCacheDataUsedBytes,(AInsertCount*FAbstractMem.SizeOfAbstractMemPosition));
+    Move(FCacheData[AIndexStart*FAbstractMem.SizeOfAbstractMemPosition],
+         FCacheData[(AIndexStart+AInsertCount)*FAbstractMem.SizeOfAbstractMemPosition],
+         FCacheDataUsedBytes-((AIndexStart+AInsertCount)*FAbstractMem.SizeOfAbstractMemPosition));
+    Inc(FNextElementIndex,AInsertCount);
     Exit;
   end;
   //
@@ -213,13 +209,14 @@ begin
     GetPointerTo(i,True,LPreviousBlockPointer,LBlockPointer,LIndexInBlock);
     // Move from LIndexInBlock to FElementsOfEachBlock-1 in this block
     j := FElementsOfEachBlock - (LIndexInBlock); // j = Elements to move right on this block
-    if ((n+j)*4>Length(LElements)) then j := (Length(LElements) DIV 4)-n;
-    FAbstractMem.Write( LBlockPointer + (LIndexInBlock*4), LElements[ n*4 ], j*4 );
+    if ((n+j)*FAbstractMem.SizeOfAbstractMemPosition>Length(LElements)) then j := (Length(LElements) DIV FAbstractMem.SizeOfAbstractMemPosition)-n;
+    FAbstractMem.Write( LBlockPointer + (LIndexInBlock*FAbstractMem.SizeOfAbstractMemPosition),
+      LElements[ n*FAbstractMem.SizeOfAbstractMemPosition ], j*FAbstractMem.SizeOfAbstractMemPosition );
     inc(n,j);
     inc(i,j);
-  until (i >= FNextElementPosition + AInsertCount) or (j=0);
-  Inc(FNextElementPosition,AInsertCount);
-  FAbstractMem.Write( FInitialZone.position + 8, FNextElementPosition, 4 );
+  until (i >= FNextElementIndex + AInsertCount) or (j=0);
+  Inc(FNextElementIndex,AInsertCount);
+  FAbstractMem.Write( FInitialZone.position + 8, FNextElementIndex, 4 );
 end;
 
 procedure TAbstractMemTList.CheckInitialized;
@@ -236,11 +233,11 @@ begin
   // Free mem
   LBlockPointer := FFirstBlockPointer;
   FFirstBlockPointer := 0;
-  FNextElementPosition := 0;
-  FAbstractMem.Write( FInitialZone.position + 12, FFirstBlockPointer, 4 );
+  FNextElementIndex := 0;
+  FAbstractMem.Write( FInitialZone.position + 12, FFirstBlockPointer, FAbstractMem.SizeOfAbstractMemPosition );
   while (LBlockPointer>0) do begin
     // Read next
-    FAbstractMem.Read( LBlockPointer + (FElementsOfEachBlock * 4), LNext, 4);
+    FAbstractMem.Read( LBlockPointer + (FElementsOfEachBlock * FAbstractMem.SizeOfAbstractMemPosition), LNext, FAbstractMem.SizeOfAbstractMemPosition);
     FAbstractMem.Dispose(LBlockPointer);
     LBlockPointer := LNext;
   end;
@@ -255,7 +252,7 @@ end;
 
 function TAbstractMemTList.Count: Integer;
 begin
-  Result := FNextElementPosition;
+  Result := FNextElementIndex;
 end;
 
 constructor TAbstractMemTList.Create(AAbstractMem: TAbstractMem; const AInitialZone: TAMZone; ADefaultElementsPerBlock : Integer; AUseCache : Boolean);
@@ -272,7 +269,7 @@ begin
 
   FElementsOfEachBlock := 0;
   FFirstBlockPointer := 0;
-  FNextElementPosition := 0;
+  FNextElementIndex := 0;
 
   FAbstractMemTListLock := TCriticalSection.Create;
 
@@ -323,34 +320,34 @@ begin
   LNext := 0;
   // Save full:
   i := 0;
-  while ((i*4) < (FCacheDataUsedBytes)) do begin
+  while ((i*FAbstractMem.SizeOfAbstractMemPosition) < (FCacheDataUsedBytes)) do begin
     GetPointerTo(i,True,LPreviousBlockPointer,LBlockPointer,LIndexInBlock);
-    if (i+FElementsOfEachBlock-1 >= FNextElementPosition) then begin
-      LElements := FNextElementPosition - i;
+    if (i+FElementsOfEachBlock-1 >= FNextElementIndex) then begin
+      LElements := FNextElementIndex - i;
     end else LElements := FElementsOfEachBlock;
-    FAbstractMem.Write(LBlockPointer,FCacheData[i*4],(LElements*4));
+    FAbstractMem.Write(LBlockPointer,FCacheData[i*FAbstractMem.SizeOfAbstractMemPosition],(LElements*FAbstractMem.SizeOfAbstractMemPosition));
     inc(i,LElements);
-    FAbstractMem.Read( LBlockPointer + (FElementsOfEachBlock * 4), LNext, 4);
+    FAbstractMem.Read( LBlockPointer + (FElementsOfEachBlock * FAbstractMem.SizeOfAbstractMemPosition), LNext, FAbstractMem.SizeOfAbstractMemPosition);
     LPreviousBlockPointer := LBlockPointer;
   end;
   // Save Header:
-  FAbstractMem.Write( FInitialZone.position + 8, FNextElementPosition, 4 );
+  FAbstractMem.Write( FInitialZone.position + 8, FNextElementIndex, 4 );
   // Free unused blocks:
-  if (FNextElementPosition=0) And (FFirstBlockPointer>0) then begin
+  if (FNextElementIndex=0) And (FFirstBlockPointer>0) then begin
     // This is first block pointer
     LNext := FFirstBlockPointer;
     FFirstBlockPointer := 0;
-    FAbstractMem.Write( FInitialZone.position + 12, FFirstBlockPointer, 4 );
+    FAbstractMem.Write( FInitialZone.position + 12, FFirstBlockPointer, FAbstractMem.SizeOfAbstractMemPosition );
     LPreviousBlockPointer := 0;
   end;
   while (LNext>0) do begin
     if LPreviousBlockPointer>0 then begin
       LZero := 0;
-      FAbstractMem.Write( LPreviousBlockPointer + (FElementsOfEachBlock * 4), LZero, 4);
+      FAbstractMem.Write( LPreviousBlockPointer + (FElementsOfEachBlock * FAbstractMem.SizeOfAbstractMemPosition), LZero, FAbstractMem.SizeOfAbstractMemPosition);
     end;
     LPreviousBlockPointer := LBlockPointer;
     LBlockPointer := LNext;
-    FAbstractMem.Read( LBlockPointer + (FElementsOfEachBlock * 4), LNext, 4);
+    FAbstractMem.Read( LBlockPointer + (FElementsOfEachBlock * FAbstractMem.SizeOfAbstractMemPosition), LNext, FAbstractMem.SizeOfAbstractMemPosition);
     FAbstractMem.Dispose(LBlockPointer);
   end;
   //
@@ -364,10 +361,10 @@ procedure TAbstractMemTList.GetPointerTo(AIndex: Integer; AAllowIncrease : Boole
 var LBlockIndex : Integer;
   i : Integer;
   LNewBlock : TAMZone;
-  LZero : Integer;
+  LZero : TAbstractMemPosition;
 begin
   CheckInitialized;
-  if (AIndex<0) or ((Not AAllowIncrease) And (AIndex>=FNextElementPosition)) then raise EAbstractMemTList.Create(Format('%s index %d out of range 0..%d',[ClassName,AIndex,FNextElementPosition-1]));
+  if (AIndex<0) or ((Not AAllowIncrease) And (AIndex>=FNextElementIndex)) then raise EAbstractMemTList.Create(Format('%s index %d out of range 0..%d',[ClassName,AIndex,FNextElementIndex-1]));
 
   // Search ABlockPointer
   LBlockIndex := AIndex DIV FElementsOfEachBlock;
@@ -379,26 +376,26 @@ begin
   repeat
     if (ABlockPointer<=0) then begin
       // Create
-      LNewBlock := FAbstractMem.New( 4 + (FElementsOfEachBlock * 4) );
+      LNewBlock := FAbstractMem.New( FAbstractMem.SizeOfAbstractMemPosition + (FElementsOfEachBlock * FAbstractMem.SizeOfAbstractMemPosition) );
       ABlockPointer := LNewBlock.position;
       // Save this pointer
       if (i=0) then begin
         // This is FFirstBlockPointer
         FFirstBlockPointer := LNewBlock.position;
         // Save header:
-        FAbstractMem.Write( FInitialZone.position + 12, FFirstBlockPointer, 4 );
+        FAbstractMem.Write( FInitialZone.position + 12, FFirstBlockPointer, FAbstractMem.SizeOfAbstractMemPosition );
       end else begin
         // This is previous block
-        FAbstractMem.Write( APreviousBlockPointer + (FElementsOfEachBlock*4), LNewBlock.position, 4 );
+        FAbstractMem.Write( APreviousBlockPointer + (FElementsOfEachBlock*FAbstractMem.SizeOfAbstractMemPosition), LNewBlock.position, FAbstractMem.SizeOfAbstractMemPosition );
       end;
       // Clear next
       LZero := 0;
-      FAbstractMem.Write( ABlockPointer + (FElementsOfEachBlock*4), LZero, 4 );
+      FAbstractMem.Write( ABlockPointer + (FElementsOfEachBlock*FAbstractMem.SizeOfAbstractMemPosition), LZero, FAbstractMem.SizeOfAbstractMemPosition );
     end;
     if (i<LBlockIndex) then begin
       APreviousBlockPointer := ABlockPointer;
       // Read
-      FAbstractMem.Read( ABlockPointer + (FElementsOfEachBlock*4), ABlockPointer, 4 );
+      FAbstractMem.Read( ABlockPointer + (FElementsOfEachBlock*FAbstractMem.SizeOfAbstractMemPosition), ABlockPointer, FAbstractMem.SizeOfAbstractMemPosition );
     end;
     inc(i);
   until (i > LBlockIndex);
@@ -412,11 +409,11 @@ begin
   FAbstractMemTListLock.Acquire;
   try
   if (UseCacheData(False)) then begin
-    if (AIndex<0) or (AIndex>=FNextElementPosition) then raise EAbstractMemTList.Create(Format('%s index %d out of range 0..%d',[ClassName,AIndex,FNextElementPosition-1]));
-    Move( FCacheData[AIndex*4], Result, 4);
+    if (AIndex<0) or (AIndex>=FNextElementIndex) then raise EAbstractMemTList.Create(Format('%s index %d out of range 0..%d',[ClassName,AIndex,FNextElementIndex-1]));
+    Move( FCacheData[AIndex*FAbstractMem.SizeOfAbstractMemPosition], Result, FAbstractMem.SizeOfAbstractMemPosition);
   end else begin
     GetPointerTo(AIndex,False,LPreviousBlockPointer,LBlockPointer,LIndexInBlock);
-    FAbstractMem.Read( LBlockPointer + (LIndexInBlock*4), Result, 4);
+    FAbstractMem.Read( LBlockPointer + (LIndexInBlock*FAbstractMem.SizeOfAbstractMemPosition), Result, FAbstractMem.SizeOfAbstractMemPosition);
   end;
   finally
     FAbstractMemTListLock.Release;
@@ -431,11 +428,11 @@ begin
   // Try to read
   FElementsOfEachBlock := 0;
   FFirstBlockPointer := 0;
-  FNextElementPosition := 0;
-  SetLength(LBytes,CT_AbstractMemTList_HeaderSize);
+  FNextElementIndex := 0;
+  SetLength(LBytes,MinAbstractMemTListHeaderSize(FAbstractMem));
   try
-    if (FInitialZone.position>0) And ((FInitialZone.size=0) or (FInitialZone.size>=CT_AbstractMemTList_HeaderSize)) then begin
-      FAbstractMem.Read(FInitialZone.position,LBytes[0],CT_AbstractMemTList_HeaderSize);
+    if (FInitialZone.position>0) And ((FInitialZone.size=0) or (FInitialZone.size>=MinAbstractMemTListHeaderSize(FAbstractMem))) then begin
+      FAbstractMem.Read(FInitialZone.position,LBytes[0],MinAbstractMemTListHeaderSize(FAbstractMem));
       if Length(CT_AbstractMemTList_Magic)<>4 then raise EAbstractMemTList.Create('Invalid CT_AbstractMemTList_Magic size!');
       // Check magic
       for i := 0 to CT_AbstractMemTList_Magic.Length-1 do begin
@@ -443,17 +440,17 @@ begin
       end;
       // Capture Size
       Move(LBytes[4],FElementsOfEachBlock,4);
-      Move(LBytes[8],FNextElementPosition,4);
-      Move(LBytes[12],FFirstBlockPointer,4);
+      Move(LBytes[8],FNextElementIndex,4);
+      Move(LBytes[12],FFirstBlockPointer,FAbstractMem.SizeOfAbstractMemPosition);
       if (FElementsOfEachBlock<=0) then begin
         // Not valid
         FElementsOfEachBlock := 0;
         FFirstBlockPointer := 0;
-        FNextElementPosition := 0;
+        FNextElementIndex := 0;
       end;
     end;
   finally
-    if (FInitialZone.position>0) and (FElementsOfEachBlock<=0) and ((FInitialZone.size=0) or (FInitialZone.size>=CT_AbstractMemTList_HeaderSize))  then begin
+    if (FInitialZone.position>0) and (FElementsOfEachBlock<=0) and ((FInitialZone.size=0) or (FInitialZone.size>=MinAbstractMemTListHeaderSize(FAbstractMem)))  then begin
       // Need to initialize and save
       FElementsOfEachBlock := ADefaultElementsPerBlock;
       if FElementsOfEachBlock<=0 then raise EAbstractMemTList.Create('Invalid Default Elements per block');
@@ -462,8 +459,8 @@ begin
         LBytes[i] := Byte(Ord(CT_AbstractMemTList_Magic.Chars[i]));
       end;
       Move(FElementsOfEachBlock,LBytes[4],4);
-      Move(FNextElementPosition,LBytes[8],4);
-      Move(FFirstBlockPointer,LBytes[12],4);
+      Move(FNextElementIndex,LBytes[8],4);
+      Move(FFirstBlockPointer,LBytes[12],FAbstractMem.SizeOfAbstractMemPosition);
       // Save header
       FAbstractMem.Write( FInitialZone.position, LBytes[0], Length(LBytes) );
     end;
@@ -478,11 +475,11 @@ begin
   try
   AddRange(AIndex,1);
   if (UseCacheData(True)) then begin
-    Move(APosition, FCacheData[AIndex*4], 4);
+    Move(APosition, FCacheData[AIndex*FAbstractMem.SizeOfAbstractMemPosition], FAbstractMem.SizeOfAbstractMemPosition);
     FCacheUpdated := True;
   end else begin
     GetPointerTo(AIndex,False,LPreviousBlockPointer,LBlockPointer,LIndexInBlock);
-    FAbstractMem.Write( LBlockPointer + (LIndexInBlock*4), APosition, 4 );
+    FAbstractMem.Write( LBlockPointer + (LIndexInBlock*FAbstractMem.SizeOfAbstractMemPosition), APosition, FAbstractMem.SizeOfAbstractMemPosition );
   end;
   finally
     FAbstractMemTListLock.Release;
@@ -494,18 +491,19 @@ var LBlockPointer, LPreviousBlockPointer : TAbstractMemPosition;
   LIndexInBlock, i, j : Integer;
 begin
   CheckInitialized;
-  if (AIndexStart<0) or (AIndexStart>FNextElementPosition) then raise EAbstractMemTList.Create(Format('%s LoadElements out of range %d in 0..%d',[ClassName,AIndexStart,FNextElementPosition-1]));
+  if (AIndexStart<0) or (AIndexStart>FNextElementIndex) then raise EAbstractMemTList.Create(Format('%s LoadElements out of range %d in 0..%d',[ClassName,AIndexStart,FNextElementIndex-1]));
 
-  SetLength(AElements, (FNextElementPosition - AIndexStart)*4);
+  SetLength(AElements, (FNextElementIndex - AIndexStart)*FAbstractMem.SizeOfAbstractMemPosition);
 
   i := AIndexStart;
-  while (i<FNextElementPosition) do begin
+  while (i<FNextElementIndex) do begin
     GetPointerTo( i ,False,LPreviousBlockPointer,LBlockPointer,LIndexInBlock);
     // Load this
     j := FElementsOfEachBlock - LIndexInBlock;
-    if (i + j -1) >= FNextElementPosition then j := FNextElementPosition - i;
+    if (i + j -1) >= FNextElementIndex then j := FNextElementIndex - i;
 
-    FAbstractMem.Read(LBlockPointer + (LindexInBlock * 4), AElements[ (i-AIndexStart)*4 ], (j)*4  );
+    FAbstractMem.Read(LBlockPointer + (LindexInBlock * FAbstractMem.SizeOfAbstractMemPosition),
+        AElements[ (i-AIndexStart)*FAbstractMem.SizeOfAbstractMemPosition ], (j)*FAbstractMem.SizeOfAbstractMemPosition  );
 
     inc(i,j);
   end;
@@ -516,6 +514,16 @@ begin
   FAbstractMemTListLock.Acquire;
 end;
 
+class function TAbstractMemTList.MinAbstractMemTListHeaderSize(AAbstractMem: TAbstractMem): Integer;
+begin
+  //
+  Result := 4 + 4 + 4 + AAbstractMem.SizeOfAbstractMemPosition;
+    // [0] 4 for magic
+    // [4] 4 for elements of each block
+    // [8] 4 for next element (counter)
+    // [12] 4 or 8 for first block position
+end;
+
 procedure TAbstractMemTList.RemoveRange(AIndexStart, ARemoveCount: Integer);
 var LBlockPointer, LPreviousBlockPointer, LNext : TAbstractMemPosition;
   LIndexInBlock, i, j, n : Integer;
@@ -525,21 +533,21 @@ begin
   FAbstractMemTListLock.Acquire;
   try
   if (ARemoveCount<=0) then raise EAbstractMemTList.Create(Format('%s remove count %d',[ClassName,ARemoveCount]));
-  if (AIndexStart+ARemoveCount-1>=FNextElementPosition) then begin
-    if (FNextElementPosition>0) then
-      raise EAbstractMemTList.Create(Format('%s remove %d..%d out of range 0..%d',[ClassName,AIndexStart,AIndexStart + ARemoveCount -1, FNextElementPosition-1]))
+  if (AIndexStart+ARemoveCount-1>=FNextElementIndex) then begin
+    if (FNextElementIndex>0) then
+      raise EAbstractMemTList.Create(Format('%s remove %d..%d out of range 0..%d',[ClassName,AIndexStart,AIndexStart + ARemoveCount -1, FNextElementIndex-1]))
     else raise EAbstractMemTList.Create(Format('%s remove %d..%d out of range (NO ELEMENTS)',[ClassName,AIndexStart,AIndexStart + ARemoveCount -1]))
   end;
 
   if (UseCacheData(True)) then begin
-    if (AIndexStart+ARemoveCount < FNextElementPosition) then begin
-      Move(FCacheData[(AIndexStart + ARemoveCount) *4],
-           FCacheData[(AIndexStart) *4],
-           FCacheDataUsedBytes-((AIndexStart + ARemoveCount)*4));
+    if (AIndexStart+ARemoveCount < FNextElementIndex) then begin
+      Move(FCacheData[(AIndexStart + ARemoveCount) *FAbstractMem.SizeOfAbstractMemPosition],
+           FCacheData[(AIndexStart) *FAbstractMem.SizeOfAbstractMemPosition],
+           FCacheDataUsedBytes-((AIndexStart + ARemoveCount)*FAbstractMem.SizeOfAbstractMemPosition));
     end;
-    Dec(FCacheDataUsedBytes,(ARemoveCount*4));
+    Dec(FCacheDataUsedBytes,(ARemoveCount*FAbstractMem.SizeOfAbstractMemPosition));
     FCacheUpdated := True;
-    Dec(FNextElementPosition,ARemoveCount);
+    Dec(FNextElementIndex,ARemoveCount);
     Exit;
   end;
 
@@ -553,37 +561,37 @@ begin
     GetPointerTo(i,False,LPreviousBlockPointer,LBlockPointer,LIndexInBlock);
     // Move from LIndexInBlock to FElementsOfEachBlock-1 in this block
     j := FElementsOfEachBlock - (LIndexInBlock);
-    if ((n+j)*4>Length(LElements)) then j := (Length(LElements) DIV 4)-n;
-    FAbstractMem.Write( LBlockPointer + (LIndexInBlock*4), LElements[ n*4 ], j*4 );
+    if ((n+j)*FAbstractMem.SizeOfAbstractMemPosition>Length(LElements)) then j := (Length(LElements) DIV FAbstractMem.SizeOfAbstractMemPosition)-n;
+    FAbstractMem.Write( LBlockPointer + (LIndexInBlock*FAbstractMem.SizeOfAbstractMemPosition), LElements[ n*FAbstractMem.SizeOfAbstractMemPosition ], j*FAbstractMem.SizeOfAbstractMemPosition );
     inc(n,j);
     inc(i,j);
-  until (i >= FNextElementPosition - ARemoveCount);// or (j=0);
+  until (i >= FNextElementIndex - ARemoveCount);// or (j=0);
 
-  LBlocksBefore := ((FNextElementPosition DIV FElementsOfEachBlock)+1);
-  LBlocksAfter := (((FNextElementPosition-ARemoveCount) DIV FElementsOfEachBlock)+1);
+  LBlocksBefore := ((FNextElementIndex DIV FElementsOfEachBlock)+1);
+  LBlocksAfter := (((FNextElementIndex-ARemoveCount) DIV FElementsOfEachBlock)+1);
 
   if (LBlocksBefore<LBlocksAfter) then begin
-    GetPointerTo(FNextElementPosition-ARemoveCount,False,LPreviousBlockPointer,LBlockPointer,LIndexInBlock);
+    GetPointerTo(FNextElementIndex-ARemoveCount,False,LPreviousBlockPointer,LBlockPointer,LIndexInBlock);
     while (LBlockPointer>0) do begin
-      FAbstractMem.Read( LBlockPointer + (FElementsOfEachBlock * 4), LNext, 4);
+      FAbstractMem.Read( LBlockPointer + (FElementsOfEachBlock * FAbstractMem.SizeOfAbstractMemPosition), LNext, FAbstractMem.SizeOfAbstractMemPosition);
       FAbstractMem.Dispose(LBlockPointer);
       LBlockPointer := LNext;
       //
       if LPreviousBlockPointer>0 then begin
         LNext := 0;
-        FAbstractMem.Write( LPreviousBlockPointer + (FElementsOfEachBlock * 4), LNext, 4);
+        FAbstractMem.Write( LPreviousBlockPointer + (FElementsOfEachBlock * FAbstractMem.SizeOfAbstractMemPosition), LNext, FAbstractMem.SizeOfAbstractMemPosition);
       end else begin
         // This is first block pointer
         FFirstBlockPointer := 0;
-        FAbstractMem.Write( FInitialZone.position + 12, FFirstBlockPointer, 4 );
+        FAbstractMem.Write( FInitialZone.position + 12, FFirstBlockPointer, FAbstractMem.SizeOfAbstractMemPosition );
       end;
     end;
 
   end;
 
   // Save to header
-  Dec(FNextElementPosition,ARemoveCount);
-  FAbstractMem.Write( FInitialZone.position + 8, FNextElementPosition, 4 );
+  Dec(FNextElementIndex,ARemoveCount);
+  FAbstractMem.Write( FInitialZone.position + 8, FNextElementIndex, 4 );
   finally
     FAbstractMemTListLock.Release;
   end;
@@ -596,11 +604,11 @@ begin
   FAbstractMemTListLock.Acquire;
   try
   if (UseCacheData(True)) then begin
-    Move( Value, FCacheData[AIndex*4], 4);
+    Move( Value, FCacheData[AIndex*FAbstractMem.SizeOfAbstractMemPosition], FAbstractMem.SizeOfAbstractMemPosition);
     FCacheUpdated := True;
   end else begin
     GetPointerTo(AIndex,False,LPreviousBlockPointer,LBlockPointer,LIndexInBlock);
-    FAbstractMem.Write( LBlockPointer + (LIndexInBlock*4), Value, 4);
+    FAbstractMem.Write( LBlockPointer + (LIndexInBlock*FAbstractMem.SizeOfAbstractMemPosition), Value, FAbstractMem.SizeOfAbstractMemPosition);
   end;
   finally
     FAbstractMemTListLock.Release;

src/libraries/abstractmem/UCacheMem.pas

@@ -52,12 +52,12 @@ type
     balance : Integer;
     //
     buffer : TBytes;
-    startPos : Integer;
+    startPos : Int64;
     used_previous : PCacheMemData;
     used_next : PCacheMemData;
     pendingToSave : Boolean;
     function GetSize : Integer;
-    function GetEndPos : Integer;
+    function GetEndPos : Int64;
     procedure Clear;
     function ToString : String;
     procedure DoMark(const ACacheMem : TCacheMem; AMySelfPointer : PCacheMemData; AAddToList : Boolean);
@@ -103,7 +103,8 @@ type
     flushSize : Integer;
     flushElapsedMillis : Int64;
     freememCount : Integer;
-    freememSize : Integer;
+    freememSize : Int64;
+    freememBlocksCount : Int64;
     freememElaspedMillis : Int64;
     maxUsedCacheSize : Integer;
     reusedCacheMemDataCount : Integer;
@@ -116,9 +117,9 @@ type
   end;
   {$ENDIF}
 
-  TOnNeedDataProc = function(var ABuffer; AStartPos : Integer; ASize : Integer) : Integer of object;
-  TOnSaveDataProc = function(const ABuffer; AStartPos : Integer; ASize : Integer) : Integer of object;
-  TOnNeedsTotalSizeProc = function(const ABuffer; AStartPos : Integer; ASize : Integer) : Integer of object;
+  TOnNeedDataProc = function(var ABuffer; AStartPos : Int64; ASize: Integer): Integer of object;
+  TOnSaveDataProc = function(const ABuffer; AStartPos : Int64; ASize: Integer): Integer of object;
+  TOnNeedsTotalSizeProc = function(const ABuffer; AStartPos : Int64; ASize: Integer): Integer of object;
 
   ECacheMem = Class(Exception);
 
@@ -130,47 +131,47 @@ type
     FOldestUsed : PCacheMemData;
     FNewestUsed : PCacheMemData;
     FCacheData : TCacheMemDataTree;
-    FPendingToSaveBytes : Integer;
-    FCacheDataBlocks : Integer;
-    FCacheDataSize : Integer;
+    FPendingToSaveBytes : Int64;
+    FCacheDataBlocks : Int64;
+    FCacheDataSize : Int64;
     FOnNeedDataProc : TOnNeedDataProc;
     FOnSaveDataProc : TOnSaveDataProc;
-    FMaxCacheSize: Integer;
-    FMaxCacheDataBlocks: Integer;
-    FDefaultCacheDataBlocksSize : Integer;
+    FMaxCacheSize: Int64;
+    FMaxCacheDataBlocks: Int64;
+    FDefaultCacheDataBlocksSize : Int64;
     FGridCache : Boolean;
-    function FindCacheMemDataByPosition(APosition : Integer; out APCacheMemData : PCacheMemData) : Boolean;
+    function FindCacheMemDataByPosition(APosition : Int64; out APCacheMemData : PCacheMemData) : Boolean;
     procedure Delete(var APCacheMemData : PCacheMemData); overload;
     function FlushCache(const AFlushCacheList : TOrderedList<PCacheMemData>) : Boolean; overload;
     procedure CheckMaxMemUsage;
-    function LoadDataExt(var ABuffer; const AStartPos, ASize : Integer) : Boolean;
-    procedure SaveToCacheExt(const ABuffer; ASize, AStartPos : Integer; AMarkAsPendingToSave : Boolean);
+    function LoadDataExt(var ABuffer; AStartPos : Int64; ASize : Integer) : Boolean;
+    procedure SaveToCacheExt(const ABuffer; ASize : Integer; AStartPos : Int64; AMarkAsPendingToSave : Boolean);
   public
     Constructor Create(AOnNeedDataProc : TOnNeedDataProc; AOnSaveDataProc : TOnSaveDataProc);
     Destructor Destroy; override;
     //
     procedure Clear;
-    procedure SaveToCache(const ABuffer; ASize, AStartPos : Integer; AMarkAsPendingToSave : Boolean); overload;
-    procedure SaveToCache(const ABuffer : TBytes; AStartPos : Integer; AMarkAsPendingToSave : Boolean); overload;
-    function LoadData(var ABuffer; const AStartPos, ASize : Integer) : Boolean;
+    procedure SaveToCache(const ABuffer; ASize : Integer; AStartPos : Int64; AMarkAsPendingToSave : Boolean); overload;
+    procedure SaveToCache(const ABuffer : TBytes; AStartPos : Int64; AMarkAsPendingToSave : Boolean); overload;
+    function LoadData(var ABuffer; AStartPos : Int64; ASize : Integer) : Boolean;
     function ToString : String; reintroduce;
     function FlushCache : Boolean; overload;
-    function FreeMem(const AMaxMemSize, AMaxBlocks : Integer) : Boolean;
+    function FreeMem(const AMaxMemSize, AMaxBlocks : Int64) : Boolean;
 
     procedure ConsistencyCheck;
 
-    property CacheDataSize : Integer read FCacheDataSize;
+    property CacheDataSize : Int64 read FCacheDataSize;
     // Bytes in cache
 
-    property PendingToSaveSize : Integer read FPendingToSaveBytes;
+    property PendingToSaveSize : Int64 read FPendingToSaveBytes;
     // Bytes in cache pending to flush
 
-    property CacheDataBlocks : Integer read FCacheDataBlocks;
+    property CacheDataBlocks : Int64 read FCacheDataBlocks;
     // Blocks in cache
 
-    property MaxCacheSize : Integer read FMaxCacheSize write FMaxCacheSize;
-    property MaxCacheDataBlocks : Integer read FMaxCacheDataBlocks write FMaxCacheDataBlocks;
-    property DefaultCacheDataBlocksSize : Integer read FDefaultCacheDataBlocksSize write FDefaultCacheDataBlocksSize;
+    property MaxCacheSize : Int64 read FMaxCacheSize write FMaxCacheSize;
+    property MaxCacheDataBlocks : Int64 read FMaxCacheDataBlocks write FMaxCacheDataBlocks;
+    property DefaultCacheDataBlocksSize : Int64 read FDefaultCacheDataBlocksSize write FDefaultCacheDataBlocksSize;
     property GridCache : Boolean read FGridCache write FGridCache;
     {$IFDEF ABSTRACTMEM_ENABLE_STATS}
     procedure ClearStats;
@@ -219,9 +220,11 @@ end;
 
 { TCacheMem }
 
-function _CacheMem_CacheData_Comparer(const Left, Right: PCacheMemData): Integer;
+function _TCacheMemDataTree_Compare(const Left, Right: PCacheMemData): Integer;
 begin
-  Result := Integer(Left^.startPos) - Integer(Right^.startPos);
+  if Left^.startPos < Right^.startPos then Result := -1
+  else if Left^.startPos > Right^.startPos then Result := 1
+  else Result := 0;
 end;
 
 procedure TCacheMem.CheckMaxMemUsage;
@@ -230,7 +233,9 @@ begin
      and
      ((FMaxCacheDataBlocks < 0) or (FCacheDataBlocks<=FMaxCacheDataBlocks)) then Exit;
   // When calling FreeMem will increase call in order to speed
-  FreeMem((FMaxCacheSize-1) SHR 1, (FMaxCacheDataBlocks-1) SHR 1);
+  if not FreeMem((FMaxCacheSize-1) SHR 1, (FMaxCacheDataBlocks-1) SHR 1) then begin
+    raise ECacheMem.Create(Format('FreeMem(%d -> %d,%d -> %d)=False',[FCacheDataSize,(FMaxCacheSize-1) SHR 1,FCacheDataBlocks,(FMaxCacheDataBlocks-1) SHR 1]));
+  end;
 end;
 
 procedure TCacheMem.Clear;
@@ -289,7 +294,7 @@ begin
   if LTotalSize<>FCacheDataSize then raise ECacheMem.Create(Format('Cache size %d <> %d',[LTotalSize,FCacheDataSize]));
   if LTotalPendingSize<>FPendingToSaveBytes then raise ECacheMem.Create(Format('Total pending size %d <> %d',[LTotalPendingSize,FPendingToSaveBytes]));
 
-  LOrder := TOrderedList<PCacheMemData>.Create(False,_CacheMem_CacheData_Comparer);
+  LOrder := TOrderedList<PCacheMemData>.Create(False,_TCacheMemDataTree_Compare);
   try
     PLast := Nil;
     PCurrent := FOldestUsed;
@@ -340,9 +345,9 @@ procedure TCacheMem.Delete(var APCacheMemData : PCacheMemData);
 var LConsistency : PCacheMemData;
 begin
   if not FindCacheMemDataByPosition(APCacheMemData^.startPos,LConsistency) then Raise ECacheMem.Create(Format('Delete not found for %s',[APCacheMemData^.ToString]));
-  Dec(FCacheDataSize,APCacheMemData.GetSize);
+  Dec(FCacheDataSize,Int64(APCacheMemData.GetSize));
   if APCacheMemData^.pendingToSave then begin
-    Dec(FPendingToSaveBytes,APCacheMemData^.GetSize);
+    FPendingToSaveBytes := FPendingToSaveBytes - Int64(APCacheMemData^.GetSize);
   end;
   SetLength(APCacheMemData^.buffer,0);
   APCacheMemData^.UnMark(Self,APCacheMemData);
@@ -361,7 +366,7 @@ begin
   inherited;
 end;
 
-function TCacheMem.FindCacheMemDataByPosition(APosition: Integer; out APCacheMemData: PCacheMemData): Boolean;
+function TCacheMem.FindCacheMemDataByPosition(APosition: Int64; out APCacheMemData: PCacheMemData): Boolean;
   // Will return APCacheMemData that contains APosition
   // When returning FALSE, APCacheMemData.startPos will be < APosition (or NIL)
 var PSearch : PCacheMemData;
@@ -394,7 +399,7 @@ end;
 function TCacheMem.FlushCache(const AFlushCacheList : TOrderedList<PCacheMemData>) : Boolean;
 var i : Integer;
   PToCurrent, PToNext : PCacheMemData;
-  LTotalBytesSaved, LTotalBytesError : Integer;
+  LTotalBytesSaved, LTotalBytesError : Int64;
   {$IFDEF ABSTRACTMEM_ENABLE_STATS}
   LTickCount : TTickCount;
   {$ENDIF}
@@ -424,11 +429,11 @@ begin
         if Not Assigned(FOnSaveDataProc) then Exit(False);
         if FOnSaveDataProc(PToCurrent^.buffer[0],PToCurrent^.startPos,PToCurrent^.GetSize)<>PToCurrent^.GetSize then begin
           Result := False;
-          inc(LTotalBytesError,PToCurrent^.GetSize);
+          inc(LTotalBytesError,Int64(PToCurrent^.GetSize));
         end else begin
-          inc(LTotalBytesSaved,PToCurrent^.GetSize);
+          inc(LTotalBytesSaved,Int64(PToCurrent^.GetSize));
           PToCurrent^.pendingToSave := False;
-          Dec(FPendingToSaveBytes,PToCurrent^.GetSize);
+          FPendingToSaveBytes := FPendingToSaveBytes - Int64(PToCurrent^.GetSize);
         end;
       end;
       PToNext := PToCurrent^.used_next;
@@ -450,13 +455,14 @@ begin
   Result := FlushCache(Nil); // FlushCache without a list, without order
 end;
 
-function TCacheMem.FreeMem(const AMaxMemSize, AMaxBlocks: Integer) : Boolean;
+function TCacheMem.FreeMem(const AMaxMemSize, AMaxBlocks: Int64) : Boolean;
 var
-  i, LPreviousCacheDataSize, LTempCacheDataSize,
-  LFinalMaxMemSize, LMaxPendingRounds : Integer;
+  i, LTempCacheDataSize,
+  LFinalMaxMemSize, LMaxPendingRounds : Int64;
   PToRemove, PToNext : PCacheMemData;
   LListToFlush : TOrderedList<PCacheMemData>;
   {$IFDEF ABSTRACTMEM_ENABLE_STATS}
+  LPreviousCacheDataSize, LPreviousCacheDataBlocks : Int64;
   LTickCount : TTickCount;
   {$ENDIF}
 begin
@@ -466,8 +472,9 @@ begin
      ((AMaxBlocks < 0) or (FCacheDataBlocks<=AMaxBlocks)) then Exit(True);
   {$IFDEF ABSTRACTMEM_ENABLE_STATS}
   LTickCount := TPlatform.GetTickCount;
-  {$ENDIF}
   LPreviousCacheDataSize := FCacheDataSize;
+  LPreviousCacheDataBlocks := FCacheDataBlocks;
+  {$ENDIF}
 
   if (AMaxMemSize<0) then LFinalMaxMemSize := FCacheDataSize
   else LFinalMaxMemSize := AMaxMemSize;
@@ -475,7 +482,7 @@ begin
   else LMaxPendingRounds := FCacheDataBlocks - AMaxBlocks;
   //
   PToRemove := FOldestUsed;
-  LListToFlush := TOrderedList<PCacheMemData>.Create(False,_CacheMem_CacheData_Comparer);
+  LListToFlush := TOrderedList<PCacheMemData>.Create(False,_TCacheMemDataTree_Compare);
   try
     LTempCacheDataSize := FCacheDataSize;
     while (Assigned(PToRemove)) and
@@ -484,10 +491,12 @@ begin
       do begin
       Dec(LMaxPendingRounds);
       PToNext := PToRemove^.used_next; // Capture now to avoid future PToRemove updates
-      Dec(LTempCacheDataSize, PToRemove^.GetSize);
+      Dec(LTempCacheDataSize, Int64(PToRemove^.GetSize));
       if (PToRemove^.pendingToSave) then begin
         // Add to list to flush
-        LListToFlush.Add(PToRemove);
+        if LListToFlush.Add(PToRemove)<0 then begin
+          raise ECacheMem.Create(Format('Inconsistent error on Freemem cannot add pending to save: %s',[PToRemove.ToString]));
+        end;
       end else Delete(PToRemove);
       PToRemove := PToNext; // Point to next used
     end;
@@ -498,16 +507,18 @@ begin
       PToRemove := LListToFlush.Get(i);
       Delete( PToRemove );
     end;
+    //
+    if (Result) and (LTempCacheDataSize <> FCacheDataSize) then raise ECacheMem.Create(Format('Inconsistent error on FreeMem Expected size %d <> obtained %d (save list %d)',[LTempCacheDataSize,FCacheDataSize,LListToFlush.Count]));
+    if (Result) and (LMaxPendingRounds>0) then raise ECacheMem.Create(Format('Inconsistent error on FreeMem Expected Max Blocks %d <> obtained %d',[AMaxBlocks,FCacheDataBlocks]));
   finally
     LListToFlush.Free;
   end;
-  if (Result) and (LTempCacheDataSize <> FCacheDataSize) then raise ECacheMem.Create(Format('Inconsistent error on FreeMem Expected size %d <> obtained %d',[LTempCacheDataSize,FCacheDataSize]));
-  if (Result) and (LMaxPendingRounds>0) then raise ECacheMem.Create(Format('Inconsistent error on FreeMem Expected Max Blocks %d <> obtained %d',[AMaxBlocks,FCacheDataBlocks]));
 
   Result := (Result) And (FCacheDataSize <= AMaxMemSize);
   {$IFDEF ABSTRACTMEM_ENABLE_STATS}
   Inc(FCacheMemStats.freememCount);
   Inc(FCacheMemStats.freememSize,LPreviousCacheDataSize - FCacheDataSize);
+  Inc(FCacheMemStats.freememBlocksCount,LPreviousCacheDataBlocks - FCacheDataBlocks);
   Inc(FCacheMemStats.freememElaspedMillis,TPlatform.GetElapsedMilliseconds(LTickCount));
   {$ENDIF}
 end;
@@ -522,9 +533,9 @@ begin
   {$ENDIF}
 end;
 
-function TCacheMem.LoadData(var ABuffer; const AStartPos, ASize: Integer): Boolean;
+function TCacheMem.LoadData(var ABuffer; AStartPos : Int64; ASize: Integer): Boolean;
 Var
-  LNewStartPos, LIndex, LLoadSize, LMoveSize : Integer;
+  LNewStartPos, LIndex, LLoadSize, LMoveSize : Int64;
   Lpc : PByte;
   LData : TBytes;
 begin
@@ -552,10 +563,10 @@ begin
   end;
 end;
 
-function TCacheMem.LoadDataExt(var ABuffer; const AStartPos, ASize: Integer): Boolean;
+function TCacheMem.LoadDataExt(var ABuffer; AStartPos : Int64; ASize: Integer): Boolean;
   // Will return a Pointer to AStartPos
 
-  function _CaptureDataFromOnNeedDataProc(ACapturePosStart, ACaptureSize : Integer; var ACapturedData : TBytes; out ACapturedSize : Integer) : Boolean;
+  function _CaptureDataFromOnNeedDataProc(ACapturePosStart : Int64; ACaptureSize : Integer; var ACapturedData : TBytes; out ACapturedSize : Integer) : Boolean;
   {$IFDEF ABSTRACTMEM_TESTING_MODE}var i : integer;{$ENDIF}
   begin
     SetLength(ACapturedData,ACaptureSize);
@@ -578,7 +589,7 @@ function TCacheMem.LoadDataExt(var ABuffer; const AStartPos, ASize: Integer): Bo
 
 var
   LNewP, PCurrent, PToDelete : PCacheMemData;
-  LLastAddedPosition, LBytesCount, LSizeToStore, LNewStartPos : Integer;
+  LLastAddedPosition, LBytesCount, LSizeToStore, LNewStartPos : Int64;
   LTempData : TBytes;
   LTempCapturedSize : Integer;
   LTmpResult : Boolean;
@@ -687,11 +698,11 @@ begin
   // Save new
   LNewP^.MarkAsUsed(Self,LNewP);
   if Not FCacheData.Add( LNewP ) then raise ECacheMem.Create(Format('Inconsistent LoadData CacheData duplicate for %s',[LNewP^.ToString]));
-  Inc(FCacheDataSize,Length(LNewP^.buffer));
+  Inc(FCacheDataSize,Int64(Length(LNewP^.buffer)));
   Inc(FCacheDataBlocks);
   //
   if (LNewP^.pendingToSave) then begin
-    inc(FPendingToSaveBytes,LNewP^.GetSize);
+    FPendingToSaveBytes := FPendingToSaveBytes + Int64(LNewP^.GetSize);
   end;
 
   Move(LNewP^.buffer[ AStartPos-LNewP^.startPos ],ABuffer,ASize);
@@ -699,10 +710,10 @@ begin
   CheckMaxMemUsage;
 end;
 
-procedure TCacheMem.SaveToCacheExt(const ABuffer; ASize, AStartPos: Integer; AMarkAsPendingToSave : Boolean);
+procedure TCacheMem.SaveToCacheExt(const ABuffer; ASize: Integer; AStartPos: Int64; AMarkAsPendingToSave : Boolean);
 var
   LNewP, PCurrent, PToDelete : PCacheMemData;
-  LLastAddedPosition, LBytesCount : Integer;
+  LLastAddedPosition, LBytesCount : Int64;
 begin
   if ASize<0 then raise ECacheMem.Create(Format('Invalid save size %d',[ASize]));
   if ASize=0 then Exit;
@@ -713,7 +724,7 @@ begin
       Move(ABuffer,PCurrent^.buffer[ AStartPos - PCurrent^.startPos ], ASize);
       if (Not PCurrent^.pendingToSave) and (AMarkAsPendingToSave) then begin
         PCurrent^.pendingToSave := True;
-        inc(FPendingToSaveBytes,PCurrent^.GetSize);
+        FPendingToSaveBytes := FPendingToSaveBytes + Int64(PCurrent^.GetSize);
       end;
       PCurrent^.MarkAsUsed(Self,PCurrent);
       Exit;
@@ -774,24 +785,24 @@ begin
   // Save new
   LNewP^.MarkAsUsed(Self,LNewP);
   if Not FCacheData.Add(LNewP) then raise ECacheMem.Create(Format('Inconsistent SaveToCache CacheData duplicate for %s',[LNewP^.ToString]));
-  Inc(FCacheDataSize,Length(LNewP^.buffer));
+  Inc(FCacheDataSize,Int64(Length(LNewP^.buffer)));
   Inc(FCacheDataBlocks);
   //
   if (LNewP^.pendingToSave) then begin
-    inc(FPendingToSaveBytes,LNewP^.GetSize);
+    FPendingToSaveBytes := FPendingToSaveBytes + Int64(LNewP^.GetSize);
   end;
 
   CheckMaxMemUsage;
 end;
 
-procedure TCacheMem.SaveToCache(const ABuffer: TBytes; AStartPos: Integer; AMarkAsPendingToSave : Boolean);
+procedure TCacheMem.SaveToCache(const ABuffer: TBytes; AStartPos: Int64; AMarkAsPendingToSave : Boolean);
 begin
   SaveToCache(ABuffer[0],Length(ABuffer),AStartPos,AMarkAsPendingToSave);
 end;
 
-procedure TCacheMem.SaveToCache(const ABuffer; ASize, AStartPos: Integer; AMarkAsPendingToSave: Boolean);
+procedure TCacheMem.SaveToCache(const ABuffer; ASize: Integer; AStartPos: Int64; AMarkAsPendingToSave: Boolean);
 Var
-  LNewStartPos, LSizeToStore : Integer;
+  LNewStartPos, LSizeToStore : Int64;
   Lpc : PByte;
   LLeftBuff : TBytes;
 begin
@@ -945,9 +956,9 @@ begin
 end;
 
 
-function TCacheMemData.GetEndPos: Integer;
+function TCacheMemData.GetEndPos: Int64;
 begin
-  Result := Self.startPos + Self.GetSize - 1;
+  Result := Self.startPos + Int64(Self.GetSize) - 1;
 end;
 
 function TCacheMemData.GetSize: Integer;
@@ -991,6 +1002,7 @@ begin
   flushElapsedMillis := 0;
   freememCount := 0;
   freememSize := 0;
+  freememBlocksCount := 0;
   freememElaspedMillis := 0;
   reusedCacheMemDataCount := 0;
   reusedCacheMemDataBytes := 0;
@@ -1001,22 +1013,17 @@ end;
 
 function TCacheMemStats.ToString: String;
 begin
-  Result := Format('CacheMemStats Reused:%d (%d bytes) - Deleteds:%d (Saved:%d - reused:%d) - Flush:%d (%d bytes) %d millis - FreeMem:%d (%d bytes) %d millis',
+  Result := Format('CacheMemStats Reused:%d (%d bytes) - Deleteds:%d (Saved:%d - reused:%d) - Flush:%d (%d bytes) %d millis - FreeMem:%d (%d bytes %d blocks) %d millis',
      [Self.reusedCacheMemDataCount,Self.reusedCacheMemDataBytes,
       Self.deletedBlocksCount,Self.deletedBlocksSaved,Self.deletedBlocksReused,
       Self.flushCount,Self.flushSize,Self.flushElapsedMillis,
-      Self.freememCount,Self.freememSize,
+      Self.freememCount,Self.freememSize,Self.freememBlocksCount,
       Self.freememElaspedMillis]);
 end;
 {$ENDIF}
 
 { TCacheMemDataTree }
 
-function _TCacheMemDataTree_Compare(const Left, Right: PCacheMemData): Integer;
-begin
-  Result := Left^.startPos - Right^.startPos;
-end;
-
 function TCacheMemDataTree.AreEquals(const ANode1, ANode2: PCacheMemData): Boolean;
 begin
   Result := ANode1 = ANode2;

src/libraries/abstractmem/UFileMem.pas

@@ -61,11 +61,12 @@ type
     FFileName: String;
     FIsStableCache: Boolean;
     FIsFlushingCache : Boolean;
+    FIncreaseFileBytes: Int64;
     {$IFDEF ABSTRACTMEM_ENABLE_STATS}
     FStats : TFileMemStats;
     {$ENDIF}
-    function OnCacheNeedDataProc(var ABuffer; AStartPos : Integer; ASize : Integer) : Integer;
-    function OnCacheSaveDataProc(const ABuffer; AStartPos : Integer; ASize : Integer) : Integer;
+    function OnCacheNeedDataProc(var ABuffer; AStartPos : Int64; ASize: Integer): Integer;
+    function OnCacheSaveDataProc(const ABuffer; AStartPos : Int64; ASize: Integer): Integer;
     procedure SetMaxCacheSize(const Value: Integer);
     function GetMaxCacheSize: Integer;
     function GetMaxCacheDataBlocks: Integer;
@@ -73,6 +74,7 @@ type
     procedure CacheIsNOTStable; inline;
     function GetUseCache: Boolean;
     procedure SetUseCache(const Value: Boolean);
+    procedure SetIncreaseFileBytes(const Value: Int64);
   protected
     function AbsoluteWrite(const AAbsolutePosition : Int64; const ABuffer; ASize : Integer) : Integer; override;
     function AbsoluteRead(const AAbsolutePosition : Int64; var ABuffer; ASize : Integer) : Integer; override;
@@ -99,6 +101,7 @@ type
     {$IFDEF ABSTRACTMEM_ENABLE_STATS}
     function GetStatsReport(AClearStats : Boolean) : String; override;
     {$ENDIF}
+    property IncreaseFileBytes : Int64 read FIncreaseFileBytes write SetIncreaseFileBytes;
   End;
 
 implementation
@@ -130,6 +133,7 @@ end;
 
 function TFileMem.AbsoluteRead(const AAbsolutePosition: Int64; var ABuffer; ASize: Integer): Integer;
 begin
+  if (AAbsolutePosition<0) then raise EFileMem.Create(Format('%s.AbsoluteRead out of range %d size %d',[ClassName,AAbsolutePosition,ASize]));
   FFileStream.Position := AAbsolutePosition;
   Result := FFileStream.Read(ABuffer,ASize);
   {$IFDEF ABSTRACTMEM_ENABLE_STATS}
@@ -140,6 +144,7 @@ end;
 
 function TFileMem.AbsoluteWrite(const AAbsolutePosition: Int64; const ABuffer; ASize: Integer): Integer;
 begin
+  if (AAbsolutePosition<0) then raise EFileMem.Create(Format('%s.AbsoluteWrite out of range %d size %d',[ClassName,AAbsolutePosition,ASize]));
   FFileStream.Position := AAbsolutePosition;
   Result := FFileStream.Write(ABuffer,ASize);
   CacheIsNOTStable;
@@ -175,6 +180,7 @@ begin
   FIsStableCache := True;
   FIsFlushingCache := False;
   FFileName := AFileName;
+  FIncreaseFileBytes := 1024*4; // 4K by default
   if AReadOnly then LFileMode := fmOpenRead + fmShareDenyNone
   else begin
     if FileExists(AFileName) then LFileMode := fmOpenReadWrite else LFileMode := fmCreate;
@@ -204,7 +210,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;
@@ -226,6 +232,10 @@ begin
   if (FFileStream.Position<ANextAvailablePos) then raise EFileMem.Create(Format('End file position (%d) is less than next available pos %d',[FFileStream.Position,ANextAvailablePos]));
   // At this time ANextAvailablePos <= FFileStream.Position
   AMaxAvailablePos := ANextAvailablePos + ANeedSize;
+  if FIncreaseFileBytes>0 then begin
+    AMaxAvailablePos := ((((AMaxAvailablePos - 1) DIV FIncreaseFileBytes)+1) * FIncreaseFileBytes);
+  end;
+
   if (FFileStream.Size<AMaxAvailablePos) then begin
     SetLength(LBuff,AMaxAvailablePos - FFileStream.Position);
     FillChar(LBuff[0],Length(LBuff),0);
@@ -275,7 +285,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}
@@ -307,12 +318,12 @@ begin
   end;
 end;
 
-function TFileMem.OnCacheNeedDataProc(var ABuffer; AStartPos, ASize: Integer): Integer;
+function TFileMem.OnCacheNeedDataProc(var ABuffer; AStartPos : Int64; ASize: Integer): Integer;
 begin
   Result := inherited Read(AStartPos,ABuffer,ASize);
 end;
 
-function TFileMem.OnCacheSaveDataProc(const ABuffer; AStartPos, ASize: Integer): Integer;
+function TFileMem.OnCacheSaveDataProc(const ABuffer; AStartPos : Int64; ASize: Integer): Integer;
 begin
   Result := inherited Write(AStartPos,ABuffer,ASize);
 end;
@@ -333,6 +344,12 @@ begin
   end;
 end;
 
+procedure TFileMem.SetIncreaseFileBytes(const Value: Int64);
+begin
+  if (Value<0) or (Value>(1024*1024*100)) then FIncreaseFileBytes := 0
+  else FIncreaseFileBytes := Value;
+end;
+
 procedure TFileMem.SetMaxCacheDataBlocks(const Value: Integer);
 begin
   if Not Assigned(FCache) then Exit;

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

@@ -17,8 +17,7 @@ uses
   Classes,
   {$ELSE}
   Interfaces,
-  Forms,
-  GUITestRunner,
+  Forms, GuiTestRunner,
   {$ENDIF }
   {$ELSE}
   Forms,
@@ -39,6 +38,7 @@ uses
   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';
 
 {$IF Defined(FPC) and (Defined(CONSOLE_TESTRUNNER))}
@@ -59,6 +59,7 @@ begin
   Application := TFreePascalConsoleRunner.Create(nil);
   {$ENDIF}
 
+  Application.Title:='Test';
   Application.Initialize;
   {$IFDEF FPC}
   {$IF Not Defined(CONSOLE_TESTRUNNER)}

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

@@ -32,7 +32,7 @@
         <PackageName Value="FCL"/>
       </Item3>
     </RequiredPackages>
-    <Units Count="15">
+    <Units Count="16">
       <Unit0>
         <Filename Value="AbstractMem.Tests.dpr"/>
         <IsPartOfProject Value="True"/>
@@ -93,19 +93,24 @@
         <Filename Value="src\UFileMem.Tests.pas"/>
         <IsPartOfProject Value="True"/>
       </Unit14>
+      <Unit15>
+        <Filename Value="src\UAbstractMemTList.Tests.pas"/>
+        <IsPartOfProject Value="True"/>
+      </Unit15>
     </Units>
   </ProjectOptions>
   <CompilerOptions>
     <Version Value="11"/>
     <PathDelim Value="\"/>
     <SearchPaths>
-      <IncludeFiles Value="..;src"/>
+      <IncludeFiles Value="..;src;$(ProjOutDir)"/>
       <OtherUnitFiles Value="..;src"/>
       <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
     </SearchPaths>
     <Parsing>
       <SyntaxOptions>
-        <SyntaxMode Value="delphi"/>
+        <SyntaxMode Value="Delphi"/>
+        <IncludeAssertionCode Value="True"/>
       </SyntaxOptions>
     </Parsing>
     <Linking>

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

@@ -21,7 +21,7 @@ type
   private
   protected
   public
-    constructor Create(AAllowDuplicates : Boolean; AOrder : Integer);
+    constructor Create(AAllowDuplicates : Boolean; AOrder: Integer);
     function NodeDataToString(const AData : Integer) : String; override;
   End;
 

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}
@@ -34,21 +34,27 @@ type
      function NodeDataToString(const AData : TAbstractMemPosition) : String; override;
    End;
 
+   TAbstractMemBTreeDataExampleInteger = Class(TAbstractMemBTreeData<Integer>)
+   protected
+     function LoadData(const APosition : TAbstractMemPosition) : Integer; override;
+     function SaveData(const AData : Integer) : TAMZone; override;
+   public
+     function NodeDataToString(const AData : TAbstractMemPosition) : String; override;
+   End;
+
    TestTAbstractMemBTree = class(TTestCase)
    strict private
    public
      procedure SetUp; override;
      procedure TearDown; override;
-     procedure TestInfinite_Integer(AOrder : Integer; AAllowDuplicates : Boolean);
-     procedure TestInfinite_String(AOrder : Integer; AAllowDuplicates : Boolean);
-     procedure TestInfinite(AOrder : Integer);
+     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;
+     procedure Test_FindExt_TAbstractMemBTree;
+     procedure Test_FindData_TAbstractMemBTreeData;
    end;
 
 implementation
@@ -115,7 +121,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,132 +133,430 @@ procedure TestTAbstractMemBTree.TearDown;
 begin
 end;
 
-procedure TestTAbstractMemBTree.TestInfinite(AOrder: Integer);
+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
-  TestInfinite_Integer(AOrder,(AOrder MOD 2)=0);
-  TestInfinite_String(AOrder,(AOrder MOD 2)=0);
+  Result := SumChars(ALeft) - SumChars(ARight);
+  ALeft.GetHashCode
 end;
 
-procedure TestTAbstractMemBTree.TestInfinite_Integer(AOrder : Integer; AAllowDuplicates : Boolean);
-var Lbt : TAbstractMemBTreeExampleInteger;
-  Lbts : TAbstractMemBTreeExampleString;
-  Lzone : TAMZone;
-  intValue, nRounds, nAdds, nDeletes, i : Integer;
-  j : TAbstractMemPosition;
-  Lnode : TAbstractMemBTreeExampleInteger.TAbstractBTreeNode;
-  Lmem : TAbstractMem;
-  LCurr : String;
+function TComparison_HashCode(const ALeft, ARight: String): Integer;
 begin
-  Lmem := TMem.Create(0,False);
+  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.Test_FindData_TAbstractMemBTreeData;
+var LAM : TMem;
+  LBTree : TAbstractMemBTreeDataExampleInteger;
+  LZone : TAMZone;
+  LValue : Int64;
+  LValueStr : String;
+
+  Function CheckSearch(ASearching : Integer; AExpectedFound : Integer; var AOut : String) : Boolean;
+  var LMemPos : TAbstractMemPosition;
+     LValueFound : Integer;
+  begin
+    AOut := '';
+    Result := False;
+    if LBTree.FindData(ASearching,LMemPos,LValueFound) then begin
+      if AExpectedFound=LValueFound then begin
+        AOut := Format('OK-FOUND Search %d and Found %d as expected %d',[ASearching,LValueFound,AExpectedFound]);
+        Exit(True);
+      end else begin
+        AOut := Format('ERR-FOUND Search %d but Found %d and expected %d',[ASearching,LValueFound,AExpectedFound]);
+        Exit(False);
+      end;
+    end else begin
+      if (LValueFound = AExpectedFound) then begin
+        AOut := Format('OK Found Search %d and Found %d as expected %d',[ASearching,LValueFound,AExpectedFound]);
+        Exit(True);
+      end else begin
+        AOut := Format('ERR Search %d Found %d but expected %d',[ASearching,LValueFound,AExpectedFound]);
+        Exit(False);
+      end;
+    end;
+  end;
+
+  Procedure Search(ASearching : Integer; AExpectedFound : Integer);
+  var LMsg : String;
+  begin
+    if Not CheckSearch(ASearching,AExpectedFound,LMsg) then raise Exception.Create(LMsg);
+  end;
+
+begin
+  LAM := TMem.Create(0,False);
   Try
-    {$IFDEF FPC}
-    Randomize;
-    {$ELSE}
-    RandomizeProc(0);
-    {$ENDIF}
-    nRounds := 0;
-    nAdds := 0;
-    nDeletes := 0;
-    Lzone := Lmem.New(TAbstractMemBTree.MinAbstractMemInitialPositionSize);
-    try
-    Lbt := TAbstractMemBTreeExampleInteger.Create(Lmem,Lzone,AAllowDuplicates,AOrder);
-    try
-      repeat
-        inc(nRounds);
-        intValue := Random(AOrder * 100);
-        if Random(2)=0 then begin
-          if (Lbt.Add(intValue)) then begin
-            inc(nAdds);
-          end;
-        end else begin
-          if Lbt.Delete(intValue) then begin
-            inc(nDeletes);
-          end;
-        end;
-        if Random(100)=0 then begin
-          Lbt.CheckConsistency;
+    LAM.Initialize(True,4);
+    LZone := LAM.New(TAbstractMemBTree.MinAbstractMemInitialPositionSize(LAM));
+    Try
+      LBTree := TAbstractMemBTreeDataExampleInteger.Create(LAM,LZone,False,3,TComparison_Integer);
+      Try
+        LBtree.AddData(100);
+        LBtree.AddData(150);
+        LBtree.AddData(200);
+        LBtree.AddData(250);
+        LBtree.AddData(300);
+        LBtree.AddData(350);
+        LBtree.AddData(400);
+
+        LBtree.AddData(125);
+        LBtree.AddData(225);
+        LBtree.AddData(325);
+        LBtree.AddData(425);
+
+        LBtree.AddData(175);
+        LBtree.AddData(275);
+        LBtree.AddData(375);
+        LBtree.AddData(475);
+
+        Search(328,325);
+        Search(480,475);
+        Search(450,425);
+        Search(410,400);
+        Search(310,300);
+        Search(210,200);
+        Search(160,150);
+        Search(355,350);
+        Search(255,250);
+        Search(101,100);
+        Search(100,100);
+        Search(300,300);
+        Search(200,200);
+        Search(250,250);
+        Search(350,350);
+        Search(99,100); // Returns LOWEST
+
+      Finally
+        LBTree.Free;
+      End;
+    Finally
+      LAM.Dispose(LZone);
+    End;
+  Finally
+    LAM.Free;
+  End;
+end;
+
+procedure TestTAbstractMemBTree.Test_FindExt_TAbstractMemBTree;
+var LAM : TMem;
+  LBTree : TAbstractMemBTree;
+  LZone : TAMZone;
+  LValue : Int64;
+  LValueStr : String;
+
+  Function CheckSearch(ASearching : Int64; AExpectedFound : Int64; var AOut : String) : Boolean;
+  var LFound : TAbstractMemBTree.TAbstractBTreeNode;
+     LiPosNode : Integer;
+     LValueFound : Int64;
+  begin
+    AOut := '';
+    Result := False;
+    if LBTree.FindExt(ASearching,LValueFound) then begin
+      if AExpectedFound=LValueFound then begin
+        AOut := Format('OK-FOUND Search %d and Found %d as expected %d',[ASearching,LValueFound,AExpectedFound]);
+        Exit(True);
+      end else begin
+        AOut := Format('ERR-FOUND Search %d but Found %d and expected %d',[ASearching,LValueFound,AExpectedFound]);
+        Exit(False);
+      end;
+    end else begin
+      if (LValueFound = AExpectedFound) then begin
+        AOut := Format('OK Found Search %d and Found %d as expected %d',[ASearching,LValueFound,AExpectedFound]);
+        Exit(True);
+      end else begin
+        AOut := Format('ERR Search %d Found %d but expected %d',[ASearching,LValueFound,AExpectedFound]);
+        Exit(False);
+      end;
+    end;
+  end;
+
+  Procedure Search(ASearching : Int64; AExpectedFound : Int64);
+  var LMsg : String;
+  begin
+    if Not CheckSearch(ASearching,AExpectedFound,LMsg) then raise Exception.Create(LMsg);
+  end;
+
+begin
+  LAM := TMem.Create(0,False);
+  Try
+    LAM.Initialize(True,4);
+    LZone := LAM.New(TAbstractMemBTree.MinAbstractMemInitialPositionSize(LAM));
+    Try
+      LBTree := TAbstractMemBTree.Create(LAM,LZone,False,3);
+      Try
+        LBtree.Add(100);
+        LBtree.Add(150);
+        LBtree.Add(200);
+        LBtree.Add(250);
+        LBtree.Add(300);
+        LBtree.Add(350);
+        LBtree.Add(400);
+
+        LBtree.Add(125);
+        LBtree.Add(225);
+        LBtree.Add(325);
+        LBtree.Add(425);
+
+        LBtree.Add(175);
+        LBtree.Add(275);
+        LBtree.Add(375);
+        LBtree.Add(475);
+
+        Search(328,325);
+        Search(480,475);
+        Search(450,425);
+        Search(410,400);
+        Search(310,300);
+        Search(210,200);
+        Search(160,150);
+        Search(355,350);
+        Search(255,250);
+        Search(101,100);
+        Search(100,100);
+        Search(300,300);
+        Search(200,200);
+        Search(250,250);
+        Search(350,350);
+        Search(99,LBTree.GetNullData); // Returns NULL
+
+      Finally
+        LBTree.Free;
+      End;
+    Finally
+      LAM.Dispose(LZone);
+    End;
+  Finally
+    LAM.Free;
+  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;
-      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 else begin
+        if Lbt.DeleteData(intValue.ToString) then begin
+          inc(nDeletes);
         end;
-        If Not Lbt.Delete(Lnode.data[Random(Lnode.Count)]) then raise Exception.Create('Not Found to delete!');
-        if Random(100)=0 then begin
-          Lbt.CheckConsistency;
+      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;
-      // Try to re-use
-      for i := 1 to AOrder do begin
-        intValue := Random(AOrder * 100);
-        Assert(Lbt.Add(intValue),Format('Cannot re-use %d/%d and add %d',[i,AOrder,intValue]));
-        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;
-    finally
-      Lbt.Free;
-    end;
-    Lbt := TAbstractMemBTreeExampleInteger.Create(Lmem,Lzone,AAllowDuplicates,AOrder);
+    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;
+  LBTreeIndex : TAbstractMemBTreeDataIndex<String>;
+begin
+  Lmem := TMem.Create(0,False);
+  Try
+    LMem.Initialize(A64Bits,AMemUnitsSize);
+    LzoneData := Lmem.New(TAbstractMemBTree.MinAbstractMemInitialPositionSize(Lmem));
     try
-      Lbt.CheckConsistency;
-      Lbt.EraseTree;
-      Lbt.CheckConsistency;
-    finally
-      Lbt.Free;
-    end;
+      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.IndexesCount-1 downto 0 do begin
+          LBTreeIndex := TAbstractMemBTreeDataIndex<String>(Lbt.GetIndex(i));
+          LzoneIndex := LBTreeIndex.InitialZone;
+          LBTreeIndex.EraseTree;
+          LBTreeIndex.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(Lzone);
+      Lmem.Dispose(LzoneData);
     end;
+    //
     DoCheckAbstractMem(Lmem,0);
+    //
+    ProcessSaveToStream(Lmem);
   Finally
     Lmem.Free;
   End;
 end;
 
-procedure TestTAbstractMemBTree.TestInfinite_String(AOrder: Integer; AAllowDuplicates : Boolean);
-var Lbt : TAbstractMemBTreeExampleString;
+procedure TestTAbstractMemBTree.TestInfinite_Integer(AMemUnitsSize, AOrder: Integer; AAllowDuplicates : Boolean; A64Bits : Boolean);
+var Lbt : TAbstractMemBTreeExampleInteger;
   Lzone : TAMZone;
-  intValue, nRounds, nAdds, nDeletes, i : Integer;
-  Lnode : TAbstractMemBTreeExampleString.TAbstractBTreeNode;
+  intValue, nRounds, nAdds, nDeletes, i, intAux : Integer;
+  j : TAbstractMemPosition;
+  Lnode : TAbstractMemBTreeExampleInteger.TAbstractBTreeNode;
   Lmem : TAbstractMem;
   LCurr : String;
-  LCurrData : String;
 begin
   Lmem := TMem.Create(0,False);
   Try
-    {$IFDEF FPC}
-    Randomize;
-    {$ELSE}
-    RandomizeProc(0);
-    {$ENDIF}
+    LMem.Initialize(A64Bits,AMemUnitsSize);
     nRounds := 0;
     nAdds := 0;
     nDeletes := 0;
-    Lzone := Lmem.New(TAbstractMemBTree.MinAbstractMemInitialPositionSize);
+    Lzone := Lmem.New(TAbstractMemBTree.MinAbstractMemInitialPositionSize(Lmem));
     try
-    Lbt := TAbstractMemBTreeExampleString.Create(Lmem,Lzone,AAllowDuplicates,AOrder,TComparison_String);
+    Lbt := TAbstractMemBTreeExampleInteger.Create(Lmem,Lzone,AAllowDuplicates,AOrder);
     try
       repeat
         inc(nRounds);
         intValue := Random(AOrder * 100);
         if Random(2)=0 then begin
-          if (Lbt.AddData(intValue.ToString)) then begin
+          if (Lbt.Add(intValue)) then begin
             inc(nAdds);
           end;
         end else begin
-          if Lbt.DeleteData(intValue.ToString) then begin
+          if Lbt.Delete(intValue) then begin
             inc(nDeletes);
           end;
         end;
-        if Random(100)=0 then begin
-          Lbt.CheckConsistency;
-        end;
-      until (nRounds>=AOrder * 10000);
+      until (nRounds>=AOrder * 1000);
       Lbt.CheckConsistency;
       // Delete mode
       while Lbt.Count>0 do begin
@@ -259,52 +564,28 @@ begin
         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!');
-        if Random(100)=0 then begin
-          Lbt.CheckConsistency;
-        end;
+        If Not Lbt.Delete(Lnode.data[Random(Lnode.Count)]) then raise Exception.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;
+      i := 0;
+      repeat
+        intValue := Random(AOrder * 100);
+        if (not Lbt.Find(intValue,Lnode,intAux)) or (AAllowDuplicates) then begin
+          inc(i);
+          Assert(Lbt.Add(intValue),Format('Cannot re-use %d/%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);
     finally
       Lbt.Free;
     end;
-    Lbt := TAbstractMemBTreeExampleString.Create(Lmem,Lzone,AAllowDuplicates,AOrder,TComparison_String);
+    Lbt := TAbstractMemBTreeExampleInteger.Create(Lmem,Lzone,AAllowDuplicates,AOrder);
     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;
@@ -317,29 +598,30 @@ begin
   End;
 end;
 
-procedure TestTAbstractMemBTree.TestInfiniteOrder_3;
-begin
-  TestInfinite(3);
-end;
 
-procedure TestTAbstractMemBTree.TestInfiniteOrder_4;
-begin
-  TestInfinite(4);
-end;
+{ TAbstractMemBTreeDataExampleInteger }
 
-procedure TestTAbstractMemBTree.TestInfiniteOrder_5;
+function TAbstractMemBTreeDataExampleInteger.LoadData(
+  const APosition: TAbstractMemPosition): Integer;
 begin
-  TestInfinite(5);
+  Result := 0;
+  FAbstractMem.Read(APosition,Result,4);
 end;
 
-procedure TestTAbstractMemBTree.TestInfiniteOrder_6;
+function TAbstractMemBTreeDataExampleInteger.NodeDataToString(
+  const AData: TAbstractMemPosition): String;
 begin
-  TestInfinite(6);
+  if AData<=0 then Result := 'Nil '+AData.ToString
+  else begin
+    Result := LoadData(AData).ToString;
+  end;
 end;
 
-procedure TestTAbstractMemBTree.TestInfiniteOrder_7;
+function TAbstractMemBTreeDataExampleInteger.SaveData(
+  const AData: Integer): TAMZone;
 begin
-  TestInfinite(7);
+  Result := AbstractMem.New(4);
+  FAbstractMem.Write(Result.position,AData,4);
 end;
 
 initialization

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

@@ -0,0 +1,120 @@
+unit UAbstractMemTList.Tests;
+
+{$IFDEF FPC}
+  {$MODE Delphi}
+{$ENDIF}
+
+interface
+
+uses
+   SysUtils,
+   {$IFDEF FPC}
+   fpcunit, testutils, testregistry,
+   {$ELSE}
+   TestFramework,
+   {$ENDIF}
+   {$IFNDEF FPC}System.Generics.Collections,System.Generics.Defaults,{$ELSE}Generics.Collections,Generics.Defaults,{$ENDIF}
+   UAbstractMem,
+   UAbstractMemTList;
+
+type
+   TestTAbstractMemTList = class(TTestCase)
+   strict private
+   public
+     procedure SetUp; override;
+     procedure TearDown; override;
+     procedure TestInfinite(A64Bytes : Boolean; AUseCache, AUseCacheAuto : Boolean; AElementsPerBlock : Integer);
+   published
+     procedure Test_32b_NoCache;
+     procedure Test_32b_Cache;
+     procedure Test_64b_NoCache;
+     procedure Test_64b_Cache;
+   end;
+
+implementation
+
+
+{ TestTAbstractMemTList }
+
+procedure TestTAbstractMemTList.SetUp;
+begin
+  inherited;
+end;
+
+procedure TestTAbstractMemTList.TearDown;
+begin
+  inherited;
+end;
+
+procedure TestTAbstractMemTList.TestInfinite(A64Bytes, AUseCache,
+  AUseCacheAuto: Boolean; AElementsPerBlock: Integer);
+var LMem : TMem;
+  LAMList : TAbstractMemTList;
+  LAMZone : TAMZone;
+  i : Integer;
+begin
+  RandSeed:=0;
+  LMem := TMem.Create(0,False);
+  Try
+    LMem.Initialize(A64Bytes,4);
+    LAMZone := LMem.New(TAbstractMemTList.MinAbstractMemTListHeaderSize(LMem));
+    LAMList := TAbstractMemTList.Create(LMem,LAMZone,AElementsPerBlock,AUseCache);
+    Try
+      LAMList.UseCacheAuto := AUseCacheAuto;
+      // Start process
+      repeat
+        LAMList.Add(LMem.New((Random(50)+1)*4).position);
+        if (Random(5)=0) and (LAMList.Count>0) then begin
+          i := Random(LAMList.Count);
+          LAMZone.position := LAMList.Position[i];
+          LAMList.Delete(i);
+          LMem.Dispose(LAMZone.position);
+        end;
+        if Random(100)=0 then
+          LAMList.FlushCache;
+      until LAMList.Count>(AElementsPerBlock*200);
+      //
+      LAMList.FlushCache;
+      //
+      while (LAMList.Count>0) do begin
+        i := Random(LAMList.Count);
+        LAMZone.position := LAMList.Position[i];
+        LAMList.Delete(i);
+        LMem.Dispose(LAMZone.position);
+        if Random(100)=0 then
+          LAMList.FlushCache;
+      end;
+      LAMList.FlushCache;
+      LMem.CheckConsistency();
+      //
+    Finally
+      LAMList.Free;
+    End;
+  Finally
+    LMem.Free;
+  End;
+end;
+
+procedure TestTAbstractMemTList.Test_32b_Cache;
+begin
+  TestInfinite(False,True,True,10);
+end;
+
+procedure TestTAbstractMemTList.Test_32b_NoCache;
+begin
+  TestInfinite(False,False,False,10);
+end;
+
+procedure TestTAbstractMemTList.Test_64b_Cache;
+begin
+  TestInfinite(True,True,True,10);
+end;
+
+procedure TestTAbstractMemTList.Test_64b_NoCache;
+begin
+  TestInfinite(True,False,False,10);
+end;
+
+initialization
+  RegisterTest(TestTAbstractMemTList{$IFNDEF FPC}.Suite{$ENDIF});
+end.

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

@@ -19,8 +19,11 @@ interface
    TestTCacheMem = class(TTestCase)
    strict private
      FCurrentMem : TBytes;
-     function OnNeedDataProc(var ABuffer; AStartPos : Integer; ASize : Integer) : Integer;
-     function OnSaveDataProc(const ABuffer; AStartPos : Integer; ASize : Integer) : Integer;
+     FReadCount, FSaveCount, FReadBytes, FSaveBytes : Int64;
+     function OnNeedDataProc(var ABuffer; AStartPos : Int64; ASize : Integer) : Integer;
+     function OnSaveDataProc(const ABuffer; AStartPos : Int64; ASize : Integer) : Integer;
+     function OnNeedDataProc_BlackHole(var ABuffer; AStartPos : Int64; ASize : Integer) : Integer;
+     function OnSaveDataProc_BlackHole(const ABuffer; AStartPos : Int64; ASize : Integer) : Integer;
      procedure CheckBytes(const ABytes : TBytes; ALoadedStartPos, ASize : Integer);
      procedure InitCurrentMem(ASize : Integer);
    public
@@ -28,6 +31,7 @@ interface
      procedure TearDown; override;
    published
      procedure TestCacheMem;
+     procedure TestCacheMem_64bits;
    end;
 
  implementation
@@ -54,10 +58,16 @@ begin
   for i :=0 to High(FCurrentMem) do begin
     FCurrentMem[i] := ((i+1) MOD 89);
   end;
+  FReadCount := 0;
+  FSaveCount := 0;
+  FReadBytes := 0;
+  FSaveBytes := 0;
 end;
 
-function TestTCacheMem.OnNeedDataProc(var ABuffer; AStartPos, ASize: Integer): Integer;
+function TestTCacheMem.OnNeedDataProc(var ABuffer; AStartPos: Int64; ASize: Integer): Integer;
 begin
+  inc(FReadCount);
+  inc(FReadBytes,ASize);
   if (Length(FCurrentMem) >= AStartPos + ASize) then begin
     Result := ASize;
     Move(FCurrentMem[AStartPos],ABuffer,ASize);
@@ -69,8 +79,21 @@ begin
   end;
 end;
 
-function TestTCacheMem.OnSaveDataProc(const ABuffer; AStartPos, ASize: Integer): Integer;
+function TestTCacheMem.OnNeedDataProc_BlackHole(var ABuffer; AStartPos: Int64;
+  ASize: Integer): Integer;
+var LBuffer : TBytes;
 begin
+  // Just fill Buffer with 0 bytes
+  FillChar(ABuffer,ASize,0);
+  inc(FReadCount);
+  inc(FReadBytes,ASize);
+  Result := ASize;
+end;
+
+function TestTCacheMem.OnSaveDataProc(const ABuffer; AStartPos: Int64; ASize: Integer): Integer;
+begin
+  inc(FSaveCount);
+  inc(FSaveBytes,ASize);
   if (Length(FCurrentMem) >= AStartPos + ASize) then begin
     Result := ASize;
     Move(ABuffer,FCurrentMem[AStartPos],ASize);
@@ -82,9 +105,21 @@ begin
   end;
 end;
 
+function TestTCacheMem.OnSaveDataProc_BlackHole(const ABuffer; AStartPos: Int64;
+  ASize: Integer): Integer;
+begin
+  inc(FSaveCount);
+  inc(FSaveBytes,ASize);
+  Result := ASize;
+end;
+
 procedure TestTCacheMem.SetUp;
 begin
   SetLength(FCurrentMem,0);
+  FReadCount := 0;
+  FSaveCount := 0;
+  FReadBytes := 0;
+  FSaveBytes := 0;
 end;
 
 procedure TestTCacheMem.TearDown;
@@ -184,6 +219,47 @@ begin
   End;
 end;
 
+procedure TestTCacheMem.TestCacheMem_64bits;
+Var LCMem : TCacheMem;
+  LBuff : TBytes;
+  i : Integer;
+  LStartPos , LEndPos : Int64;
+
+begin
+  InitCurrentMem(0);
+  SetLength(LBuff,256*200);
+  LCMem := TCacheMem.Create(OnNeedDataProc_BlackHole,OnSaveDataProc_BlackHole);
+  Try
+    LCMem.GridCache := False;
+    LCMem.DefaultCacheDataBlocksSize := -1;
+    LCMem.MaxCacheSize := 1024*1024 * 1;
+    LCMem.MaxCacheDataBlocks := 500;
+    Try
+      LStartPos := (256*256*256)-(1024*10);
+      LEndPos := (LStartPos * 256) + Length(LBuff) + 1024;
+      i := 0;
+      repeat
+        inc(i);
+        Inc(LStartPos,Length(LBuff));
+        LCMem.LoadData(LBuff[0],LStartPos,Length(LBuff));
+        if (i MOD 2)=0 then begin
+          LCMem.SaveToCache(LBuff,LStartPos,True);
+        end;
+
+      until LStartPos > LEndPos;
+    Except
+      on E:Exception do begin
+        E.Message := Format('Round %d StartPos:%d %s (%s):%s',[i, LStartPos,LStartPos.ToHexString, E.ClassName,E.Message]);
+        Raise;
+      end;
+    End;
+    // Check replacing initial position of buffer on Load
+    LCMem.Clear;
+  Finally
+    LCMem.Free;
+  End;
+end;
+
 initialization
   RegisterTest(TestTCacheMem{$IFNDEF FPC}.Suite{$ENDIF});
 end.