Browse Source

Merge pull request #196 from PascalCoinDev/abstractmem

Build 5.4.beta with Abstractmem
Pascal Coin 5 years ago
parent
commit
f0500382b0
39 changed files with 7950 additions and 372 deletions
  1. 6 0
      CHANGELOG.md
  2. 4 1
      src/config.inc
  3. 1 1
      src/core/UAccountKeyStorage.pas
  4. 282 170
      src/core/UAccounts.pas
  5. 120 1
      src/core/UBaseTypes.pas
  6. 74 9
      src/core/UBlockChain.pas
  7. 103 1
      src/core/UChunk.pas
  8. 1 1
      src/core/UConst.pas
  9. 80 24
      src/core/UFileStorage.pas
  10. 166 107
      src/core/UNetProtocol.pas
  11. 2 1
      src/core/UNode.pas
  12. 1180 0
      src/core/UPCAbstractMem.pas
  13. 602 0
      src/core/UPCAbstractMemAccountKeys.pas
  14. 322 1
      src/core/UPCDataTypes.pas
  15. 1 1
      src/core/UPCOperationsBlockValidator.pas
  16. 6 1
      src/core/UPCOrderedLists.pas
  17. 7 6
      src/core/UPCRPCFindAccounts.pas
  18. 1 1
      src/core/UPCRPCOpData.pas
  19. 7 0
      src/core/UPCSafeBoxRootHash.pas
  20. 1 1
      src/core/UPCTNetDataExtraMessages.pas
  21. 23 0
      src/core/UPCTemporalFileStream.pas
  22. 1 1
      src/core/UPoolMining.pas
  23. 17 16
      src/core/URPC.pas
  24. 9 2
      src/core/upcdaemon.pas
  25. 1 0
      src/gui-classic/UFRMAccountSelect.pas
  26. 2 2
      src/gui-classic/UFRMOperation.pas
  27. 1 1
      src/gui-classic/UFRMOperationsExplorer.pas
  28. 2 0
      src/gui-classic/UFRMRandomOperations.pas
  29. 38 7
      src/gui-classic/UFRMWallet.pas
  30. 6 2
      src/gui-classic/UFRMWalletKeys.pas
  31. 36 14
      src/gui-classic/UGridUtils.pas
  32. 47 0
      src/libraries/abstractmem/ConfigAbstractMem.inc
  33. 493 0
      src/libraries/abstractmem/UAVLCache.pas
  34. 986 0
      src/libraries/abstractmem/UAbstractBTree.pas
  35. 960 0
      src/libraries/abstractmem/UAbstractMem.pas
  36. 863 0
      src/libraries/abstractmem/UAbstractMemTList.pas
  37. 967 0
      src/libraries/abstractmem/UCacheMem.pas
  38. 296 0
      src/libraries/abstractmem/UFileMem.pas
  39. 236 0
      src/libraries/abstractmem/UOrderedList.pas

+ 6 - 0
CHANGELOG.md

@@ -1,5 +1,11 @@
 # Changelog
 
+## Build 5.4 - (PENDING RELEASE)
+- Added usage of AbstractMem library to allow build a PascalCoin version using virtual memory and efficient caching mechanism
+  - Must activate {$DEFINE USE_ABSTRACTMEM} at config.inc file
+- Improved performance when downloading Safebox (Fresh installation)
+- Fixed minor bugs
+
 ## Build 5.3.0 - 2020-03-12
 - Fixed "out of memory" error when downloading Safebox
 - Fixed freeze bug on GUI when updating accounts grid

+ 4 - 1
src/config.inc

@@ -60,7 +60,10 @@
   
   // This will assume that PoW on old protocols are true and will not check, usefull after enough time to increase validation speed. 
   // Warning: Use only on versions after enough time since last protocol upgrade and non main-node versions
-  {.$DEFINE ASSUME_VALID_POW_OLD_PROTOCOLS}
+  {$DEFINE ASSUME_VALID_POW_OLD_PROTOCOLS}
+  
+  // Activate ABSTRACTMEM library. Will use a virtual memory caching mechanism for efficient usage without high RAM requirements
+  {$DEFINE USE_ABSTRACTMEM}
   
 
 { ********************************************************************

+ 1 - 1
src/core/UAccountKeyStorage.pas

@@ -7,7 +7,7 @@ unit UAccountKeyStorage;
 interface
 
 uses
-  Classes, SysUtils, UAccounts, UThread, UBaseTypes,
+  Classes, SysUtils, UAccounts, UThread, UBaseTypes, UPCDataTypes,
   {$IFNDEF FPC}System.Generics.Collections{$ELSE}Generics.Collections{$ENDIF};
 
 type

File diff suppressed because it is too large
+ 282 - 170
src/core/UAccounts.pas


+ 120 - 1
src/core/UBaseTypes.pas

@@ -62,8 +62,18 @@ Type
     procedure FromString(const AValue : String); // Will store a RAW bytes assuming each char of the string is a byte -> ALERT: Do not use when the String contains chars encoded with multibyte character set!
     function Add(const ARawValue : TRawBytes) : TRawBytes; // Will concat a new RawBytes value to current value
     function IsEmpty : Boolean; // Will return TRUE when Length = 0
+    function IsEqualTo(const ACompareTo : TRawBytes) : Boolean;
+    //
     procedure FromStream(AStream : TStream); overload;
     procedure FromStream(AStream : TStream; AStartPos, ALength : Integer); overload;
+    //
+    procedure SaveInsideTBytes(var ADestToWrite: TBytes; var AStartPosition: integer);    // AStartPosition will update to next position
+    function LoadFromTBytes(const ASource: TBytes; var AStartPosition: integer): boolean; // AStartPosition will update to next position
+    function ToSerialized : TBytes; overload;
+    procedure ToSerialized(const AStream : TStream); overload;
+    function FromSerialized(const ASerialized : TBytes; ACheckLength : Integer = 0) : Boolean; overload;
+    function FromSerialized(const AStream : TStream; ACheckLength : Integer = 0) : Integer; overload;
+    function GetSerializedLength: integer; // 2 + Length
   end;
 
 
@@ -91,8 +101,10 @@ Type
     function Compare(ABytesBuffer : TBytesBuffer) : Integer;
     procedure SetLength(ANewLength : Integer);
     function Memory : Pointer;
+    function MemoryLength : Integer;
     procedure Clear;
     procedure CopyFrom(ABytesBuffer : TBytesBuffer);
+    function Capture(AStartPos, ALength : Integer) : TBytes;
   end;
 
 
@@ -195,11 +207,94 @@ begin
   end else Result := '';
 end;
 
+function TRawBytesHelper.FromSerialized(const ASerialized: TBytes; ACheckLength : Integer = 0): Boolean;
+var Lsize: integer;
+begin
+  if (Length(ASerialized)<2) then Exit(False);
+  Lsize := 0;
+  Move(ASerialized[0],Lsize,2);
+  if (2 + Lsize > Length(ASerialized)) then Exit(False);
+  SetLength(Self,Lsize);
+  Move(ASerialized[2],Self[0],Lsize);
+  Result := True;
+end;
+
+function TRawBytesHelper.FromSerialized(const AStream: TStream; ACheckLength : Integer = 0): Integer;
+Var w: Word;
+begin
+  if AStream.Size - AStream.Position < 2 then begin
+    SetLength(Self,0);
+    Result := -1;
+    Exit;
+  end;
+  AStream.Read(w, 2);
+  if (AStream.Size - AStream.Position < w) OR ((ACheckLength > 0) AND (w <> ACheckLength)) then begin
+    AStream.Position := AStream.Position - 2; // Go back!
+    SetLength(Self,0);
+    Result := -1;
+    Exit;
+  end;
+  SetLength(Self, w);
+  if (w>0) then begin
+    AStream.ReadBuffer(Self[0], w);
+  end;
+  Result := w+2;
+end;
+
 procedure TRawBytesHelper.FromStream(AStream: TStream; AStartPos, ALength: Integer);
 begin
   System.SetLength(Self,ALength);
   AStream.Position := AStartPos;
-  AStream.Read(Self,ALength);
+  AStream.Read(Self[0],ALength);
+end;
+
+procedure TRawBytesHelper.SaveInsideTBytes(var ADestToWrite: TBytes; var AStartPosition: integer);
+var Lsize: integer;
+begin
+  if (AStartPosition + Length(Self) + 2) > Length(ADestToWrite) then begin
+    SetLength(ADestToWrite,AStartPosition + Length(Self) + 2);
+  end;
+  Lsize := Length(Self);
+  Move(Lsize, ADestToWrite[AStartPosition], 2);
+  Move(Self[0], ADestToWrite[AStartPosition + 2], Lsize);
+  Inc(AStartPosition, 2 + Lsize);
+end;
+
+function TRawBytesHelper.LoadFromTBytes(const ASource: TBytes; var AStartPosition: integer): boolean;
+var Lsize: integer;
+begin
+  Lsize := 0;
+  if (AStartPosition + 2 > Length(ASource)) then Exit(False);
+  Move(ASource[AStartPosition],Lsize,2);
+  if (AStartPosition + 2 + Lsize > Length(ASource)) then Exit(False);
+  SetLength(Self,Lsize);
+  Move(ASource[AStartPosition + 2],Self[0],Lsize);
+  inc(AStartPosition, 2 + Lsize);
+  Result := True;
+end;
+
+function TRawBytesHelper.ToSerialized: TBytes;
+var Lsize: integer;
+begin
+  LSize := Length(Self);
+  if LSize>65536 then raise Exception.Create('Cannot serialize TBytes due high length '+IntToStr(Length(Self)));
+  SetLength(Result, LSize + 2);
+  Move(Lsize, Result[0], 2);
+  Move(Self[0], Result[2], Lsize);
+end;
+
+procedure TRawBytesHelper.ToSerialized(const AStream: TStream);
+var LSize : Integer;
+begin
+  LSize := Length(Self);
+  if LSize>65536 then raise Exception.Create('Cannot serialize TBytes due high length '+IntToStr(Length(Self)));
+  AStream.Write(LSize,2);
+  AStream.Write(Self[0],LSize);
+end;
+
+function TRawBytesHelper.GetSerializedLength: integer;
+begin
+  Result := 2 + Length(Self);
 end;
 
 procedure TRawBytesHelper.FromStream(AStream: TStream);
@@ -230,6 +325,13 @@ begin
   Result := Length(Self)=0;
 end;
 
+function TRawBytesHelper.IsEqualTo(const ACompareTo: TRawBytes): Boolean;
+begin
+  if (Length(Self)=Length(ACompareTo)) and (Length(Self)>0) then
+    Result := (CompareMem(@Self[0],@ACompareTo[0],Length(Self)))
+  else Result := False;
+end;
+
 function TRawBytesHelper.ToHexaString: String;
 Var i : Integer;
   rbs : RawByteString;
@@ -553,6 +655,18 @@ begin
   Result := Replace(Length,buffer);
 end;
 
+function TBytesBuffer.Capture(AStartPos, ALength: Integer): TBytes;
+var LLength : Integer;
+begin
+  if AStartPos+ALength <= Self.Length then LLength := ALength
+  else LLength := Self.Length - AStartPos;
+  if (LLength<0) or (LLength>Self.Length) or (AStartPos<0) or (ALength<0) then raise Exception.Create(Format('Invalid Capture start %d length %d for a %d buffer',
+    [AStartPos,ALength,Self.Length]));
+  System.SetLength(Result,LLength);
+  if LLength>0 then
+    Move(FBytes[AStartPos],Result[0],LLength);
+end;
+
 procedure TBytesBuffer.Clear;
 begin
   System.SetLength(FBytes,0);
@@ -616,6 +730,11 @@ begin
   Result := addr(FBytes[0]);
 end;
 
+function TBytesBuffer.MemoryLength: Integer;
+begin
+  Result := System.Length(FBytes);
+end;
+
 procedure TBytesBuffer.NotifyUpdated(AStartPos, ACountBytes: Integer);
 begin
   //

+ 74 - 9
src/core/UBlockChain.pas

@@ -16,6 +16,8 @@ unit UBlockChain;
   THIS LICENSE HEADER MUST NOT BE REMOVED.
 }
 
+{$I ./../config.inc}
+
 {$IFDEF FPC}
   {$MODE Delphi}
 {$ENDIF}
@@ -25,8 +27,8 @@ interface
 uses
   Classes, UCrypto, UAccounts, ULog, UThread, SyncObjs, UBaseTypes, SysUtils,
   {$IFNDEF FPC}System.Generics.Collections{$ELSE}Generics.Collections{$ENDIF},
-  UPCDataTypes;
-{$I ./../config.inc}
+  {$IFDEF USE_ABSTRACTMEM}UPCAbstractMem,{$ENDIF}
+  UPCDataTypes, UChunk;
 
 {
 
@@ -472,6 +474,9 @@ Type
 
   TOrphan = RawByteString;
 
+
+  TCheckPointStruct = {$IFDEF USE_ABSTRACTMEM}TPCAbstractMem{$ELSE}TStream{$ENDIF};
+
   { TStorage }
 
   TStorage = Class(TComponent)
@@ -494,7 +499,7 @@ Type
     function GetFirstBlockNumber: Int64; virtual; abstract;
     function GetLastBlockNumber: Int64; virtual; abstract;
     function DoInitialize:Boolean; virtual; abstract;
-    Function DoCreateSafeBoxStream(blockCount : Cardinal) : TStream; 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;
@@ -513,10 +518,10 @@ Type
     Property FirstBlock : Int64 read GetFirstBlockNumber;
     Property LastBlock : Int64 read GetLastBlockNumber;
     Function Initialize : Boolean;
-    Function CreateSafeBoxStream(blockCount : Cardinal) : TStream;
+    Function OpenSafeBoxCheckpoint(blockCount : Cardinal) : TCheckPointStruct;
     Function HasUpgradedToVersion2 : Boolean; virtual; abstract;
     Procedure CleanupVersion1Data; virtual; abstract;
-    Procedure EraseStorage;
+    Procedure EraseStorage; // Erase Blockchain storage
     Procedure SavePendingBufferOperations(OperationsHashTree : TOperationsHashTree);
     Procedure LoadPendingBufferOperations(OperationsHashTree : TOperationsHashTree);
     Function BlockExists(Block : Cardinal) : Boolean;
@@ -549,6 +554,7 @@ Type
     function GetActualTargetSecondsAverage(BackBlocks : Cardinal): Real;
     function GetTargetSecondsAverage(FromBlock,BackBlocks : Cardinal): Real;
     function GetTargetSecondsMedian(AFromBlock: Cardinal; ABackBlocks : Integer): Real;
+    function LoadBankFromChunks(AChunks : TPCSafeboxChunks; checkSafeboxHash : TRawBytes; previousCheckedSafebox : TPCSafebox; progressNotify : TProgressNotify; var errors : String) : Boolean;
     function LoadBankFromStream(Stream : TStream; useSecureLoad : Boolean; checkSafeboxHash : TRawBytes; previousCheckedSafebox : TPCSafebox; progressNotify : TProgressNotify; var errors : String) : Boolean;
     Procedure Clear;
     Function LoadOperations(Operations : TPCOperationsComp; Block : Cardinal) : Boolean;
@@ -929,6 +935,7 @@ Var
   LTmpPCOperationsComp : TPCOperationsComp;
   i,j, LProgressBlock, LProgressEndBlock, LOpsInBlocks : Integer;
   LSafeboxTransaction : TPCSafeBoxTransaction;
+  LTempSafebox : TPCSafeBox;
 begin
   if FIsRestoringFromFile then begin
     TLog.NewLog(lterror,Classname,'Is Restoring!!!');
@@ -943,8 +950,9 @@ begin
     try
       Clear;
       Storage.Initialize;
-      If (max_block<Storage.LastBlock) then n := max_block
+      If (max_block<Storage.LastBlock) or (Storage.LastBlock<0) then n := max_block
       else n := Storage.LastBlock;
+
       Storage.RestoreBank(n,restoreProgressNotify);
       // Restore last blockchain
       if (BlocksCount>0) And (SafeBox.CurrentProtocol=CT_PROTOCOL_1) then begin
@@ -955,6 +963,12 @@ begin
           FLastOperationBlock := FLastBlockCache.OperationBlock;
         end;
       end;
+      If SafeBox.BlocksCount>0 then FLastOperationBlock := SafeBox.GetBlockInfo(SafeBox.BlocksCount-1)
+      else begin
+        FLastOperationBlock := TPCOperationsComp.GetFirstBlock;
+        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);
       LBlocks := TList<TPCOperationsComp>.Create;
       try
@@ -1032,7 +1046,12 @@ begin
     finally
       FIsRestoringFromFile := False;
       FUpgradingToV2 := false;
+      for i := 0 to FNotifyList.Count - 1 do begin
+        TPCBankNotify(FNotifyList.Items[i]).NotifyNewBlock;
+      end;
     end;
+
+
   finally
     FBankLock.Release;
   end;
@@ -1168,7 +1187,7 @@ begin
   Result := FStorage;
 end;
 
-function TPCBank.IsReady(Var CurrentProcess: String): Boolean;
+function TPCBank.IsReady(var CurrentProcess: String): Boolean;
 begin
   Result := false;
   CurrentProcess := '';
@@ -1180,6 +1199,52 @@ begin
   end else Result := true;
 end;
 
+function TPCBank.LoadBankFromChunks(AChunks : TPCSafeboxChunks;
+  checkSafeboxHash: TRawBytes; previousCheckedSafebox: TPCSafebox;
+  progressNotify: TProgressNotify; var errors: String): Boolean;
+Var LastReadBlock : TBlockAccount;
+  i : Integer;
+  LMemStream : TStream;
+begin
+  Result := False;
+  Try
+    if Not AChunks.IsComplete then begin
+      errors := 'AChunks is not complete';
+      Exit;
+    end;
+    LMemStream := TMemoryStream.Create;
+    try
+      for i := 0 to AChunks.Count-1 do begin
+        LMemStream.Size:=0;
+        LMemStream.Position := 0;
+        LMemStream.CopyFrom( AChunks.GetSafeboxChunk(i), 0 );
+        LMemStream.Position := 0;
+          if Not Safebox.LoadSafeBoxChunkFromStream(LMemStream,True,checkSafeboxHash,progressNotify,previousCheckedSafebox,LastReadBlock,errors) then begin
+          errors := Format('Error at chunk %d/%d ',[i+1,AChunks.Count])+errors;
+          Exit;
+        end;
+      end;
+    finally
+      LMemStream.Free;
+    end;
+    Result := True;
+    TPCThread.ProtectEnterCriticalSection(Self,FBankLock);
+    try
+      If SafeBox.BlocksCount>0 then FLastOperationBlock := SafeBox.GetBlockInfo(SafeBox.BlocksCount-1)
+      else begin
+        FLastOperationBlock := TPCOperationsComp.GetFirstBlock;
+        FLastOperationBlock.initial_safe_box_hash := TPCSafeBox.InitialSafeboxHash; // Genesis hash
+      end;
+    finally
+      FBankLock.Release;
+    end;
+    for i := 0 to FNotifyList.Count - 1 do begin
+      TPCBankNotify(FNotifyList.Items[i]).NotifyNewBlock;
+    end;
+  finally
+  end;
+end;
+
 function TPCBank.LoadBankFromStream(Stream: TStream; useSecureLoad : Boolean; checkSafeboxHash : TRawBytes; previousCheckedSafebox : TPCSafebox; progressNotify : TProgressNotify; var errors: String): Boolean;
 Var LastReadBlock : TBlockAccount;
   i : Integer;
@@ -2894,9 +2959,9 @@ begin
   Result := DoInitialize;
 end;
 
-function TStorage.CreateSafeBoxStream(blockCount: Cardinal): TStream;
+function TStorage.OpenSafeBoxCheckpoint(blockCount: Cardinal): TCheckPointStruct;
 begin
-  Result := DoCreateSafeBoxStream(blockCount);
+  Result := DoOpenSafeBoxCheckpoint(blockCount);
 end;
 
 procedure TStorage.EraseStorage;

+ 103 - 1
src/core/UChunk.pas

@@ -36,10 +36,12 @@ uses
   {$ELSE}
   zlib,
   {$ENDIF}
-  UAccounts, ULog, UConst, UCrypto, UBaseTypes;
+  UAccounts, ULog, UConst, UCrypto, UBaseTypes, UPCDataTypes;
 
 type
 
+  EPCChunk = Class(Exception);
+
   { TPCChunk }
 
   TPCChunk = Class
@@ -49,8 +51,108 @@ type
     class function LoadSafeBoxFromChunk(Chunk, DestStream : TStream; var safeBoxHeader : TPCSafeBoxHeader; var errors : String) : Boolean;
   end;
 
+  { TPCSafeboxChunks }
+
+  TPCSafeboxChunks = Class
+  private
+    FChunks : Array of TStream;
+  public
+    constructor Create;
+    destructor Destroy; override;
+    procedure Clear;
+    function Count : Integer;
+    procedure AddChunk(ASafeboxStreamChunk : TStream);
+    function GetSafeboxChunk(index : Integer) : TStream;
+    function GetSafeboxChunkHeader(index : Integer) : TPCSafeBoxHeader;
+    function IsComplete : Boolean;
+    function GetSafeboxHeader : TPCSafeBoxHeader;
+  end;
+
 implementation
 
+{ TPCSafeboxChunks }
+
+constructor TPCSafeboxChunks.Create;
+begin
+  SetLength(FChunks,0);
+end;
+
+destructor TPCSafeboxChunks.Destroy;
+begin
+  Clear;
+  inherited Destroy;
+end;
+
+procedure TPCSafeboxChunks.Clear;
+var i : Integer;
+begin
+  For i:=0 to Count-1 do begin
+    FChunks[i].Free;
+  end;
+  SetLength(FChunks,0);
+end;
+
+function TPCSafeboxChunks.Count: Integer;
+begin
+  Result := Length(FChunks);
+end;
+
+procedure TPCSafeboxChunks.AddChunk(ASafeboxStreamChunk: TStream);
+var LLastHeader, LsbHeader : TPCSafeBoxHeader;
+begin
+  If Not TPCSafeBox.LoadSafeBoxStreamHeader(ASafeboxStreamChunk,LsbHeader) then begin
+    Raise EPCChunk.Create('SafeBoxStream is not a valid SafeBox to add!');
+  end;
+  if (Count>0) then begin
+    LLastHeader := GetSafeboxChunkHeader(Count-1);
+    if (LsbHeader.ContainsFirstBlock)
+      or (LsbHeader.startBlock<>LLastHeader.endBlock+1)
+      or (LLastHeader.ContainsLastBlock)
+      or (LsbHeader.protocol<>LLastHeader.protocol)
+      or (LsbHeader.blocksCount<>LLastHeader.blocksCount)
+      or (Not LsbHeader.safeBoxHash.IsEqualTo( LLastHeader.safeBoxHash ))
+      then begin
+      raise EPCChunk.Create(Format('Cannot add %s at (%d) %s',[LsbHeader.ToString,Length(FChunks),LLastHeader.ToString]));
+    end;
+  end else if (Not LsbHeader.ContainsFirstBlock) then begin
+    raise EPCChunk.Create(Format('Cannot add %s',[LsbHeader.ToString]));
+  end;
+  //
+  SetLength(FChunks,Length(FChunks)+1);
+  FChunks[High(FChunks)] := ASafeboxStreamChunk;
+end;
+
+function TPCSafeboxChunks.GetSafeboxChunk(index: Integer): TStream;
+begin
+  if (index<0) or (index>=Count) then raise EPCChunk.Create(Format('Invalid index %d of %d',[index,Length(FChunks)]));
+  Result := FChunks[index];
+  Result.Position := 0;
+end;
+
+function TPCSafeboxChunks.GetSafeboxChunkHeader(index: Integer): TPCSafeBoxHeader;
+begin
+  If Not TPCSafeBox.LoadSafeBoxStreamHeader(GetSafeboxChunk(index),Result) then begin
+    Raise EPCChunk.Create(Format('Cannot capture header index %d of %d',[index,Length(FChunks)]));
+  end;
+end;
+
+function TPCSafeboxChunks.IsComplete: Boolean;
+var LsbHeader : TPCSafeBoxHeader;
+begin
+  if Count=0 then Result := False
+  else begin
+    LsbHeader := GetSafeboxChunkHeader(Count-1);
+    Result := LsbHeader.ContainsLastBlock;
+  end;
+end;
+
+function TPCSafeboxChunks.GetSafeboxHeader: TPCSafeBoxHeader;
+begin
+  if Not IsComplete then Raise EPCChunk.Create(Format('Chunks are not complete %d',[Length(FChunks)]));
+  Result := GetSafeboxChunkHeader(Count-1);
+  Result.startBlock := 0;
+end;
+
 { TPCChunk }
 
 class function TPCChunk.SaveSafeBoxChunkFromSafeBox(SafeBoxStream, DestStream : TStream; fromBlock, toBlock: Cardinal; var errors : String) : Boolean;

+ 1 - 1
src/core/UConst.pas

@@ -195,7 +195,7 @@ Const
   CT_OpSubtype_Data_Signer                = 103;
   CT_OpSubtype_Data_Receiver              = 104;
 
-  CT_ClientAppVersion : String = {$IFDEF PRODUCTION}'5.3'{$ELSE}{$IFDEF TESTNET}'TESTNET 5.3'{$ELSE}{$ENDIF}{$ENDIF};
+  CT_ClientAppVersion : String = {$IFDEF PRODUCTION}'5.4.beta'{$ELSE}{$IFDEF TESTNET}'TESTNET 5.4.beta'{$ELSE}{$ENDIF}{$ENDIF};
 
   CT_Discover_IPs = {$IFDEF PRODUCTION}'bpascal1.dynamic-dns.net;bpascal2.dynamic-dns.net;pascalcoin1.dynamic-dns.net;pascalcoin2.dynamic-dns.net;pascalcoin1.dns1.us;pascalcoin2.dns1.us;pascalcoin1.dns2.us;pascalcoin2.dns2.us'
                     {$ELSE}'pascaltestnet1.dynamic-dns.net;pascaltestnet2.dynamic-dns.net;pascaltestnet1.dns1.us;pascaltestnet2.dns1.us'{$ENDIF};

+ 80 - 24
src/core/UFileStorage.pas

@@ -22,10 +22,12 @@ unit UFileStorage;
 
 interface
 
-uses
-  Classes, {$IFnDEF FPC}Windows,{$ENDIF} UBlockChain, SyncObjs, UThread, UAccounts, UCrypto;
 {$I ./../config.inc}
 
+uses
+  Classes, {$IFnDEF FPC}Windows,{$ENDIF} UBlockChain, SyncObjs, UThread, UAccounts, UCrypto, UPCDataTypes;
+
+
 Type
   TBlockHeader = Record
     BlockNumber : Cardinal;
@@ -74,7 +76,7 @@ Type
     function GetFirstBlockNumber: Int64; override;
     function GetLastBlockNumber: Int64; override;
     function DoInitialize : Boolean; override;
-    Function DoCreateSafeBoxStream(blockCount : Cardinal) : TStream; override;
+    Function DoOpenSafeBoxCheckpoint(blockCount : Cardinal) : TCheckPointStruct; override;
     Procedure DoEraseStorage; override;
     Procedure DoSavePendingBufferOperations(OperationsHashTree : TOperationsHashTree); override;
     Procedure DoLoadPendingBufferOperations(OperationsHashTree : TOperationsHashTree); override;
@@ -92,12 +94,18 @@ Type
 
 implementation
 
-Uses ULog, SysUtils, UConst;
-
+Uses ULog, SysUtils, UBaseTypes,
+  {$IFDEF USE_ABSTRACTMEM}
+  UPCAbstractMem,
+  {$ENDIF}
+  UConst;
 { TFileStorage }
 
 Const CT_TBlockHeader_NUL : TBlockHeader = (BlockNumber:0;StreamBlockRelStartPos:0;BlockSize:0);
 
+
+  CT_Safebox_Extension = {$IFDEF USE_ABSTRACTMEM}'.am_safebox'{$ELSE}'.safebox'{$ENDIF};
+
   CT_GroupBlockSize = 1000;
   CT_SizeOfBlockHeader = 16;
   {
@@ -270,14 +278,18 @@ begin
   End;
 end;
 
-function TFileStorage.DoCreateSafeBoxStream(blockCount: Cardinal): TStream;
+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;
@@ -378,7 +390,7 @@ function TFileStorage.DoMoveBlockChain(Start_Block: Cardinal; const DestOrphan:
   begin
     FileAttrs := faArchive;
     folder := GetFolder(Orphan);
-    if SysUtils.FindFirst(GetFolder(Orphan)+PathDelim+'*.safebox', FileAttrs, sr) = 0 then begin
+    if SysUtils.FindFirst(GetFolder(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;
@@ -452,28 +464,66 @@ var
     sr: TSearchRec;
     FileAttrs: Integer;
     folder : AnsiString;
-    filename,auxfn : AnsiString;
+    Lfilename,auxfn : AnsiString;
     fs : TFileStream;
     ms : TMemoryStream;
     errors : String;
-    blockscount : Cardinal;
+    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);
-    filename := '';
-    blockscount := 0;
+    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>blockscount)) And
+            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
-              filename := auxfn;
-              blockscount := sbHeader.blocksCount;
+              Lfilename := auxfn;
+              LBlockscount := sbHeader.blocksCount;
               goodSbHeader := sbHeader;
             end;
           end;
@@ -481,14 +531,14 @@ begin
       until FindNext(sr) <> 0;
       FindClose(sr);
     end;
-    if (filename<>'') then begin
-      TLog.NewLog(ltinfo,Self.ClassName,'Loading SafeBox protocol:'+IntToStr(goodSbHeader.protocol)+' with '+inttostr(blockscount)+' blocks from file '+filename);
-      fs := TFileStream.Create(filename,fmOpenRead);
+    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: '+filename+ ' Error: '+errors);
+            TLog.NewLog(lterror,ClassName,'Error reading bank from file: '+Lfilename+ ' Error: '+errors);
           end;
         end else begin
           ms := TMemoryStream.Create;
@@ -496,7 +546,7 @@ begin
             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: '+filename+ ' Error: '+errors);
+              TLog.NewLog(lterror,ClassName,'Error reading bank from file: '+Lfilename+ ' Error: '+errors);
             end;
           Finally
             ms.Free;
@@ -515,11 +565,15 @@ 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
-    TLog.NewLog(ltInfo,ClassName,'Saving Safebox blocks:'+IntToStr(Bank.BlocksCount)+' file:'+bankfilename);
+    LTC := TPlatform.GetTickCount;
+    {$IFDEF USE_ABSTRACTMEM}
+    Bank.SafeBox.SaveCheckpointing(bankfilename);
+    {$ELSE}
     fs := TFileStream.Create(bankfilename,fmCreate);
     try
       fs.Size := 0;
@@ -539,9 +593,11 @@ begin
     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)+'.safebox';
+      aux_newfilename := GetFolder('') + PathDelim+'checkpoint_'+ inttostr(Bank.BlocksCount)+CT_Safebox_Extension;
       try
         {$IFDEF FPC}
         DoCopyFile(bankfilename,aux_newfilename);
@@ -589,9 +645,9 @@ begin
   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)+'.safebox';
+    Result := BaseDataFolder + PathDelim+'checkpoint'+ inttostr((block DIV CT_BankToDiskEveryNBlocks) MOD CT_SafeboxsToStore)+CT_Safebox_Extension;
   end else begin
-    Result := BaseDataFolder + PathDelim+'checkpoint_'+inttostr(block)+'.safebox';
+    Result := BaseDataFolder + PathDelim+'checkpoint_'+inttostr(block)+CT_Safebox_Extension;
   end;
 end;
 
@@ -1082,7 +1138,7 @@ end;
 function TFileStorage.HasUpgradedToVersion2: Boolean;
 var searchRec: TSearchRec;
 begin
-  HasUpgradedToVersion2 := SysUtils.FindFirst( GetFolder(Orphan)+PathDelim+'*.safebox', faArchive, searchRec) = 0;
+  HasUpgradedToVersion2 := SysUtils.FindFirst( GetFolder(Orphan)+PathDelim+'*'+CT_Safebox_Extension, faArchive, searchRec) = 0;
   FindClose(searchRec);
 end;
 

+ 166 - 107
src/core/UNetProtocol.pas

@@ -16,6 +16,8 @@ unit UNetProtocol;
   THIS LICENSE HEADER MUST NOT BE REMOVED.
 }
 
+{$I ./../config.inc}
+
 {$IFDEF FPC}
   {$MODE Delphi}
 {$ENDIF}
@@ -31,12 +33,12 @@ Uses
 {$ENDIF}
   UBlockChain, Classes, SysUtils, UAccounts, UThread,
   UCrypto, UTCPIP, SyncObjs, UBaseTypes, UCommon, UPCOrderedLists,
+  UPCDataTypes,
   {$IFNDEF FPC}System.Generics.Collections,System.Generics.Defaults
   {$ELSE}Generics.Collections,Generics.Defaults{$ENDIF},
+  {$IFDEF USE_ABSTRACTMEM}UPCAbstractMem,{$ENDIF}
   UNetProtection;
 
-{$I ./../config.inc}
-
 Const
   CT_MagicRequest = $0001;
   CT_MagicResponse = $0002;
@@ -161,6 +163,7 @@ Type
     procedure CleanNodeServersList;
     Function LockList : TList<Pointer>;
     Procedure UnlockList;
+    procedure ResetConnectAttempts;
     function IsBlackListed(const ip: String): Boolean;
     function GetNodeServerAddress(const ip : String; port:Word; CanAdd : Boolean; var nodeServerAddress : TNodeServerAddress) : Boolean;
     procedure SetNodeServerAddress(const nodeServerAddress : TNodeServerAddress);
@@ -846,6 +849,25 @@ begin
   Result := FListByIp;
 end;
 
+procedure TOrderedServerAddressListTS.ResetConnectAttempts;
+Var P : PNodeServerAddress;
+  i : Integer;
+begin
+  CleanNodeServersList;
+  FCritical.Acquire;
+  Try
+    for i := FListByIp.Count - 1 downto 0 do begin
+      P := FListByIp[i];
+      P^.last_connection := 0;
+      P^.last_connection_by_server := 0;
+      P^.last_connection_by_me := 0;
+      P^.last_attempt_to_connect := 0;
+    end;
+  Finally
+    FCritical.Release;
+  End;
+end;
+
 procedure TOrderedServerAddressListTS.SecuredDeleteFromListByIp(index: Integer);
 Var P : PNodeServerAddress;
   i2 : Integer;
@@ -1625,13 +1647,24 @@ Const CT_LogSender = 'GetNewBlockChainFromClient';
       Bank.Storage.Orphan := TNode.Node.Bank.Storage.Orphan;
       Bank.Storage.ReadOnly := true;
       Bank.Storage.CopyConfiguration(TNode.Node.Bank.Storage);
+
+
       if start_block>=0 then begin
         If (TNode.Node.Bank.SafeBox.HasSnapshotForBlock(start_block-1)) then begin
           // Restore from a Snapshot (New on V3) instead of restore reading from File
           Bank.SafeBox.SetToPrevious(TNode.Node.Bank.SafeBox,start_block-1);
           Bank.UpdateValuesFromSafebox;
           IsUsingSnapshot := True;
+
+          Bank.Storage.Orphan := FormatDateTime('yyyymmddhhnnss',DateTime2UnivDateTime(now));
+          Bank.Storage.ReadOnly := false;
+
         end else begin
+          {$IFDEF USE_ABSTRACTMEM}
+          Bank.Storage.Orphan := FormatDateTime('yyyymmddhhnnss',DateTime2UnivDateTime(now));
+          Bank.Storage.ReadOnly := false;
+          {$ENDIF}
+
           // Restore a part from disk
           Bank.DiskRestoreFromOperations(start_block-1);
           Bank.Storage.SaveBank(True);
@@ -1647,8 +1680,10 @@ Const CT_LogSender = 'GetNewBlockChainFromClient';
         start_block := 0;
       end;
       start_c := start;
-      Bank.Storage.Orphan := FormatDateTime('yyyymmddhhnnss',DateTime2UnivDateTime(now));
-      Bank.Storage.ReadOnly := false;
+      if Bank.Storage.ReadOnly then begin
+        Bank.Storage.Orphan := FormatDateTime('yyyymmddhhnnss',DateTime2UnivDateTime(now));
+        Bank.Storage.ReadOnly := false;
+      end;
       // Receive new blocks:
       finished := false;
       repeat
@@ -1738,6 +1773,11 @@ Const CT_LogSender = 'GetNewBlockChainFromClient';
               {$ENDIF}
             end else begin
               TLog.NewLog(ltInfo,CT_LogSender,'Restoring modified Safebox from Disk');
+
+              {$IFDEF USE_ABSTRACTMEM}
+              TNode.Node.Bank.SafeBox.ClearSafeboxfile;
+              {$ELSE}
+              {$ENDIF}
               TNode.Node.Bank.DiskRestoreFromOperations(CT_MaxBlock);
             end;
           Finally
@@ -1844,105 +1884,75 @@ Const CT_LogSender = 'GetNewBlockChainFromClient';
     end;
   end;
 
-  Type TSafeBoxChunkData = Record
+  Function DownloadSafeboxChunks(ASafeboxChunks : TPCSafeboxChunks; var ASafeboxLastOperationBlock : TOperationBlock; var errors : String) : Boolean;
+  var LDownloadedSafeboxBlocksCount, request_id : Cardinal;
+    LreceivedChunk : TStream;
     safeBoxHeader : TPCSafeBoxHeader;
-    chunkStream : TStream;
-  end;
-
-  Function DownloadSafeboxStream(safeboxStream : TStream; var safebox_last_operation_block : TOperationBlock) : Boolean;
-  var _blockcount, request_id : Cardinal;
-    chunks : Array of TSafeBoxChunkData;
-    receiveChunk, chunk1 : TStream;
-    safeBoxHeader : TPCSafeBoxHeader;
-    errors : String;
+    //errors : String;
     i : Integer;
-    LFirstSafebox : Boolean;
   Begin
     Result := False;
-    LFirstSafebox := TNode.Node.Bank.SafeBox.BlocksCount = 0;
-    safeboxStream.Size:=0;
-    safeboxStream.Position:=0;
+    ASafeboxChunks.Clear;
     // Will try to download penultimate saved safebox
-    _blockcount := ((Connection.FRemoteOperationBlock.block DIV CT_BankToDiskEveryNBlocks)-1) * CT_BankToDiskEveryNBlocks;
-    If not Do_GetOperationBlock(_blockcount,5000,safebox_last_operation_block) then begin
-      Connection.DisconnectInvalidClient(false,Format('Cannot obtain operation block %d for downloading safebox',[_blockcount]));
+    LDownloadedSafeboxBlocksCount := ((Connection.FRemoteOperationBlock.block DIV CT_BankToDiskEveryNBlocks)-1) * CT_BankToDiskEveryNBlocks;
+
+    If not Do_GetOperationBlock(LDownloadedSafeboxBlocksCount,5000,ASafeboxLastOperationBlock) then begin
+      Connection.DisconnectInvalidClient(false,Format('Cannot obtain operation block %d for downloading safebox',[LDownloadedSafeboxBlocksCount]));
       exit;
     end;
     // New Build 2.1.7 - Check valid operationblock
-    If Not TPCSafeBox.IsValidOperationBlock(safebox_last_operation_block,errors) then begin
-      Connection.DisconnectInvalidClient(false,'Invalid operation block at DownloadSafeBox '+TPCOperationsComp.OperationBlockToText(safebox_last_operation_block)+' errors: '+errors);
+    If Not TPCSafeBox.IsValidOperationBlock(ASafeboxLastOperationBlock,errors) then begin
+      Connection.DisconnectInvalidClient(false,'Invalid operation block at DownloadSafeBox '+TPCOperationsComp.OperationBlockToText(ASafeboxLastOperationBlock)+' errors: '+errors);
       Exit;
     end;
-    SetLength(chunks,0);
-    try
       // Will obtain chunks of 10000 blocks each -> Note: Maximum is CT_MAX_SAFEBOXCHUNK_BLOCKS
-      for i:=0 to ((_blockcount-1) DIV 10000) do begin // Bug v3.0.1 and minors
+      for i:=0 to ((LDownloadedSafeboxBlocksCount-1) DIV 10000) do begin // Bug v3.0.1 and minors
         FNewBlockChainFromClientStatus := Format('Receiving new safebox with %d blocks (step %d/%d) from %s',
-          [_blockcount,i+1,((_blockcount-1) DIV 10000)+1,Connection.ClientRemoteAddr]);
-        if LFirstSafebox then receiveChunk := TMemoryStream.Create
-        else receiveChunk := TPCTemporalFileStream.Create('CHUNK_'+IntToStr(i)+'_');
-        if (Not DownloadSafeBoxChunk(_blockcount,safebox_last_operation_block.initial_safe_box_hash,(i*10000),((i+1)*10000)-1,receiveChunk,safeBoxHeader,errors)) then begin
-          receiveChunk.Free;
+          [LDownloadedSafeboxBlocksCount,i+1,((LDownloadedSafeboxBlocksCount-1) DIV 10000)+1,Connection.ClientRemoteAddr]);
+        LreceivedChunk := TPCTemporalFileStream.Create(Format('CHUNK_%.3d_',[i]));
+        if (Not DownloadSafeBoxChunk(LDownloadedSafeboxBlocksCount,ASafeboxLastOperationBlock.initial_safe_box_hash,(i*10000),((i+1)*10000)-1,LreceivedChunk,safeBoxHeader,errors)) then begin
+          LreceivedChunk.Free;
           TLog.NewLog(ltError,CT_LogSender,errors);
           Exit;
         end;
-        SetLength(chunks,length(chunks)+1);
-        chunks[High(chunks)].safeBoxHeader := safeBoxHeader;
-        chunks[High(chunks)].chunkStream := receiveChunk;
-      end;
-      TLog.NewLog(ltDebug,CT_LogSender,Format('Concatening %d chunks',[Length(chunks)]));
-      // Will concat safeboxs:
-      chunk1 := TPCTemporalFileStream.Create('CONCAT_CHUNKS_');
-      try
-        if (length(chunks)=1) then begin
-          safeboxStream.CopyFrom(chunks[0].chunkStream,0);
-        end else begin
-          chunk1.CopyFrom(chunks[0].chunkStream,0);
-        end;
-        for i:=1 to high(chunks) do begin
-          FNewBlockChainFromClientStatus := Format('Concatening downloaded safebox (step %d/%d) from %s',
-            [i,High(chunks),Connection.ClientRemoteAddr]);
-          TLog.NewLog(ltDebug,CT_LogSender,Format('Concatening chunk %d/%d',[i,High(chunks)]));
-          safeboxStream.Size:=0;
-          safeboxStream.Position := 0; // Added caused by FPC 3.0.4 bug that does not update position auto when setting size=0 at a TFileStream
-          chunk1.Position:=0;
-          chunks[i].chunkStream.Position:=0;
-          If Not TPCSafeBox.ConcatSafeBoxStream(chunk1,chunks[i].chunkStream,safeboxStream,errors) then begin
-            TLog.NewLog(ltError,CT_LogSender,errors);
-            exit;
+        try
+          LreceivedChunk.Position := 0;
+          ASafeboxChunks.AddChunk( LreceivedChunk );
+        Except
+          On E:Exception do begin
+            errors:= Format('(%s) %s',[E.ClassName,E.Message]);
+            Result := false;
+            LreceivedChunk.Free;
+            Exit;
           end;
-          chunk1.Size := 0;
-          chunk1.CopyFrom(safeboxStream,0);
         end;
-        FNewBlockChainFromClientStatus := Format('Downloaded safebox with %d chunks from %s',[High(chunks),Connection.ClientRemoteAddr]);
-      finally
-        chunk1.Free;
-      end;
-    finally
-      for i:=0 to high(chunks) do begin
-        chunks[i].chunkStream.Free;
       end;
-      SetLength(chunks,0);
-    end;
-    Result := True;
-  End;
+
+      if Not ASafeboxChunks.IsComplete then begin
+        errors := 'Safebox Chunks is not complete!';
+        Exit;
+      end else Result := True;
+  end;
+
 
   Function DownloadSafeBox(IsMyBlockchainValid : Boolean) : Boolean;
-  var receiveData : TStream;
-    op : TOperationBlock;
+  var LChunks : TPCSafeboxChunks;
+    LSafeboxLastOperationBlock : TOperationBlock;
     errors : String;
     request_id : Cardinal;
   Begin
     Result := False;
-    receiveData := TPCTemporalFileStream.Create('SAFEBOX_');
+    LChunks := TPCSafeboxChunks.Create;
     try
-      if Not DownloadSafeboxStream(receiveData,op) then Exit;
+      if Not DownloadSafeboxChunks( LChunks, LSafeboxLastOperationBlock, errors ) then begin
+        TLog.NewLog(lterror,CT_LogSender,'Cannot DownloadSafeBox: '+errors);
+        Exit;
+      end;
       // Now receiveData is the ALL safebox
       TNode.Node.DisableNewBlocks;
       try
-          FNewBlockChainFromClientStatus := Format('Received new safebox with %d blocks from %s',[op.block+1,Connection.ClientRemoteAddr]);
-          receiveData.Position:=0;
-          If TNode.Node.Bank.LoadBankFromStream(receiveData,True,op.initial_safe_box_hash,TNode.Node.Bank.SafeBox,OnReadingNewSafeboxProgressNotify,errors) then begin
+          FNewBlockChainFromClientStatus := Format('Received new safebox with %d blocks from %s',[LSafeboxLastOperationBlock.block+1,Connection.ClientRemoteAddr]);
+          If TNode.Node.Bank.LoadBankFromChunks(LChunks,LSafeboxLastOperationBlock.initial_safe_box_hash,TNode.Node.Bank.SafeBox,OnReadingNewSafeboxProgressNotify,errors) then begin
             TLog.NewLog(ltInfo,ClassName,'Received new safebox!');
             If Not IsMyBlockchainValid then begin
               TNode.Node.Bank.Storage.EraseStorage;
@@ -1958,14 +1968,14 @@ Const CT_LogSender = 'GetNewBlockChainFromClient';
         TNode.Node.EnableNewBlocks;
       end;
     finally
-      receiveData.Free;
+      LChunks.Free;
     end;
   end;
 
   procedure DownloadNewBlockchain(start_block : Int64; IsMyBlockChainOk : Boolean);
-  var safeboxStream : TStream;
+  var LChunks : TPCSafeboxChunks;
     newTmpBank : TPCBank;
-    safebox_last_operation_block : TOperationBlock;
+    LSafeboxLastOperationBlock : TOperationBlock;
     opComp : TPCOperationsComp;
     errors : String;
     blocksList : TList<TPCOperationsComp>;
@@ -1981,10 +1991,12 @@ Const CT_LogSender = 'GetNewBlockChainFromClient';
     if (download_new_safebox) then begin
       TLog.NewLog(ltinfo,ClassName,Format('Will download new safebox. My blocks:%d Remote blocks:%d Equal Block:%d (MaxFutureBlocksToDownloadNewSafebox:%d)',[TNode.Node.Bank.BlocksCount,Connection.RemoteOperationBlock.block+1,start_block-1,MinFutureBlocksToDownloadNewSafebox]));
       // Will try to download safebox
-      safeboxStream := TPCTemporalFileStream.Create('NEW_SAFEBOX_');
-      Try
-        if Not DownloadSafeboxStream(safeboxStream,safebox_last_operation_block) then Exit;
-        safeboxStream.Position := 0;
+      LChunks := TPCSafeboxChunks.Create;
+      try
+        if Not DownloadSafeboxChunks( LChunks, LSafeboxLastOperationBlock, errors ) then begin
+          TLog.NewLog(lterror,CT_LogSender,'Cannot DownloadNewBlockchain: '+errors);
+          Exit;
+        end;
         newTmpBank := TPCBank.Create(Nil);
         try
           newTmpBank.StorageClass := TNode.Node.Bank.StorageClass;
@@ -1993,7 +2005,7 @@ Const CT_LogSender = 'GetNewBlockChainFromClient';
           newTmpBank.Storage.CopyConfiguration(TNode.Node.Bank.Storage);
           newTmpBank.Storage.Orphan := FormatDateTime('yyyymmddhhnnss',DateTime2UnivDateTime(now));
           newTmpBank.Storage.ReadOnly := false;
-          if newTmpBank.LoadBankFromStream(safeboxStream,True,safebox_last_operation_block.initial_safe_box_hash,TNode.Node.Bank.SafeBox,OnReadingNewSafeboxProgressNotify,errors) then begin
+          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!');
@@ -2001,8 +2013,8 @@ Const CT_LogSender = 'GetNewBlockChainFromClient';
               // Receive at least 1 new block
               blocksList := TList<TPCOperationsComp>.Create;
               try
-                if Not Do_GetOperationsBlock(newTmpBank,safebox_last_operation_block.block,safebox_last_operation_block.block+10,20000,False,blocksList) then begin
-                  TLog.NewLog(ltError,ClassName,Format('Cannot receive at least 1 new block:%d',[safebox_last_operation_block.block]));
+                if Not Do_GetOperationsBlock(newTmpBank,LSafeboxLastOperationBlock.block,LSafeboxLastOperationBlock.block+10,20000,False,blocksList) then begin
+                  TLog.NewLog(ltError,ClassName,Format('Cannot receive at least 1 new block:%d',[LSafeboxLastOperationBlock.block]));
                   Exit;
                 end;
                 for i:=0 to blocksList.Count-1 do begin
@@ -2025,7 +2037,7 @@ Const CT_LogSender = 'GetNewBlockChainFromClient';
               TNode.Node.Bank.Storage.MoveBlockChainBlocks(start_block,IntToStr(start_block)+'_'+FormatDateTime('yyyymmddhhnnss',DateTime2UnivDateTime(now)),Nil);
               TNode.Node.Bank.Storage.DeleteBlockChainBlocks(start_block);
 
-              newTmpBank.Storage.MoveBlockChainBlocks(safebox_last_operation_block.block,'',TNode.Node.Bank.Storage);
+              newTmpBank.Storage.MoveBlockChainBlocks(LSafeboxLastOperationBlock.block,'',TNode.Node.Bank.Storage);
               TNode.Node.Bank.DiskRestoreFromOperations(CT_MaxBlock);
             Finally
               TNode.Node.EnableNewBlocks;
@@ -2037,12 +2049,11 @@ Const CT_LogSender = 'GetNewBlockChainFromClient';
             Connection.DisconnectInvalidClient(false,'Cannot load from stream! '+errors);
             exit;
           end;
-
         finally
           newTmpBank.Free;
         end;
       Finally
-        safeboxStream.Free;
+        LChunks.Free;
       End;
     end else begin
       if IsMyBlockChainOk then begin
@@ -2354,6 +2365,8 @@ begin
   NotifyConnectivityChanged;
   if FNetConnectionsActive then DiscoverServers
   else DisconnectClients;
+  TNode.Node.NetServer.Active := Value;
+  NotifyConnectivityChanged;
 end;
 
 function TNetData.UnRegisterRequest(Sender: TNetConnection; operation: Word; request_id: Cardinal): Boolean;
@@ -2463,6 +2476,7 @@ begin
   inherited;
   if Active then begin
     // TNode.Node.AutoDiscoverNodes(CT_Discover_IPs);
+    TNetData.NetData.NodeServersAddresses.ResetConnectAttempts;
   end else if TNetData.NetDataExists then begin
     TNetData.NetData.DisconnectClients;
   end;
@@ -3114,10 +3128,14 @@ procedure TNetConnection.DoProcess_GetSafeBox_Request(HeaderData: TNetHeaderData
 Var _blockcount : Cardinal;
     _safeboxHash : TRawBytes;
     _from,_to : Cardinal;
+  {$IFDEF USE_ABSTRACTMEM}
+  Labstracmem : TPCAbstractMem;
+  {$ELSE}
+  sbHeader : TPCSafeBoxHeader;
+  {$ENDIF}
   sbStream : TStream;
   responseStream : TStream;
   antPos : Int64;
-  sbHeader : TPCSafeBoxHeader;
   errors : String;
 begin
   {
@@ -3142,16 +3160,54 @@ begin
     Exit;
   end;
   //
-  sbStream := TNode.Node.Bank.Storage.CreateSafeBoxStream(_blockcount);
+
+  responseStream := TMemoryStream.Create;
   try
-    responseStream := TMemoryStream.Create;
+    {$IFDEF USE_ABSTRACTMEM}
+    Labstracmem := TNode.Node.Bank.Storage.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]));
+        exit;
+      end;
+      If Not TBaseType.Equals(Labstracmem.BufferBlocksHash.GetSafeBoxHash,_safeboxHash) then begin
+        DisconnectInvalidClient(false,Format('Invalid safeboxhash on GetSafeBox request (Real:%s > Requested:%s)',[TCrypto.ToHexaString(Labstracmem.BufferBlocksHash.GetSafeBoxHash),TCrypto.ToHexaString(_safeboxHash)]));
+        exit;
+      end;
+
+
+      sbStream := TMemoryStream.Create;
+      try
+        if Not TPCSafeBox.CopyAbstractMemToSafeBoxStream(Labstracmem,sbStream,_from,_to,errors) then begin
+          SendError(ntp_response,HeaderData.operation,CT_NetError_SafeboxNotFound,HeaderData.request_id,Format('Invalid Safebox stream for block %d',[_blockcount]));
+          TLog.NewLog(ltError,Classname,'Error CopyAbstractMemToSafeBoxStream: '+errors);
+          exit;
+        end;
+
+        // Response:
+        sbStream.Position:=0;
+        If not TPCChunk.SaveSafeBoxChunkFromSafeBox(sbStream,responseStream,_from,_to,errors) then begin
+          TLog.NewLog(ltError,Classname,'Error saving chunk: '+errors);
+          exit;
+        end;
+      finally
+        sbStream.Free;
+      end;
+    finally
+      FreeAndNil(Labstracmem);
+    end;
+    {$ELSE}
+    sbStream := TNode.Node.Bank.Storage.OpenSafeBoxCheckpoint(_blockcount);
     try
       If Not Assigned(sbStream) then begin
-        SendError(ntp_response,HeaderData.operation,CT_NetError_SafeboxNotFound,HeaderData.request_id,Format('Safebox for block %d not found',[_blockcount]));
+        SendError(ntp_response,HeaderData.operation,CT_NetError_SafeboxNotFound,HeaderData.request_id,Format('Safebox stream file for block %d not found',[_blockcount]));
         exit;
       end;
       antPos := sbStream.Position;
-      TPCSafeBox.LoadSafeBoxStreamHeader(sbStream,sbHeader);
+      If Not TPCSafeBox.LoadSafeBoxStreamHeader(sbStream,sbHeader) then begin
+        SendError(ntp_response,HeaderData.operation,CT_NetError_SafeboxNotFound,HeaderData.request_id,Format('Invalid Safebox stream for block %d',[_blockcount]));
+        exit;
+      end;
       If Not TBaseType.Equals(sbHeader.safeBoxHash,_safeboxHash) then begin
         DisconnectInvalidClient(false,Format('Invalid safeboxhash on GetSafeBox request (Real:%s > Requested:%s)',[TCrypto.ToHexaString(sbHeader.safeBoxHash),TCrypto.ToHexaString(_safeboxHash)]));
         exit;
@@ -3162,14 +3218,15 @@ begin
         TLog.NewLog(ltError,Classname,'Error saving chunk: '+errors);
         exit;
       end;
-      // Sending
-      Send(ntp_response,HeaderData.operation,0,HeaderData.request_id,responseStream);
-      TLog.NewLog(ltInfo,ClassName,Format('Sending Safebox(%d) chunk[%d..%d] to %s Bytes:%d',[_blockcount,_from,_to,ClientRemoteAddr,responseStream.Size]));
     finally
-      responseStream.Free;
+      FreeAndNil(sbStream);
     end;
+    {$ENDIF}
+    // Sending
+    Send(ntp_response,HeaderData.operation,0,HeaderData.request_id,responseStream);
+    TLog.NewLog(ltInfo,ClassName,Format('Sending Safebox(%d) chunk[%d..%d] to %s Bytes:%d',[_blockcount,_from,_to,ClientRemoteAddr,responseStream.Size]));
   finally
-    FreeAndNil(sbStream);
+    responseStream.Free;
   end;
 end;
 
@@ -3318,8 +3375,10 @@ begin
         opht.Free;
       end;
     end;
-    TLog.NewLog(ltInfo,Classname,Format('Processed GetPendingOperations to %s obtaining %d (available %d) operations and added %d to Node',
-      [Self.ClientRemoteAddr,cTotal,cTotalByOther,cAddedOperations]));
+    if cAddedOperations>0 then begin
+      TLog.NewLog(ltInfo,Classname,Format('Processed GetPendingOperations to %s obtaining %d (available %d) operations and added %d to Node',
+        [Self.ClientRemoteAddr,cTotal,cTotalByOther,cAddedOperations]));
+    end;
   finally
     dataSend.Free;
     dataReceived.Free;
@@ -3329,14 +3388,14 @@ end;
 procedure TNetConnection.DoProcess_GetPubkeyAccounts_Request(HeaderData: TNetHeaderData; DataBuffer: TStream);
 Const CT_Max_Accounts_per_call = 1000;
 var responseStream, accountsStream : TMemoryStream;
-  start,max,iPubKey : Integer;
+  start,max : Integer;
   c, nAccounts : Cardinal;
   acc : TAccount;
   DoDisconnect : Boolean;
   errors : String;
   pubKey : TAccountKey;
-  sbakl : TOrderedAccountKeysList;
-  ocl : TOrderedCardinalList;
+  sbakl : TSafeboxPubKeysAndAccounts;
+  ocl : TAccountsNumbersList;
 begin
   {
   This call is used to obtain Accounts used by a Public key
@@ -3381,9 +3440,8 @@ begin
     nAccounts := 0;
     sbakl := TNode.Node.Bank.SafeBox.OrderedAccountKeysList;
     if Assigned(sbakl) then begin
-      iPubKey := sbakl.IndexOfAccountKey(pubKey);
-      if (iPubKey>=0) then begin
-        ocl := sbakl.AccountKeyList[iPubKey];
+      ocl := sbakl.GetAccountsUsingThisKey(pubKey);
+      if Assigned(ocl) then begin
         while (start<ocl.Count) And (max>0) do begin
           acc := TNode.Node.GetMempoolAccount(ocl.Get(start));
           if (HeaderData.protocol.protocol_available>9) then
@@ -4901,7 +4959,8 @@ begin
       i := 0;
       if (candidates.Count>1) then i := Random(candidates.Count); // i = 0..count-1
       nc := TNetConnection(candidates[i]);
-      TNetData.NetData.GetNewBlockChainFromClient(nc,Format('Candidate block: %d Aggregated: %d %s',[nc.FRemoteOperationBlock.block,nc.FRemoteAccumulatedWork,nc.FRemoteAggregatedHashrate.ToDecimal]));
+      TNetData.NetData.GetNewBlockChainFromClient(nc,Format('Candidate block: %d Aggregated: %d %s (My %d %s)',[nc.FRemoteOperationBlock.block,nc.FRemoteAccumulatedWork,nc.FRemoteAggregatedHashrate.ToDecimal,
+        TNode.Node.Bank.SafeBox.WorkSum,TNode.Node.Bank.SafeBox.AggregatedHashrate.ToDecimal]));
     end;
   finally
     LMaxAggregatedHashrate.Free;

+ 2 - 1
src/core/UNode.pas

@@ -35,7 +35,7 @@ interface
 
 uses
   Classes, SysUtils,
-  {$IFNDEF FPC}System.Generics.Collections{$ELSE}Generics.Collections{$ENDIF},
+  {$IFNDEF FPC}System.Generics.Collections{$ELSE}Generics.Collections{$ENDIF}, UPCDataTypes,
   UBlockChain, UNetProtocol, UAccounts, UCrypto, UThread, SyncObjs, ULog, UBaseTypes, UPCOrderedLists;
 
 {$I ./../config.inc}
@@ -874,6 +874,7 @@ end;
 class function TNode.NodeVersion: String;
 begin
   Result := CT_ClientAppVersion
+    {$IFDEF USE_ABSTRACTMEM}+'am'{$ENDIF}
     {$IFDEF LINUX}+'L'{$ELSE}+'W'{$ENDIF}
     {$IFDEF FPC}{$IFDEF LCL}+'l'{$ELSE}+'f'{$ENDIF}{$ENDIF}
     {$IFDEF FPC}{$IFDEF CPU32}+'32b'{$ELSE}+'64b'{$ENDIF}{$ELSE}{$IFDEF CPU32BITS}+'32b'{$ELSE}+'64b'{$ENDIF}{$ENDIF}

+ 1180 - 0
src/core/UPCAbstractMem.pas

@@ -0,0 +1,1180 @@
+unit UPCAbstractMem;
+
+interface
+
+{$IFDEF FPC}
+  {$MODE DELPHI}
+{$ENDIF}
+
+uses Classes, SysUtils, SyncObjs,
+  UAbstractMem, UFileMem, UAbstractMemTList,
+  UAbstractBTree, UThread,
+  UAVLCache, ULog, UCrypto,
+  UPCAbstractMemAccountKeys,
+  UPCDataTypes, UBaseTypes, UConst, UPCSafeBoxRootHash, UOrderedList,
+{$IFNDEF FPC}System.Generics.Collections,System.Generics.Defaults{$ELSE}Generics.Collections,Generics.Defaults{$ENDIF};
+
+type
+  EPCAbstractMem = class(Exception);
+
+  TPCAbstractMem = class;
+
+  TOperationBlockExt = record
+    operationBlock : TOperationBlock;
+    accumulatedWork : UInt64;
+  end;
+
+  TPCAbstractMemListBlocks = class(TAbstractMemTList<TOperationBlockExt>)
+  private
+    FPCAbstractMem: TPCAbstractMem;
+  protected
+    function ToString(const AItem: TOperationBlockExt): string; override;
+
+    procedure LoadFrom(const ABytes: TBytes; var AItem: TOperationBlockExt); override;
+    procedure SaveTo(const AItem: TOperationBlockExt; AIsAddingItem : Boolean; var ABytes: TBytes); override;
+  end;
+
+  TPCAbstractMemListAccounts = class;
+
+  TAccountNameInfo = record
+    accountName: string;
+    accountNumber: cardinal;
+  end;
+
+  { TPCAbstractMemListAccountNames }
+
+  TPCAbstractMemListAccountNames = class(TAbstractMemOrderedTList<TAccountNameInfo>)
+  private
+    FPCAbstractMem: TPCAbstractMem;
+  protected
+    function ToString(const AItem: TAccountNameInfo): string; override;
+
+    procedure LoadFrom(const ABytes: TBytes; var AItem: TAccountNameInfo); override;
+    procedure SaveTo(const AItem: TAccountNameInfo; AIsAddingItem : Boolean; var ABytes: TBytes); override;
+    function Compare(const ALeft, ARight: TAccountNameInfo): integer; override;
+  public
+    function IndexOf(const AName : String) : Integer;
+    procedure Remove(const AName : String);
+    procedure Add(const AName : String; AAccountNumber : Cardinal);
+    function FindByName(const AName : String; out AIndex : Integer) : Boolean;
+  end;
+
+  { TPCAbstractMemListAccounts }
+
+  TPCAbstractMemListAccounts = class(TAbstractMemTList<TAccount>)
+  private
+    FPCAbstractMem: TPCAbstractMem;
+  protected
+    procedure LoadFrom(const ABytes: TBytes; var AItem: TAccount); override;
+    procedure SaveTo(const AItem: TAccount; AIsAddingItem : Boolean; var ABytes: TBytes); override;
+  end;
+
+  { TPCAbstractMemBytesBuffer32Safebox }
+
+  TPCAbstractMemBytesBuffer32Safebox = Class(TBytesBuffer32Safebox)
+  private
+    FAbstractMem: TAbstractMem;
+    FSaveBufferPosition : TAbstractMemPosition;
+  protected
+  public
+    Constructor Create(AAbstractMem : TAbstractMem; APosition : TAbstractMemPosition; ACurrBlocksCount : Integer);
+    procedure Flush;
+  end;
+
+  TPCAbstractMemCheckThread = Class(TPCThread)
+    FPCAbstractMem : TPCAbstractMem;
+    FErrorsCount : Integer;
+    FErrors : TStrings;
+    FMustRestart : Boolean;
+  protected
+    procedure BCExecute; override;
+  public
+    Constructor Create(APCAbstractMem : TPCAbstractMem);
+    Destructor Destroy;
+    procedure Restart;
+    property Errors : TStrings read FErrors;
+  End;
+
+  TAccountCache = Class(TAVLCache<TAccount>)
+  End;
+
+  TPCAbstractMem = class
+  private
+    FFileName : String;
+    FAbstractMem: TAbstractMem;
+    FCheckingThread : TPCAbstractMemCheckThread;
+    FLockAbstractMem : TPCCriticalSection;
+
+    FBlocks: TPCAbstractMemListBlocks;
+    FAccounts: TPCAbstractMemListAccounts;
+    FAccountsNames: TPCAbstractMemListAccountNames;
+    FAccountKeys: TPCAbstractMemAccountKeys;
+    FAccountCache : TAccountCache;
+    FBufferBlocksHash: TPCAbstractMemBytesBuffer32Safebox;
+    FAggregatedHashrate : TBigNum;
+    FZoneAggregatedHashrate : TAMZone;
+
+    function IsChecking : Boolean;
+    procedure DoCheck;
+
+
+    procedure AddBlockInfo(const ABlock : TOperationBlockExt);
+    procedure SetBlockInfo(const ABlock : TOperationBlockExt);
+    function DoInit(out AIsNewStructure : Boolean) : Boolean;
+  protected
+    procedure UpgradeAbstractMemVersion(const ACurrentHeaderVersion : Integer);
+  public
+    constructor Create(const ASafeboxFileName: string; AReadOnly: boolean);
+    class function AnalyzeFile(const ASafeboxFileName: string; var ABlocksCount : Integer) : Boolean;
+    destructor Destroy; override;
+
+    function BlocksCount: integer;
+    function GetBlockInfo(ABlockNumber: cardinal): TOperationBlockExt;
+
+    procedure AddBlockAccount(const ABlockAccount : TBlockAccount);
+    procedure SetBlockAccount(const ABlockAccount : TBlockAccount);
+    function GetBlockAccount(const ABlockNumber : Integer) : TBlockAccount;
+    procedure DeleteBlockAccount(const ABlockNumber : Integer);
+
+    function AccountsCount: integer;
+    function GetAccount(AAccountNumber: cardinal): TAccount;
+    procedure SetAccount(const AAccount : TAccount);
+
+    property AccountKeys : TPCAbstractMemAccountKeys read FAccountKeys;
+    property AccountsNames: TPCAbstractMemListAccountNames read FAccountsNames;
+
+    property AbstractMem: TAbstractMem read FAbstractMem;
+    procedure FlushCache;
+    procedure CopyFrom(ASource : TPCAbstractMem);
+    //
+    property BufferBlocksHash: TPCAbstractMemBytesBuffer32Safebox read FBufferBlocksHash;
+    property AggregatedHashrate : TBigNum read FAggregatedHashrate;
+
+    function CheckConsistency(AReport : TStrings) : Boolean;
+    procedure SaveToFile(const ASaveToFileName : String);
+    procedure UpdateSafeboxFileName(const ANewSafeboxFileName : String);
+    property AccountCache : TAccountCache read FAccountCache;
+    property FileName : String read FFileName;
+    procedure EraseData;
+  end;
+
+implementation
+
+uses UAccounts;
+
+const
+  CT_PCAbstractMem_FileVersion = CT_PROTOCOL_5;
+  CT_PCAbstractMem_HeaderVersion = 1;
+
+function _AccountCache_Comparision(const Left, Right: TAccountCache.PAVLCacheMemData): Integer;
+begin
+  // Compare only by data.account number (not for content)
+  Result := Left^.data.account - Right^.data.account;
+end;
+
+{ TPCAbstractMemBytesBuffer32Safebox }
+
+constructor TPCAbstractMemBytesBuffer32Safebox.Create(AAbstractMem : TAbstractMem; APosition : TAbstractMemPosition; ACurrBlocksCount : Integer);
+var LZone : TAMZone;
+  LBufferBlockHashData,
+  LCachedSafeboxHash : TBytes;
+begin
+  FCachedSafeboxHash := Nil;
+  inherited Create(1000*32);
+  FAbstractMem := AAbstractMem;
+  FSaveBufferPosition:=APosition;
+  if (APosition>0) then begin
+    LZone.Clear;
+    FAbstractMem.Read(FSaveBufferPosition,LZone.position,4);
+    if FAbstractMem.GetUsedZoneInfo(LZone.position,True,LZone) then begin
+      // LZone contains info
+      // 32 bytes for FSavedSafeboxHash (as a cache)
+      // 32*ACurrBlocksCount bytes for data
+      // Minimum Size >= ((ACurrBlocksCount+1)*32)
+      if (LZone.size>=((ACurrBlocksCount+1) * 32)) then begin
+        // Valid
+        System.SetLength(LCachedSafeboxHash,32);
+        if FAbstractMem.Read(LZone.position,LCachedSafeboxHash[0],32)<>32 then Raise EPCAbstractMem.Create('Error dev 20200522-1');
+        System.SetLength(LBufferBlockHashData,ACurrBlocksCount * 32);
+        if FAbstractMem.Read(LZone.position + 32,LBufferBlockHashData[0],System.Length(LBufferBlockHashData))<>System.Length(LBufferBlockHashData) then Raise EPCAbstractMem.Create('Error dev 20200522-2');
+        Self.Clear;
+        Self.Add(LBufferBlockHashData);
+        FCachedSafeboxHash := LCachedSafeboxHash; // Set cached info
+      end;
+    end;
+  end;
+  if (Self.Length<>(ACurrBlocksCount*32)) then Raise EPCAbstractMem.Create(Format('Error dev 20200403-4 %d <> %d (%d)',[Self.Length,ACurrBlocksCount*32,ACurrBlocksCount]));
+end;
+
+procedure TPCAbstractMemBytesBuffer32Safebox.Flush;
+var LZone : TAMZone;
+begin
+  if FCachedSafeboxHash=Nil then FCachedSafeboxHash := GetSafeBoxHash;
+  LZone.Clear;
+  FAbstractMem.Read(FSaveBufferPosition,LZone.position,4);
+  if FAbstractMem.GetUsedZoneInfo(LZone.position,True,LZone) then begin
+    if ((Self.Length + 32)<=LZone.size) then begin
+      // Use same:
+      FAbstractMem.Write(LZone.position, FCachedSafeboxHash[0], 32);
+      FAbstractMem.Write(LZone.position + 32,Self.Memory^,Self.Length);
+      Exit;
+    end else begin
+      // Not enough space...
+      FAbstractMem.Dispose(LZone);
+    end;
+  end;
+  if (Self.Length>0) then begin
+    LZone := FAbstractMem.New(((Self.Length + 32) * 3) DIV 2);
+    FAbstractMem.Write(FSaveBufferPosition,LZone.position,4);
+    FAbstractMem.Write(LZone.position, FCachedSafeboxHash[0], 32);
+    FAbstractMem.Write(LZone.position + 32,Self.Memory^,Self.Length);
+  end;
+end;
+
+{ TPCAbstractMemListAccounts }
+
+procedure TPCAbstractMemListAccounts.LoadFrom(const ABytes: TBytes; var AItem: TAccount);
+var
+  LPointer: TAbstractMemPosition;
+  LStream : TStream;
+  w : Word;
+begin
+  AItem.Clear;
+  LStream := TMemoryStream.Create;
+  Try
+    LPointer := 0;
+    LStream.Write(ABytes[0],Length(ABytes));
+    LStream.Position := 0;
+
+    LStream.Read( AItem.account , 4 );
+
+    LStream.Read( w,2 );
+    if (w<>CT_PROTOCOL_5) then raise EPCAbstractMem.Create(Format('Invalid Account %d protocol %d',[AItem.account,w]));
+
+    LStream.Read( w, 2 );
+    case w of
+      CT_NID_secp256k1,CT_NID_secp384r1,CT_NID_sect283k1,CT_NID_secp521r1 : Begin
+        AItem.accountInfo.state := as_Normal;
+        LStream.Read(LPointer,4);
+        AItem.accountInfo.accountKey := FPCAbstractMem.FAccountKeys.GetKeyAtPosition( LPointer );
+        if w<>AItem.accountInfo.accountKey.EC_OpenSSL_NID then raise EPCAbstractMem.Create('INCONSISTENT 20200318-2');
+      End;
+      CT_AccountInfo_ForSale, CT_AccountInfo_ForAccountSwap, CT_AccountInfo_ForCoinSwap : Begin
+        case w of
+          CT_AccountInfo_ForSale : AItem.accountInfo.state := as_ForSale;
+          CT_AccountInfo_ForAccountSwap : AItem.accountInfo.state := as_ForAtomicAccountSwap;
+          CT_AccountInfo_ForCoinSwap : AItem.accountInfo.state := as_ForAtomicCoinSwap;
+        end;
+        LStream.Read(LPointer,4);
+        AItem.accountInfo.accountKey := FPCAbstractMem.FAccountKeys.GetKeyAtPosition( LPointer );
+
+        LStream.Read(AItem.accountInfo.locked_until_block,4);
+        LStream.Read(AItem.accountInfo.price,8);
+        LStream.Read(AItem.accountInfo.account_to_pay,4);
+        LStream.Read(LPointer,4);
+        AItem.accountInfo.new_publicKey := FPCAbstractMem.FAccountKeys.GetKeyAtPosition( LPointer );
+        if (w<>CT_AccountInfo_ForSale) then begin
+          AItem.accountInfo.hashed_secret.FromSerialized(LStream);
+        end;
+
+      End;
+      else raise EPCAbstractMem.Create(Format('Unknow accountInfo type %d for account %d',[w,Aitem.account]));
+    end;
+    //
+    LStream.Read( AItem.balance , 8);
+    LStream.Read( AItem.updated_on_block_passive_mode , 4);
+    LStream.Read( AItem.updated_on_block_active_mode , 4);
+    LStream.Read( AItem.n_operation , 4);
+    AItem.name.FromSerialized( LStream );
+    LStream.Read( AItem.account_type ,2);
+    AItem.account_data.FromSerialized( LStream );
+    if AItem.account_seal.FromSerialized( LStream )<0 then raise EPCAbstractMem.Create('INCONSISTENT 20200318-4');
+    // Force account_seal to 20 bytes
+    if Length(AItem.account_seal)<>20 then begin
+      AItem.account_seal := TBaseType.T20BytesToRawBytes( TBaseType.To20Bytes(AItem.account_seal) );
+    end;
+  Finally
+    LStream.Free;
+  End;
+end;
+
+procedure TPCAbstractMemListAccounts.SaveTo(const AItem: TAccount; AIsAddingItem : Boolean; var ABytes: TBytes);
+var LStream : TStream;
+  LPointer : TAbstractMemPosition;
+  w : Word;
+  LPrevious : TAccount;
+begin
+  if (Length(ABytes)>0) and (Not AIsAddingItem) then begin
+    // Capture previous values
+    LoadFrom(ABytes,LPrevious);
+    if (LPrevious.account<>AItem.account) then raise EPCAbstractMem.Create(Format('INCONSISTENT account number %d<>%d',[AItem.account,LPrevious.account]));
+
+    if Not LPrevious.accountInfo.accountKey.IsEqualTo( AItem.accountInfo.accountKey ) then begin
+      // Remove previous account link
+      FPCAbstractMem.FAccountKeys.GetPositionOfKeyAndRemoveAccount( LPrevious.accountInfo.accountKey, LPrevious.account );
+    end;
+  end;
+
+  LStream := TMemoryStream.Create;
+  try
+    LStream.Position := 0;
+
+
+    LStream.Write( AItem.account , 4 );
+
+    w := CT_PROTOCOL_5;
+    LStream.Write( w, 2 );
+
+    w := 0;
+    case AItem.accountInfo.state of
+      as_Normal : begin
+        LPointer := FPCAbstractMem.FAccountKeys.GetPositionOfKeyAndAddAccount(AItem.accountInfo.accountKey,AItem.account);
+        LStream.Write( AItem.accountInfo.accountKey.EC_OpenSSL_NID , 2 );
+        LStream.Write( LPointer, 4);
+      end;
+      as_ForSale : w := CT_AccountInfo_ForSale;
+      as_ForAtomicAccountSwap : w := CT_AccountInfo_ForAccountSwap;
+      as_ForAtomicCoinSwap :  w := CT_AccountInfo_ForCoinSwap;
+    end;
+    if (w>0) then begin
+      LStream.Write(w,2);
+
+      LPointer := FPCAbstractMem.FAccountKeys.GetPositionOfKeyAndAddAccount(AItem.accountInfo.accountKey,AItem.account);
+      LStream.Write( LPointer, 4);
+
+      LStream.Write(AItem.accountInfo.locked_until_block,4);
+      LStream.Write(AItem.accountInfo.price,8);
+      LStream.Write(AItem.accountInfo.account_to_pay,4);
+      LPointer := FPCAbstractMem.FAccountKeys.GetPositionOfKey(AItem.accountInfo.new_publicKey,True);
+      LStream.Write(LPointer,4);
+      if (w<>CT_AccountInfo_ForSale) then begin
+        AItem.accountInfo.hashed_secret.ToSerialized(LStream);
+      end;
+    end;
+    //
+    LStream.Write( AItem.balance , 8);
+    LStream.Write( AItem.updated_on_block_passive_mode , 4);
+    LStream.Write( AItem.updated_on_block_active_mode , 4);
+    LStream.Write( AItem.n_operation , 4);
+
+    AItem.name.ToSerialized( LStream );
+
+    LStream.Write( AItem.account_type ,2);
+    AItem.account_data.ToSerialized( LStream );
+    AItem.account_seal.ToSerialized( LStream );
+    //
+    ABytes.FromStream( LStream );
+
+  finally
+    LStream.Free;
+  end;
+end;
+
+{ TPCAbstractMem }
+
+function TPCAbstractMem.CheckConsistency(AReport: TStrings) : Boolean;
+begin
+  AReport.Clear;
+  FLockAbstractMem.Acquire;
+  Try
+    if Assigned(FCheckingThread) then begin
+      FCheckingThread.Terminate;
+      FCheckingThread.WaitFor;
+      FreeAndNil(FCheckingThread);
+    end;
+
+    if Not Assigned(FCheckingThread) then begin
+      FCheckingThread := TPCAbstractMemCheckThread.Create(Self);
+    end;
+    while Not FCheckingThread.Terminated do Sleep(1);
+    AReport.Assign( FCheckingThread.Errors );
+
+    FCheckingThread.Terminate;
+    FCheckingThread.WaitFor;
+    FreeAndNil(FCheckingThread);
+  Finally
+    FLockAbstractMem.Release;
+  End;
+  Result := AReport.Count=0;
+end;
+
+procedure TPCAbstractMem.CopyFrom(ASource: TPCAbstractMem);
+var LIsNew : Boolean;
+begin
+  ASource.FlushCache;
+  FAbstractMem.CopyFrom(ASource.FAbstractMem);
+  DoInit(LIsNew);
+end;
+
+function TPCAbstractMem.DoInit(out AIsNewStructure : Boolean) : Boolean;
+const
+  CT_HEADER_MIN_SIZE = 100;
+  CT_HEADER_STRING = 'TPCAbstractMem'; // Do not localize/modify. Fixed 14 bytes!
+  {
+  Header: 0..99 = 100 Bytes (CT_HEADER_MIN_SIZE)
+  [ 0..13] 14 bytes: Literal "TPCAbstractMem"
+  [14..15] 2 bytes: Protocol version
+  [16..19] 4 bytes: LZoneBlocks.position
+  [20..23] 4 bytes: LZoneAccounts.position
+  [24..27] 4 bytes: LZoneAccountsNames.position
+  [28..31] 4 bytes: LZoneAccountKeys.position
+  [32..35] 4 bytes: FZoneAggregatedHashrate.position
+  [36..39] 4 bytes: LZoneBuffersBlockHash
+  ...
+  [96..99] 4 bytes: Header version
+  }
+var LZone,
+  LZoneBlocks,
+  LZoneAccounts,
+  LZoneAccountsNames,
+  LZoneAccountKeys : TAMZone;
+  LZoneBuffersBlockHash : TAbstractMemPosition;
+  LHeader, LBuffer, LBigNum : TBytes;
+  LIsGood : Boolean;
+  w : Word;
+  i : Integer;
+  LHeaderVersion : UInt32;
+begin
+  // Free
+  FreeAndNil(FBlocks);
+  FreeAndNil(FAccounts);
+  FreeAndNil(FAccountsNames);
+  FreeAndNil(FAccountKeys);
+  FreeAndNil(FBufferBlocksHash);
+  //
+  Result := False;
+  AIsNewStructure := True;
+  LZone.Clear;
+  LZoneBlocks.Clear;
+  LZoneAccounts.Clear;
+  LZoneAccountsNames.Clear;
+  LZoneAccountKeys.Clear;
+  FZoneAggregatedHashrate.Clear;
+  LZoneBuffersBlockHash := 0;
+
+  if (FAbstractMem.ReadFirstData(LZone,LHeader)) then begin
+    // Check if header is valid:
+    if Length(LHeader)>=CT_HEADER_MIN_SIZE then begin
+      LIsGood := True;
+      i := 0;
+      while (LIsGood) and (i<CT_HEADER_STRING.Length) do begin
+        LIsGood := ord(CT_HEADER_STRING.Chars[i])=LHeader[i];
+        inc(i);
+      end;
+      if i<>14 then LIsGood := False;
+      if LIsGood then begin
+        Move(LHeader[14], w, 2);
+        LIsGood := (w = CT_PCAbstractMem_FileVersion);
+      end;
+      if LIsGood then begin
+        Move(LHeader[16], LZoneBlocks.position, 4);
+        Move(LHeader[20], LZoneAccounts.position, 4);
+        Move(LHeader[24], LZoneAccountsNames.position, 4);
+        Move(LHeader[28], LZoneAccountKeys.position, 4);
+        Move(LHeader[32], FZoneAggregatedHashrate.position, 4);
+        LZoneBuffersBlockHash := LZone.position + 36;
+        Move(LHeader[96], LHeaderVersion, 4);
+        if (LHeaderVersion>CT_PCAbstractMem_HeaderVersion) then begin
+          TLog.NewLog(lterror,ClassName,Format('Header version readed %d is greater than expected %d',[LHeaderVersion,CT_PCAbstractMem_HeaderVersion]));
+        end else begin
+          AIsNewStructure := False;
+        end;
+      end;
+    end;
+  end;
+  if (Not FAbstractMem.ReadOnly) and (AIsNewStructure) then begin
+    // Initialize struct
+    FAbstractMem.ClearContent;
+    LZone := FAbstractMem.New( CT_HEADER_MIN_SIZE );  // Header zone
+    SetLength(LHeader,100);
+    FillChar(LHeader[0],Length(LHeader),0);
+    //
+    LBuffer.FromString(CT_HEADER_STRING);
+    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 );
+    LZoneAccountKeys := FAbstractMem.New( 100 );
+    FZoneAggregatedHashrate := FAbstractMem.New(100); // Note: Enough big to store a BigNum
+    LZoneBuffersBlockHash := LZone.position+36;
+
+    Move(LZoneBlocks.position,       LHeader[16],4);
+    Move(LZoneAccounts.position,     LHeader[20],4);
+    Move(LZoneAccountsNames.position,LHeader[24],4);
+    Move(LZoneAccountKeys.position,  LHeader[28],4);
+    Move(FZoneAggregatedHashrate.position,LHeader[32],4);
+    LHeaderVersion := CT_PCAbstractMem_HeaderVersion;
+    Move(LHeaderVersion,             LHeader[96],4);
+
+    FAbstractMem.Write(LZone.position,LHeader[0],Length(LHeader));
+
+  end;
+  // Free
+  FreeAndNil(FBlocks);
+  //
+  FBlocks := TPCAbstractMemListBlocks.Create( FAbstractMem, LZoneBlocks, 10000 );
+  FBlocks.FPCAbstractMem := Self;
+  FAccounts := TPCAbstractMemListAccounts.Create( FAbstractMem, LZoneAccounts, 50000);
+  FAccounts.FPCAbstractMem := Self;
+  FAccountsNames := TPCAbstractMemListAccountNames.Create( FAbstractMem, LZoneAccountsNames, 5000 , False);
+  FAccountsNames.FPCAbstractMem := Self;
+  FAccountKeys := TPCAbstractMemAccountKeys.Create( FAbstractMem, LZoneAccountKeys.position );
+  // Read AggregatedHashrate
+  SetLength(LBuffer,100);
+  FAbstractMem.Read(FZoneAggregatedHashrate.position,LBuffer[0],Length(LBuffer));
+  if LBigNum.FromSerialized(LBuffer) then begin
+    FAggregatedHashrate.RawValue := LBigNum;
+  end;
+  FBufferBlocksHash := TPCAbstractMemBytesBuffer32Safebox.Create(FAbstractMem,LZoneBuffersBlockHash,FBlocks.Count);
+
+  FAccountCache.Clear;
+
+  if (Not AIsNewStructure) And (Not FAbstractMem.ReadOnly) And (LHeaderVersion<CT_PCAbstractMem_HeaderVersion) then begin
+    UpgradeAbstractMemVersion( LHeaderVersion );
+    // Set for future
+    LHeaderVersion := CT_PCAbstractMem_HeaderVersion;
+    Move(LHeaderVersion,             LHeader[96],4);
+    FAbstractMem.Write(LZone.position,LHeader[0],Length(LHeader));
+  end;
+
+end;
+
+procedure TPCAbstractMem.EraseData;
+var
+  LIsNewStructure : Boolean;
+begin
+  FlushCache;
+  FAbstractMem.ClearContent;
+  DoInit(LIsNewStructure);
+end;
+
+constructor TPCAbstractMem.Create(const ASafeboxFileName: string; AReadOnly: boolean);
+var
+  LIsNewStructure : Boolean;
+begin
+  FCheckingThread := Nil;
+  FLockAbstractMem := TPCCriticalSection.Create(Self.ClassName);
+  FAccountCache := TAccountCache.Create(10000,_AccountCache_Comparision);
+
+  FAggregatedHashrate := TBigNum.Create(0);
+  FFileName := ASafeboxFileName;
+  if (FFileName<>'') {and (FileExists(ASafeboxFileName))} then begin
+    FAbstractMem := TFileMem.Create( ASafeboxFileName , AReadOnly);
+  end else begin
+    FAbstractMem := TMem.Create(0,AReadOnly);
+  end;
+  if FAbstractMem is TFileMem then begin
+    TFileMem(FAbstractMem).MaxCacheSize := 40 * 1024 * 1024; // 40Mb
+    TFileMem(FAbstractMem).MaxCacheDataBlocks := 200000;
+  end;
+
+  DoInit(LIsNewStructure);
+  //
+  if (Not AReadOnly) and (((BlocksCount>0) And (ASafeboxFileName<>'')) Or (Not LIsNewStructure)) then begin
+    TLog.NewLog(ltdebug,ClassName,Format('Opened PascalCoin AbstractMem File with %d blocks %d accounts %s aggregated hashrate and buffer %d size (%d blocks) at file: %s',
+      [BlocksCount,AccountsCount,FAggregatedHashrate.ToDecimal,FBufferBlocksHash.Length,FBufferBlocksHash.Length DIV 32,ASafeboxFileName]));
+  end;
+end;
+
+destructor TPCAbstractMem.Destroy;
+var LFile : TFileStream;
+begin
+  FLockAbstractMem.Acquire;
+  try
+    if Assigned(FCheckingThread) then begin
+      FCheckingThread.Terminate;
+    end;
+  finally
+    FLockAbstractMem.Release;
+  end;
+
+  FlushCache;
+  FreeAndNil(FAccountCache);
+  FreeAndNil(FBlocks);
+  FreeAndNil(FAccounts);
+  FreeAndNil(FAccountsNames);
+  FreeAndNil(FAccountKeys);
+  FreeAndNil(FBufferBlocksHash);
+  FreeAndNil(FAggregatedHashrate);
+  if (FFileName<>'') And (FAbstractMem is TMem) And (Not FAbstractMem.ReadOnly) then begin
+    LFile := TFileStream.Create(FFileName,fmCreate);
+    try
+      LFile.Size := 0;
+      LFile.Position := 0;
+      FAbstractMem.SaveToStream(LFile);
+    finally
+      LFile.Free;
+    end;
+  end;
+  FreeAndNil(FAbstractMem);
+
+
+  FreeAndNil(FLockAbstractMem);
+
+  inherited Destroy;
+end;
+
+procedure TPCAbstractMem.DoCheck;
+begin
+  if IsChecking then Exit;
+  FLockAbstractMem.Acquire;
+  Try
+    if Not Assigned(FCheckingThread) then begin
+      FCheckingThread := TPCAbstractMemCheckThread.Create(Self);
+    end;
+  Finally
+    FLockAbstractMem.Release;
+  End;
+end;
+
+procedure TPCAbstractMem.FlushCache;
+var LBigNum : TBytes;
+begin
+  if FAbstractMem.ReadOnly then Exit;
+  FBlocks.FlushCache;
+  FAccounts.FlushCache;
+  FAccountsNames.FlushCache;
+  FAccountKeys.FlushCache;
+  FBufferBlocksHash.Flush;
+  LBigNum := FAggregatedHashrate.RawValue.ToSerialized;
+  FAbstractMem.Write( FZoneAggregatedHashrate.position, LBigNum[0], Length(LBigNum) );
+  if FAbstractMem is TFileMem then begin
+    TFileMem(FAbstractMem).FlushCache;
+  end;
+end;
+
+Procedure DoCopyFile(const ASource, ADest : String);
+var LSourceFS, LDestFS : TFileStream;
+Begin
+  if Not FileExists(ASource) then Raise Exception.Create('Source file not found: '+ASource);
+  LSourceFS := TFileStream.Create(ASource,fmOpenRead+fmShareDenyNone);
+  try
+    LSourceFS.Position:=0;
+    LDestFS := TFileStream.Create(ADest,fmCreate+fmShareDenyWrite);
+    try
+      LDestFS.Size:=0;
+      LDestFS.CopyFrom(LSourceFS,LSourceFS.Size);
+    finally
+      LDestFS.Free;
+    end;
+  finally
+    LSourceFS.Free;
+  end;
+end;
+
+
+procedure TPCAbstractMem.SaveToFile(const ASaveToFileName: String);
+var LFile : TFileStream;
+begin
+  FlushCache;
+  //
+  ForceDirectories(ExtractFileDir(ASaveToFileName));
+  if FileExists(ASaveToFileName) then DeleteFile(ASaveToFileName);
+  //
+  if (FAbstractMem is TFileMem) then begin
+    DoCopyFile(TFileMem(FAbstractMem).FileName,ASaveToFileName);
+  end else begin
+    LFile := TFileStream.Create(ASaveToFileName,fmCreate);
+    try
+      LFile.Size := 0;
+      LFile.Position := 0;
+      FAbstractMem.SaveToStream(LFile);
+    finally
+      LFile.Free;
+    end;
+  end;
+end;
+
+procedure TPCAbstractMem.SetAccount(const AAccount: TAccount);
+begin
+  if (AAccount.account<0) or (AAccount.account>FAccounts.Count) then begin
+    raise EPCAbstractMem.Create(Format('Account %d not in range %d..%d',[AAccount.account,0,FAccounts.Count]));
+  end;
+  FAccountCache.Remove(AAccount);
+  if (AAccount.account = FAccounts.Count) then begin
+    FAccounts.Add(AAccount);
+  end else begin
+    FAccounts.SetItem( AAccount.account , AAccount);
+  end;
+  // Update cache
+  FAccountCache.Add(AAccount);
+end;
+
+procedure TPCAbstractMem.AddBlockAccount(const ABlockAccount: TBlockAccount);
+var i : Integer;
+  LOpBlockExt :  TOperationBlockExt;
+begin
+  LOpBlockExt.operationBlock := ABlockAccount.blockchainInfo;
+  LOpBlockExt.accumulatedWork := ABlockAccount.accumulatedWork;
+  AddBlockInfo(LOpBlockExt);
+  for i := Low(ABlockAccount.accounts) to High(ABlockAccount.accounts) do begin
+    SetAccount( ABlockAccount.accounts[i] );
+  end;
+  FBufferBlocksHash.Replace(ABlockAccount.blockchainInfo.block * 32, ABlockAccount.block_hash);
+end;
+
+procedure TPCAbstractMem.SetBlockAccount(const ABlockAccount: TBlockAccount);
+var i : Integer;
+  LOpBlockExt, LSavedOpBlockExt :  TOperationBlockExt;
+  LSavedAccount : TAccount;
+begin
+  if ABlockAccount.blockchainInfo.block=BlocksCount then AddBlockAccount(ABlockAccount)
+  else if ABlockAccount.blockchainInfo.block<BlocksCount then begin
+    LOpBlockExt.operationBlock := ABlockAccount.blockchainInfo;
+    LOpBlockExt.accumulatedWork := ABlockAccount.accumulatedWork;
+    LSavedOpBlockExt := GetBlockInfo( ABlockAccount.blockchainInfo.block );
+    if (Not TAccountComp.EqualOperationBlocks( LOpBlockExt.operationBlock, LSavedOpBlockExt.operationBlock ))
+       or (LOpBlockExt.accumulatedWork <> LSavedOpBlockExt.accumulatedWork) then begin
+      SetBlockInfo(LOpBlockExt);
+    end;
+    for i := Low(ABlockAccount.accounts) to High(ABlockAccount.accounts) do begin
+      if TAccountComp.AccountBlock(ABlockAccount.accounts[i].account)<>ABlockAccount.blockchainInfo.block then
+        raise EPCAbstractMem.Create(Format('Account %d is not valid for block %d',[ABlockAccount.accounts[i].account,ABlockAccount.blockchainInfo.block]));
+      LSavedAccount := GetAccount(ABlockAccount.accounts[i].account);
+      if Not TAccountComp.EqualAccounts(LSavedAccount, ABlockAccount.accounts[i]) then begin
+        SetAccount( ABlockAccount.accounts[i] );
+      end;
+    end;
+    FBufferBlocksHash.Replace(ABlockAccount.blockchainInfo.block * 32, ABlockAccount.block_hash);
+  end else raise EPCAbstractMem.Create(Format('Cannot add Block %d on %d count list',[ABlockAccount.blockchainInfo.block,BlocksCount]));
+end;
+
+procedure TPCAbstractMem.AddBlockInfo(const ABlock : TOperationBlockExt);
+begin
+  if (ABlock.operationBlock.block<>FBlocks.Count) then raise EPCAbstractMem.Create(Format('Cannot add blockInfo %d at pos %d',[ABlock.operationBlock.block,FBlocks.Count]));
+  SetBlockInfo(ABlock);
+end;
+
+class function TPCAbstractMem.AnalyzeFile(const ASafeboxFileName: string; var ABlocksCount: Integer): Boolean;
+var LPCAbstractMem : TPCAbstractMem;
+begin
+  ABlocksCount := 0;
+  Result := False;
+  if Not FileExists(ASafeboxFileName) then Exit(False);
+  LPCAbstractMem := TPCAbstractMem.Create(ASafeboxFileName,True);
+  try
+    ABlocksCount := LPCAbstractMem.BlocksCount;
+    Result := (ABlocksCount>0) And (LPCAbstractMem.AccountsCount = ABlocksCount * CT_AccountsPerBlock);
+  finally
+    LPCAbstractMem.Free;
+  end;
+end;
+
+procedure TPCAbstractMem.SetBlockInfo(const ABlock: TOperationBlockExt);
+var LCount : Integer;
+begin
+  LCount := FBlocks.Count;
+  if ABlock.operationBlock.block<LCount then begin
+    FBlocks.Item[ABlock.operationBlock.block] := ABlock;
+  end else if ABlock.operationBlock.block=LCount then begin
+    FBlocks.Add( ABlock );
+  end else raise EPCAbstractMem.Create(Format('Cannot set block info %d (current %d blocks)',[ABlock.operationBlock.block,LCount]));
+end;
+
+procedure TPCAbstractMem.UpdateSafeboxFileName(const ANewSafeboxFileName: String);
+var LReadOnly, Ltmp : Boolean;
+begin
+  if SameFileName(FFileName,ANewSafeboxFileName) then Exit;
+
+  if ANewSafeboxFileName<>'' then
+    SaveToFile(ANewSafeboxFileName);
+
+  FFileName := ANewSafeboxFileName;
+  LReadOnly := FAbstractMem.ReadOnly;
+  FreeAndNil(FAbstractMem);
+
+  if (FFileName<>'') then begin
+    FAbstractMem := TFileMem.Create( FFileName , LReadOnly)
+  end else begin
+    FAbstractMem := TMem.Create(0,LReadOnly);
+  end;
+  if FAbstractMem is TFileMem then begin
+    TFileMem(FAbstractMem).MaxCacheSize := 40 * 1024 * 1024; // 40Mb
+    TFileMem(FAbstractMem).MaxCacheDataBlocks := 200000;
+  end;
+  DoInit(Ltmp);
+end;
+
+procedure TPCAbstractMem.UpgradeAbstractMemVersion(const ACurrentHeaderVersion: Integer);
+var LFirstTC, LTC : TTickCount;
+  i : integer;
+  LAccount : TAccount;
+begin
+  LFirstTC := TPlatform.GetTickCount;
+  LTC := LFirstTC;
+  if (ACurrentHeaderVersion=0) then begin
+    // Redo AccountNames
+    TLog.NewLog(ltinfo,ClassName,Format('Upgrade AbstractMem file from %d to %d with %d Accounts and %d AccNames',[ACurrentHeaderVersion,CT_PCAbstractMem_HeaderVersion, AccountsCount, AccountsNames.Count]));
+    AccountsNames.Clear;
+    for i := 0 to AccountsCount-1 do begin
+      LAccount := GetAccount(i);
+      if Length(LAccount.name)>0 then begin
+        AccountsNames.Add( LAccount.name.ToString, LAccount.account );
+      end;
+      if TPlatform.GetElapsedMilliseconds(LTC)>5000 then begin
+        LTC := TPlatform.GetTickCount;
+        TLog.NewLog(ltdebug,ClassName,Format('Upgrading %d/%d found %d',[i,AccountsCount,AccountsNames.Count]));
+      end;
+    end;
+    TLog.NewLog(ltdebug,ClassName,Format('End upgrade found %d',[AccountsNames.Count]));
+  end;
+  TLog.NewLog(ltinfo,ClassName,Format('Finalized upgrade AbstractMem file from %d to %d in %.2f seconds',[ACurrentHeaderVersion,CT_PCAbstractMem_HeaderVersion, TPlatform.GetElapsedMilliseconds(LFirstTC)/1000]));
+end;
+
+function TPCAbstractMem.BlocksCount: integer;
+begin
+  Result := FBlocks.Count;
+end;
+
+function TPCAbstractMem.GetBlockAccount(const ABlockNumber: Integer): TBlockAccount;
+var i : Integer;
+ LBlock : TOperationBlockExt;
+begin
+  Result := CT_BlockAccount_NUL;
+  LBlock := GetBlockInfo(ABlockNumber);
+  Result.blockchainInfo := LBlock.operationBlock;
+  Result.accumulatedWork := LBlock.accumulatedWork;
+
+  Result.block_hash := FBufferBlocksHash.Capture( ABlockNumber * 32, 32);
+
+  for i := Low(Result.accounts) to High(Result.accounts) do begin
+    Result.accounts[i] := GetAccount( i + (ABlockNumber * CT_AccountsPerBlock) );
+  end;
+end;
+
+procedure TPCAbstractMem.DeleteBlockAccount(const ABlockNumber: Integer);
+var i : Integer;
+  LBlAcc :  TBlockAccount;
+  LExtract : TBytes;
+begin
+  LBlAcc := GetBlockAccount(ABlockNumber);
+  FBlocks.Delete(ABlockNumber);
+  for i := High(LBlAcc.accounts) downto Low(LBlAcc.accounts) do begin
+    FAccounts.Delete(LBlAcc.accounts[i].account );
+  end;
+  LExtract := FBufferBlocksHash.Capture((ABlockNumber+1)*32,32);
+  FBufferBlocksHash.Replace(ABlockNumber*32,LExtract);
+  FBufferBlocksHash.SetLength(BufferBlocksHash.Length - 32);
+end;
+
+function TPCAbstractMem.GetBlockInfo(ABlockNumber: cardinal): TOperationBlockExt;
+begin
+  Result := FBlocks.GetItem( ABlockNumber );
+end;
+
+function TPCAbstractMem.IsChecking: Boolean;
+begin
+  Result := Assigned(TPCThread.GetThreadByClass(TPCAbstractMemCheckThread,Nil));
+  FLockAbstractMem.Acquire;
+  Try
+    Result := Assigned(FCheckingThread);
+  Finally
+    FLockAbstractMem.Release;
+  End;
+end;
+
+function TPCAbstractMem.AccountsCount: integer;
+begin
+  Result := FAccounts.Count;
+end;
+
+function TPCAbstractMem.GetAccount(AAccountNumber: cardinal): TAccount;
+begin
+  Result.Clear;
+  Result.account := AAccountNumber;
+  if Not FAccountCache.Find(Result,Result) then begin
+    Result := FAccounts.GetItem( AAccountNumber );
+    // Save for future usage:
+    FAccountCache.Add(Result);
+  end;
+end;
+
+{ TPCAbstractMemListAccountNames }
+
+function TPCAbstractMemListAccountNames.ToString(const AItem: TAccountNameInfo): string;
+begin
+  Result:= Format('AccountNameInfo: Account:%d Name(%d):%d',[AItem.accountNumber, Length(AItem.accountName), AItem.accountName]);
+end;
+
+function TPCAbstractMemListAccountNames.IndexOf(const AName: String): Integer;
+var LFind : TAccountNameInfo;
+begin
+  LFind.accountName := AName;
+  LFind.accountNumber := 0;
+  if Not Find(LFind,Result) then Result := -1;
+end;
+
+procedure TPCAbstractMemListAccountNames.LoadFrom(const ABytes: TBytes; var AItem: TAccountNameInfo);
+var LTmp : TBytes;
+begin
+  if Not LTmp.FromSerialized(ABytes) then raise EPCAbstractMem.Create('INCONSISTENT 20200318-5');
+  AItem.accountName := LTmp.ToString;
+  Move(ABytes[LTmp.GetSerializedLength],AItem.accountNumber,4);
+end;
+
+procedure TPCAbstractMemListAccountNames.Remove(const AName: String);
+var i : Integer;
+begin
+  i := IndexOf(AName);
+  if i>=0 then Delete(i);
+end;
+
+procedure TPCAbstractMemListAccountNames.SaveTo(const AItem: TAccountNameInfo; AIsAddingItem : Boolean; var ABytes: TBytes);
+var LStream : TStream;
+  LTmp : TBytes;
+begin
+  LStream := TMemoryStream.Create;
+  Try
+    LTmp.FromString(AItem.accountName);
+    LTmp.ToSerialized(LStream);
+    LStream.Write(AItem.accountNumber,4);
+    //
+    ABytes.FromStream(LStream);
+  Finally
+    LStream.Free;
+  End;
+end;
+
+procedure TPCAbstractMemListAccountNames.Add(const AName: String; AAccountNumber: Cardinal);
+var LItem : TAccountNameInfo;
+  i : Integer;
+begin
+  LItem.accountName := AName;
+  LItem.accountNumber := AAccountNumber;
+  i := inherited Add(LItem);
+  if (i<0) then begin
+    i := IndexOf(AName);
+    if (i<0) then
+      raise EPCAbstractMem.Create(Format('Fatal error Cannot add account(%d) name %s',[AAccountNumber,AName]))
+    else raise EPCAbstractMem.Create(Format('Cannot add account(%d) name %s because used by %d with %s',[AAccountNumber,AName,
+      GetItem(i).accountNumber,GetItem(i).accountName]));
+  end;
+end;
+
+function TPCAbstractMemListAccountNames.Compare(const ALeft, ARight: TAccountNameInfo): integer;
+Var LBytesLeft,LBytesRight : TBytes;
+begin
+  LBytesLeft.FromString(ALeft.accountName);
+  LBytesRight.FromString(ARight.accountName);
+  Result := TBaseType.BinStrComp(LBytesLeft,LBytesRight);
+end;
+
+function TPCAbstractMemListAccountNames.FindByName(const AName: String; out AIndex: Integer): Boolean;
+var LFind : TAccountNameInfo;
+begin
+  LFind.accountName := AName;
+  LFind.accountNumber := 0;
+  Result := Find(LFind,AIndex);
+end;
+
+{ TPCAbstractMemListBlocks }
+
+procedure TPCAbstractMemListBlocks.LoadFrom(const ABytes: TBytes; var AItem: TOperationBlockExt);
+var
+  LPointer: TAbstractMemPosition;
+  LIndex: integer;
+begin
+  AItem.accumulatedWork := 0;
+  Move(ABytes[0], AItem.operationBlock.block, 4);
+  Move(ABytes[4], LPointer, 4);
+  // Load account_key
+  AItem.operationBlock.account_key := FPCAbstractMem.FAccountKeys.GetKeyAtPosition(LPointer);
+
+  Move(ABytes[8], AItem.operationBlock.reward, 8);
+  Move(ABytes[16], AItem.operationBlock.fee, 8);
+  Move(ABytes[24], AItem.operationBlock.protocol_version, 2);
+  Move(ABytes[26], AItem.operationBlock.protocol_available, 2);
+  Move(ABytes[28], AItem.operationBlock.timestamp, 4);
+  Move(ABytes[32], AItem.operationBlock.compact_target, 4);
+  Move(ABytes[36], AItem.operationBlock.nonce, 4);
+  Move(ABytes[40], AItem.accumulatedWork, 8);
+
+  LIndex := 48;
+  if not AItem.operationBlock.block_payload.LoadFromTBytes(ABytes, LIndex) then
+    raise EPCAbstractMem.Create(Format('LoadFrom Invalid 20200317-2 %d', [LIndex]));
+  if not AItem.operationBlock.initial_safe_box_hash.LoadFromTBytes(ABytes, LIndex) then
+    raise EPCAbstractMem.Create(Format('LoadFrom Invalid 20200317-3 %d', [LIndex]));
+  if not AItem.operationBlock.operations_hash.LoadFromTBytes(ABytes, LIndex) then
+    raise EPCAbstractMem.Create(Format('LoadFrom Invalid 20200317-4 %d', [LIndex]));
+  if not AItem.operationBlock.proof_of_work.LoadFromTBytes(ABytes, LIndex) then
+    raise EPCAbstractMem.Create(Format('LoadFrom Invalid 20200317-5 %d', [LIndex]));
+  if not AItem.operationBlock.previous_proof_of_work.LoadFromTBytes(ABytes, LIndex) then
+    raise EPCAbstractMem.Create(Format('LoadFrom Invalid 20200317-6 %d', [LIndex]));
+end;
+
+procedure TPCAbstractMemListBlocks.SaveTo(const AItem: TOperationBlockExt; AIsAddingItem : Boolean; var ABytes: TBytes);
+var
+  LPointer: TAbstractMemPosition;
+  LStream : TStream;
+begin
+  LStream := TMemoryStream.Create;
+  Try
+    LStream.Write(AItem.operationBlock.block, 4);
+    // Pointer
+    LPointer := FPCAbstractMem.FAccountKeys.GetPositionOfKey(AItem.operationBlock.account_key,True);
+    LStream.Write(LPointer, 4);
+    LStream.Write(AItem.operationBlock.reward, 8);
+    LStream.Write(AItem.operationBlock.fee, 8);
+    LStream.Write(AItem.operationBlock.protocol_version, 2);
+    LStream.Write(AItem.operationBlock.protocol_available, 2);
+    LStream.Write(AItem.operationBlock.timestamp, 4);
+    LStream.Write(AItem.operationBlock.compact_target, 4);
+    LStream.Write(AItem.operationBlock.nonce, 4);
+    LStream.Write(AItem.accumulatedWork, 8);
+    AItem.operationBlock.block_payload.ToSerialized(LStream);
+    AItem.operationBlock.initial_safe_box_hash.ToSerialized(LStream);
+    AItem.operationBlock.operations_hash.ToSerialized(LStream);
+    AItem.operationBlock.proof_of_work.ToSerialized(LStream);
+    AItem.operationBlock.previous_proof_of_work.ToSerialized(LStream);
+    ABytes.FromStream(LStream);
+  Finally
+    LStream.Free;
+  End;
+end;
+
+function TPCAbstractMemListBlocks.ToString(const AItem: TOperationBlockExt): string;
+begin
+  Result := Format('Block %d AccWork:%s', [AItem.operationBlock.block,AItem.accumulatedWork]);
+end;
+
+{ TPCAbstractMemCheckThread }
+
+procedure TPCAbstractMemCheckThread.BCExecute;
+  procedure _error(const AError : String);
+  begin
+    FErrors.Add( AError );
+    inc(FErrorsCount);
+    TLog.NewLog(ltError,ClassName,'CheckConsistency: '+AError);
+  end;
+var iBlock, i, iAccName : Integer;
+  LAccount : TAccount;
+  LBlockAccount : TBlockAccount;
+  LOrdered : TOrderedList<Integer>;
+  LOrderedNames : TOrderedList<String>;
+  LAccountNameInfo : TAccountNameInfo;
+  LTC, LTCInitial : TTickCount;
+  LAggregatedHashrate, LBlockHashRate : TBigNum;
+begin
+  iBlock :=0;
+  LOrdered := TOrderedList<Integer>.Create(False,TComparison_Integer);
+  LOrderedNames := TOrderedList<String>.Create(False,TComparison_String);
+  LAggregatedHashrate := TBigNum.Create;
+  Try
+    LTC := TPlatform.GetTickCount;
+    LTCInitial := LTC;
+    while (iBlock < FPCAbstractMem.BlocksCount) and (Not Terminated) do begin
+      if FMustRestart then begin
+        TLog.NewLog(ltdebug,ClassName,Format('Restarting check thread after %d/%d blocks',[iBlock+1,FPCAbstractMem.BlocksCount]) );
+        FMustRestart := False;
+        FErrorsCount := 0;
+        FErrors.Clear;
+        iBlock := 0;
+        LOrdered.Clear;
+        LOrderedNames.Clear;
+        LAggregatedHashrate.Value := 0;
+      end;
+
+      LBlockAccount := FPCAbstractMem.GetBlockAccount(iBlock);
+      for i:=Low(LBlockAccount.accounts) to high(LBlockAccount.accounts) do begin
+        //
+        LAccount := LBlockAccount.accounts[i];
+        if Length(LAccount.name)>0 then begin
+          if LOrderedNames.Add(LAccount.name.ToString)<0 then begin
+            _error(Format('Account %d name %s allready added',[LAccount.account,LAccount.name.ToString]));
+          end;
+          iAccName := FPCAbstractMem.AccountsNames.IndexOf(LAccount.name.ToString);
+          if iAccName<0 then begin
+            // ERROR
+            _error(Format('Account %d name %s not found at list',[LAccount.account,LAccount.name.ToString]));
+          end else begin
+            if FPCAbstractMem.AccountsNames.Item[iAccName].accountNumber<>LAccount.account then begin
+              _error(Format('Account %d name %s found at list at pos %d but links to %d',[LAccount.account,LAccount.name.ToString,iAccName,FPCAbstractMem.AccountsNames.Item[iAccName].accountNumber]));
+            end;
+            if (LOrdered.Add(LAccount.account)<0) then begin
+              _error(Format('Account %d (with name %s) allready added',[LAccount.account,LAccount.name.ToString]));
+            end;
+          end;
+        end;
+      end;
+
+      LBlockHashRate := TBigNum.TargetToHashRate( LBlockAccount.blockchainInfo.compact_target );
+      Try
+        LAggregatedHashrate.Add( LBlockHashRate );
+      finally
+        LBlockHashRate.Free;
+      end;
+
+      if (TPlatform.GetElapsedMilliseconds(LTC)>2000) then begin
+        LTC := TPlatform.GetTickCount;
+        TLog.NewLog(ltDebug,ClassName,Format('Checking consistency at %d/%d',[iBlock+1,FPCAbstractMem.BlocksCount]));
+      end;
+      inc(iBlock);
+    end;
+    //
+    for i := 0 to FPCAbstractMem.AccountsNames.Count-1 do begin
+      LAccountNameInfo := FPCAbstractMem.AccountsNames.Item[i];
+      if LOrdered.IndexOf( LAccountNameInfo.accountNumber ) < 0 then begin
+        _error(Format('Account name %s at index %d/%d not found in search',[LAccountNameInfo.accountName, i+1,FPCAbstractMem.AccountsNames.Count]));
+      end;
+    end;
+    if (LOrdered.Count)<>FPCAbstractMem.AccountsNames.Count then begin
+      _error(Format('Found %d accounts with names but %d on list',[LOrdered.Count,FPCAbstractMem.AccountsNames.Count]));
+    end;
+    if (LOrderedNames.Count)<>FPCAbstractMem.AccountsNames.Count then begin
+      _error(Format('Found %d accounts with names but %d on ordered names list',[FPCAbstractMem.AccountsNames.Count,LOrderedNames.Count]));
+    end;
+    //
+    if FPCAbstractMem.AggregatedHashrate.CompareTo(LAggregatedHashrate)<>0 then begin
+      _error(Format('Different AggregatedHashRate Found %s vs previous %s',[LAggregatedHashrate.ToDecimal,FPCAbstractMem.AggregatedHashrate.ToDecimal]));
+      FPCAbstractMem.AggregatedHashrate.RawValue := LAggregatedHashrate.RawValue;
+    end;
+
+  finally
+    LOrdered.Free;
+    LOrderedNames.Free;
+    LAggregatedHashrate.Free;
+  end;
+
+  TLog.NewLog(ltDebug,ClassName,Format('Finalized checking consistency at %d %d blocks in %.2f sec',[iBlock+1,FPCAbstractMem.BlocksCount,TPlatform.GetElapsedMilliseconds(LTCInitial)/1000]));
+end;
+
+constructor TPCAbstractMemCheckThread.Create(APCAbstractMem: TPCAbstractMem);
+begin
+  FPCAbstractMem := APCAbstractMem;
+
+  FPCAbstractMem.FLockAbstractMem.Acquire;
+  try
+    FPCAbstractMem.FCheckingThread := Self;
+  finally
+    FPCAbstractMem.FLockAbstractMem.Release;
+  end;
+
+  FErrorsCount := 0;
+  FErrors := TStringList.Create;
+  FMustRestart := False;
+  inherited Create(True);
+  FreeOnTerminate := False;
+  Suspended := False;
+end;
+
+destructor TPCAbstractMemCheckThread.Destroy;
+begin
+  FPCAbstractMem.FLockAbstractMem.Acquire;
+  try
+    FPCAbstractMem.FCheckingThread := Nil;
+  finally
+    FPCAbstractMem.FLockAbstractMem.Release;
+  end;
+  FErrors.Free;
+end;
+
+procedure TPCAbstractMemCheckThread.Restart;
+begin
+  FMustRestart := True;
+  TLog.NewLog(ltdebug,ClassName,Format('Callirg Restart at %d',[FPCAbstractMem.BlocksCount]) );
+end;
+
+
+end.

+ 602 - 0
src/core/UPCAbstractMemAccountKeys.pas

@@ -0,0 +1,602 @@
+unit UPCAbstractMemAccountKeys;
+
+interface
+
+{$IFDEF FPC}
+  {$MODE DELPHI}
+{$ENDIF}
+
+uses Classes, SysUtils,
+  SyncObjs,
+  UAbstractMem, UFileMem, UAbstractMemTList,
+  UAbstractBTree,
+  UPCDataTypes, UBaseTypes, UAVLCache,
+  {$IFNDEF FPC}System.Generics.Collections,System.Generics.Defaults{$ELSE}Generics.Collections,Generics.Defaults{$ENDIF};
+
+type
+  TAccountsUsingThisKey = Class;
+
+  TAbstractMemAccountKeyNode = record
+    myPosition :   TAbstractMemPosition;    // Position in the AbstractMem
+    accountKey : TAccountKey;
+    accounts_using_this_key_position : TAbstractMemPosition;
+    function GetSize : Integer;
+    procedure ReadFromMem(AMyPosition : TAbstractMemPosition; AAbstractMem : TAbstractMem);
+    procedure WriteToMem(AAbstractMem : TAbstractMem);
+    procedure Clear;
+    function ToString : String;
+  end;
+
+  EPCAbstractMemAccountKeys = Class(Exception);
+
+  { TAccountsUsingThisKey }
+
+  TAccountsUsingThisKey = Class(TAbstractMemOrderedTList<Cardinal>)
+  protected
+    function GetItem(index : Integer) : Cardinal; override;
+    procedure LoadFrom(const ABytes : TBytes; var AItem : Cardinal); override;
+    procedure SaveTo(const AItem : Cardinal; AIsAddingItem : Boolean; var ABytes : TBytes); override;
+    function Compare(const ALeft, ARight : Cardinal) : Integer; override;
+  public
+    Constructor Create(AAbstractMem : TAbstractMem; const AInitialZone : TAMZone); reintroduce;
+    Function Add(const AItem : Cardinal) : Integer; reintroduce;
+    procedure Delete(index : Integer); reintroduce;
+  End;
+
+  TAccountKeyByPosition = record
+    position : TAbstractMemPosition;
+    accountKey : TAccountKey;
+    accountsUsingThisKey : TAccountsUsingThisKey;
+    procedure Clear;
+    procedure Dispose;
+  end;
+
+  TPCAccountKeyByPositionCache = Class(TAVLCache<TAccountKeyByPosition>)
+  protected
+    procedure BeforeDelete(var AData : TAccountKeyByPosition); override;
+  public
+  End;
+
+  TPCAbstractMemAccountKeys = Class(TAVLAbstractTree<TAbstractMemAccountKeyNode>)
+  private
+    FAccountKeysLock : TCriticalSection;
+    FAbstractMem : TAbstractMem;
+    FPointerToRootPosition : TAbstractMemPosition;
+    FRootPosition : TAbstractMemPosition;
+    FAccountKeyByPositionCache : TPCAccountKeyByPositionCache;
+  protected
+    function GetRoot: TAbstractMemAccountKeyNode; override;
+    procedure SetRoot(const Value: TAbstractMemAccountKeyNode); override;
+    function HasPosition(const ANode : TAbstractMemAccountKeyNode; APosition : TAVLTreePosition) : Boolean; override;
+    function GetPosition(const ANode : TAbstractMemAccountKeyNode; APosition : TAVLTreePosition) : TAbstractMemAccountKeyNode; override;
+    procedure SetPosition(var ANode : TAbstractMemAccountKeyNode; APosition : TAVLTreePosition; const ANewValue : TAbstractMemAccountKeyNode); override;
+    procedure ClearPosition(var ANode : TAbstractMemAccountKeyNode; APosition : TAVLTreePosition); override;
+    function GetBalance(const ANode : TAbstractMemAccountKeyNode) : Integer; override;
+    procedure SetBalance(var ANode : TAbstractMemAccountKeyNode; ANewBalance : Integer); override;
+    function AreEquals(const ANode1, ANode2 : TAbstractMemAccountKeyNode) : Boolean; override;
+    procedure ClearNode(var ANode : TAbstractMemAccountKeyNode); override;
+    procedure DisposeNode(var ANode : TAbstractMemAccountKeyNode); override;
+  public
+    function IsNil(const ANode : TAbstractMemAccountKeyNode) : Boolean; override;
+    function ToString(const ANode: TAbstractMemAccountKeyNode) : String; override;
+    constructor Create(AAbstractMem : TAbstractMem; APointerToRootPosition : TAbstractMemPosition); reintroduce;
+    destructor Destroy; override;
+    //
+    function GetKeyAtPosition(APosition : TAbstractMemPosition) : TAccountKey;
+    function GetPositionOfKey(const AAccountKey : TAccountKey; AAddIfNotFound : Boolean) : TAbstractMemPosition;
+    function GetPositionOfKeyAndAddAccount(const AAccountKey : TAccountKey; const AAccountNumber : Cardinal) : TAbstractMemPosition;
+    function GetPositionOfKeyAndRemoveAccount(const AAccountKey : TAccountKey; const AAccountNumber : Cardinal) : TAbstractMemPosition;
+    procedure GetAccountsUsingKey(const AAccountKey : TAccountKey; const AList : TList<Cardinal>);
+    function GetAccountsUsingThisKey(const AAccountKey : TAccountKey) : TAccountsUsingThisKey;
+    procedure FlushCache;
+  end;
+
+
+implementation
+
+type
+  TAccountsUsingThisKey_BlackHole = Class(TAccountsUsingThisKey)
+  public
+    class function GetInstance : TAccountsUsingThisKey_BlackHole;
+  End;
+
+var _TAccountsUsingThisKey_BlackHole : TAccountsUsingThisKey_BlackHole = Nil;
+    _BlackHoleAbstractMem : TMem;
+
+{ TAccountsUsingThisKey_BlackHole }
+
+class function TAccountsUsingThisKey_BlackHole.GetInstance: TAccountsUsingThisKey_BlackHole;
+var LZone : TAMZone;
+begin
+  if Not Assigned(_TAccountsUsingThisKey_BlackHole) then begin
+    if Not Assigned(_BlackHoleAbstractMem) then begin
+      _BlackHoleAbstractMem := TMem.Create(0,True);
+    end;
+    LZone.Clear;
+    _TAccountsUsingThisKey_BlackHole := TAccountsUsingThisKey_BlackHole.Create(_BlackHoleAbstractMem,LZone);
+  end;
+  Result :=  _TAccountsUsingThisKey_BlackHole;
+end;
+
+
+{ TAbstractMemAccountKeyNode }
+
+procedure TAbstractMemAccountKeyNode.Clear;
+begin
+  Self.myPosition := 0;
+  Self.accountKey.EC_OpenSSL_NID := 0;
+  Self.accountKey.x := Nil;
+  Self.accountKey.y := Nil;
+  Self.accounts_using_this_key_position := 0;
+end;
+
+function TAbstractMemAccountKeyNode.GetSize: Integer;
+begin
+  Result := accountKey.GetSerializedLength + 4 + TAbstractMemAVLTreeNodeInfoClass.GetSize;
+end;
+
+procedure TAbstractMemAccountKeyNode.ReadFromMem(AMyPosition: TAbstractMemPosition; AAbstractMem: TAbstractMem);
+var LBytes : TBytes;
+  LRawSize : Integer;
+  i : Integer;
+begin
+  Self.Clear;
+  Self.myPosition := AMyPosition;
+  inc(AMyPosition,TAbstractMemAVLTreeNodeInfoClass.GetSize);
+  // Minimum size is  4 + 2 + 2 = 8 bytes
+  i := 8;
+  SetLength(LBytes,i);
+  if AAbstractMem.Read(AMyPosition,LBytes[0],Length(LBytes))<>Length(LBytes) then raise EPCAbstractMemAccountKeys.Create(Format('Not enough data to read AccountKeyNode at %d',[AMyPosition]));
+  Move(LBytes[0],Self.accounts_using_this_key_position,4);
+  Move(LBytes[4],Self.accountKey.EC_OpenSSL_NID,2);
+  //
+  LRawSize := 0;
+  Move(LBytes[6],LRawSize,2);
+  SetLength(Self.accountKey.x,LRawSize);
+  if AAbstractMem.Read(AMyPosition + i,Self.accountKey.x[0],Length(Self.accountKey.x))<>Length(Self.accountKey.x) then raise EPCAbstractMemAccountKeys.Create(Format('Not enough data to read AccountKeyNode.x at %d',[AMyPosition]));
+  // Read next
+  inc(i,LRawSize);
+  LRawSize := 0;
+  if AAbstractMem.Read(AMyPosition + i,LRawSize,2)<>2 then raise EPCAbstractMemAccountKeys.Create(Format('Not enough data to read AccountKeyNode.Length(y) at %d',[AMyPosition]));
+  SetLength(Self.accountKey.y,LRawSize);
+  inc(i,2);
+  if AAbstractMem.Read(AMyPosition + i,Self.accountKey.y[0],Length(Self.accountKey.y))<>Length(Self.accountKey.y) then raise EPCAbstractMemAccountKeys.Create(Format('Not enough data to read AccountKeyNode.y at %d',[AMyPosition]));
+end;
+
+function TAbstractMemAccountKeyNode.ToString: String;
+begin
+  Result := Format('AccountKeyNode type %d (length x:%d y:%d) at position %d',[Self.accountKey.EC_OpenSSL_NID,Length(Self.accountKey.x),Length(Self.accountKey.y),Self.myPosition]);
+end;
+
+procedure TAbstractMemAccountKeyNode.WriteToMem(AAbstractMem: TAbstractMem);
+var LBytes : TBytes;
+  LStream : TStream;
+begin
+  LStream := TMemoryStream.Create;
+  try
+    LStream.Write(Self.accounts_using_this_key_position,4);
+    Self.accountKey.ToSerialized(LStream);
+    LBytes.FromStream(LStream);
+    AAbstractMem.Write(Self.myPosition + TAbstractMemAVLTreeNodeInfoClass.GetSize,LBytes[0],Length(LBytes));
+  finally
+    LStream.Free;
+  end;
+end;
+
+{ TPCAbstractMemAccountKeys }
+
+function _TPCAbstractMemAccountKeys_Compare(const Left, Right: TAbstractMemAccountKeyNode): Integer;
+begin
+  Result := Left.accountKey.EC_OpenSSL_NID - Right.accountKey.EC_OpenSSL_NID;
+  if (Result = 0) then begin
+    Result := TBaseType.BinStrComp(Left.accountKey.x,Right.accountKey.x);
+    if Result=0 then begin
+      Result := TBaseType.BinStrComp(Left.accountKey.y,Right.accountKey.y);
+    end;
+  end;
+
+  if (Result=0) and (Left.myPosition>0) and (Right.myPosition>0) then begin
+    // This will allow to find exactly a node when both are real (otherwise is searching for a position)
+    Result := Left.myPosition - Right.myPosition;
+  end;
+end;
+
+
+function TPCAbstractMemAccountKeys.AreEquals(const ANode1, ANode2: TAbstractMemAccountKeyNode): Boolean;
+begin
+  Result := (ANode1.accountKey.EC_OpenSSL_NID = ANode2.accountKey.EC_OpenSSL_NID)
+    and (TBaseType.Equals(ANode1.accountKey.x,ANode2.accountKey.x))
+    And (TBaseType.Equals(ANode1.accountKey.y,ANode2.accountKey.y));
+end;
+
+procedure TPCAbstractMemAccountKeys.ClearNode(var ANode: TAbstractMemAccountKeyNode);
+begin
+  ANode.Clear;
+end;
+
+procedure TPCAbstractMemAccountKeys.ClearPosition(var ANode: TAbstractMemAccountKeyNode; APosition: TAVLTreePosition);
+begin
+  TAbstractMemAVLTreeNodeInfoClass.ClearPosition(ANode.myPosition,FAbstractMem,APosition);
+end;
+
+function _AccountKeyByPositionCache_Comparision(const Left, Right: TPCAccountKeyByPositionCache.PAVLCacheMemData): Integer;
+begin
+  // Compare only by data.account number (not for content)
+  Result := Left.data.position - Right.data.position;
+end;
+
+constructor TPCAbstractMemAccountKeys.Create(AAbstractMem: TAbstractMem; APointerToRootPosition : TAbstractMemPosition);
+begin
+  FAccountKeysLock := TCriticalSection.Create;
+  FAbstractMem := AAbstractMem;
+  FPointerToRootPosition := APointerToRootPosition;
+  FRootPosition := 0;
+  // Read Root position
+  FAbstractMem.Read(FPointerToRootPosition,FRootPosition,4);
+  FAccountKeyByPositionCache := TPCAccountKeyByPositionCache.Create(5000,_AccountKeyByPositionCache_Comparision);
+  inherited Create(_TPCAbstractMemAccountKeys_Compare,False);
+end;
+
+destructor TPCAbstractMemAccountKeys.Destroy;
+begin
+  FAccountKeyByPositionCache.Free;
+  FAccountKeysLock.Free;
+  inherited;
+end;
+
+procedure TPCAbstractMemAccountKeys.DisposeNode(var ANode: TAbstractMemAccountKeyNode);
+begin
+  // Free from mem
+  FAbstractMem.Dispose(ANode.myPosition);
+end;
+
+procedure TPCAbstractMemAccountKeys.FlushCache;
+begin
+  FAccountKeyByPositionCache.Clear;
+end;
+
+procedure TPCAbstractMemAccountKeys.GetAccountsUsingKey(
+  const AAccountKey: TAccountKey; const AList: TList<Cardinal>);
+var Lautk : TAccountsUsingThisKey;
+  i : Integer;
+begin
+  AList.Clear;
+  FAccountKeysLock.Acquire;
+  try
+  Lautk := GetAccountsUsingThisKey(AAccountKey);
+  if Assigned(Lautk) then begin
+    for i:=0 to Lautk.Count-1 do begin
+      AList.Add( Lautk.GetItem(i) );
+    end;
+  end;
+  finally
+    FAccountKeysLock.Release;
+  end;
+end;
+
+function TPCAbstractMemAccountKeys.GetAccountsUsingThisKey(const AAccountKey: TAccountKey): TAccountsUsingThisKey;
+var LNode : TAbstractMemAccountKeyNode;
+  LZone : TAMZone;
+  i : Integer;
+  LP : TAccountKeyByPosition;
+begin
+  Result := TAccountsUsingThisKey_BlackHole.GetInstance;
+  FAccountKeysLock.Acquire;
+  try
+  LNode.Clear;
+  LNode.accountKey := AAccountKey;
+  LNode := Find(LNode);
+  if IsNil(LNode) then Exit;
+  LZone.Clear;
+  LZone.position := LNode.accounts_using_this_key_position;
+  // Add Account Number
+  if (LNode.accounts_using_this_key_position=0) then Exit;
+  LP.Clear;
+  LP.position := LNode.myPosition;
+  if Not FAccountKeyByPositionCache.Find(LP,LP) then begin
+    LP.Clear;
+    LP.position := LNode.myPosition;
+    LP.accountKey := AAccountKey;
+    LP.accountsUsingThisKey := TAccountsUsingThisKey.Create(FAbstractMem,LZone);
+    FAccountKeyByPositionCache.Add(LP); // Add to cache!
+  end;
+  Result := LP.accountsUsingThisKey;
+  finally
+    FAccountKeysLock.Release;
+  end;
+end;
+
+function TPCAbstractMemAccountKeys.GetBalance(const ANode: TAbstractMemAccountKeyNode): Integer;
+begin
+  Result := TAbstractMemAVLTreeNodeInfoClass.GetBalance(ANode.myPosition,FAbstractMem);
+end;
+
+function TPCAbstractMemAccountKeys.GetKeyAtPosition(APosition: TAbstractMemPosition): TAccountKey;
+var LNode : TAbstractMemAccountKeyNode;
+  LP, LPFound : TAccountKeyByPosition;
+  LAccZone : TAMZone;
+begin
+  FAccountKeysLock.Acquire;
+  try
+  LP.Clear;
+  LP.position := APosition;
+  LPFound.Clear;
+  if FAccountKeyByPositionCache.Find(LP,LPFound) then begin
+    Result := LPFound.accountKey;
+  end else begin
+    LNode.ReadFromMem(APosition,FAbstractMem);
+    Result := LNode.accountKey;
+    LP.accountKey := Result;
+    if LNode.accounts_using_this_key_position>0 then begin
+      LAccZone.Clear;
+      LAccZone.position := LNode.accounts_using_this_key_position;
+      LP.accountsUsingThisKey := TAccountsUsingThisKey.Create(FAbstractMem,LAccZone);
+    end else LP.accountsUsingThisKey := Nil;
+    FAccountKeyByPositionCache.Add(LP); // Add to cache!
+  end;
+  finally
+    FAccountKeysLock.Release;
+  end;
+end;
+
+function TPCAbstractMemAccountKeys.GetPosition(
+  const ANode: TAbstractMemAccountKeyNode;
+  APosition: TAVLTreePosition): TAbstractMemAccountKeyNode;
+var LPos : TAbstractMemPosition;
+begin
+  if ANode.myPosition>0 then begin
+    LPos := TAbstractMemAVLTreeNodeInfoClass.GetPosition(ANode.myPosition,FAbstractMem,APosition);
+  end else LPos := 0;
+  if (LPos>0) then begin
+    Result.ReadFromMem(LPos,FAbstractMem);
+  end else Result.Clear;
+end;
+
+function TPCAbstractMemAccountKeys.GetPositionOfKeyAndAddAccount(const AAccountKey: TAccountKey; const AAccountNumber: Cardinal): TAbstractMemPosition;
+var LNode : TAbstractMemAccountKeyNode;
+  LZone : TAMZone;
+  Lacckutk : TAccountsUsingThisKey;
+  LAccKeyByPos  : TAccountKeyByPosition;
+begin
+  FAccountKeysLock.Acquire;
+  try
+  LNode.Clear;
+  LNode.accountKey := AAccountKey;
+  LNode := Find(LNode);
+  if IsNil(LNode) then begin
+    // if LNode does not exists, then ADD
+    LNode.accountKey := AAccountKey;
+    LNode.accounts_using_this_key_position := 0;
+    LNode.myPosition := FAbstractMem.New( LNode.GetSize ).position;
+    LNode.WriteToMem(FAbstractMem);
+    Add(LNode);
+  end;
+
+  LAccKeyByPos.Clear;
+  LAccKeyByPos.position := LNode.myPosition;
+  if FAccountKeyByPositionCache.Find(LAccKeyByPos,LAccKeyByPos) then begin
+    if Not Assigned(LAccKeyByPos.accountsUsingThisKey) then begin
+      // We will need to add... remove from cache
+      FAccountKeyByPositionCache.Remove(LAccKeyByPos);
+      LAccKeyByPos.Clear;
+    end;
+  end else LAccKeyByPos.Clear;
+  if (LAccKeyByPos.position<=0) then begin
+    // Create
+    LAccKeyByPos.position := LNode.myPosition;
+    LAccKeyByPos.accountKey := AAccountKey;
+    LZone.Clear;
+    if (LNode.accounts_using_this_key_position=0) then begin
+      // Create
+      LZone := FAbstractMem.New( CT_AbstractMemTList_HeaderSize );
+      LNode.accounts_using_this_key_position := LZone.position;
+      LNode.WriteToMem( FAbstractMem ); // Save update:
+    end else LZone.position := LNode.accounts_using_this_key_position;
+    LAccKeyByPos.accountsUsingThisKey := TAccountsUsingThisKey.Create(FAbstractMem,LZone);
+    // Add to cache
+    FAccountKeyByPositionCache.Add( LAccKeyByPos );
+  end;
+  //
+  LAccKeyByPos.accountsUsingThisKey.Add( AAccountNumber );
+
+  Result := LNode.myPosition;
+  finally
+    FAccountKeysLock.Release;
+  end;
+end;
+
+function TPCAbstractMemAccountKeys.GetPositionOfKeyAndRemoveAccount(
+  const AAccountKey: TAccountKey;
+  const AAccountNumber: Cardinal): TAbstractMemPosition;
+var LNode : TAbstractMemAccountKeyNode;
+  LZone : TAMZone;
+  i : Integer;
+  Lacckutk : TAccountsUsingThisKey;
+  LAccKeyByPos : TAccountKeyByPosition;
+begin
+  FAccountKeysLock.Acquire;
+  try
+  LNode.Clear;
+  LNode.accountKey := AAccountKey;
+  LNode := Find(LNode);
+  if IsNil(LNode) then begin
+    Exit(0);
+  end;
+  Result := LNode.myPosition;
+  // Remove Account Number
+
+  if (LNode.accounts_using_this_key_position=0) then Exit;
+
+  LAccKeyByPos.Clear;
+  LAccKeyByPos.position := LNode.myPosition;
+  if Not FAccountKeyByPositionCache.Find(LAccKeyByPos,LAccKeyByPos) then begin
+    // Create
+    LAccKeyByPos.position := LNode.myPosition;
+    LAccKeyByPos.accountKey := AAccountKey;
+    LZone.Clear;
+    LZone.position := LNode.accounts_using_this_key_position;
+    LAccKeyByPos.accountsUsingThisKey := TAccountsUsingThisKey.Create(FAbstractMem,LZone);
+    // Add to cache
+    FAccountKeyByPositionCache.Add( LAccKeyByPos );
+  end;
+
+  if Assigned(LAccKeyByPos.accountsUsingThisKey) then begin
+    i := LAccKeyByPos.accountsUsingThisKey.IndexOf( AAccountNumber );
+    if i>=0 then begin
+      LAccKeyByPos.accountsUsingThisKey.Delete( i );
+    end;
+  end;
+  finally
+    FAccountKeysLock.Release;
+  end;
+end;
+
+function TPCAbstractMemAccountKeys.GetPositionOfKey(const AAccountKey: TAccountKey; AAddIfNotFound : Boolean): TAbstractMemPosition;
+var LNode : TAbstractMemAccountKeyNode;
+begin
+  LNode.Clear;
+  LNode.accountKey := AAccountKey;
+  LNode := Find(LNode);
+  if (IsNil(LNode) and (AAddIfNotFound)) then begin
+    // if LNode does not exists, then ADD
+    LNode.accountKey := AAccountKey;
+    LNode.accounts_using_this_key_position := 0;
+    LNode.myPosition := FAbstractMem.New( LNode.GetSize ).position;
+    LNode.WriteToMem(FAbstractMem);
+    Add(LNode);
+  end;
+  Result := LNode.myPosition;
+end;
+
+function TPCAbstractMemAccountKeys.GetRoot: TAbstractMemAccountKeyNode;
+begin
+  if FRootPosition>0 then Result.ReadFromMem( FRootPosition , FAbstractMem )
+  else Result.Clear;
+end;
+
+function TPCAbstractMemAccountKeys.HasPosition(
+  const ANode: TAbstractMemAccountKeyNode;
+  APosition: TAVLTreePosition): Boolean;
+begin
+  if (ANode.myPosition>0) then begin
+    Result := TAbstractMemAVLTreeNodeInfoClass.GetPosition(ANode.myPosition,FAbstractMem,APosition)>0;
+  end else Result := False;
+end;
+
+function TPCAbstractMemAccountKeys.IsNil(
+  const ANode: TAbstractMemAccountKeyNode): Boolean;
+begin
+  Result := ANode.myPosition=0;
+end;
+
+procedure TPCAbstractMemAccountKeys.SetBalance(
+  var ANode: TAbstractMemAccountKeyNode; ANewBalance: Integer);
+begin
+  TAbstractMemAVLTreeNodeInfoClass.SetBalance(ANode.myPosition,FAbstractMem,ANewBalance);
+end;
+
+procedure TPCAbstractMemAccountKeys.SetPosition(
+  var ANode: TAbstractMemAccountKeyNode; APosition: TAVLTreePosition;
+  const ANewValue: TAbstractMemAccountKeyNode);
+begin
+  TAbstractMemAVLTreeNodeInfoClass.SetPosition(ANode.myPosition,FAbstractMem,APosition,ANewValue.myPosition);
+end;
+
+procedure TPCAbstractMemAccountKeys.SetRoot(
+  const Value: TAbstractMemAccountKeyNode);
+begin
+  FRootPosition := Value.myPosition;
+  // Save
+  if Value.myPosition>0 then begin
+    Value.WriteToMem(FAbstractMem);
+  end;
+  FAbstractMem.Write(FPointerToRootPosition,FRootPosition,4);
+end;
+
+function TPCAbstractMemAccountKeys.ToString(const ANode: TAbstractMemAccountKeyNode): String;
+begin
+  Result := ANode.ToString;
+end;
+
+{ TAccountsUsingThisKey }
+
+procedure TAccountsUsingThisKey.LoadFrom(const ABytes: TBytes; var AItem: Cardinal);
+begin
+  Move(ABytes[0],AItem,4);
+end;
+
+procedure TAccountsUsingThisKey.SaveTo(const AItem: Cardinal; AIsAddingItem : Boolean; var ABytes: TBytes);
+begin
+  SetLength(ABytes,4);
+  Move(AItem,ABytes[0],4);
+  raise Exception.Create('INCONSISTENT 20200324-1 NEVER CALL HERE');
+end;
+
+function TAccountsUsingThisKey.Add(const AItem: Cardinal): Integer;
+var
+  LFound : Boolean;
+  LBytes : TBytes;
+  LZone : TAMZone;
+begin
+  FList.LockList;
+  try
+    LFound := Find(AItem,Result);
+    if (LFound and AllowDuplicates) or (Not LFound) then begin
+      FList.Insert( Result , AItem );
+    end else Result := -1;
+  finally
+    FList.UnlockList;
+  end;
+end;
+
+function TAccountsUsingThisKey.Compare(const ALeft, ARight: Cardinal): Integer;
+begin
+  Result := ALeft - ARight;
+end;
+
+constructor TAccountsUsingThisKey.Create(AAbstractMem: TAbstractMem; const AInitialZone: TAMZone);
+begin
+  inherited Create(AAbstractMem,AInitialZone,1000,False);
+end;
+
+procedure TAccountsUsingThisKey.Delete(index: Integer);
+begin
+  FList.Delete( index );
+end;
+
+function TAccountsUsingThisKey.GetItem(index: Integer): Cardinal;
+begin
+  Result := FList.Position[index];
+end;
+
+{ TPCAccountKeyByPositionCache }
+
+procedure TPCAccountKeyByPositionCache.BeforeDelete(var AData: TAccountKeyByPosition);
+begin
+  inherited;
+  if Assigned(AData.accountsUsingThisKey) then begin
+    FreeAndNil(AData.accountsUsingThisKey);
+  end;
+end;
+
+{ TAccountKeyByPosition }
+
+procedure TAccountKeyByPosition.Clear;
+begin
+  Self.position := 0;
+  Self.accountKey := CT_AccountInfo_NUL.accountKey;
+  Self.accountsUsingThisKey := Nil;
+end;
+
+procedure TAccountKeyByPosition.Dispose;
+begin
+  FreeAndNil(Self.accountsUsingThisKey);
+end;
+
+initialization
+  _TAccountsUsingThisKey_BlackHole := Nil;
+  _BlackHoleAbstractMem := Nil;
+finalization
+  FreeAndNil(_TAccountsUsingThisKey_BlackHole);
+  FreeAndNil(_BlackHoleAbstractMem);
+end.

+ 322 - 1
src/core/UPCDataTypes.pas

@@ -23,7 +23,7 @@ unit UPCDataTypes;
 interface
 
 uses
-  Classes, SysUtils, UBaseTypes;
+  Classes, SysUtils, UBaseTypes, UConst;
 
 type
 
@@ -38,6 +38,15 @@ type
      EC_OpenSSL_NID : Word;
      x: TRawBytes;
      y: TRawBytes;
+     //
+     procedure Clear;
+     function GetSerializedLength : Integer;
+     function ToSerialized : TBytes; overload;
+     procedure ToSerialized(const AStream : TStream); overload;
+     function FromSerialized(const ASerialized : TBytes) : Boolean; overload;
+     function FromSerialized(const AStream : TStream) : Boolean; overload;
+     function LoadFromTBytes(const ABytes : TBytes; var AStartIndex : Integer) : Boolean;
+     function IsEqualTo(const ACompareTo : TECDSA_Public) : Boolean;
   end;
 
   { TECDSA_Public_Raw is a TECDSA_Public stored in a single TRawBytes
@@ -59,8 +68,269 @@ type
   end;
   PECDSA_Public = ^TECDSA_Public; // Pointer to a TECDSA_SIG
 
+
+
+  TAccountKey = TECDSA_Public;
+  PAccountKey = ^TAccountKey;
+
+  TAccountState = (as_Unknown, as_Normal, as_ForSale, as_ForAtomicAccountSwap, as_ForAtomicCoinSwap);
+
+  { TAccountInfo }
+
+  TAccountInfo = Record
+    state : TAccountState;
+    accountKey: TAccountKey;
+    // Trade info, only when state=as_ForSale
+    locked_until_block : Cardinal; // 0 = Not locked
+    price : UInt64;                // 0 = invalid price
+    account_to_pay : Cardinal;     // <> itself
+    new_publicKey : TAccountKey;
+    hashed_secret : TRawBytes;     // Hashed Secret for AtomicSwaps
+    //
+    procedure Clear;
+    function ToSerialized : TBytes;
+    function FromSerialized(const ASerialized : TBytes) : Boolean;
+    function LoadFromTBytes(const ABytes : TBytes; var AStartIndex : Integer) : Boolean;
+  end;
+
+  TOperationBlock = Record
+    block: Cardinal;
+    account_key: TAccountKey;
+    reward: UInt64;
+    fee: UInt64;
+    protocol_version: Word;     // Protocol version
+    protocol_available: Word;   // Used to upgrade protocol
+    timestamp: Cardinal;        // Timestamp creation
+    compact_target: Cardinal;   // Target in compact form
+    nonce: Cardinal;            // Random value to generate a new P-o-W
+    block_payload : TRawBytes;  // RAW Payload that a miner can include to a blockchain
+    initial_safe_box_hash: TRawBytes; // RAW Safe Box Hash value (32 bytes, it's a Sha256)
+    operations_hash: TRawBytes; // RAW sha256 (32 bytes) of Operations
+    proof_of_work: TRawBytes;   // RAW 32 bytes
+    previous_proof_of_work: TRawBytes; // RAW 32 bytes
+  end;
+
+  { TAccount }
+
+  TAccount = Record
+    account: Cardinal;        // FIXED value. Account number
+    accountInfo : TAccountInfo;
+    balance: UInt64;          // Balance, always >= 0
+    updated_on_block_passive_mode: Cardinal; // Number of block where was updated (active or passive mode)
+    updated_on_block_active_mode: Cardinal; // Number of block where was used (active mode only)
+    n_operation: Cardinal;    // count number of owner operations (when receive, this is not updated)
+    name : TRawBytes;         // Protocol 2. Unique name
+    account_type : Word;      // Protocol 2. Layer 2 use case
+    account_data : TRawBytes; // Protocol 5. PIP-0024 RAW data information
+    account_seal : TRawBytes;  // Protocol 5. PIP-0029 seal of data changes
+    procedure Clear;
+    function GetLastUpdatedBlock : Cardinal;
+  End;
+  PAccount = ^TAccount;
+
+  TBlockAccount = Record
+    blockchainInfo : TOperationBlock;
+    accounts : Array[0..CT_AccountsPerBlock-1] of TAccount;
+    block_hash: TRawBytes;   // Calculated on every block change (on create and on accounts updated)
+    accumulatedWork : UInt64; // Accumulated work (previous + target) this value can be calculated.
+  end;
+
+  { TPCSafeBoxHeader }
+
+  TPCSafeBoxHeader = Record
+    protocol : Word;
+    startBlock,
+    endBlock,
+    blocksCount : Cardinal;
+    safeBoxHash : TRawBytes;
+    function GetSavedBlocksCount : Integer;
+    function IsAChunk : Boolean;
+    function IsFullSafebox : Boolean;
+    function ContainsFirstBlock : Boolean;
+    function ContainsLastBlock : Boolean;
+    function ToString : String;
+  end;
+
+
+
+const
+  CT_AccountInfo_NUL : TAccountInfo = (state:as_Unknown;accountKey:(EC_OpenSSL_NID:0;x:Nil;y:Nil);locked_until_block:0;price:0;account_to_pay:0;new_publicKey:(EC_OpenSSL_NID:0;x:Nil;y:Nil);hashed_secret:Nil);
+  CT_Account_NUL : TAccount = (account:0;accountInfo:(state:as_Unknown;accountKey:(EC_OpenSSL_NID:0;x:Nil;y:Nil);locked_until_block:0;price:0;account_to_pay:0;new_publicKey:(EC_OpenSSL_NID:0;x:Nil;y:Nil));balance:0;updated_on_block_passive_mode:0;updated_on_block_active_mode:0;n_operation:0;name:Nil;account_type:0;account_data:Nil;account_seal:Nil);
+  CT_BlockAccount_NUL : TBlockAccount = (
+    blockchainInfo:(block:0;account_key:(EC_OpenSSL_NID:0;x:Nil;y:Nil);reward:0;fee:0;protocol_version:0;
+    protocol_available:0;timestamp:0;compact_target:0;nonce:0;block_payload:Nil;initial_safe_box_hash:Nil;operations_hash:Nil;proof_of_work:Nil;previous_proof_of_work:Nil);
+    accounts:(
+    (account:0;accountInfo:(state:as_Unknown;accountKey:(EC_OpenSSL_NID:0;x:Nil;y:Nil);locked_until_block:0;price:0;account_to_pay:0;new_publicKey:(EC_OpenSSL_NID:0;x:Nil;y:Nil));balance:0;updated_on_block_passive_mode:0;updated_on_block_active_mode:0;n_operation:0;name:Nil;account_type:0;account_data:Nil;account_seal:Nil),
+    (account:0;accountInfo:(state:as_Unknown;accountKey:(EC_OpenSSL_NID:0;x:Nil;y:Nil);locked_until_block:0;price:0;account_to_pay:0;new_publicKey:(EC_OpenSSL_NID:0;x:Nil;y:Nil));balance:0;updated_on_block_passive_mode:0;updated_on_block_active_mode:0;n_operation:0;name:Nil;account_type:0;account_data:Nil;account_seal:Nil),
+    (account:0;accountInfo:(state:as_Unknown;accountKey:(EC_OpenSSL_NID:0;x:Nil;y:Nil);locked_until_block:0;price:0;account_to_pay:0;new_publicKey:(EC_OpenSSL_NID:0;x:Nil;y:Nil));balance:0;updated_on_block_passive_mode:0;updated_on_block_active_mode:0;n_operation:0;name:Nil;account_type:0;account_data:Nil;account_seal:Nil),
+    (account:0;accountInfo:(state:as_Unknown;accountKey:(EC_OpenSSL_NID:0;x:Nil;y:Nil);locked_until_block:0;price:0;account_to_pay:0;new_publicKey:(EC_OpenSSL_NID:0;x:Nil;y:Nil));balance:0;updated_on_block_passive_mode:0;updated_on_block_active_mode:0;n_operation:0;name:Nil;account_type:0;account_data:Nil;account_seal:Nil),
+    (account:0;accountInfo:(state:as_Unknown;accountKey:(EC_OpenSSL_NID:0;x:Nil;y:Nil);locked_until_block:0;price:0;account_to_pay:0;new_publicKey:(EC_OpenSSL_NID:0;x:Nil;y:Nil));balance:0;updated_on_block_passive_mode:0;updated_on_block_active_mode:0;n_operation:0;name:Nil;account_type:0;account_data:Nil;account_seal:Nil)
+    );
+    block_hash:Nil;
+    accumulatedWork:0);
+  CT_PCSafeBoxHeader_NUL : TPCSafeBoxHeader = (protocol:0;startBlock:0;endBlock:0;blocksCount:0;safeBoxHash:Nil);
+
+
 implementation
 
+{ TECDSA_Public }
+
+procedure TECDSA_Public.Clear;
+begin
+  Self.EC_OpenSSL_NID:=0;
+  Self.x := Nil;
+  Self.y := Nil;
+end;
+
+function TECDSA_Public.ToSerialized: TBytes;
+var LPos : Integer;
+begin
+  SetLength(Result,2 + 2 + Length(Self.x) + 2 + Length(Self.y));
+  Move(Self.EC_OpenSSL_NID,Result[0],2);
+  LPos := 2;
+  Self.x.SaveInsideTBytes(Result,LPos);
+  Self.y.SaveInsideTBytes(Result,LPos);
+end;
+
+function TECDSA_Public.FromSerialized(const ASerialized: TBytes): Boolean;
+var i : Integer;
+begin
+  i := 0;
+  Result := LoadFromTBytes(ASerialized,i);
+end;
+
+function TECDSA_Public.FromSerialized(const AStream: TStream): Boolean;
+begin
+  if AStream.Read(Self.EC_OpenSSL_NID,2)<>2 then Exit(False);
+  if Self.x.FromSerialized(AStream)<0 then Exit(False);
+  if Self.y.FromSerialized(AStream)<0 then Exit(False);
+  Result := True;
+end;
+
+function TECDSA_Public.GetSerializedLength: Integer;
+begin
+  Result := 2 + Self.x.GetSerializedLength + Self.y.GetSerializedLength;
+end;
+
+function TECDSA_Public.IsEqualTo(const ACompareTo: TECDSA_Public): Boolean;
+begin
+  Result := (Self.EC_OpenSSL_NID = ACompareTo.EC_OpenSSL_NID) and
+    (Self.x.IsEqualTo(ACompareTo.x)) and (Self.y.IsEqualTo(ACompareTo.y));
+end;
+
+function TECDSA_Public.LoadFromTBytes(const ABytes: TBytes; var AStartIndex: Integer): Boolean;
+begin
+  Self.Clear;
+  if (AStartIndex + 2 + 2 + 2 > Length(ABytes)) then Exit(False);
+  Move(ABytes[AStartIndex],Self.EC_OpenSSL_NID,2);
+  inc(AStartIndex,2);
+  if Not Self.x.LoadFromTBytes(ABytes,AStartIndex) then Exit(False);
+  if Not Self.y.LoadFromTBytes(ABytes,AStartIndex) then Exit(False);
+end;
+
+procedure TECDSA_Public.ToSerialized(const AStream: TStream);
+begin
+  AStream.Write(Self.EC_OpenSSL_NID,2);
+  Self.x.ToSerialized(AStream);
+  Self.y.ToSerialized(AStream);
+end;
+
+{ TAccountInfo }
+
+procedure TAccountInfo.Clear;
+begin
+  Self.state := as_Unknown;
+  Self.accountKey.Clear;
+  Self.locked_until_block := 0;
+  Self.price := 0;
+  Self.account_to_pay := 0;
+  Self.new_publicKey.Clear;
+  Self.hashed_secret := Nil;
+end;
+
+function TAccountInfo.ToSerialized: TBytes;
+var w : Word;
+  LtotalLenght : Integer;
+  Lacc_serialized, Lnew_serialized, Lsecret_serialized : TBytes;
+begin
+  Lacc_serialized := Self.accountKey.ToSerialized;
+  case Self.state of
+    as_Unknown: begin
+      Result := Nil;
+      Exit;
+    end;
+    as_Normal: Begin
+      Result := Lacc_serialized;
+      Exit;
+    End;
+    as_ForSale, as_ForAtomicAccountSwap, as_ForAtomicCoinSwap: begin
+      Lnew_serialized := Self.new_publicKey.ToSerialized;
+      Lsecret_serialized := Self.hashed_secret.ToSerialized;
+      LtotalLenght := 2 + Length(Lacc_serialized) + 4 + 8 + 4 + Length(Lnew_serialized);
+      case Self.state of
+        as_ForSale: w := CT_AccountInfo_ForSale;
+        as_ForAtomicAccountSwap: begin
+          w := CT_AccountInfo_ForAccountSwap;
+          inc(LtotalLenght,Length(Lsecret_serialized));
+        end;
+        as_ForAtomicCoinSwap: begin
+          w := CT_AccountInfo_ForCoinSwap;
+          inc(LtotalLenght,Length(Lsecret_serialized));
+        end;
+      end;
+      SetLength(Result, LtotalLenght);
+      Move(w,Result[0],2);
+      Move(Lacc_serialized[0],Result[2],Length(Lacc_serialized));
+      //
+      Move(Self.locked_until_block,Result[2+Length(Lacc_serialized)],4);
+      Move(Self.price,Result[2+Length(Lacc_serialized)+4],8);
+      Move(Self.account_to_pay,Result[2+Length(Lacc_serialized)+4+8],4);
+      //
+      Move(Lnew_serialized[0],Result[2+Length(Lacc_serialized)+4+8+4], Length(Lnew_serialized));
+      if (Self.state in [as_ForAtomicAccountSwap,as_ForAtomicCoinSwap]) then begin
+        Move(Lsecret_serialized[0],Result[2+Length(Lacc_serialized)+4+8+4+Length(Lnew_serialized)],Length(Lsecret_serialized));
+      end;
+    end;
+  end;
+end;
+
+function TAccountInfo.FromSerialized(const ASerialized: TBytes): Boolean;
+var i : Integer;
+begin
+  i := 0;
+  Result := LoadFromTBytes(ASerialized,i);
+end;
+
+function TAccountInfo.LoadFromTBytes(const ABytes: TBytes; var AStartIndex: Integer): Boolean;
+var w : Word;
+begin
+  Self.Clear;
+  if (AStartIndex + 2 > Length(ABytes)) then Exit(False);
+  Move(ABytes[AStartIndex],w,2);
+  case w of
+    CT_NID_secp256k1,CT_NID_secp384r1,CT_NID_sect283k1,CT_NID_secp521r1 : Begin
+      Self.state := as_Normal;
+      Result := Self.accountKey.LoadFromTBytes(ABytes,AStartIndex);
+    End;
+    CT_AccountInfo_ForSale, CT_AccountInfo_ForAccountSwap, CT_AccountInfo_ForCoinSwap : Begin
+      inc(AStartIndex,2);
+      if Not Self.accountKey.LoadFromTBytes(ABytes,AStartIndex) then Exit(False);
+      if (AStartIndex + 4 + 8 + 4 > Length(ABytes)) then Exit(False);
+      Move(ABytes[AStartIndex],Self.locked_until_block,4);
+      Move(ABytes[AStartIndex + 4],Self.price,8);
+      Move(ABytes[AStartIndex + 4 + 8],Self.account_to_pay,4);
+      inc(AStartIndex, 4+8+4);
+      if Not Self.new_publicKey.LoadFromTBytes(ABytes,AStartIndex) then Exit(False);
+      if Self.state in [as_ForAtomicAccountSwap,as_ForAtomicCoinSwap] then begin
+        if Not Self.hashed_secret.LoadFromTBytes(ABytes,AStartIndex) then Exit(False);
+      end;
+      Result:=True;
+    End;
+  else
+    raise Exception.Create('DEVELOP ERROR 20200318-1');
+  end;
+end;
+
 { TECDSA_Public_Helper }
 
 function TECDSA_Public_Helper.ToRaw(var OECDSA_Public_Raw: TECDSA_Public_Raw): Boolean;
@@ -117,5 +387,56 @@ begin
   end;
 end;
 
+{ TAccount }
+
+procedure TAccount.Clear;
+begin
+  Self := CT_Account_NUL;
+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
+  else Result := Self.updated_on_block_active_mode;
+end;
+
+{ TPCSafeBoxHeader }
+
+function TPCSafeBoxHeader.GetSavedBlocksCount: Integer;
+begin
+  Result := Self.endBlock - Self.startBlock + 1;
+end;
+
+function TPCSafeBoxHeader.IsAChunk: Boolean;
+begin
+  Result := (Self.startBlock<>0) or (Self.endBlock+1<>Self.blocksCount);
+end;
+
+function TPCSafeBoxHeader.IsFullSafebox: Boolean;
+begin
+  Result := (Self.startBlock=0) and (Self.endBlock+1=Self.blocksCount);
+end;
+
+function TPCSafeBoxHeader.ContainsFirstBlock: Boolean;
+begin
+  Result := (Self.startBlock=0);
+end;
+
+function TPCSafeBoxHeader.ContainsLastBlock: Boolean;
+begin
+  Result := (Self.endBlock+1=Self.blocksCount);
+end;
+
+function TPCSafeBoxHeader.ToString: String;
+begin
+  if IsFullSafebox then begin
+    Result := Format('Fulls SafeboxHeader from %d to %d (%d)',[Self.startBlock,Self.endBlock,Self.blocksCount])
+  end else begin
+    Result := Format('Chunk SafeboxHeader from %d to %d (%d of %d)',[Self.startBlock,Self.endBlock,Self.GetSavedBlocksCount,Self.blocksCount]);
+  end;
+end;
+
+
+
 end.
 

+ 1 - 1
src/core/UPCOperationsBlockValidator.pas

@@ -35,7 +35,7 @@ interface
 {$ENDIF}
 
 
-Uses UThread, UAccounts, UPCOrderedLists, UBlockChain, Classes,
+Uses UThread, UAccounts, UPCOrderedLists, UBlockChain, Classes, UPCDataTypes,
   {$IFNDEF FPC}System.Generics.Collections{$ELSE}Generics.Collections{$ENDIF};
 
 type

+ 6 - 1
src/core/UPCOrderedLists.pas

@@ -27,6 +27,8 @@ uses
   {$IFNDEF FPC}System.Generics.Collections{$ELSE}Generics.Collections{$ENDIF};
 
 Type
+  EOrderedList = Class(Exception);
+
   TCardinalsArray = Array of Cardinal;
 
   // Maintans a Cardinal ordered (without duplicates) list with TRawData each
@@ -298,6 +300,7 @@ end;
 procedure TOrderedRawList.Delete(index: Integer);
 Var P : PRawListData;
 begin
+  if (index<0) or (index>=FList.Count) then raise EOrderedList.Create(Format('Index %d out of range 0..%d',[index,FList.Count-1]));
   P := PRawListData(FList[index]);
   FList.Delete(index);
   Dispose(P);
@@ -337,11 +340,13 @@ end;
 
 function TOrderedRawList.Get(index: Integer): TRawBytes;
 begin
-  Result := PRawListData(FList[index])^.RawData;
+  if (index<0) or (index>=FList.Count) then raise EOrderedList.Create(Format('Index %d out of range 0..%d',[index,FList.Count-1]));
+  Result := Copy(PRawListData(FList[index])^.RawData);
 end;
 
 function TOrderedRawList.GetTag(index: Integer): Integer;
 begin
+  if (index<0) or (index>=FList.Count) then raise EOrderedList.Create(Format('Index %d out of range 0..%d',[index,FList.Count-1]));
   Result := PRawListData(FList[index])^.tag;
 end;
 

+ 7 - 6
src/core/UPCRPCFindAccounts.pas

@@ -39,6 +39,7 @@ Type
 
 implementation
 
+uses UPCDataTypes;
 
 { TRPCFindAccounts }
 
@@ -142,8 +143,8 @@ var
   LAccountNumber : Integer;
   LRaw : TRawBytes;
   LSearchByPubkey : Boolean;
-  LStart, LMax,
-  iPubKey : Integer;
+  LStart, LMax : Integer;
+  LAccountsNumbersList : TAccountsNumbersList;
   LAccount : TAccount;
   i : Integer;
   LErrors : String;
@@ -232,8 +233,8 @@ begin
       Exit;
     end;
     LSearchByPubkey := True;
-    iPubKey := ASender.Node.Bank.SafeBox.OrderedAccountKeysList.IndexOfAccountKey(LAccPubKey);
-    if (iPubKey<0) then begin
+    LAccountsNumbersList := ASender.Node.Bank.SafeBox.OrderedAccountKeysList.GetAccountsUsingThisKey(LAccPubKey);
+    if (Not Assigned(LAccountsNumbersList)) then begin
       // No account available with this pubkey, exit
       Result := True;
       Exit;
@@ -272,8 +273,8 @@ begin
     // Search by type-forSale-balance
     for i := LStart to ASender.Node.Bank.AccountsCount - 1 do begin
       if (LSearchByPubkey) then begin
-        if (i>=ASender.Node.Bank.SafeBox.OrderedAccountKeysList.AccountKeyList[iPubKey].Count) then Break;
-        LAccount := ASender.Node.GetMempoolAccount( ASender.Node.Bank.SafeBox.OrderedAccountKeysList.AccountKeyList[iPubKey].Get(i) );
+        if (i>=LAccountsNumbersList.Count) then Break;
+        LAccount := ASender.Node.GetMempoolAccount( LAccountsNumbersList.Get(i) );
       end else begin
         LAccount := ASender.Node.GetMempoolAccount(i);
       end;

+ 1 - 1
src/core/UPCRPCOpData.pas

@@ -25,7 +25,7 @@ interface
 {$I ./../config.inc}
 
 Uses classes, SysUtils,
-  UJSONFunctions, UAccounts, UBaseTypes, UOpTransaction, UConst,
+  UJSONFunctions, UAccounts, UBaseTypes, UOpTransaction, UConst, UPCDataTypes,
   {$IFNDEF FPC}System.Generics.Collections{$ELSE}Generics.Collections{$ENDIF},
   URPC, UCrypto, UWallet, UBlockChain, ULog;
 

+ 7 - 0
src/core/UPCSafeBoxRootHash.pas

@@ -115,6 +115,7 @@ type
     FSafeBoxHashCalcType: TSafeboxHashCalcType;
     procedure SetSafeBoxHashCalcType(const Value: TSafeboxHashCalcType);
   protected
+    FCachedSafeboxHash : TRawBytes;
     procedure NotifyUpdated(AStartPos, ACountBytes : Integer); override;
     procedure RedoNextLevelsForMerkleRootHash;
   public
@@ -379,6 +380,7 @@ end;
 
 constructor TBytesBuffer32Safebox.Create(ADefaultIncrement: Integer);
 begin
+  FCachedSafeboxHash := Nil;
   FNextLevelBytesBuffer := Nil;
   FSafeBoxHashCalcType := sbh_Single_Sha256;
   inherited Create(ADefaultIncrement);
@@ -392,6 +394,8 @@ end;
 
 function TBytesBuffer32Safebox.GetSafeBoxHash: TRawBytes;
 begin
+  if System.Length(FCachedSafeboxHash)=32 then Exit(FCachedSafeboxHash);
+
   if (FSafeBoxHashCalcType = sbh_Single_Sha256) then begin
     if ((Self.Length MOD 32)=0) and (Self.Length>0) then begin
       Result := TCrypto.DoSha256(Self.Memory,Self.Length);
@@ -409,6 +413,7 @@ begin
   end else begin
     Result := Nil;
   end;
+  FCachedSafeboxHash := Result; // Save to a Cache
 end;
 
 procedure TBytesBuffer32Safebox.NotifyUpdated(AStartPos, ACountBytes: Integer);
@@ -417,6 +422,7 @@ var LLevelItemIndex, LLevelItemsCount : Integer;
   LSHA256 : TRawBytes;
 begin
   inherited;
+  FCachedSafeboxHash := Nil; // Set my cahce to Nil
   if (FSafeBoxHashCalcType = sbh_Single_Sha256) or
     ((ACountBytes<>32) or ((AStartPos MOD 32)<>0)) or (Self.Length<64) or ((Self.Length MOD 32)<>0) then begin
     FreeAndNil(FNextLevelBytesBuffer);
@@ -471,6 +477,7 @@ end;
 procedure TBytesBuffer32Safebox.SetSafeBoxHashCalcType(const Value: TSafeboxHashCalcType);
 begin
   if FSafeBoxHashCalcType=Value then Exit;
+  FCachedSafeboxHash := Nil;
   FSafeBoxHashCalcType := Value;
   FreeAndNil(FNextLevelBytesBuffer);
 end;

+ 1 - 1
src/core/UPCTNetDataExtraMessages.pas

@@ -33,7 +33,7 @@ interface
 {$ENDIF}
 
 Uses Classes, UThread, UAccounts, UBlockChain, UNetProtocol, SysUtils, UNode,
-  UWallet, UNetProtection,
+  UWallet, UNetProtection, UPCDataTypes,
   {$IFNDEF FPC}System.Generics.Collections{$ELSE}Generics.Collections{$ENDIF};
 
 type

+ 23 - 0
src/core/UPCTemporalFileStream.pas

@@ -36,6 +36,7 @@ Type
   public
     Constructor Create(const AInitialName : String); reintroduce;
     Destructor Destroy; override;
+    class function GetTemporalFileName(const AInitialName : String) : String;
   End;
 
 implementation
@@ -78,4 +79,26 @@ begin
   end;
 end;
 
+class function TPCTemporalFileStream.GetTemporalFileName(
+  const AInitialName: String): String;
+var LFolder, LTime, LFileName : String;
+  i : Integer;
+begin
+  Result:= '';
+  LFolder := TNode.GetPascalCoinDataFolder+PathDelim+'Temp';
+  ForceDirectories(LFolder);
+  i := 0;
+  repeat
+    LTime := FormatDateTime('yyyymmddhhnnsszzz',Now);
+    if i>0 then begin
+      Sleep(1);
+      LFileName := LFolder + PathDelim + AInitialName + LTime +'_'+ IntToStr(i) + '.tmp';
+    end else begin
+      LFileName := LFolder + PathDelim + AInitialName + LTime + '.tmp';
+    end;
+    inc(i);
+  until (Not (FileExists(LFileName)) or (i>5000));
+  Result := LFileName;
+end;
+
 end.

+ 1 - 1
src/core/UPoolMining.pas

@@ -31,7 +31,7 @@ Uses
   {LCLIntf, LCLType, LMessages,}
 {$ENDIF}
   UTCPIP, SysUtils, UThread, SyncObjs, Classes, UJSONFunctions, UPCEncryption, UNode,
-  UCrypto, UAccounts, UConst, UBlockChain, UBaseTypes,
+  UCrypto, UAccounts, UConst, UBlockChain, UBaseTypes, UPCDataTypes,
   {$IFNDEF FPC}System.Generics.Collections{$ELSE}Generics.Collections{$ENDIF};
 
 Const

+ 17 - 16
src/core/URPC.pas

@@ -2776,6 +2776,7 @@ Var c,c2,c3 : Cardinal;
   opr : TOperationResume;
   r1,r2 : TRawBytes;
   ocl : TOrderedCardinalList;
+  Lanl : TAccountsNumbersList;
   jsonarr : TPCJSONArray;
   jso : TPCJSONObject;
   LRPCProcessMethod : TRPCProcessMethod;
@@ -2830,12 +2831,12 @@ begin
         ErrorDesc := 'Public key not found in wallet';
         exit;
       end;
-      ocl := _RPCServer.WalletKeys.AccountsKeyList.AccountKeyList[i];
+      Lanl := _RPCServer.WalletKeys.AccountsKeyList.AccountKeyList[i];
       k := params.AsInteger('max',100);
       l := params.AsInteger('start',0);
-      for j := 0 to ocl.Count - 1 do begin
+      for j := 0 to Lanl.Count - 1 do begin
         if (j>=l) then begin
-          account := FNode.GetMempoolAccount(ocl.Get(j));
+          account := FNode.GetMempoolAccount(Lanl.Get(j));
           TPascalCoinJSONComp.FillAccountObject(account,jsonarr.GetAsObject(jsonarr.Count));
         end;
         if (k>0) And ((j+1)>=(k+l)) then break;
@@ -2846,10 +2847,10 @@ begin
       l := params.AsInteger('start',0);
       c := 0;
       for i:=0 to _RPCServer.WalletKeys.AccountsKeyList.Count-1 do begin
-        ocl := _RPCServer.WalletKeys.AccountsKeyList.AccountKeyList[i];
-        for j := 0 to ocl.Count - 1 do begin
+        Lanl := _RPCServer.WalletKeys.AccountsKeyList.AccountKeyList[i];
+        for j := 0 to Lanl.Count - 1 do begin
           if (c>=l) then begin
-            account := FNode.GetMempoolAccount(ocl.Get(j));
+            account := FNode.GetMempoolAccount(Lanl.Get(j));
             TPascalCoinJSONComp.FillAccountObject(account,jsonarr.GetAsObject(jsonarr.Count));
           end;
           inc(c);
@@ -2878,15 +2879,15 @@ begin
         ErrorDesc := 'Public key not found in wallet';
         exit;
       end;
-      ocl := _RPCServer.WalletKeys.AccountsKeyList.AccountKeyList[i];
-      jsonresponse.GetAsVariant('result').value := ocl.count;
+      Lanl := _RPCServer.WalletKeys.AccountsKeyList.AccountKeyList[i];
+      jsonresponse.GetAsVariant('result').value := Lanl.count;
       Result := true;
     end else begin
       ErrorDesc := '';
       c :=0;
       for i:=0 to _RPCServer.WalletKeys.AccountsKeyList.Count-1 do begin
-        ocl := _RPCServer.WalletKeys.AccountsKeyList.AccountKeyList[i];
-        inc(c,ocl.count);
+        Lanl := _RPCServer.WalletKeys.AccountsKeyList.AccountKeyList[i];
+        inc(c,Lanl.count);
       end;
       jsonresponse.GetAsVariant('result').value := c;
       Result := true;
@@ -2908,10 +2909,10 @@ begin
         ErrorDesc := 'Public key not found in wallet';
         exit;
       end;
-      ocl := _RPCServer.WalletKeys.AccountsKeyList.AccountKeyList[i];
+      Lanl := _RPCServer.WalletKeys.AccountsKeyList.AccountKeyList[i];
       account.balance := 0;
-      for j := 0 to ocl.Count - 1 do begin
-        inc(account.balance, FNode.GetMempoolAccount(ocl.Get(j)).balance );
+      for j := 0 to Lanl.Count - 1 do begin
+        inc(account.balance, FNode.GetMempoolAccount(Lanl.Get(j)).balance );
       end;
       jsonresponse.GetAsVariant('result').value := ToJSONCurrency(account.balance);
       Result := true;
@@ -2920,9 +2921,9 @@ begin
       c :=0;
       account.balance := 0;
       for i:=0 to _RPCServer.WalletKeys.AccountsKeyList.Count-1 do begin
-        ocl := _RPCServer.WalletKeys.AccountsKeyList.AccountKeyList[i];
-        for j := 0 to ocl.Count - 1 do begin
-          inc(account.balance, FNode.GetMempoolAccount(ocl.Get(j)).balance );
+        Lanl := _RPCServer.WalletKeys.AccountsKeyList.AccountKeyList[i];
+        for j := 0 to Lanl.Count - 1 do begin
+          inc(account.balance, FNode.GetMempoolAccount(Lanl.Get(j)).balance );
         end;
       end;
       jsonresponse.GetAsVariant('result').value := ToJSONCurrency(account.balance);

+ 9 - 2
src/core/upcdaemon.pas

@@ -26,7 +26,7 @@ uses
   Classes, SysUtils, daemonapp,
   SyncObjs, UOpenSSL, UCrypto, UNode, UFileStorage, UFolderHelper, UWallet, UConst, ULog, UNetProtocol,
   IniFiles, UBaseTypes,
-  UThread, URPC, UPoolMining, UAccounts;
+  UThread, URPC, UPoolMining, UAccounts, UPCDataTypes;
 
 Const
   CT_INI_SECTION_GLOBAL = 'GLOBAL';
@@ -56,6 +56,7 @@ Type
     FMaxBlockToRead: Int64;
     FLastNodesCacheUpdatedTS : TTickCount;
     procedure OnNetDataReceivedHelloMessage(Sender : TObject);
+    procedure OnInitSafeboxProgressNotify(sender : TObject; const message : String; curPos, totalCount : Int64);
   protected
     Procedure BCExecute; override;
   public
@@ -122,6 +123,12 @@ begin
   TNode.Node.PeerCache := s;
 end;
 
+procedure TPCDaemonThread.OnInitSafeboxProgressNotify(sender: TObject;
+  const message: String; curPos, totalCount: Int64);
+begin
+  TLog.NewLog(ltdebug,ClassName,Format('Progress (%d/%d): %s',[curPos,totalCount,message]));
+end;
+
 procedure TPCDaemonThread.BCExecute;
 var
   FNode : TNode;
@@ -249,7 +256,7 @@ begin
         TNetData.NetData.OnReceivedHelloMessage:=@OnNetDataReceivedHelloMessage;
         FNode.PeerCache:=  FIniFile.ReadString(CT_INI_SECTION_GLOBAL,CT_INI_IDENT_PEERCACHE,'');
         // Reading database
-        FNode.InitSafeboxAndOperations(MaxBlockToRead);
+        FNode.InitSafeboxAndOperations(MaxBlockToRead,@OnInitSafeboxProgressNotify);
         FWalletKeys.SafeBox := FNode.Node.Bank.SafeBox;
         FNode.Node.NetServer.Port:=FIniFile.ReadInteger(CT_INI_SECTION_GLOBAL,CT_INI_IDENT_NODE_PORT,CT_NetServer_Port);
         FNode.Node.NetServer.MaxConnections:=FIniFile.ReadInteger(CT_INI_SECTION_GLOBAL,CT_INI_IDENT_NODE_MAX_CONNECTIONS,CT_MaxClientsConnected);

+ 1 - 0
src/gui-classic/UFRMAccountSelect.pas

@@ -28,6 +28,7 @@ uses
 {$ELSE}
   LCLIntf, LCLType, LMessages,
 {$ENDIF}
+  UPCDataTypes,
   Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
   Dialogs, UAccounts, Grids, StdCtrls, Buttons, ExtCtrls, UWallet, UNode,
   UGridUtils, UConst, UThread, UPCOrderedLists, UBaseTypes;

+ 2 - 2
src/gui-classic/UFRMOperation.pas

@@ -32,7 +32,7 @@ uses
   Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
   Dialogs, StdCtrls, UNode, UWallet, UCrypto, Buttons, UBlockChain,
   UAccounts, UFRMAccountSelect, ActnList, ComCtrls, Types, UFRMMemoText,
-  UPCEncryption, UBaseTypes, UPCOrderedLists;
+  UPCEncryption, UBaseTypes, UPCDataTypes, UPCOrderedLists;
 
 Const
   CM_PC_WalletKeysChanged = WM_USER + 1;
@@ -192,7 +192,7 @@ implementation
 
 uses
   UConst, UOpTransaction, UFRMNewPrivateKeyType, UFRMWalletKeys, UFRMHashLock,
-  UCommon, UPCDataTypes, ULog, UGUIUtils;
+  UCommon, ULog, UGUIUtils;
 
 {$IFnDEF FPC}
   {$R *.dfm}

+ 1 - 1
src/gui-classic/UFRMOperationsExplorer.pas

@@ -132,7 +132,7 @@ Uses
 {$IFDEF TESTNET}
    UFRMRandomOperations,
 {$ENDIF}
-   UFRMRPCCalls, UFRMMemoText;
+   UPCDataTypes, UFRMRPCCalls, UFRMMemoText;
 
 
 { TFRMOperationsExplorer }

+ 2 - 0
src/gui-classic/UFRMRandomOperations.pas

@@ -129,6 +129,8 @@ implementation
   {$R *.lfm}
 {$ENDIF}
 
+uses UPCDataTypes;
+
 { TRandomGeneratorThread }
 
 procedure TRandomGeneratorThread.OnBankNewBlock(Sender: TObject);

+ 38 - 7
src/gui-classic/UFRMWallet.pas

@@ -34,7 +34,7 @@ uses
   ExtCtrls, ComCtrls, UWallet, StdCtrls, ULog, Grids, UAppParams, UBlockChain,
   UNode, UGridUtils, UJSONFunctions, UAccounts, Menus, ImgList, UNetProtocol,
   UCrypto, Buttons, UPoolMining, URPC, UFRMAccountSelect, UConst,
-  UAccountKeyStorage, UBaseTypes, UPCDataTypes,
+  UAccountKeyStorage, UBaseTypes, UPCDataTypes, UOrderedList,
   UFRMRPCCalls, UTxMultiOperation,
   {$IFNDEF FPC}System.Generics.Collections{$ELSE}Generics.Collections{$ENDIF};
 
@@ -250,6 +250,7 @@ type
     {$IFDEF TESTING_NO_POW_CHECK}
     Procedure Test_CreateABlock(Sender: TObject);
     {$ENDIF}
+    Procedure Test_ConnectDisconnect(Sender: TObject);
     {$ENDIF}
     Procedure Test_ShowPublicKeys(Sender: TObject);
     Procedure Test_ShowOperationsInMemory(Sender: TObject);
@@ -338,6 +339,7 @@ Uses UFolderHelper,
   UPCTNetDataExtraMessages,
   UFRMDiagnosticTool,
   {$ENDIF}
+  UAbstractBTree,
   UFRMAbout, UFRMOperation, UFRMWalletKeys, UFRMPayloadDecoder, UFRMNodesIp, UFRMMemoText,
   USettings, UCommon, UPCOrderedLists;
 
@@ -393,6 +395,8 @@ begin
     ExtractFileDir(Application.ExeName)+PathDelim+CT_Hardcoded_RandomHash_Table_Filename,
     LRaw );
   {$ENDIF}
+  FLastTC := 0;
+  OnProgressNotify(Self,'Initializing databases',0,0);
   // Read Operations saved from disk
   TNode.Node.InitSafeboxAndOperations($FFFFFFFF,OnProgressNotify); // New Build 2.1.4 to load pending operations buffer
   TNode.Node.AutoDiscoverNodes(CT_Discover_IPs);
@@ -1089,8 +1093,15 @@ begin
   mi := TMenuItem.Create(MainMenu);
   mi.Caption:='Create a block';
   mi.OnClick:=Test_CreateABlock;
+  mi.ShortCut := TextToShortCut('CTRL+B');
   miAbout.Add(mi);
   {$ENDIF}
+  mi := TMenuItem.Create(MainMenu);
+  mi.Caption:='Connect/Disconnect';
+  mi.OnClick:=Test_ConnectDisconnect;
+  mi.ShortCut := TextToShortCut('CTRL+D');
+  miAbout.Add(mi);
+
   mi := TMenuItem.Create(MainMenu);
   mi.Caption:='Create Random operations';
   mi.OnClick:=Test_RandomOperations;
@@ -1120,19 +1131,25 @@ end;
 
 {$IFDEF TESTING_NO_POW_CHECK}
 procedure TFRMWallet.Test_CreateABlock(Sender: TObject);
-var ops : TPCOperationsComp;
+var ops, mempoolOps : TPCOperationsComp;
   nba : TBlockAccount;
-  errors : AnsiString;
+  errors : String;
+
 begin
   {$IFDEF TESTNET}
   ops := TPCOperationsComp.Create(Nil);
   Try
     ops.bank := FNode.Bank;
-    ops.CopyFrom(FNode.Operations);
-    ops.BlockPayload:=IntToStr(FNode.Bank.BlocksCount);
+    mempoolOps := FNode.LockMempoolRead;
+    try
+      ops.CopyFrom(mempoolOps);
+    finally
+      FNode.UnlockMempoolRead;
+    end;
+    ops.BlockPayload.FromString(IntToStr(FNode.Bank.BlocksCount));
     ops.nonce := FNode.Bank.BlocksCount;
     ops.UpdateTimestamp;
-    FNode.AddNewBlockChain(Nil,ops,nba,errors);
+    FNode.AddNewBlockChain(Nil,ops,errors);
   finally
     ops.Free;
   end;
@@ -1143,6 +1160,18 @@ end;
 {$ENDIF}
 
 {$IFDEF TESTNET}
+
+procedure TFRMWallet.Test_ConnectDisconnect(Sender: TObject);
+begin
+  TNetData.NetData.NetConnectionsActive := Not TNetData.NetData.NetConnectionsActive;
+  Exit;
+  if FNode.NetServer.Active then begin
+    FNode.NetServer.Active := False;
+  end else begin
+    FNode.NetServer.Active := True;
+  end;
+end;
+
 procedure TFRMWallet.Test_RandomOperations(Sender: TObject);
 Var FRM : TFRMRandomOperations;
 begin
@@ -1207,6 +1236,7 @@ begin
           TCrypto.ToHexaString(TAccountComp.AccountKey2RawString(acc.accountInfo.new_publicKey))]));
       end;
     end;
+    {$IFnDEF USE_ABSTRACTMEM}
     l := TAccountKeyStorage.KS.LockList;
     try
       sl.Add(Format('%d public keys in TAccountKeyStorage data',[l.count]));
@@ -1240,6 +1270,7 @@ begin
         ak.EC_OpenSSL_NID,
         TCrypto.ToHexaString(TAccountComp.AccountKey2RawString(ak)) ]));
     end;
+    {$ENDIF}
     F := TFRMMemoText.Create(Self);
     try
       F.InitData('Keys in safebox',sl.Text);
@@ -2558,7 +2589,7 @@ begin
     FLog.OnNewLog := Nil;
     if PageControl.ActivePage = tsLogs then PageControl.ActivePage := tsMyAccounts;
   end else FLog.OnNewLog := OnNewLog;
-  if FAppParams.ParamByName[CT_PARAM_SaveLogFiles].GetAsBoolean(false) then begin
+  if (FAppParams.ParamByName[CT_PARAM_SaveLogFiles].GetAsBoolean(false)) then begin
     if FAppParams.ParamByName[CT_PARAM_SaveDebugLogs].GetAsBoolean(false) then FLog.SaveTypes := CT_TLogTypes_ALL
     else FLog.SaveTypes := CT_TLogTypes_DEFAULT;
     FLog.FileName := TNode.GetPascalCoinDataFolder+PathDelim+'PascalCointWallet.log';

+ 6 - 2
src/gui-classic/UFRMWalletKeys.pas

@@ -96,7 +96,7 @@ uses
   LCLIntf, LCLType,
 {$ENDIF}
   UCrypto, UAccounts, UFRMNewPrivateKeyType, UBaseTypes, UPCEncryption,
-  UCommon, UGUIUtils;
+  UPCDataTypes, UCommon, UGUIUtils;
 
 {$IFnDEF FPC}
   {$R *.dfm}
@@ -580,6 +580,7 @@ procedure TFRMWalletKeys.UpdateWalletKeys;
 Var lasti,i,j : Integer;
   selected_wk,wk : TWalletKey;
   s : AnsiString;
+  Lanl : TAccountsNumbersList;
 begin
   GetSelectedWalletKeyAndIndex(wk,lasti);
   lbWalletKeys.Items.BeginUpdate;
@@ -608,7 +609,10 @@ begin
       if (WalletKeys is TWalletKeysExt) then begin
         j := TWalletKeysExt(WalletKeys).AccountsKeyList.IndexOfAccountKey(wk.AccountKey);
         if (j>=0) then begin
-          s := s+' ('+IntToStr(TWalletKeysExt(WalletKeys).AccountsKeyList.AccountKeyList[j].Count)+' Accounts)';
+          Lanl := TWalletKeysExt(WalletKeys).AccountsKeyList.AccountKeyList[j];
+          if Assigned(Lanl) then begin
+            s := s+' ('+IntToStr(Lanl.Count)+' Accounts)';
+          end else s := s+' (No Accounts)';
         end;
       end;
       if Not Assigned(wk.PrivateKey) then begin

+ 36 - 14
src/gui-classic/UGridUtils.pas

@@ -30,7 +30,7 @@ uses
 {$ELSE}
   LCLIntf, LCLType, LMessages,
 {$ENDIF}
-  Classes, Grids, UNode, UAccounts, UBlockChain, UAppParams, UThread,
+  Classes, Grids, UNode, UAccounts, UBlockChain, UAppParams, UThread, UPCDataTypes,
   UWallet, UCrypto, UPoolMining, URPC, UBaseTypes, UPCOrderedLists,
   {$IFNDEF FPC}System.Generics.Collections{$ELSE}Generics.Collections{$ENDIF};
 
@@ -289,8 +289,8 @@ uses
 
 procedure TAccountsGridUpdateThread.BCExecute;
 Var
-  l : TOrderedCardinalList;
-  i,j : Integer;
+  l : TAccountsNumbersList;
+  i,j, j_min, j_max : Integer;
   c  : Cardinal;
   LApplyfilter : Boolean;
   LAccount : TAccount;
@@ -307,26 +307,44 @@ begin
         while (Not Terminated) and (i<FAccountsGridFilter.OrderedAccountsKeyList.Count)
           and ((FAccountsGridFilter.indexAccountsKeyList<0) or (FAccountsGridFilter.indexAccountsKeyList=i)) do begin
 
+          j_min := 0;
+
+          while (j_min>=0) do begin
+
           LNode.bank.SafeBox.StartThreadSafe;
           FAccountsGridFilter.OrderedAccountsKeyList.Lock; // Protection v4
           Try
             l := FAccountsGridFilter.OrderedAccountsKeyList.AccountKeyList[i];
-            for j := 0 to l.Count - 1 do begin
-              LAccount := LNode.Bank.SafeBox.Account(l.Get(j));
-              if LApplyfilter then begin
-                if (LAccount.balance>=FAccountsGridFilter.MinBalance) And ((FAccountsGridFilter.MaxBalance<0) Or (LAccount.balance<=FAccountsGridFilter.MaxBalance)) then begin
+            if Assigned(l) then begin
+
+              j_max := (j_min + 500);
+              if j_max>=l.Count then j_max := l.Count-1;
+
+              for j := j_min to j_max do begin
+                LAccount := LNode.Bank.SafeBox.Account(l.Get(j));
+                if LApplyfilter then begin
+                  if (LAccount.balance>=FAccountsGridFilter.MinBalance) And ((FAccountsGridFilter.MaxBalance<0) Or (LAccount.balance<=FAccountsGridFilter.MaxBalance)) then begin
+                    FProcessedList.Add(LAccount.account);
+                    FBalance := FBalance + LAccount.balance;
+                  end;
+                end else begin
                   FProcessedList.Add(LAccount.account);
                   FBalance := FBalance + LAccount.balance;
                 end;
-              end else begin
-                FProcessedList.Add(LAccount.account);
-                FBalance := FBalance + LAccount.balance;
+                if Terminated then Exit;
+              end;
+              j_min := j_max+1;
+              if (j_max>=(l.Count-1)) then begin
+                j_min := -1;
+                break;
               end;
-              if Terminated then Exit;
             end;
           finally
             FAccountsGridFilter.OrderedAccountsKeyList.Unlock;
             LNode.Bank.SafeBox.EndThreadSave;
+          end;
+            if j_max>=0 then Sleep(0);
+
           end;
           inc(i);
         end;
@@ -342,10 +360,10 @@ begin
         end;
       end;
   Finally
-    FisProcessing := False;
     if Not Terminated then begin
       Synchronize(SynchronizedOnTerminated);
     end;
+    FisProcessing := False;
   End;
 end;
 
@@ -377,6 +395,7 @@ begin
     finally
       FAccountsGrid.UnlockAccountsList;
     end;
+    FisProcessing := False;
     if Assigned(FAccountsGrid.FOnAccountsGridUpdatedData) then  FAccountsGrid.FOnAccountsGridUpdatedData(FAccountsGrid);
   end;
 end;
@@ -860,7 +879,10 @@ begin
   LTmp := FAccountsGridUpdateThread;
   FAccountsGridUpdateThread := Nil;
   if Assigned(Ltmp) then begin
-    if Not AWaitUntilTerminated then LTmp.FreeOnTerminate := True;
+    if Not LTmp.IsProcessing then AWaitUntilTerminated := True;
+    if Not AWaitUntilTerminated then begin
+      LTmp.FreeOnTerminate := True;
+    end;
     LTmp.Terminate;
     if AWaitUntilTerminated then begin
       LTmp.WaitFor;
@@ -896,10 +918,10 @@ end;
 procedure TAccountsGrid.UpdateData;
 begin
   UpdateAccountsBalance;
+  TerminateAccountGridUpdateThread(False);
   if Assigned(Node) then begin
     case FAccountsGridDatasource of
       acds_NodeFiltered: begin
-        TerminateAccountGridUpdateThread(False);
         FAccountsBalance := 0;
         FAccountsGridUpdateThread := TAccountsGridUpdateThread.Create(Self,AccountsGridFilter);
       end;

+ 47 - 0
src/libraries/abstractmem/ConfigAbstractMem.inc

@@ -0,0 +1,47 @@
+{
+  This file is part of AbstractMem framework
+
+  Copyright (C) 2020 Albert Molina - [email protected]
+  
+  https://github.com/PascalCoinDev/  
+
+  *** BEGIN LICENSE BLOCK *****
+
+  The contents of this files are subject to the Mozilla Public License Version
+  2.0 (the "License"); you may not use this file except in compliance with
+  the License. You may obtain a copy of the License at
+  http://www.mozilla.org/MPL
+
+  Software distributed under the License is distributed on an "AS IS" basis,
+  WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
+  for the specific language governing rights and limitations under the License.
+
+  The Initial Developer of the Original Code is Albert Molina.
+
+  ***** END LICENSE BLOCK *****
+}
+
+{.$define ABSTRACTMEM_TESTING_MODE}
+// define this if you want some testing mode capabilities
+
+{.$define ABSTRACTMEM_ENABLE_STATS}
+// define this to activate some stats on objects usefull for testing
+
+{$if (defined(ABSTRACTMEM_TESTING_MODE)) or (defined(ABSTRACTMEM_USE_TLOG))}{$define ABSTRACTMEM_ENABLE_STATS}{$endif}
+
+{ 
+  HISTORY
+  
+  Version 0.1 - January-April 2020
+  - First implementation for use in PascalCoin project as a File/Mem cached struct to store SafeBox
+  - Creation of TAbstractMem, TAVLAbstractTree and TCacheMem for use in TFileMem
+  - Initial tests
+
+  Version 1.0 - May 2020
+  - Integration with PascalCoin project and final tests
+  
+
+}
+
+const
+  CT_ABSTRACTMEM_VERSION = 1.0; // Each revision should increase this version...

+ 493 - 0
src/libraries/abstractmem/UAVLCache.pas

@@ -0,0 +1,493 @@
+unit UAVLCache;
+
+{
+  This file is part of AbstractMem framework
+
+  Copyright (C) 2020 Albert Molina - [email protected]
+
+  https://github.com/PascalCoinDev/
+
+  *** BEGIN LICENSE BLOCK *****
+
+  The contents of this files are subject to the Mozilla Public License Version
+  2.0 (the "License"); you may not use this file except in compliance with
+  the License. You may obtain a copy of the License at
+  http://www.mozilla.org/MPL
+
+  Software distributed under the License is distributed on an "AS IS" basis,
+  WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
+  for the specific language governing rights and limitations under the License.
+
+  The Initial Developer of the Original Code is Albert Molina.
+
+  See ConfigAbstractMem.inc file for more info
+
+  ***** END LICENSE BLOCK *****
+}
+
+{$IFDEF FPC}
+  {$MODE DELPHI}
+{$ENDIF}
+
+interface
+
+uses Classes, SysUtils,
+  SyncObjs,
+  UAbstractBTree, UOrderedList,
+  {$IFNDEF FPC}System.Generics.Collections,System.Generics.Defaults{$ELSE}Generics.Collections,Generics.Defaults{$ENDIF};
+
+type
+  EAVLCache = class(Exception);
+
+  { TAVLCache }
+
+  TAVLCache<T> = Class
+  public
+    type
+      PAVLCacheMemData = ^TAVLCacheMemData;
+      TAVLCacheMemData = record
+        parent : PAVLCacheMemData;
+        left : PAVLCacheMemData;
+        right : PAVLCacheMemData;
+        balance : ShortInt;
+        //
+        used_previous : PAVLCacheMemData;
+        used_next : PAVLCacheMemData;
+        pendingToSave : Boolean;
+        //
+        data : T;
+        procedure Clear;
+        function ToString : String;
+      end;
+  private
+    type
+    { TAVLCacheMem }
+    TAVLCacheMem = Class(TAVLAbstractTree<PAVLCacheMemData>)
+    private
+      FRoot : PAVLCacheMemData;
+      FOldestUsed, FNewestUsed : PAVLCacheMemData;
+    protected
+      function GetRoot: PAVLCacheMemData; override;
+      procedure SetRoot(const Value: PAVLCacheMemData); override;
+      function HasPosition(const ANode : PAVLCacheMemData; APosition : TAVLTreePosition) : Boolean; override;
+      function GetPosition(const ANode : PAVLCacheMemData; APosition : TAVLTreePosition) : PAVLCacheMemData; override;
+      procedure SetPosition(var ANode : PAVLCacheMemData; APosition : TAVLTreePosition; const ANewValue : PAVLCacheMemData); override;
+      procedure ClearPosition(var ANode : PAVLCacheMemData; APosition : TAVLTreePosition); override;
+      function GetBalance(const ANode : PAVLCacheMemData) : Integer; override;
+      procedure SetBalance(var ANode : PAVLCacheMemData; ANewBalance : Integer); override;
+      function AreEquals(const ANode1, ANode2 : PAVLCacheMemData) : Boolean; override;
+      procedure ClearNode(var ANode : PAVLCacheMemData); override;
+      procedure DisposeNode(var ANode : PAVLCacheMemData); override;
+
+      procedure DoMark(var ANode : PAVLCacheMemData; AAddToList : Boolean);
+
+    public
+      function IsNil(const ANode : PAVLCacheMemData) : Boolean; override;
+      Constructor Create(const OnCompareMethod: TComparison<PAVLCacheMemData>; AAllowDuplicates : Boolean); override;
+      function ConsistencyCheck(const AErrors : TStrings): integer; override;
+    end;
+    var FAVLCacheMem : TAVLCacheMem;
+    FDefaultMax : Integer;
+    FAVLCacheLock : TCriticalSection;
+  protected
+    procedure BeforeDelete(var AData : T); virtual;
+    procedure ConsistencyCheck;
+  public
+    Constructor Create(ADefaultMax : Integer; const AOnCompareMethod: TComparison<PAVLCacheMemData>);
+    Destructor Destroy; override;
+    //
+    function Find(const AData : T; out AFound : T) : Boolean;
+    procedure Add(const AData : T);
+    procedure Remove(const AData : T);
+    function Exists(const AData : T) : Boolean;
+    procedure Clear;
+    function TreeToString: String;
+    function ToString(const AData : T) : String; overload; virtual;
+  End;
+
+implementation
+
+{ TAVLCache.TAVLCacheMem }
+
+function TAVLCache<T>.TAVLCacheMem.GetRoot: PAVLCacheMemData;
+begin
+  Result := FRoot;
+end;
+
+procedure TAVLCache<T>.TAVLCacheMem.SetRoot(const Value: PAVLCacheMemData);
+begin
+  FRoot := Value;
+end;
+
+function TAVLCache<T>.TAVLCacheMem.HasPosition(const ANode: PAVLCacheMemData;
+  APosition: TAVLTreePosition): Boolean;
+begin
+  case APosition of
+    poParent: Result := Assigned( ANode^.parent );
+    poLeft: Result := Assigned( ANode^.left );
+    poRight: Result := Assigned( ANode^.right );
+  else raise EAVLAbstractTree.Create('Undefined 20200324-5');
+  end;
+end;
+
+function TAVLCache<T>.TAVLCacheMem.GetPosition(const ANode: PAVLCacheMemData;
+  APosition: TAVLTreePosition): PAVLCacheMemData;
+begin
+  case APosition of
+    poParent: Result := ANode^.parent;
+    poLeft: Result := ANode^.left;
+    poRight: Result := ANode^.right;
+  else raise EAVLAbstractTree.Create('Undefined 20200324-4');
+  end;
+end;
+
+procedure TAVLCache<T>.TAVLCacheMem.SetPosition(var ANode: PAVLCacheMemData;
+  APosition: TAVLTreePosition; const ANewValue: PAVLCacheMemData);
+begin
+  case APosition of
+    poParent: ANode^.parent := ANewValue;
+    poLeft: ANode^.left := ANewValue;
+    poRight: ANode^.right := ANewValue;
+  end;
+end;
+
+procedure TAVLCache<T>.TAVLCacheMem.ClearPosition(var ANode: PAVLCacheMemData;
+  APosition: TAVLTreePosition);
+begin
+  case APosition of
+    poParent: ANode^.parent := Nil;
+    poLeft: ANode^.left := Nil;
+    poRight: ANode^.right := Nil;
+  end;
+end;
+
+function TAVLCache<T>.TAVLCacheMem.ConsistencyCheck(const AErrors: TStrings): integer;
+var i, iLOrderPos : Integer;
+  PLast, PCurrent : PAVLCacheMemData;
+  LTotalNodes : Integer;
+  LOrder : TOrderedList<PAVLCacheMemData>;
+begin
+  if Assigned(AErrors) then begin
+    AErrors.Clear;
+  end;
+  Result := inherited ConsistencyCheck(AErrors);
+  if Assigned(AErrors) then begin
+    if (Result<>0) or (AErrors.Text<>'') then raise EAVLCache.Create(Format('Consistency error %d errors: %s',[Result,AErrors.Text]));
+
+  end else if (Result<>0) then raise EAVLCache.Create(Format('Consistency error %d',[Result]));
+
+  //
+  LTotalNodes := 0;
+  PCurrent := FindLowest;
+  while (Assigned(PCurrent)) do begin
+    inc(LTotalNodes);
+    PCurrent := FindSuccessor(PCurrent);
+  end;
+
+  LOrder := TOrderedList<PAVLCacheMemData>.Create(False,OnCompareMethod);
+  try
+    PLast := Nil;
+    PCurrent := FOldestUsed;
+    i := 0;
+    while (Assigned(PCurrent)) do begin
+      inc(i);
+      if PCurrent^.used_previous<>PLast then raise EAVLCache.Create(Format('Previous <> Last at %d for %s',[i,PCurrent^.ToString]));
+      if LOrder.Find( PCurrent, iLOrderPos ) then begin
+        raise EAVLCache.Create(Format('Circular in mark at %d for %s',[i,PCurrent^.ToString]));
+      end;
+      if LOrder.Add(PCurrent)<0 then raise EAVLCache.Create(Format('Circular in mark at %d for %s',[i,PCurrent^.ToString]));
+      PLast := PCurrent;
+      PCurrent := PCurrent^.used_next;
+    end;
+    // Check last
+    if (PLast<>FNewestUsed) then raise EAVLCache.Create(Format('Last <> Newest at %d/%d',[i,LTotalNodes]));
+    if (i<>LTotalNodes) then raise EAVLCache.Create(Format('Marked nodes %d <> CacheData nodes %d',[i,LTotalNodes]));
+
+  finally
+    LOrder.Free;
+  end;
+
+end;
+
+constructor TAVLCache<T>.TAVLCacheMem.Create(
+  const OnCompareMethod: TComparison<PAVLCacheMemData>;
+  AAllowDuplicates: Boolean);
+begin
+  inherited;
+  FRoot := Nil;
+  FOldestUsed := Nil;
+  FNewestUsed := Nil;
+end;
+
+function TAVLCache<T>.TAVLCacheMem.GetBalance(const ANode: PAVLCacheMemData
+  ): Integer;
+begin
+  Result := ANode^.balance;
+end;
+
+procedure TAVLCache<T>.TAVLCacheMem.SetBalance(var ANode: PAVLCacheMemData;
+  ANewBalance: Integer);
+begin
+  ANode^.balance := ANewBalance;
+end;
+
+function TAVLCache<T>.TAVLCacheMem.AreEquals(const ANode1,
+  ANode2: PAVLCacheMemData): Boolean;
+begin
+  Result := ANode1 = ANode2;
+end;
+
+procedure TAVLCache<T>.TAVLCacheMem.ClearNode(var ANode: PAVLCacheMemData);
+begin
+  ANode := Nil;
+end;
+
+procedure TAVLCache<T>.TAVLCacheMem.DisposeNode(var ANode: PAVLCacheMemData);
+begin
+  if Not Assigned(ANode) then Exit;
+  Dispose( ANode );
+  ANode := Nil;
+end;
+
+procedure TAVLCache<T>.TAVLCacheMem.DoMark(var ANode: PAVLCacheMemData; AAddToList: Boolean);
+{
+    O = FOldestUsed
+    N = FNewestUsed
+
+    O       N
+    A - B - C   ( D = New CacheMem )
+}
+begin
+  if Assigned(ANode^.used_previous) then begin
+    // B or C
+    if (ANode^.used_previous^.used_next<>ANode) then raise EAVLCache.Create(Format('Inconsistent previous.next<>MySelf in %s',[ANode^.ToString]));
+    if (FOldestUsed = ANode) then raise EAVLCache.Create(Format('Inconsistent B,C Oldest = MySelf in %s',[ANode^.ToString]));
+    if Assigned(ANode^.used_next) then begin
+      // B only
+      if (ANode^.used_next^.used_previous<>ANode) then raise EAVLCache.Create(Format('Inconsistent B next.previous<>MySelf in %s',[ANode^.ToString]));
+      if (FNewestUsed = ANode) then raise EAVLCache.Create(Format('Inconsistent B Newest = MySelf in %s',[ANode^.ToString]));
+      ANode^.used_previous^.used_next := ANode^.used_next;
+      ANode^.used_next^.used_previous := ANode^.used_previous;
+    end else begin
+      // C only
+      if (FNewestUsed <> ANode) then raise EAVLCache.Create(Format('Inconsistent Newest <> MySelf in %s',[ANode^.ToString]));
+      if (Not AAddToList) then begin
+        ANode^.used_previous^.used_next := Nil;
+      end;
+    end;
+  end else if assigned(ANode^.used_next) then begin
+    // A
+    if (ANode^.used_next^.used_previous<>ANode) then raise EAVLCache.Create(Format('Inconsistent A next.previous<>MySelf in %s',[ANode^.ToString]));
+    if (FOldestUsed <> ANode) then raise EAVLCache.Create(Format('Inconsistent Oldest <> MySelf in %s',[ANode^.ToString]));
+    if (FNewestUsed = ANode) then raise EAVLCache.Create(Format('Inconsistent A Newest = MySelf in %s',[ANode^.ToString]));
+    ANode^.used_next^.used_previous := ANode^.used_previous; // = NIL
+    FOldestUsed:=ANode^.used_next; // Set oldest
+  end else begin
+    // D
+    if (FOldestUsed = ANode) and (FNewestUsed = ANode) then begin
+      // D is the "only one", no previous, no next, but added or removed
+      if (Not AAddToList) then begin
+        FOldestUsed := Nil;
+      end;
+    end else begin
+      if (FOldestUsed = ANode) then raise EAVLCache.Create(Format('Inconsistent D Oldest = MySelf in %s',[ANode^.ToString]));
+      if (FNewestUsed = ANode) then raise EAVLCache.Create(Format('Inconsistent D Newest = MySelf in %s',[ANode^.ToString]));
+    end;
+    if Not Assigned(FOldestUsed) and (AAddToList) then begin
+      // D is first one to be added
+      FOldestUsed := ANode; // Set oldest
+    end;
+  end;
+  if Assigned(FNewestUsed) then begin
+    if Assigned(FNewestUsed^.used_next) then raise EAVLCache.Create(Format('Inconsistent Newest.next <> Nil in %s',[ANode^.ToString]));
+  end;
+  // Update ANode^.used_previous and ANode^.used_next
+  if AAddToList then begin
+    // Adding to list
+    if (FNewestUsed<>ANode) then begin
+      // Link to previous if newest <> MySelf
+      ANode^.used_previous := FNewestUsed;
+    end;
+    if Assigned(FNewestUsed) then begin
+      FNewestUsed^.used_next:= ANode;
+    end;
+    FNewestUsed:=ANode;
+  end else begin
+    // Removing from list
+    if FNewestUsed = ANode then begin
+      if (Assigned(ANode^.used_next)) then raise EAVLCache.Create(Format('Inconsistent next <> Nil when Self = Newest in %s',[ANode^.ToString]));
+      FNewestUsed := ANode^.used_previous;
+    end;
+    ANode^.used_previous := Nil;
+  end;
+  ANode^.used_next := Nil;
+end;
+
+function TAVLCache<T>.TAVLCacheMem.IsNil(const ANode: PAVLCacheMemData): Boolean;
+begin
+  Result := Not Assigned(ANode);
+end;
+
+procedure TAVLCache<T>.Add(const AData: T);
+var P, PToDelete : PAVLCacheMemData;
+  i,LnToRemove : Integer;
+begin
+  FAVLCacheLock.Acquire;
+  Try
+  New(P);
+  P^.Clear;
+  P^.data := AData;
+  FAVLCacheMem.Add(P);
+  FAVLCacheMem.DoMark(P,True);
+  if (FDefaultMax > 0) And (FAVLCacheMem.FCount>FDefaultMax) then begin
+    // Dispose cache
+    LnToRemove := FAVLCacheMem.FCount SHR 1;
+    i := 1;
+    P := FAVLCacheMem.FOldestUsed;
+    while (Assigned(P)) And (i <= LnToRemove) do begin
+      PToDelete := P;
+      P := P^.used_next;
+
+      FAVLCacheMem.DoMark(PToDelete,False);
+      BeforeDelete(PToDelete^.data);
+      FAVLCacheMem.Delete(PToDelete);
+
+      inc(i);
+    end;
+  end;
+  Finally
+    FAVLCacheLock.Release;
+  End;
+end;
+
+procedure TAVLCache<T>.BeforeDelete(var AData: T);
+begin
+//
+end;
+
+procedure TAVLCache<T>.Clear;
+var P, PCurr : PAVLCacheMemData;
+begin
+  FAVLCacheLock.Acquire;
+  Try
+  PCurr := FAVLCacheMem.FindLowest;
+  while (Assigned(PCurr)) do begin
+    P := PCurr;
+    PCurr := FAVLCacheMem.FindSuccessor(P);
+    BeforeDelete(P^.data);
+    FAVLCacheMem.DoMark(P,False);
+    FAVLCacheMem.Delete(P);
+  end;
+  Finally
+    FAVLCacheLock.Release;
+  End;
+end;
+
+procedure TAVLCache<T>.ConsistencyCheck;
+var LErrors : TStrings;
+  LResult : Integer;
+begin
+  LErrors := TStringList.Create;
+  Try
+    LResult := FAVLCacheMem.ConsistencyCheck(LErrors);
+  Finally
+    LErrors.Free;
+  End;
+end;
+
+constructor TAVLCache<T>.Create(ADefaultMax: Integer;  const AOnCompareMethod: TComparison<PAVLCacheMemData>);
+begin
+  FAVLCacheMem := TAVLCacheMem.Create(AOnCompareMethod,False);
+  FDefaultMax := ADefaultMax;
+  FAVLCacheLock := TCriticalSection.Create;
+end;
+
+destructor TAVLCache<T>.Destroy;
+begin
+  Clear;
+  FAVLCacheMem.Free;
+  FAVLCacheLock.Free;
+  inherited Destroy;
+end;
+
+function TAVLCache<T>.Exists(const AData: T): Boolean;
+var LFound : T;
+begin
+  Result := Find(AData,LFound);
+end;
+
+function TAVLCache<T>.Find(const AData: T; out AFound: T): Boolean;
+var P, PFound: PAVLCacheMemData;
+begin
+  FAVLCacheLock.Acquire;
+  Try
+  New(P);
+  try
+    P^.Clear;
+    P^.data := AData;
+    PFound := FAVLCacheMem.Find(P);
+    if Assigned(PFound) then begin
+      AFound := PFound^.data;
+      Result := True;
+      FAVLCacheMem.DoMark(PFound,True);
+    end else Result := False;
+  finally
+    Dispose(P);
+  end;
+  Finally
+    FAVLCacheLock.Release;
+  End;
+end;
+
+procedure TAVLCache<T>.Remove(const AData: T);
+var P, PFound: PAVLCacheMemData;
+begin
+  FAVLCacheLock.Acquire;
+  Try
+  New(P);
+  try
+    P^.Clear;
+    P^.data := AData;
+    PFound := FAVLCacheMem.Find(P);
+    if Assigned(PFound) then begin
+      BeforeDelete(PFound^.data);
+      FAVLCacheMem.DoMark(PFound,False);
+      FAVLCacheMem.Delete(PFound);
+    end;
+  finally
+    Dispose(P);
+  end;
+  Finally
+    FAVLCacheLock.Release;
+  End;
+end;
+
+function TAVLCache<T>.ToString(const AData: T): String;
+begin
+  Result := Self.ClassName+'.T '+IntToStr(SizeOf(AData));
+end;
+
+function TAVLCache<T>.TreeToString: String;
+begin
+  Result := FAVLCacheMem.ToString;
+end;
+
+{ TAVLCache<T>.TAVLCacheMemData }
+
+procedure TAVLCache<T>.TAVLCacheMemData.Clear;
+begin
+  Self.parent := Nil;
+  Self.left := Nil;
+  Self.right := Nil;
+  Self.balance := 0;
+  Self.used_previous := Nil;
+  Self.used_next := Nil;
+  Self.pendingToSave := False;
+end;
+
+function TAVLCache<T>.TAVLCacheMemData.ToString: String;
+begin
+  Result := 'TAVLCache<T>.TAVLCacheMemData.'+IntToStr(SizeOf(Self.data));
+end;
+
+end.

+ 986 - 0
src/libraries/abstractmem/UAbstractBTree.pas

@@ -0,0 +1,986 @@
+unit UAbstractBTree;
+
+{
+  This file is part of AbstractMem framework
+
+  Copyright (C) 2020 Albert Molina - [email protected]
+
+  https://github.com/PascalCoinDev/
+
+  *** BEGIN LICENSE BLOCK *****
+
+  The contents of this files are subject to the Mozilla Public License Version
+  2.0 (the "License"); you may not use this file except in compliance with
+  the License. You may obtain a copy of the License at
+  http://www.mozilla.org/MPL
+
+  Software distributed under the License is distributed on an "AS IS" basis,
+  WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
+  for the specific language governing rights and limitations under the License.
+
+  The Initial Developer of the Original Code is Albert Molina.
+
+  See ConfigAbstractMem.inc file for more info
+
+  SPECIAL CONTRIBUTOR:
+  This unit contains TAVLAbstractTree component that
+  is created based on work previously made
+  by Mattias Gaertner at unit AVL_Tree for Free Component Library (FCL)
+  and Lazarus: lazarus\components\lazutils\laz_avl_tree.pp
+  Code object has been fully redo but algo is based on it... and on
+  initial algo of AVL Tree created by Adelson-Velsky and Landis
+
+  ***** END LICENSE BLOCK *****
+}
+
+{$ifdef FPC}
+  {$mode DELPHI}
+{$endif}
+{$H+}
+
+interface
+
+uses
+  Classes, SysUtils,
+  // NOTE ABOUT FREEPASCAL (2020-03-10)
+  // Current version 3.0.4 does not contain valid support for Generics, using Generics from this:
+  // https://github.com/PascalCoinDev/PascalCoin/tree/master/src/libraries/generics.collections
+  // (Download and set folder as a "units include folder" in compiler options)
+  {$IFNDEF FPC}System.Generics.Collections,System.Generics.Defaults,{$ELSE}Generics.Collections,Generics.Defaults,{$ENDIF}
+  UOrderedList;
+
+{$I ./ConfigAbstractMem.inc }
+
+type
+  TAVLTreePosition = (poParent, poLeft, poRight);
+
+  EAVLAbstractTree = Class(Exception);
+
+  { TAVLAbstractTree }
+
+  TAVLAbstractTree<T> = class
+  private
+    FOnCompare: TComparison<T>;
+    FDisabledsCount : Integer;
+    FAllowDuplicates: Boolean;
+    procedure BalanceAfterInsert(ANode: T);
+    procedure BalanceAfterDelete(ANode: T);
+    procedure CheckNode(const ANode: T); overload;
+    function CheckNode(const ANode: T; ACheckedList:TOrderedList<T>; var ALeftDepth, ARightDepth : Integer; const AErrors : TStrings): integer; overload;
+    procedure RotateLeft(var ANode: T);
+    procedure RotateRight(var ANode: T);
+    procedure BeginUpdate;
+    procedure EndUpdate;
+    procedure SwitchPositionWithSuccessor(aNode, aSuccessor: T);
+  protected
+    FCount: integer;
+    function GetRoot: T; virtual; abstract;
+    procedure SetRoot(const Value: T); virtual; abstract;
+    function HasPosition(const ANode : T; APosition : TAVLTreePosition) : Boolean; virtual; abstract;
+    function GetPosition(const ANode : T; APosition : TAVLTreePosition) : T; virtual; abstract;
+    procedure SetPosition(var ANode : T; APosition : TAVLTreePosition; const ANewValue : T); virtual; abstract;
+    procedure ClearPosition(var ANode : T; APosition : TAVLTreePosition); virtual; abstract;
+    function GetBalance(const ANode : T) : Integer; virtual; abstract;
+    procedure SetBalance(var ANode : T; ANewBalance : Integer); virtual; abstract;
+    function AreEquals(const ANode1, ANode2 : T) : Boolean; virtual; abstract;
+    procedure ClearNode(var ANode : T); virtual; abstract;
+    procedure DisposeNode(var ANode : T); virtual; abstract;
+    //
+    procedure UpdateFinished; virtual;
+  public
+    property AllowDuplicates : Boolean read FAllowDuplicates write FAllowDuplicates;
+    property DisabledsCount:Integer read FDisabledsCount;
+    function IsNil(const ANode : T) : Boolean; virtual; abstract;
+    //
+    property Root: T read GetRoot;
+    function FindInsertPos(const AData: T): T;
+    function Find(const AData: T): T;
+    function FindSuccessor(const ANode: T): T;
+    function FindPrecessor(const ANode: T): T;
+    function FindLowest: T;
+    function FindHighest: T;
+    function Add(var ANode: T) : Boolean;
+    procedure Delete(var ANode: T);
+    constructor Create(const OnCompareMethod: TComparison<T>; AAllowDuplicates : Boolean); virtual;
+    function ConsistencyCheck(const AErrors : TStrings): integer; virtual;
+    function ToString(const ANode:T) : String; reintroduce; overload; virtual;
+    function ToString : String; reintroduce; overload;
+    property OnCompareMethod: TComparison<T> read FOnCompare;
+  end;
+
+  //
+
+  PAVLPointerTreeNode = ^TAVLPointerTreeNode;
+  TAVLPointerTreeNode = Record
+    parent : PAVLPointerTreeNode;
+    left : PAVLPointerTreeNode;
+    right : PAVLPointerTreeNode;
+    balance : Integer;
+    data : Pointer;
+  End;
+
+  TPAVLPointerTree = Class( TAVLAbstractTree<PAVLPointerTreeNode> )
+  private
+    FRoot : PAVLPointerTreeNode;
+  protected
+    function GetRoot: PAVLPointerTreeNode; override;
+    procedure SetRoot(const Value: PAVLPointerTreeNode); override;
+    function HasPosition(const ANode : PAVLPointerTreeNode; APosition : TAVLTreePosition) : Boolean; override;
+    procedure SetPosition(var ANode : PAVLPointerTreeNode; APosition : TAVLTreePosition; const ANewValue : PAVLPointerTreeNode); override;
+    procedure ClearPosition(var ANode : PAVLPointerTreeNode; APosition : TAVLTreePosition); override;
+    function GetBalance(const ANode : PAVLPointerTreeNode) : Integer; override;
+    procedure SetBalance(var ANode : PAVLPointerTreeNode; ANewBalance : Integer); override;
+    function AreEquals(const ANode1, ANode2 : PAVLPointerTreeNode) : Boolean; override;
+    procedure ClearNode(var ANode : PAVLPointerTreeNode); override;
+    procedure DisposeNode(var ANode : PAVLPointerTreeNode); override;
+  public
+    function IsNil(const ANode : PAVLPointerTreeNode) : Boolean; override;
+    function ToString(const ANode: PAVLPointerTreeNode) : String; override;
+    constructor Create(const OnCompareMethod: TComparison<PAVLPointerTreeNode>; AAllowDuplicates : Boolean); override;
+    //
+    function GetPosition(const ANode : PAVLPointerTreeNode; APosition : TAVLTreePosition) : PAVLPointerTreeNode; override;
+  End;
+
+
+const
+  CT_TAVLPointerTreeNode_NULL : TAVLPointerTreeNode = (parent:Nil;left:Nil;right:Nil;balance:0;data:Nil);
+
+implementation
+
+{ TAVLAbstractTree }
+
+function TAVLAbstractTree<T>.Add(var ANode : T) : Boolean;
+var LInsertPos: T;
+  LInsertComp: integer;
+begin
+  BeginUpdate;
+  Try
+    // Init T
+    ClearPosition(ANode,poLeft);
+    ClearPosition(ANode,poRight);
+    SetBalance(ANode,0); // Init Balance to 0
+    if Not IsNil(Root) then begin
+      LInsertPos:=FindInsertPos(ANode);
+      LInsertComp:=fOnCompare(ANode,LInsertPos);
+      SetPosition(ANode,poParent,LInsertPos);
+      if LInsertComp<0 then begin
+        // insert to the left
+        SetPosition(LInsertPos,poLeft,ANode);
+      end else if (AllowDuplicates) Or (LInsertComp>0) then begin
+        // insert to the right
+        SetPosition(LInsertPos,poRight,ANode);
+      end else begin
+        Exit(False);
+      end;
+      BalanceAfterInsert(ANode);
+    end else begin
+      SetRoot( ANode );
+      ClearPosition(ANode,poParent);
+    end;
+    inc(FCount);
+    Result := True;
+  Finally
+    EndUpdate;
+  End;
+end;
+
+function TAVLAbstractTree<T>.FindLowest: T;
+begin
+  Result:=Root;
+  if Not IsNil(Result) then
+    while HasPosition(Result,poLeft) do Result := GetPosition(Result,poLeft);
+end;
+
+function TAVLAbstractTree<T>.FindHighest: T;
+begin
+  Result:=Root;
+  if Not IsNil(Result) then
+    while HasPosition(Result,poRight) do Result := GetPosition(Result,poRight);
+end;
+
+procedure TAVLAbstractTree<T>.BalanceAfterDelete(ANode: T);
+var
+  OldParent, OldRight, OldRightLeft, OldLeft, OldLeftRight: T;
+begin
+  while Not IsNil(ANode) do begin
+    if ((GetBalance(ANode)=+1) or (GetBalance(ANode)=-1)) then exit;
+    OldParent:=GetPosition(ANode,poParent);
+    if (GetBalance(ANode)=0) then begin
+      // Treeheight has decreased by one
+      if IsNil(OldParent) then
+        exit;
+      if (AreEquals(GetPosition(OldParent,poLeft),ANode)) then
+        SetBalance(OldParent,GetBalance(OldParent)+1)
+      else
+      SetBalance(OldParent,GetBalance(OldParent)-1);
+      ANode:=OldParent;
+    end else if (GetBalance(ANode)=+2) then begin
+      // Node is overweighted to the right
+      OldRight:=GetPosition(ANode,poRight);
+      if (GetBalance(OldRight)>=0) then begin
+        // OldRight.Balance is 0 or +1
+        // rotate ANode,OldRight left
+        RotateLeft(ANode);
+        SetBalance(ANode,(1-GetBalance(OldRight))); // toggle 0 and 1
+        SetBalance(OldRight,GetBalance(OldRight)-1);
+        ANode:=OldRight;
+      end else begin
+        // OldRight.Balance=-1
+        { double rotate
+          = rotate OldRightLeft,OldRight right
+            and then rotate ANode,OldRightLeft left
+                  OldParent                           OldParent
+                      |                                  |
+                    ANode                           OldRightLeft
+                       \                               /      \
+                    OldRight             =>          ANode    OldRight
+                      /                                \         /
+               OldRightLeft                OldRightLeftLeft OldRightLeftRight
+                   /     \
+        OldRightLeftLeft OldRightLeftRight
+        }
+        OldRightLeft:=GetPosition(OldRight,poLeft);
+        RotateRight(OldRight);
+        RotateLeft(ANode);
+        if (GetBalance(OldRightLeft)<=0) then
+          SetBalance(ANode,0)
+        else
+          SetBalance(ANode,-1);
+        if (GetBalance(OldRightLeft)>=0) then
+          SetBalance(OldRight,0)
+        else
+          SetBalance(OldRight,+1);
+        SetBalance(OldRightLeft,0);
+        ANode:=OldRightLeft;
+      end;
+    end else begin
+      // Node.Balance=-2
+      // Node is overweighted to the left
+      OldLeft:=GetPosition(ANode,poLeft);
+      if (GetBalance(OldLeft)<=0) then begin
+        // rotate OldLeft,ANode right
+        RotateRight(ANode);
+        SetBalance(ANode,(-1-GetBalance(OldLeft))); // toggle 0 and -1
+        SetBalance(OldLeft,GetBalance(OldLeft)+1);
+        ANode:=OldLeft;
+      end else begin
+        // OldLeft.Balance = 1
+        { double rotate left right
+          = rotate OldLeft,OldLeftRight left
+            and then rotate OldLeft,ANode right
+                    OldParent                           OldParent
+                        |                                  |
+                      ANode                            OldLeftRight
+                       /                               /         \
+                    OldLeft             =>          OldLeft    ANode
+                       \                                \         /
+                   OldLeftRight               OldLeftRightLeft OldLeftRightRight
+                     /     \
+          OldLeftRightLeft OldLeftRightRight
+        }
+        OldLeftRight:=GetPosition(OldLeft,poRight);
+        RotateLeft(OldLeft);
+        RotateRight(ANode);
+        if (GetBalance(OldLeftRight)>=0) then
+          SetBalance(ANode,0)
+        else
+          SetBalance(ANode,+1);
+        if (GetBalance(OldLeftRight)<=0) then
+          SetBalance(OldLeft,0)
+        else
+          SetBalance(OldLeft,-1);
+        SetBalance(OldLeftRight,0);
+        ANode:=OldLeftRight;
+      end;
+    end;
+  end;
+end;
+
+procedure TAVLAbstractTree<T>.BalanceAfterInsert(ANode : T);
+var
+  OldParent, OldRight, OldLeft: T;
+begin
+  OldParent:=GetPosition(ANode,poParent);
+  while Not IsNil(OldParent) do begin
+    if (AreEquals(GetPosition(OldParent,poLeft),ANode)) then begin
+      // Node is left child
+      SetBalance(OldParent,GetBalance(OldParent)-1);
+      if (GetBalance(OldParent)=0) then exit;
+      if (GetBalance(OldParent)=-1) then begin
+        ANode:=OldParent;
+        OldParent:=GetPosition(ANode,poParent);
+        continue;
+      end;
+      // OldParent.Balance=-2
+      if (GetBalance(ANode)=-1) then begin
+        { rotate ANode,ANode.Parent right
+             OldParentParent        OldParentParent
+                   |                     |
+               OldParent        =>     ANode
+                 /                        \
+              ANode                     OldParent
+                \                        /
+              OldRight               OldRight      }
+        RotateRight(OldParent);
+        SetBalance(ANode,0);
+        SetBalance(OldParent,0);
+      end else begin
+        // Node.Balance = +1
+        { double rotate
+          = rotate ANode,OldRight left and then rotate OldRight,OldParent right
+             OldParentParent             OldParentParent
+                    |                           |
+                OldParent                    OldRight
+                   /            =>          /        \
+                 ANode                   ANode      OldParent
+                    \                       \          /
+                   OldRight          OldRightLeft  OldRightRight
+                     / \
+          OldRightLeft OldRightRight
+        }
+        OldRight:=GetPosition(ANode,poRight);
+        RotateLeft(ANode);
+        RotateRight(OldParent);
+        if (GetBalance(OldRight)<=0) then
+          SetBalance(ANode,0)
+        else
+          SetBalance(ANode,-1);
+        if (GetBalance(OldRight)=-1) then
+          SetBalance(OldParent,1)
+        else
+          SetBalance(OldParent,0);
+        SetBalance(OldRight,0);
+      end;
+      exit;
+    end else begin
+      // Node is right child
+      SetBalance(OldParent, GetBalance(OldParent)+1);
+      if (GetBalance(OldParent)=0) then exit;
+      if (GetBalance(OldParent)=+1) then begin
+        ANode:=OldParent;
+        OldParent:=GetPosition(ANode,poParent);
+        continue;
+      end;
+      // OldParent.Balance = +2
+      if (GetBalance(ANode)=+1) then begin
+        { rotate OldParent,ANode left
+             OldParentParent        OldParentParent
+                   |                     |
+               OldParent        =>     ANode
+                    \                   /
+                  ANode               OldParent
+                   /                      \
+                OldLeft                 OldLeft      }
+        RotateLeft(OldParent);
+        SetBalance(ANode,0);
+        SetBalance(OldParent,0);
+      end else begin
+        // Node.Balance = -1
+        { double rotate
+          = rotate OldLeft,ANode right and then rotate OldParent,OldLeft right
+             OldParentParent             OldParentParent
+                    |                           |
+                OldParent                    OldLeft
+                     \            =>        /       \
+                    ANode               OldParent   ANode
+                     /                     \          /
+                  OldLeft          OldLeftLeft  OldLeftRight
+                    / \
+         OldLeftLeft OldLeftRight
+        }
+        OldLeft:=GetPosition(ANode,poLeft);
+        RotateRight(ANode);
+        RotateLeft(OldParent);
+        if (GetBalance(OldLeft)>=0) then
+          SetBalance(ANode,0)
+        else
+          SetBalance(ANode,+1);
+        if (GetBalance(OldLeft)=+1) then
+          SetBalance(OldParent,-1)
+        else
+          SetBalance(OldParent,0);
+        SetBalance(OldLeft,0);
+      end;
+      exit;
+    end;
+  end;
+end;
+
+procedure TAVLAbstractTree<T>.BeginUpdate;
+begin
+  inc(FDisabledsCount);
+end;
+
+constructor TAVLAbstractTree<T>.Create(const OnCompareMethod: TComparison<T>; AAllowDuplicates : Boolean);
+begin
+  inherited Create;
+  FOnCompare:=OnCompareMethod;
+  FCount:=0;
+  FDisabledsCount := 0;
+  FAllowDuplicates := AAllowDuplicates;
+end;
+
+procedure TAVLAbstractTree<T>.Delete(var ANode: T);
+var OldParent, Child, LSuccessor: T;
+begin
+  BeginUpdate;
+  try
+    if (Not IsNil(GetPosition(ANode,poLeft))) and (Not IsNil(GetPosition(ANode,poRight))) then begin
+      // ANode has both: Left and Right
+      // Switch ANode position with Successor
+      // Because ANode.Right<>nil the Successor is a child of ANode
+      LSuccessor := FindSuccessor(ANode);
+      SwitchPositionWithSuccessor(ANode,LSuccessor);
+    end;
+    // left or right is nil
+    OldParent:=GetPosition(ANode,poParent);
+    ClearPosition(ANode,poParent);
+    if Not IsNil(GetPosition(ANode,poLeft)) then
+      Child:=GetPosition(ANode,poLeft)
+    else
+      Child:=GetPosition(ANode,poRight);
+    if Not IsNil(Child) then
+      SetPosition(Child,poParent,OldParent);
+    if Not IsNil(OldParent) then begin
+      // Node has parent
+      if (AreEquals(GetPosition(OldParent,poLeft),ANode)) then begin
+        // Node is left child of OldParent
+        SetPosition(OldParent,poLeft,Child);
+        SetBalance(OldParent, GetBalance(OldParent)+1);
+      end else begin
+        // Node is right child of OldParent
+        SetPosition(OldParent,poRight,Child);
+        SetBalance(OldParent, GetBalance(OldParent)-1);
+      end;
+      BalanceAfterDelete(OldParent);
+    end else begin
+      // Node was Root
+      SetRoot( Child );
+    end;
+    dec(FCount);
+
+    DisposeNode(ANode);
+
+  finally
+    EndUpdate;
+  end;
+end;
+
+
+procedure TAVLAbstractTree<T>.EndUpdate;
+begin
+  if FDisabledsCount<=0 then Raise EAVLAbstractTree.Create('EndUpdate invalid');
+  Dec(FDisabledsCount);
+  if FDisabledsCount=0 then UpdateFinished;
+end;
+
+procedure TAVLAbstractTree<T>.SwitchPositionWithSuccessor(aNode, aSuccessor: T);
+{ called by delete, when aNode.Left<>nil and aNode.Right<>nil
+  Switch ANode position with Successor
+  Because ANode.Right<>nil the Successor is a child of ANode }
+var
+  OldBalance: Integer;
+  OldParent, OldLeft, OldRight,
+  OldSuccParent, OldSuccLeft, OldSuccRight: T;
+begin
+  OldBalance:=GetBalance(aNode);
+  SetBalance(aNode, GetBalance(aSuccessor));
+  SetBalance(aSuccessor, OldBalance);
+
+  OldParent:=GetPosition(aNode,poParent);
+  OldLeft:=GetPosition(aNode,poLeft);
+  OldRight:=GetPosition(aNode,poRight);
+  OldSuccParent:=GetPosition(aSuccessor,poParent);
+  OldSuccLeft:=GetPosition(aSuccessor,poLeft);
+  OldSuccRight:=GetPosition(aSuccessor,poRight);
+
+  if Not IsNil(OldParent) then begin
+    if AreEquals(GetPosition(OldParent,poLeft),aNode) then
+      SetPosition(OldParent,poLeft,aSuccessor)
+    else
+      SetPosition(OldParent,poRight,aSuccessor);
+  end else
+    SetRoot(aSuccessor);
+  SetPosition(aSuccessor,poParent,OldParent);
+
+  if Not AreEquals(OldSuccParent,aNode) then begin
+    if AreEquals(GetPosition(OldSuccParent,poLeft),aSuccessor) then
+      SetPosition(OldSuccParent,poLeft,aNode)
+    else
+      SetPosition(OldSuccParent,poRight,aNode);
+    SetPosition(aSuccessor,poRight,OldRight);
+    SetPosition(aNode,poParent,OldSuccParent);
+    if Not IsNil(OldRight) then
+      SetPosition(OldRight,poParent,aSuccessor);
+  end else begin
+    {  aNode            aSuccessor
+         \          =>    \
+         aSuccessor       aNode  }
+    SetPosition(aSuccessor,poRight,aNode);
+    SetPosition(aNode,poParent,aSuccessor);
+  end;
+
+  SetPosition(aNode,poLeft,OldSuccLeft);
+  if Not IsNil(OldSuccLeft) then
+    SetPosition(OldSuccLeft,poParent,aNode);
+  SetPosition(aNode,poRight,OldSuccRight);
+  if Not IsNil(OldSuccRight) then
+    SetPosition(OldSuccRight,poParent,aNode);
+  SetPosition(aSuccessor,poLeft,OldLeft);
+  if Not IsNil(OldLeft) then
+    SetPosition(OldLeft,poParent,aSuccessor);
+end;
+
+function TAVLAbstractTree<T>.Find(const AData: T): T;
+var Comp: integer;
+  LPreviousSearch : TOrderedList<T>;
+begin
+  LPreviousSearch := TOrderedList<T>.Create(False,FOnCompare); // Protection against circular "malformed" structure
+  try
+    Result:=Root;
+    while (Not IsNil(Result)) do begin
+      if LPreviousSearch.Add(Result)<0 then raise EAVLAbstractTree.Create('Circular T structure at Find for T='+ToString(Result)+ ' searching for '+ToString(AData));
+      Comp:=fOnCompare(AData,Result);
+      if Comp=0 then exit;
+      if Comp<0 then begin
+        Result:=GetPosition(Result,poLeft);
+      end else begin
+        Result:=GetPosition(Result,poRight);
+      end;
+    end;
+  finally
+    LPreviousSearch.Free;
+  end;
+end;
+
+function TAVLAbstractTree<T>.FindInsertPos(const AData: T): T;
+var Comp: integer;
+  LPreviousSearch : TOrderedList<T>;
+begin
+  LPreviousSearch := TOrderedList<T>.Create(False,FOnCompare); // Protection against circular "malformed" structure
+  try
+    Result:=Root;
+    while (Not IsNil(Result)) do begin
+      if LPreviousSearch.Add(Result)<0 then raise EAVLAbstractTree.Create('Circular T structure at FindInsertPos for T='+ToString(Result)+ ' searching for '+ToString(AData));
+      Comp:=fOnCompare(AData,Result);
+      if Comp<0 then begin
+        if (HasPosition(Result,poLeft)) then begin
+          Result:=GetPosition(Result,poLeft);
+        end else begin
+          Exit;
+        end;
+      end else begin
+        if (HasPosition(Result,poRight)) then begin
+          Result:=GetPosition(Result,poRight);
+        end else begin
+          Exit;
+        end;
+      end;
+    end;
+  finally
+    LPreviousSearch.Free;
+  end;
+end;
+
+function TAVLAbstractTree<T>.FindSuccessor(const ANode: T): T;
+begin
+  if HasPosition(ANode,poRight) then begin
+    Result := GetPosition(ANode,poRight);
+    while (HasPosition(Result,poLeft)) do Result:=GetPosition(Result,poLeft);
+  end else begin
+    Result := ANode;
+    while (HasPosition(Result,poParent)) and (AreEquals(GetPosition(GetPosition(Result,poParent),poRight),Result)) do
+      Result:=GetPosition(Result,poParent);
+    Result := GetPosition(Result,poParent);
+  end;
+end;
+
+function TAVLAbstractTree<T>.ToString: String;
+var i : Integer;
+  LStrings : TStringList;
+  LNode : T;
+begin
+  LStrings := TStringList.Create;
+  try
+    i := 0;
+    LNode := FindLowest;
+    while (Not IsNil(LNode)) do begin
+      inc(i);
+      LStrings.Add(Format('Pos:%d - %s',[i,ToString(LNode)]));
+      LNode := FindSuccessor(LNode);
+    end;
+    LStrings.Add(Format('Total:%d',[i]));
+    Result := LStrings.Text;
+  finally
+    LStrings.Free;
+  end;
+end;
+
+procedure TAVLAbstractTree<T>.UpdateFinished;
+{$IFDEF ABSTRACTMEM_TESTING_MODE}
+var LErrors : TStrings;
+{$ENDIF}
+begin
+  // Nothing to do here. Used in inheritance classes
+  {$IFDEF ABSTRACTMEM_TESTING_MODE}
+  LErrors := TStringList.Create;
+  Try
+    if ConsistencyCheck(LErrors)<>0 then begin
+      raise EAVLAbstractTree.Create('CONSISTENCY ERRORS'+#10+LErrors.Text);
+    end;
+  Finally
+    LErrors.Free;
+  End;
+  {$ENDIF}
+end;
+
+function TAVLAbstractTree<T>.ToString(const ANode: T): String;
+begin
+  Result := Format('Abstract T %d bytes',[SizeOf(T)]);
+end;
+
+function TAVLAbstractTree<T>.FindPrecessor(const ANode: T): T;
+begin
+  if HasPosition(ANode,poLeft) then begin
+    Result := GetPosition(ANode,poLeft);
+    while (HasPosition(Result,poRight)) do Result:=GetPosition(Result,poRight);
+  end else begin
+    Result := ANode;
+    while (HasPosition(Result,poParent)) and (AreEquals(GetPosition(GetPosition(Result,poParent),poLeft),Result)) do
+      Result:=GetPosition(Result,poParent);
+    Result := GetPosition(Result,poParent);
+  end;
+end;
+
+function TAVLAbstractTree<T>.CheckNode(const ANode: T; ACheckedList : TOrderedList<T>; var ALeftDepth, ARightDepth : Integer; const AErrors : TStrings): integer;
+var i : Integer;
+  LLeftDepth, LRightDepth : Integer;
+  LParent, LLeft, LRight : T;
+begin
+  Result := 0;
+
+  LLeftDepth := 0;
+  LRightDepth := 0;
+
+  ALeftDepth := 0;
+  ARightDepth := 0;
+
+  if IsNil(ANode) then begin
+    exit(0);
+  end;
+  if Assigned(ACheckedList) then begin
+    if ACheckedList.Find(ANode,i) then begin
+      // Found in previous searchs...
+      Result := -1;
+      if Assigned(AErrors) then begin
+        AErrors.Add(Format('Error Consistency circular found at %d of %d -> %s',[i,ACheckedList.Count,ToString(ANode)]));
+      end;
+      Exit;
+    end;
+    ACheckedList.Add(ANode);
+  end;
+
+  // test left son
+  if HasPosition(ANode,poLeft) then begin
+    LLeft := GetPosition(ANode,poLeft);
+    if Not AreEquals(GetPosition(GetPosition(ANode,poLeft),poParent),ANode) then begin
+      Result:=-2;
+      if Assigned(AErrors) then begin
+        AErrors.Add(Format('Error Consistency not equals in left for %s',[ToString(ANode)]));
+      end;
+      Exit;
+    end;
+    if fOnCompare(GetPosition(ANode,poLeft),ANode)>0 then begin
+      Result:=-3;
+      if Assigned(AErrors) then begin
+        AErrors.Add(Format('Error Consistency compare>0 in left for %s',[ToString(ANode)]));
+      end;
+      Exit;
+    end;
+    Result:=CheckNode(GetPosition(ANode,poLeft),ACheckedList,LLeftDepth,LRightDepth,AErrors);
+    if LLeftDepth>LRightDepth then inc(ALeftDepth,LLeftDepth+1)
+    else inc(ALeftDepth,LRightDepth+1);
+    if Result<>0 then Exit;
+  end else ClearNode(LLeft);
+  // test right son
+  if HasPosition(ANode,poRight) then begin
+    LRight := GetPosition(ANode,poRight);
+    if Not AreEquals(GetPosition(GetPosition(ANode,poRight),poParent),ANode) then begin
+      Result:=-4;
+      if Assigned(AErrors) then begin
+        AErrors.Add(Format('Error Consistency not equals in right for %s found %s at right.parent',[ToString(ANode),ToString(GetPosition(GetPosition(ANode,poRight),poParent))]));
+      end;
+      Exit;
+    end;
+    if fOnCompare(GetPosition(ANode,poRight),ANode)<0 then begin
+      Result:=-5;
+      if Assigned(AErrors) then begin
+        AErrors.Add(Format('Error Consistency compare>0 in right for %s',[ToString(ANode)]));
+      end;
+      Exit;
+    end;
+    Result:=CheckNode(GetPosition(ANode,poRight),ACheckedList,LLeftDepth,LRightDepth,AErrors);
+    if LLeftDepth>LRightDepth then inc(ARightDepth,LLeftDepth+1)
+    else inc(ARightDepth,LRightDepth+1);
+    if Result<>0 then Exit;
+  end else ClearNode(LRight);
+
+  if (HasPosition(ANode,poParent)) then begin
+    LParent := GetPosition(ANode,poParent);
+  end else ClearNode(LParent);
+
+  if Not IsNil(LParent) then begin
+    if AreEquals(ANode,LParent) then begin
+      if Assigned(AErrors) then begin
+        AErrors.Add(Format('Error Consistency Self=Parent for %s (Parent %s)',[ToString(ANode),ToString(LParent)]));
+      end;
+      Result := -7;
+    end;
+  end;
+  if Not IsNil(LLeft) then begin
+    if AreEquals(ANode,LLeft) then begin
+      if Assigned(AErrors) then begin
+        AErrors.Add(Format('Error Consistency Self=Left for %s (Left %s)',[ToString(ANode),ToString(LLeft)]));
+      end;
+      Result := -8;
+    end;
+  end;
+  if Not IsNil(LRight) then begin
+    if AreEquals(ANode,LRight) then begin
+      if Assigned(AErrors) then begin
+        AErrors.Add(Format('Error Consistency Self=Right for %s (Right %s)',[ToString(ANode),ToString(LRight)]));
+      end;
+      Result := -9;
+    end;
+  end;
+  if (Not IsNil(LParent)) and (Not IsNil(LLeft)) then begin
+    if AreEquals(LParent,LLeft) then begin
+      if Assigned(AErrors) then begin
+        AErrors.Add(Format('Error Consistency Parent=Left for %s (Parent %s)',[ToString(ANode),ToString(LParent)]));
+      end;
+      Result := -10;
+    end;
+  end;
+  if (Not IsNil(LParent)) and (Not IsNil(LRight)) then begin
+    if AreEquals(LParent,LRight) then begin
+      if Assigned(AErrors) then begin
+        AErrors.Add(Format('Error Consistency Parent=Right for %s (Parent %s)',[ToString(ANode),ToString(LParent)]));
+      end;
+      Result := -11;
+    end;
+  end;
+  if (Not IsNil(LLeft)) and (Not IsNil(LRight)) then begin
+    if AreEquals(LLeft,LRight) then begin
+      if Assigned(AErrors) then begin
+        AErrors.Add(Format('Error Consistency Left=Right for %s (Left %s)',[ToString(ANode),ToString(LLeft)]));
+      end;
+      Result := -12;
+    end;
+  end;
+
+  // Check balance
+  if GetBalance(ANode)<>(ARightDepth - ALeftDepth) then begin
+    if Assigned(AErrors) then begin
+      AErrors.Add(Format('Error Consistency balance (%d <> Right(%d) - Left(%d)) at %s',[GetBalance(ANode),ARightDepth,ALeftDepth,ToString(ANode)]));
+    end;
+    Result := -15;
+    Exit;
+  end;
+end;
+
+procedure TAVLAbstractTree<T>.RotateLeft(var ANode: T);
+{    Parent                Parent
+       |                     |
+      Node        =>       OldRight
+      /  \                  /
+   Left OldRight          Node
+          /               /  \
+     OldRightLeft      Left OldRightLeft  }
+var
+  AParent, OldRight, OldRightLeft: T;
+begin
+  OldRight:=GetPosition(aNode,poRight);
+  OldRightLeft:=GetPosition(OldRight,poLeft);
+  AParent:=GetPosition(aNode,poParent);
+  if Not IsNil(AParent) then begin
+    if AreEquals(GetPosition(AParent,poLeft),aNode) then
+      SetPosition(AParent,poLeft,OldRight)
+    else
+      SetPosition(AParent,poRight,OldRight);
+  end else
+    SetRoot( OldRight );
+  SetPosition(OldRight,poParent,AParent);
+  SetPosition(aNode,poParent,OldRight);
+  SetPosition(aNode,poRight,OldRightLeft);
+  if Not IsNil(OldRightLeft) then
+    SetPosition(OldRightLeft,poParent,aNode);
+  SetPosition(OldRight,poLeft,aNode);
+end;
+
+procedure TAVLAbstractTree<T>.RotateRight(var ANode: T);
+{       Parent              Parent
+          |                   |
+         Node        =>     OldLeft
+         /   \                 \
+    OldLeft  Right            Node
+        \                     /  \
+   OldLeftRight      OldLeftRight Right  }
+var
+  AParent, OldLeft, OldLeftRight: T;
+begin
+  OldLeft:=GetPosition(ANode,poLeft);
+  OldLeftRight:=GetPosition(OldLeft,poRight);
+  AParent:=GetPosition(ANode,poParent);
+  if Not IsNil(AParent) then begin
+    if AreEquals(GetPosition(AParent,poLeft),aNode) then
+      SetPosition(AParent,poLeft,OldLeft)
+    else
+      SetPosition(AParent,poRight,OldLeft);
+  end else
+    SetRoot( OldLeft );
+  SetPosition(OldLeft,poParent,AParent);
+  SetPosition(aNode,poParent,OldLeft);
+  SetPosition(aNode,poLeft,OldLeftRight);
+  if Not IsNil(OldLeftRight) then
+    SetPosition(OldLeftRight,poParent,aNode);
+  SetPosition(OldLeft,poRight,aNode);
+end;
+
+procedure TAVLAbstractTree<T>.CheckNode(const ANode: T);
+var LLeft,LRight : Integer;
+  LErrors : TStrings;
+begin
+  LErrors := TStringList.Create;
+  try
+    if CheckNode(ANode,Nil,LLeft,LRight,LErrors)<>0 then
+      raise EAVLAbstractTree.Create('CHECK CONSISTENCY ERROR'+#10+LErrors.Text);
+  finally
+    LErrors.Free;
+  end;
+end;
+
+function TAVLAbstractTree<T>.ConsistencyCheck(const AErrors : TStrings): integer;
+var LCheckedList : TOrderedList<T>;
+var LLeftDepth, LRightDepth : Integer;
+begin
+  LCheckedList := TOrderedList<T>.Create(False,FOnCompare);
+  try
+    LLeftDepth := 0;
+    LRightDepth := 0;
+    Result:=CheckNode(Root,LCheckedList,LLeftDepth,LRightDepth,AErrors);
+  finally
+    LCheckedList.Free;
+  end;
+end;
+
+{ TPAVLPointerTree }
+
+function TPAVLPointerTree.AreEquals(const ANode1, ANode2: PAVLPointerTreeNode): Boolean;
+begin
+  Result := ANode1 = ANode2;
+end;
+
+procedure TPAVLPointerTree.ClearNode(var ANode: PAVLPointerTreeNode);
+begin
+  ANode := Nil;
+end;
+
+procedure TPAVLPointerTree.ClearPosition(var ANode: PAVLPointerTreeNode; APosition: TAVLTreePosition);
+begin
+  case APosition of
+    poParent: ANode.parent := Nil;
+    poLeft: ANode.left := Nil;
+    poRight: ANode.right := Nil;
+  end;
+end;
+
+constructor TPAVLPointerTree.Create(const OnCompareMethod: TComparison<PAVLPointerTreeNode>; AAllowDuplicates : Boolean);
+begin
+  FRoot := Nil;
+  inherited;
+end;
+
+procedure TPAVLPointerTree.DisposeNode(var ANode: PAVLPointerTreeNode);
+begin
+  if Not Assigned(ANode) then Exit;
+  Dispose( ANode );
+  ANode := Nil;
+end;
+
+function TPAVLPointerTree.GetBalance(const ANode: PAVLPointerTreeNode): Integer;
+begin
+  Result := ANode^.balance;
+end;
+
+function TPAVLPointerTree.GetPosition(const ANode: PAVLPointerTreeNode;
+  APosition: TAVLTreePosition): PAVLPointerTreeNode;
+begin
+  case APosition of
+    poParent: Result := ANode.parent;
+    poLeft: Result := ANode.left;
+    poRight: Result := ANode.right;
+  else raise EAVLAbstractTree.Create('Undefined 20200310-1');
+  end;
+end;
+
+function TPAVLPointerTree.GetRoot: PAVLPointerTreeNode;
+begin
+  Result := FRoot;
+end;
+
+function TPAVLPointerTree.HasPosition(const ANode: PAVLPointerTreeNode;
+  APosition: TAVLTreePosition): Boolean;
+begin
+  case APosition of
+    poParent: Result := Assigned( ANode.parent );
+    poLeft: Result := Assigned( ANode.left );
+    poRight: Result := Assigned( ANode.right );
+  else raise EAVLAbstractTree.Create('Undefined 20200310-2');
+  end;
+end;
+
+function TPAVLPointerTree.IsNil(const ANode: PAVLPointerTreeNode): Boolean;
+begin
+  Result := ANode = Nil;
+end;
+
+procedure TPAVLPointerTree.SetBalance(var ANode: PAVLPointerTreeNode;
+  ANewBalance: Integer);
+begin
+  ANode^.balance := ANewBalance;
+end;
+
+procedure TPAVLPointerTree.SetPosition(var ANode: PAVLPointerTreeNode;
+  APosition: TAVLTreePosition; const ANewValue: PAVLPointerTreeNode);
+begin
+  case APosition of
+    poParent: ANode.parent := ANewValue;
+    poLeft: ANode.left := ANewValue;
+    poRight: ANode.right := ANewValue;
+  end;
+end;
+
+procedure TPAVLPointerTree.SetRoot(const Value: PAVLPointerTreeNode);
+begin
+  FRoot := Value;
+end;
+
+function TPAVLPointerTree.ToString(const ANode: PAVLPointerTreeNode): String;
+var LParent, LLeft, LRight : String;
+begin
+  if Assigned(ANode) then begin
+    if Assigned(ANode.parent) then LParent := IntToStr(Integer(ANode.parent.data)) else LParent := 'NIL';
+    if Assigned(ANode.left) then LLeft := IntToStr(Integer(ANode.left.data)) else LLeft := 'NIL';
+    if Assigned(ANode.right) then LRight := IntToStr(Integer(ANode.right.data)) else LRight := 'NIL';
+
+    Result := Format('%d (Parent:%s Left:%s Right:%s Balance:%d)',[Integer(ANode.data),LParent,LLeft,LRight,ANode.balance]);
+  end else begin
+    Result := 'NIL';
+  end;
+end;
+
+initialization
+
+finalization
+
+end.

+ 960 - 0
src/libraries/abstractmem/UAbstractMem.pas

@@ -0,0 +1,960 @@
+unit UAbstractMem;
+
+{
+  This file is part of AbstractMem framework
+
+  Copyright (C) 2020 Albert Molina - [email protected]
+
+  https://github.com/PascalCoinDev/
+
+  *** BEGIN LICENSE BLOCK *****
+
+  The contents of this files are subject to the Mozilla Public License Version
+  2.0 (the "License"); you may not use this file except in compliance with
+  the License. You may obtain a copy of the License at
+  http://www.mozilla.org/MPL
+
+  Software distributed under the License is distributed on an "AS IS" basis,
+  WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
+  for the specific language governing rights and limitations under the License.
+
+  The Initial Developer of the Original Code is Albert Molina.
+
+  See ConfigAbstractMem.inc file for more info
+
+  ***** END LICENSE BLOCK *****
+}
+
+{$IFDEF FPC}
+  {$MODE DELPHI}
+{$ENDIF}
+
+interface
+
+uses
+  Classes, SysUtils,
+  SyncObjs,
+  UAbstractBTree;
+
+{$I ./ConfigAbstractMem.inc }
+
+Type
+  TAbstractMemPosition = Integer;
+
+  TAMZone = record
+    position : TAbstractMemPosition;
+    size : Integer;
+    procedure Clear;
+    function ToString : String;
+  end;
+
+  EAbstractMem = Class(Exception);
+
+  TAbstractMem = Class;
+
+  TAbstractMemMemoryLeaksComparer = function(const ABuffer1; ABufferSize1:Integer; const AData2: Integer): Integer;
+
+  TAbstractMemMemoryLeaksNode = record
+    myPosition,       // Position in the AbstractMem
+    parentPosition,
+    leftPosition,
+    rigthPosition : TAbstractMemPosition;
+    balance : ShortInt;
+    units : Integer; // units equals to "4 bytes packet", 1=4 bytes 2=8 bytes ...
+    function GetSize : Integer;
+    procedure SetSize(ABytesSize : Integer); // ABytesSize will be converted to units
+    function GetPosition(APosition : TAVLTreePosition) : TAbstractMemPosition;
+    procedure SetPosition(APosition : TAVLTreePosition; AMemPosition : TAbstractMemPosition);
+    procedure ReadFromMem(AMyPosition : TAbstractMemPosition; AAbstractMem : TAbstractMem);
+    procedure WriteToMem(AAbstractMem : TAbstractMem);
+    procedure Clear;
+    function ToString : String;
+  end;
+
+
+  TAbstractMemMemoryLeaks = Class( TAVLAbstractTree<TAbstractMemMemoryLeaksNode> )
+  private
+    FAbstractMem : TAbstractMem;
+    FRootPosition : TAbstractMemPosition;
+  protected
+    function GetRoot: TAbstractMemMemoryLeaksNode; override;
+    procedure SetRoot(const Value: TAbstractMemMemoryLeaksNode); override;
+    function HasPosition(const ANode : TAbstractMemMemoryLeaksNode; APosition : TAVLTreePosition) : Boolean; override;
+    function GetPosition(const ANode : TAbstractMemMemoryLeaksNode; APosition : TAVLTreePosition) : TAbstractMemMemoryLeaksNode; override;
+    procedure SetPosition(var ANode : TAbstractMemMemoryLeaksNode; APosition : TAVLTreePosition; const ANewValue : TAbstractMemMemoryLeaksNode); override;
+    procedure ClearPosition(var ANode : TAbstractMemMemoryLeaksNode; APosition : TAVLTreePosition); override;
+    function GetBalance(const ANode : TAbstractMemMemoryLeaksNode) : Integer; override;
+    procedure SetBalance(var ANode : TAbstractMemMemoryLeaksNode; ANewBalance : Integer); override;
+    function AreEquals(const ANode1, ANode2 : TAbstractMemMemoryLeaksNode) : Boolean; override;
+    procedure ClearNode(var ANode : TAbstractMemMemoryLeaksNode); override;
+    procedure DisposeNode(var ANode : TAbstractMemMemoryLeaksNode); override;
+  public
+    function IsNil(const ANode : TAbstractMemMemoryLeaksNode) : Boolean; override;
+    function ToString(const ANode: TAbstractMemMemoryLeaksNode) : String; override;
+    constructor Create(AAbstractMem : TAbstractMem; ARootPosition : TAbstractMemPosition); reintroduce;
+    destructor Destroy; override;
+  End;
+
+  TAbstractMemZoneType = (amzt_unknown, amzt_memory_leak, amzt_used);
+
+  { TAbstractMem }
+
+  TAbstractMem = Class
+  private
+    FReadOnly : Boolean;
+    FHeaderInitialized : Boolean;
+    FInitialPosition : Integer;
+    FNextAvailablePos : Integer;
+    FMaxAvailablePos : Integer;
+    FMemLeaks : TAbstractMemMemoryLeaks;
+    //
+  protected
+    FLock : TCriticalSection;
+    function AbsoluteWrite(const AAbsolutePosition : Int64; const ABuffer; ASize : Integer) : Integer; virtual; abstract;
+    function AbsoluteRead(const AAbsolutePosition : Int64; var ABuffer; ASize : Integer) : Integer; virtual; abstract;
+    procedure DoIncreaseSize(var ANextAvailablePos, AMaxAvailablePos : Integer; ANeedSize : Integer); virtual; abstract;
+    //
+    function PositionToAbsolute(const APosition : Integer) : Int64;
+    procedure IncreaseSize(ANeedSize : Integer);
+    //
+    function GetZoneType(APosition : TAbstractMemPosition; out AAMZone : TAMZone) : TAbstractMemZoneType;
+    procedure CheckInitialized(AWantsToWrite : Boolean);
+    function IsAbstractMemInfoStable : Boolean; virtual;
+    procedure SaveHeader;
+  public
+    procedure Write(const APosition : Integer; const ABuffer; ASize : Integer); overload; virtual;
+    function Read(const APosition : Integer; var ABuffer; ASize : Integer) : Integer; overload; virtual;
+
+    Constructor Create(AInitialPosition : Integer; AReadOnly : Boolean); virtual;
+    Destructor Destroy; override;
+    //
+    procedure ClearContent;
+    //
+    function New(AMemSize : Integer) : TAMZone; virtual;
+    procedure Dispose(const AAMZone : TAMZone); overload;
+    procedure Dispose(const APosition : TAbstractMemPosition); overload;
+    function GetUsedZoneInfo(const APosition : TAbstractMemPosition; ACheckForUsedZone : Boolean; out AAMZone : TAMZone) : Boolean;
+    function ToString : String; override;
+    function CheckConsistency(const AStructure : TStrings; out ATotalUsedSize, ATotalUsedBlocksCount, ATotalLeaksSize, ATotalLeaksBlocksCount : Integer) : Boolean;
+    function ReadFirstData(var AFirstDataZone : TAMZone; var AFirstData : TBytes) : Boolean;
+    class function GetAbstractMemVersion : String;
+    property ReadOnly : Boolean read FReadOnly;
+    procedure SaveToStream(AStream : TStream);
+    procedure CopyFrom(ASource : TAbstractMem);
+  End;
+
+  TMem = Class(TAbstractMem)
+  private
+    FMem : TBytes;
+  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 : Integer; ANeedSize : Integer); override;
+  public
+    Constructor Create(AInitialPosition : Integer; AReadOnly : Boolean); override;
+  End;
+
+  TAbstractMemAVLTreeNodeInfo = record
+    parentPosition,
+    leftPosition,
+    rigthPosition : TAbstractMemPosition;
+    balance : ShortInt;
+    procedure Clear;
+    function ToString : String;
+  end;
+    //
+  TAbstractMemAVLTreeNodeInfoClass = Class
+    class function ReadFromMem(AMyPosition : TAbstractMemPosition; AAbstractMem : TAbstractMem) : TAbstractMemAVLTreeNodeInfo;
+    class procedure WriteToMem(AMyPosition : TAbstractMemPosition; AAbstractMem : TAbstractMem; const ANodeInfo : TAbstractMemAVLTreeNodeInfo);
+    class procedure ClearPosition(AMyPosition : TAbstractMemPosition; AAbstractMem : TAbstractMem; APosition: TAVLTreePosition);
+    class function GetPosition(AMyPosition : TAbstractMemPosition; AAbstractMem : TAbstractMem; APosition: TAVLTreePosition) : TAbstractMemPosition;
+    class procedure SetPosition(AMyPosition : TAbstractMemPosition; AAbstractMem : TAbstractMem; APosition: TAVLTreePosition; ANewPosition : TAbstractMemPosition);
+    class function GetBalance(AMyPosition : TAbstractMemPosition; AAbstractMem : TAbstractMem) : ShortInt;
+    class procedure SetBalance(AMyPosition : TAbstractMemPosition; AAbstractMem : TAbstractMem; ANewBalance : ShortInt);
+    class function GetSize : Integer;
+  end;
+
+
+implementation
+
+const
+  CT_Magic : Array[0..5] of byte = (7,6,5,4,3,2);
+  CT_IsStable = 1;
+  CT_Is_NOT_Stable = 0;
+  CT_Version = 1;
+  CT_HeaderSize = 16; // Magic(7) + Version(1) + MemLeak_root_position(4) + NextAvailable_position(4) = 16 bytes
+  CT_ExtraSizeForUsedZoneType = 4;
+
+{ TAbstractMem }
+
+function TAbstractMem.CheckConsistency(const AStructure: TStrings; out ATotalUsedSize, ATotalUsedBlocksCount, ATotalLeaksSize, ATotalLeaksBlocksCount : Integer) : Boolean;
+var LPosition : TAbstractMemPosition;
+  LZone : TAMZone;
+begin
+  // Will check since first position:
+  FLock.Acquire;
+  Try
+    ATotalUsedSize := 0;
+    ATotalUsedBlocksCount := 0;
+    ATotalLeaksSize := 0;
+    ATotalLeaksBlocksCount := 0;
+    LPosition := CT_HeaderSize;
+    Result := True;
+    while (Result) and (LPosition < FNextAvailablePos) do begin
+      case GetZoneType(LPosition,LZone) of
+        amzt_memory_leak : begin
+          if Assigned(AStructure) then AStructure.Add( Format('%d to %d mem leak %d bytes',[LPosition,LZone.position + LZone.size,LZone.size]));
+          Inc(LPosition, LZone.size);
+          inc(ATotalLeaksSize,LZone.size);
+          inc(ATotalLeaksBlocksCount);
+        end;
+        amzt_used : begin
+          if Assigned(AStructure) then AStructure.Add( Format('%d to %d used %d bytes',[LPosition,LZone.position + LZone.size, LZone.size]));
+          inc(LPosition, LZone.size + CT_ExtraSizeForUsedZoneType);
+          inc(ATotalUsedSize,LZone.size + CT_ExtraSizeForUsedZoneType);
+          inc(ATotalUsedBlocksCount);
+        end;
+      else
+        if Assigned(AStructure) then AStructure.Add( Format('Consisteny error at %d (End position: %d)',[LPosition,FNextAvailablePos]));
+        Result := False;
+      end;
+    end;
+  Finally
+    FLock.Release;
+  End;
+end;
+
+procedure TAbstractMem.CheckInitialized(AWantsToWrite : Boolean);
+begin
+  if (AWantsToWrite and FReadOnly) then raise EAbstractMem.Create('Cannot write to a ReadOnly AbstractMem');
+  if Not FHeaderInitialized then begin
+    // Needs to write
+    if FReadOnly then raise EAbstractMem.Create('Cannot initialize a ReadOnly AbstractMem');
+    //
+    IncreaseSize(CT_HeaderSize);
+    // Write Header:
+    SaveHeader;
+  end;
+end;
+
+procedure TAbstractMem.ClearContent;
+var LNewRoot : TAbstractMemMemoryLeaksNode;
+begin
+  // Will erase ALL content creating a new null header
+  if FReadOnly then raise EAbstractMem.Create('Cannot ClearContent on a ReadOnly AbstractMem');
+  CheckInitialized(True);
+
+  FNextAvailablePos := CT_HeaderSize; // By Default
+
+  FMaxAvailablePos := 0;
+  IncreaseSize(0);
+
+  FHeaderInitialized := False;
+  CheckInitialized(True);
+
+  LNewRoot.Clear;
+  FMemLeaks.SetRoot( LNewRoot );
+end;
+
+procedure TAbstractMem.CopyFrom(ASource: TAbstractMem);
+var LBuff : TBytes;
+  iPos, LBuffDataCount : Integer;
+  LMemLeakRelativeRootPos : TAbstractMemPosition;
+begin
+  ASource.FLock.Acquire;
+  Self.FLock.Acquire;
+  try
+    ClearContent;
+
+    CheckInitialized(True);
+    IncreaseSize(ASource.FNextAvailablePos);
+    FNextAvailablePos := ASource.FNextAvailablePos;
+
+    SetLength(LBuff,1024*1024);
+    iPos := 0;
+    while (iPos < ASource.FNextAvailablePos) do begin
+      LBuffDataCount := (ASource.FNextAvailablePos - iPos);
+      if LBuffDataCount>Length(LBuff) then LBuffDataCount := Length(LBuff);
+      ASource.Read(iPos,LBuff[0],LBuffDataCount);
+      Self.Write(iPos,LBuff[0],LBuffDataCount);
+      inc(iPos,LBuffDataCount);
+    end;
+
+    LMemLeakRelativeRootPos := ASource.FMemLeaks.FRootPosition;
+    FMemLeaks.Free;
+    FMemLeaks := TAbstractMemMemoryLeaks.Create(Self,LMemLeakRelativeRootPos);
+
+    SaveHeader;
+  finally
+    Self.FLock.Release;
+    ASource.FLock.Release;
+  end;
+end;
+
+constructor TAbstractMem.Create(AInitialPosition: Integer; AReadOnly : Boolean);
+var LBuffer : TBytes;
+  LMemLeakRelativeRootPos : TAbstractMemPosition;
+  LOk : Boolean;
+begin
+  FMemLeaks := Nil;
+  FReadOnly := AReadOnly;
+  LMemLeakRelativeRootPos := 0;
+  FInitialPosition := AInitialPosition;
+  //
+  FNextAvailablePos := CT_HeaderSize; // By Default
+
+  FMaxAvailablePos := 0;
+
+  FLock := TCriticalSection.Create;
+  // Try to initialize
+  // Magic: 7 bytes
+  // version: 1 byte
+  // START OF FIRST BLOCK 1 = Header info
+  FHeaderInitialized := True;
+  LOk := False;
+  Try
+    SetLength(LBuffer,CT_HeaderSize);
+    if Read(0,LBuffer[0],CT_HeaderSize)=CT_HeaderSize then begin
+      if CompareMem(@LBuffer[0],@CT_Magic[0],6) then begin
+        LOk := LBuffer[6] = CT_IsStable;
+        if (LOk) And (LBuffer[7] = CT_Version) then begin
+          Move(LBuffer[8],LMemLeakRelativeRootPos,4);
+          Move(LBuffer[12],FNextAvailablePos,4);
+          //
+          LOk := (FNextAvailablePos >= CT_HeaderSize) and (LMemLeakRelativeRootPos<FNextAvailablePos);
+        end;
+      end;
+    end;
+  Finally
+    FHeaderInitialized := LOk;
+  End;
+  FMemLeaks := TAbstractMemMemoryLeaks.Create(Self,LMemLeakRelativeRootPos);
+end;
+
+destructor TAbstractMem.Destroy;
+begin
+  FreeAndNil(FMemLeaks);
+  FreeAndNil(FLock);
+  inherited;
+end;
+
+procedure TAbstractMem.Dispose(const APosition: TAbstractMemPosition);
+var LZone : TAMZone;
+begin
+  if APosition<=CT_HeaderSize then raise EAbstractMem.Create('Dispose: Invalid position '+IntToStr(APosition));
+  // @[APosition] - 4 bytes = position to size
+  LZone.position := APosition;
+  if Read(APosition - 4,LZone.size,4) <> 4 then raise EAbstractMem.Create('Dispose: Cannot read size');
+  Dispose(LZone);
+end;
+
+procedure TAbstractMem.Dispose(const AAMZone: TAMZone);
+var LNewMemLeak : TAbstractMemMemoryLeaksNode;
+  LZoneSize : UInt32;
+begin
+  CheckInitialized(True);
+
+  LNewMemLeak.Clear;
+  LNewMemLeak.myPosition := AAMZone.position - 4;
+  LNewMemLeak.SetSize(AAMZone.size+4);
+
+  if Read(LNewMemLeak.myPosition,LZoneSize,4)<>4 then raise EAbstractMem.Create('Dispose: Cannot read size');
+  if Integer(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<>AAMZone.size+4) then raise EAbstractMem.Create(Format('Dispose: Invalid size %d at position %d',[AAMZone.size,AAMZone.position]));
+  FLock.Acquire;
+  Try
+    // Save mem leak to mem
+    LNewMemLeak.WriteToMem(Self);
+    // Add leak to BTree
+    FMemLeaks.Add( LNewMemLeak );
+  Finally
+    FLock.Release;
+  End;
+end;
+
+class function TAbstractMem.GetAbstractMemVersion: String;
+begin
+  Result := ClassName+' v'+FloatToStr(CT_ABSTRACTMEM_VERSION);
+end;
+
+function TAbstractMem.GetUsedZoneInfo(const APosition: TAbstractMemPosition; ACheckForUsedZone: Boolean; out AAMZone: TAMZone): Boolean;
+begin
+  if (ACheckForUsedZone) then begin
+    if GetZoneType(APosition - CT_ExtraSizeForUsedZoneType,AAMZone)<>amzt_used then Exit(False)
+    else Exit(True);
+  end else begin
+    AAMZone.position := APosition;
+    if Read(APosition - CT_ExtraSizeForUsedZoneType,AAMZone.size,4)<>4 then Exit(False); // This is the CT_ExtraSizeForUsedZoneType = 4 bytes for size indicator
+    Result := (AAMZone.position + AAMZone.size <= FNextAvailablePos)  And ( ((((AAMZone.size-1) DIV 4)+1)*4) = AAMZone.size );
+  end;
+end;
+
+function TAbstractMem.GetZoneType(APosition: TAbstractMemPosition; out AAMZone : TAMZone): TAbstractMemZoneType;
+var LZone : TAMZone;
+  LMemLeak, LSearchedMemLeak : TAbstractMemMemoryLeaksNode;
+begin
+  Result := amzt_unknown;
+  AAMZone.position := APosition;
+  AAMZone.size := 0;
+  LZone.position := (((APosition-1) DIV 4)+1)*4;
+  if (LZone.position <> APosition) or (LZone.position<CT_HeaderSize) or (LZone.position>=FNextAvailablePos) then Exit;
+  // Check if Memory leak
+  LMemLeak.myPosition := LZone.position;
+  LMemLeak.ReadFromMem(LMemLeak.myPosition,Self);
+  LSearchedMemLeak := FMemLeaks.Find(LMemLeak);
+  if FMemLeaks.IsNil(LSearchedMemLeak) then begin
+    if Read(APosition,LZone.size,4)<>4 then Exit; // This is the CT_ExtraSizeForUsedZoneType = 4 bytes for size indicator
+    if (LZone.position + CT_ExtraSizeForUsedZoneType + LZone.size <= FNextAvailablePos)
+      And ( ((((LZone.size-1) DIV 4)+1)*4) = LZone.size ) then begin
+      Result := amzt_used;
+      AAMZone.position := LZone.position + CT_ExtraSizeForUsedZoneType;
+      AAMZone.size := LZone.size;
+    end;
+  end else begin
+    AAMZone.size := LSearchedMemLeak.GetSize;
+    Result := amzt_memory_leak;
+  end;
+end;
+
+procedure TAbstractMem.IncreaseSize(ANeedSize: Integer);
+  // This will guarantee at the end that FMaxAvailablePos-FNextAvailablePos+1 >= ANeededSize
+var LTmpNextAvailablePos, LTmpMaxAvailablePos : Integer;
+begin
+  if FMaxAvailablePos-FNextAvailablePos+1 >= ANeedSize then Exit;
+  LTmpNextAvailablePos := FNextAvailablePos;
+  LTmpMaxAvailablePos := FMaxAvailablePos;
+  DoIncreaseSize(LTmpNextAvailablePos,LTmpMaxAvailablePos,ANeedSize);
+  // Check
+  if (LTmpNextAvailablePos + LTmpMaxAvailablePos + 1 < ANeedSize) then raise EAbstractMem.Create(FormaT('IncreaseSize error. Needed %d obtained from %d to %d = %d',
+    [ANeedSize,LTmpNextAvailablePos,LTmpMaxAvailablePos,(LTmpMaxAvailablePos-LTmpNextAvailablePos+1)]));
+  //
+  FNextAvailablePos := LTmpNextAvailablePos;
+  FMaxAvailablePos := LTmpMaxAvailablePos;
+  if ANeedSize>0 then SaveHeader;
+end;
+
+function TAbstractMem.IsAbstractMemInfoStable: Boolean;
+begin
+  Result := True;
+end;
+
+function TAbstractMem.New(AMemSize: Integer): TAMZone;
+var LNeededMemSize : Integer;
+  LMemLeakToFind, LMemLeakFound : TAbstractMemMemoryLeaksNode;
+begin
+  CheckInitialized(True);
+  // AMemSize must be a value stored in 3 bytes (24 bits) where each value is a "unit" of 4 bytes, so:
+  // (AMemSize > 0) and (AMemSize <= ((((2^24)-1)*4) - 4) )
+  if (AMemSize<=0) or (AMemSize>=67108860) then raise EAbstractMem.Create('Invalid new size: '+IntToStr(AMemSize));
+
+  FLock.Acquire;
+  Try
+    // First 4 bytes will be "how many units"
+    LNeededMemSize := AMemSize + 4;
+    // Minimum size is always 16 bytes (Mem needed for a mem leak = 4 * 4 bytes)
+    if LNeededMemSize<16 then LNeededMemSize := 16
+    else LNeededMemSize := LNeededMemSize;
+    // Round LMemSize to a 4 bytes packet
+    LNeededMemSize := (((LNeededMemSize-1) DIV 4)+1)*4;
+
+    LMemLeakToFind.Clear;
+    LMemLeakToFind.SetSize(LNeededMemSize);
+
+    LMemLeakFound := FMemLeaks.Find( LMemLeakToFind );
+    if Not FMemLeaks.IsNil(LMemLeakFound) then begin
+      // Found a Memory leak with this size, REUSE
+      Result.position := LMemLeakFound.myPosition + 4;
+      Result.size := LMemLeakFound.GetSize - 4;
+      // Remove leak
+      FMemLeaks.Delete( LMemLeakFound );
+    end else begin
+      // Need a new available zone
+      IncreaseSize( LNeededMemSize );
+      //
+      Result.position := FNextAvailablePos + 4; // 4 = "units"
+      FNextAvailablePos := FNextAvailablePos + LNeededMemSize;
+      Result.size := LNeededMemSize - 4;
+      SaveHeader; // NextAvailablePos updated, save changes
+    end;
+    // Save "unit"
+    Write(Result.position - 4,Result.size,4);
+  Finally
+    FLock.Release;
+  End;
+end;
+
+function TAbstractMem.PositionToAbsolute(const APosition: Integer): Int64;
+begin
+  Result := FInitialPosition + APosition;
+end;
+
+procedure TAbstractMem.SaveHeader;
+var LBuffer : TBytes;
+  LUInt32 : UInt32;
+begin
+  if FReadOnly then raise EAbstractMem.Create('Cannot save Haeder on a ReadOnly AbstractMem');
+  // Write Header:
+  SetLength(LBuffer,CT_HeaderSize);
+  Move(CT_Magic[0],LBuffer[0],6);
+  if IsAbstractMemInfoStable then begin
+    LBuffer[6] := CT_IsStable;
+  end else begin
+    LBuffer[6] := CT_Is_NOT_Stable;
+  end;
+  LBuffer[7] := CT_Version;
+  LUInt32 := FMemLeaks.Root.myPosition;
+  Move(LUInt32,LBuffer[8],4);  // position to memleak btree root
+  LUInt32 := FNextAvailablePos;
+  Move(LUInt32,LBuffer[12],4); // next available pos
+  //
+  FHeaderInitialized := True;  // Set before call to Write
+  //
+  Write(0,LBuffer[0],Length(LBuffer));
+end;
+
+procedure TAbstractMem.SaveToStream(AStream: TStream);
+var LBuffer : TBytes;
+  i : Integer;
+  LNextStart : Integer;
+begin
+  CheckInitialized(False);
+  LNextStart := 0;
+  SetLength(LBuffer,1024*1024);
+  FLock.Acquire;
+  Try
+    while (LNextStart < FNextAvailablePos) do begin
+      i := FNextAvailablePos - LNextStart;
+      if (i>Length(LBuffer)) then i := Length(LBuffer);
+      Read(LNextStart,LBuffer[0],i);
+      AStream.Write(LBuffer[0],i);
+      inc(LNextStart,i);
+    end;
+  Finally
+    FLock.Release;
+  End;
+end;
+
+function TAbstractMem.ToString: String;
+var LAnalize : TStrings;
+  LTotalUsedSize, LTotalUsedBlocksCount, LTotalLeaksSize, LTotalLeaksBlocksCount : Integer;
+begin
+  LAnalize := TStringList.Create;
+  try
+    if Not CheckConsistency(LAnalize,LTotalUsedSize, LTotalUsedBlocksCount, LTotalLeaksSize, LTotalLeaksBlocksCount) then begin
+      LAnalize.Add('CONSISTENCY ERROR FOUND');
+    end else begin
+      LAnalize.Clear;
+    end;
+    LAnalize.Add(Format('%s Start position %d - Used %d bytes in %d blocks - Available %d bytes in %d blocks',[Self.GetAbstractMemVersion, FInitialPosition,LTotalUsedSize, LTotalUsedBlocksCount, LTotalLeaksSize, LTotalLeaksBlocksCount]));
+    Result := LAnalize.Text;
+  finally
+    LAnalize.Free;
+  end;
+end;
+
+function TAbstractMem.Read(const APosition: Integer; var ABuffer; ASize: Integer): Integer;
+begin
+  FLock.Acquire;
+  try
+    if Not FHeaderInitialized then Result := 0
+    else Result := AbsoluteRead(PositionToAbsolute(APosition),ABuffer,ASize);
+  Finally
+    FLock.Release;
+  End;
+end;
+
+function TAbstractMem.ReadFirstData(var AFirstDataZone: TAMZone; var AFirstData: TBytes): Boolean;
+var LPosition : TAbstractMemPosition;
+begin
+  LPosition := CT_HeaderSize;
+  Result := False;
+  AFirstDataZone.Clear;
+  SetLength(AFirstData,0);
+  if (LPosition < FNextAvailablePos) then begin
+    case GetZoneType(LPosition,AFirstDataZone) of
+      amzt_used : begin
+        SetLength(AFirstData,AFirstDataZone.size);
+        Result := Read(AFirstDataZone.position,AFirstData[0],Length(AFirstData))=AFirstDataZone.size;
+      end;
+    end;
+  end;
+end;
+
+procedure TAbstractMem.Write(const APosition: Integer; const ABuffer; ASize: Integer);
+begin
+  FLock.Acquire;
+  Try
+    CheckInitialized(True);
+    if AbsoluteWrite(PositionToAbsolute(APosition),ABuffer,ASize)<>ASize then raise EAbstractMem.Create('Cannot write expected size');
+  Finally
+    FLock.Release;
+  End;
+end;
+
+{ TAbstractMemMemoryLeaksNode }
+
+procedure TAbstractMemMemoryLeaksNode.Clear;
+begin
+  Self.myPosition := 0;
+  Self.parentPosition := 0;
+  Self.leftPosition := 0;
+  Self.rigthPosition := 0;
+  Self.balance := 0;
+  Self.units := 0;
+end;
+
+function TAbstractMemMemoryLeaksNode.GetPosition(APosition: TAVLTreePosition): TAbstractMemPosition;
+begin
+  case APosition of
+    poParent: Result := Self.parentPosition;
+    poLeft: Result := Self.leftPosition;
+    poRight: Result := Self.rigthPosition;
+  else raise EAbstractMem.Create('Undefined 20200310-3');
+  end;
+end;
+
+function TAbstractMemMemoryLeaksNode.GetSize: Integer;
+begin
+  Result := Self.units * 4;
+end;
+
+procedure TAbstractMemMemoryLeaksNode.ReadFromMem(AMyPosition: TAbstractMemPosition; AAbstractMem: TAbstractMem);
+var LBuff : TBytes;
+begin
+  Self.Clear;
+  Self.myPosition := AMyPosition;
+  if Self.myPosition<=0 then Exit;
+  SetLength(LBuff,16);
+  AAbstractMem.Read(AMyPosition,LBuff[0],16);
+  Move(LBuff[0],Self.parentPosition,4);
+  Move(LBuff[4],Self.leftPosition,4);
+  Move(LBuff[8],Self.rigthPosition,4);
+  Move(LBuff[12],Self.balance,1);
+  Move(LBuff[13],Self.units,3);
+end;
+
+procedure TAbstractMemMemoryLeaksNode.SetPosition(APosition: TAVLTreePosition; AMemPosition: TAbstractMemPosition);
+begin
+  case APosition of
+    poParent: Self.parentPosition := AMemPosition;
+    poLeft: Self.leftPosition := AMemPosition ;
+    poRight: Self.rigthPosition := AMemPosition;
+  else raise EAbstractMem.Create('Undefined 20200310-3');
+  end;
+end;
+
+procedure TAbstractMemMemoryLeaksNode.SetSize(ABytesSize: Integer);
+begin
+  Self.units := (((ABytesSize-1) DIV 4)+1);
+end;
+
+function TAbstractMemMemoryLeaksNode.ToString: String;
+begin
+  Result := Format('%d Bytes at %d with p:%d l:%d r:%d b:%d u:%d',
+    [Self.GetSize,
+     Self.myPosition,Self.parentPosition,Self.leftPosition,Self.rigthPosition,
+     Self.balance,Self.units]);
+end;
+
+procedure TAbstractMemMemoryLeaksNode.WriteToMem(AAbstractMem: TAbstractMem);
+var LBuff : TBytes;
+begin
+  if Self.myPosition<=0 then Exit;
+  SetLength(LBuff,16);
+  Move(Self.parentPosition,LBuff[0],4);
+  Move(Self.leftPosition,LBuff[4],4);
+  Move(Self.rigthPosition,LBuff[8],4);
+  Move(Self.balance,LBuff[12],1);
+  Move(Self.units,LBuff[13],3);
+  AAbstractMem.Write(Self.myPosition,LBuff[0],16);
+end;
+
+{ TAbstractMemMemoryLeaks }
+
+function _TAbstractMemMemoryLeaksNode_CompareByUnits(const Left, Right: TAbstractMemMemoryLeaksNode): Integer;
+begin
+  Result := Left.units - Right.units;
+  if (Result=0) and (Left.myPosition>0) and (Right.myPosition>0) then begin
+    // This will allow to find exactly a node when both are real (otherwise is searching for a position)
+    Result := Left.myPosition - Right.myPosition;
+  end;
+end;
+
+function TAbstractMemMemoryLeaks.AreEquals(const ANode1, ANode2: TAbstractMemMemoryLeaksNode): Boolean;
+begin
+  Result := (ANode1.myPosition = ANode2.myPosition);
+end;
+
+procedure TAbstractMemMemoryLeaks.ClearNode(var ANode: TAbstractMemMemoryLeaksNode);
+begin
+  ANode.Clear;
+end;
+
+procedure TAbstractMemMemoryLeaks.ClearPosition(var ANode: TAbstractMemMemoryLeaksNode; APosition: TAVLTreePosition);
+begin
+  ANode.SetPosition(APosition,0);
+  if ANode.myPosition>0 then begin
+    ANode.WriteToMem(FAbstractMem);
+  end;
+end;
+
+constructor TAbstractMemMemoryLeaks.Create(AAbstractMem: TAbstractMem; ARootPosition: TAbstractMemPosition);
+begin
+  FRootPosition := ARootPosition;
+  FAbstractMem := AAbstractMem;
+  inherited Create(_TAbstractMemMemoryLeaksNode_CompareByUnits,False);
+end;
+
+destructor TAbstractMemMemoryLeaks.Destroy;
+var LTmp : TAbstractMemMemoryLeaksNode;
+begin
+  LTmp := Root;
+  DisposeNode(LTmp);
+  inherited;
+end;
+
+procedure TAbstractMemMemoryLeaks.DisposeNode(var ANode: TAbstractMemMemoryLeaksNode);
+begin
+  //
+  ANode.Clear;
+end;
+
+function TAbstractMemMemoryLeaks.GetBalance(const ANode: TAbstractMemMemoryLeaksNode): Integer;
+begin
+  if ANode.myPosition>0 then ANode.ReadFromMem(ANode.myPosition,Self.FAbstractMem);
+  Result := ANode.balance;
+end;
+
+function TAbstractMemMemoryLeaks.GetPosition(const ANode: TAbstractMemMemoryLeaksNode;
+  APosition: TAVLTreePosition): TAbstractMemMemoryLeaksNode;
+var LPos : TAbstractMemPosition;
+begin
+  if ANode.myPosition>0 then ANode.ReadFromMem(ANode.myPosition,Self.FAbstractMem);
+  LPos := ANode.GetPosition(APosition);
+  if LPos>0 then begin
+    Result.ReadFromMem(LPos,FAbstractMem);
+  end else Result.Clear;
+end;
+
+function TAbstractMemMemoryLeaks.GetRoot: TAbstractMemMemoryLeaksNode;
+begin
+  if FRootPosition>0 then begin
+    Result.ReadFromMem(FRootPosition,FAbstractMem);
+  end else Result.Clear;
+end;
+
+function TAbstractMemMemoryLeaks.HasPosition(const ANode: TAbstractMemMemoryLeaksNode;
+  APosition: TAVLTreePosition): Boolean;
+begin
+  if ANode.myPosition>0 then ANode.ReadFromMem(ANode.myPosition,Self.FAbstractMem);
+  Result := ANode.GetPosition(APosition) > 0;
+end;
+
+function TAbstractMemMemoryLeaks.IsNil(const ANode: TAbstractMemMemoryLeaksNode): Boolean;
+begin
+  Result := ANode.myPosition = 0;
+end;
+
+procedure TAbstractMemMemoryLeaks.SetBalance(var ANode: TAbstractMemMemoryLeaksNode; ANewBalance: Integer);
+begin
+  if ANode.myPosition>0 then ANode.ReadFromMem(ANode.myPosition,Self.FAbstractMem);
+  ANode.balance := ANewBalance;
+  if ANode.myPosition>0 then begin
+    ANode.WriteToMem(FAbstractMem);
+  end;
+end;
+
+procedure TAbstractMemMemoryLeaks.SetPosition(var ANode: TAbstractMemMemoryLeaksNode;
+  APosition: TAVLTreePosition; const ANewValue: TAbstractMemMemoryLeaksNode);
+begin
+  if ANode.myPosition>0 then ANode.ReadFromMem(ANode.myPosition,Self.FAbstractMem);
+  ANode.SetPosition(APosition,ANewValue.myPosition);
+  if ANode.myPosition>0 then begin
+    ANode.WriteToMem(FAbstractMem);
+  end;
+end;
+
+procedure TAbstractMemMemoryLeaks.SetRoot(const Value: TAbstractMemMemoryLeaksNode);
+begin
+  FRootPosition := Value.myPosition;
+  // Save to header info
+  FAbstractMem.SaveHeader;
+end;
+
+function TAbstractMemMemoryLeaks.ToString(const ANode: TAbstractMemMemoryLeaksNode): String;
+begin
+  Result := ANode.ToString;
+end;
+
+{ TMem }
+
+function TMem.AbsoluteRead(const AAbsolutePosition: Int64; var ABuffer; ASize: Integer): Integer;
+begin
+  if AAbsolutePosition>=Length(FMem) then Exit(0)
+  else begin
+    if AAbsolutePosition + ASize > Length(FMem) then Result := Length(FMem) - AAbsolutePosition
+    else Result := ASize;
+    Move(FMem[AAbsolutePosition],ABuffer,Result);
+  end;
+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
+    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);
+  Result := ASize;
+end;
+
+constructor TMem.Create(AInitialPosition: Integer; AReadOnly: Boolean);
+begin
+  SetLength(FMem,0);
+  inherited;
+end;
+
+procedure TMem.DoIncreaseSize(var ANextAvailablePos, AMaxAvailablePos: Integer; ANeedSize: Integer);
+begin
+  if (ANeedSize<=0) And (AMaxAvailablePos<=0) then begin
+    SetLength(FMem,0); // Reset
+    Exit;
+  end;
+  AMaxAvailablePos := Length(FMem);
+  if (AMaxAvailablePos-ANextAvailablePos+1 >= ANeedSize) then Exit;
+
+  ANeedSize := (((ANeedSize-1) DIV 256)+1)*256;
+
+  SetLength(FMem, AMaxAvailablePos + ANeedSize);
+  Inc(AMaxAvailablePos,ANeedSize);
+  //
+end;
+
+{ TAMZone }
+
+procedure TAMZone.Clear;
+begin
+  Self.position := 0;
+  Self.size := 0;
+end;
+
+function TAMZone.ToString: String;
+begin
+  Result := Format('Pos:%d Size:%d bytes',[Self.position,Self.size]);
+end;
+
+{ TAbstractMemAVLTreeNodeInfo }
+
+procedure TAbstractMemAVLTreeNodeInfo.Clear;
+begin
+  Self.parentPosition := 0;
+  Self.leftPosition := 0;
+  Self.rigthPosition := 0;
+  Self.balance := 0;
+end;
+
+function TAbstractMemAVLTreeNodeInfo.ToString: String;
+begin
+  Result := Format('TreeBasicNode: Parent:%d Left:%d Right:%d Balance:%d',[Self.parentPosition,Self.leftPosition,Self.rigthPosition,Self.balance]);
+end;
+
+{ TAbstractMemAVLTreeNodeInfoClass }
+
+class procedure TAbstractMemAVLTreeNodeInfoClass.ClearPosition(
+  AMyPosition: TAbstractMemPosition; AAbstractMem: TAbstractMem;
+  APosition: TAVLTreePosition);
+var L : TAbstractMemAVLTreeNodeInfo;
+begin
+  L := ReadFromMem(AMyPosition,AAbstractMem);
+  case APosition of
+    poParent: L.parentPosition := 0;
+    poLeft:   L.leftPosition := 0;
+    poRight:  L.rigthPosition := 0;
+  end;
+  WriteToMem(AMyPosition,AAbstractMem,L);
+end;
+
+class function TAbstractMemAVLTreeNodeInfoClass.GetBalance(
+  AMyPosition: TAbstractMemPosition; AAbstractMem: TAbstractMem): ShortInt;
+var L : TAbstractMemAVLTreeNodeInfo;
+begin
+  L := ReadFromMem(AMyPosition,AAbstractMem);
+  Result := L.balance;
+end;
+
+class function TAbstractMemAVLTreeNodeInfoClass.GetPosition(
+  AMyPosition: TAbstractMemPosition; AAbstractMem: TAbstractMem;
+  APosition: TAVLTreePosition): TAbstractMemPosition;
+var L : TAbstractMemAVLTreeNodeInfo;
+begin
+  L := ReadFromMem(AMyPosition,AAbstractMem);
+  case APosition of
+    poParent: Result := L.parentPosition;
+    poLeft:   Result := L.leftPosition;
+    poRight:  Result := L.rigthPosition;
+  end;
+end;
+
+class function TAbstractMemAVLTreeNodeInfoClass.GetSize: Integer;
+begin
+  Result := 13; // 4*3 + 1 (balance)
+end;
+
+class function TAbstractMemAVLTreeNodeInfoClass.ReadFromMem(
+  AMyPosition: TAbstractMemPosition;
+  AAbstractMem: TAbstractMem): TAbstractMemAVLTreeNodeInfo;
+var LBytes : TBytes;
+begin
+  if (AMyPosition>=CT_HeaderSize) then begin
+    Result.Clear;
+    SetLength(LBytes,Self.GetSize);
+    if AAbstractMem.Read(AMyPosition,LBytes[0],Length(LBytes))<>Length(LBytes) then raise EAbstractMem.Create(Format('Not enough data to read TreeNodeInfo at %d',[AMyPosition]));
+    Move(LBytes[0],Result.parentPosition,4);
+    Move(LBytes[4],Result.leftPosition,4);
+    Move(LBytes[8],Result.rigthPosition,4);
+    Move(LBytes[12],Result.balance,1);
+  end else raise EAbstractMem.Create(Format('Invalid position read TAbstractMemAVLTreeNodeInfo.ReadFromMem(%d)',[AMyPosition]));
+end;
+
+class procedure TAbstractMemAVLTreeNodeInfoClass.SetBalance(
+  AMyPosition: TAbstractMemPosition; AAbstractMem: TAbstractMem;
+  ANewBalance: ShortInt);
+var L : TAbstractMemAVLTreeNodeInfo;
+begin
+  L := ReadFromMem(AMyPosition,AAbstractMem);
+  L.balance := ANewBalance;
+  WriteToMem(AMyPosition,AAbstractMem,L);
+end;
+
+class procedure TAbstractMemAVLTreeNodeInfoClass.SetPosition(
+  AMyPosition: TAbstractMemPosition; AAbstractMem: TAbstractMem;
+  APosition: TAVLTreePosition; ANewPosition: TAbstractMemPosition);
+var L : TAbstractMemAVLTreeNodeInfo;
+begin
+  L := ReadFromMem(AMyPosition,AAbstractMem);
+  case APosition of
+    poParent: L.parentPosition := ANewPosition;
+    poLeft:   L.leftPosition := ANewPosition;
+    poRight:  L.rigthPosition := ANewPosition;
+  end;
+  WriteToMem(AMyPosition,AAbstractMem,L);
+end;
+
+class procedure TAbstractMemAVLTreeNodeInfoClass.WriteToMem(
+  AMyPosition: TAbstractMemPosition; AAbstractMem: TAbstractMem;
+  const ANodeInfo: TAbstractMemAVLTreeNodeInfo);
+var LBytes : TBytes;
+begin
+  if (AMyPosition>=CT_HeaderSize) then begin
+    SetLength(LBytes,Self.GetSize);
+    Move(ANodeInfo.parentPosition,LBytes[0],4);
+    Move(ANodeInfo.leftPosition,LBytes[4],4);
+    Move(ANodeInfo.rigthPosition,LBytes[8],4);
+    Move(ANodeInfo.balance,LBytes[12],1);
+    AAbstractMem.Write(AMyPosition,LBytes[0],Length(LBytes));
+  end else raise EAbstractMem.Create(Format('Invalid position write TAbstractMemAVLTreeNodeInfo.WriteToMem(%d) for %s',[AMyPosition,ANodeInfo.ToString]));
+end;
+
+end.

+ 863 - 0
src/libraries/abstractmem/UAbstractMemTList.pas

@@ -0,0 +1,863 @@
+unit UAbstractMemTList;
+
+{
+  This file is part of AbstractMem framework
+
+  Copyright (C) 2020 Albert Molina - [email protected]
+
+  https://github.com/PascalCoinDev/
+
+  *** BEGIN LICENSE BLOCK *****
+
+  The contents of this files are subject to the Mozilla Public License Version
+  2.0 (the "License"); you may not use this file except in compliance with
+  the License. You may obtain a copy of the License at
+  http://www.mozilla.org/MPL
+
+  Software distributed under the License is distributed on an "AS IS" basis,
+  WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
+  for the specific language governing rights and limitations under the License.
+
+  The Initial Developer of the Original Code is Albert Molina.
+
+  See ConfigAbstractMem.inc file for more info
+
+  ***** END LICENSE BLOCK *****
+}
+
+{$ifdef FPC}
+  {$mode DELPHI}
+{$endif}
+{$H+}
+
+interface
+
+uses
+  Classes, SysUtils,
+  SyncObjs,
+  UAbstractMem,
+  // NOTE ABOUT FREEPASCAL (2020-03-10)
+  // Current version 3.0.4 does not contain valid support for Generics, using Generics from this:
+  // https://github.com/PascalCoinDev/PascalCoin/tree/master/src/libraries/generics.collections
+  // (Download and set folder as a "units include folder" in compiler options)
+  {$IFNDEF FPC}System.Generics.Collections,System.Generics.Defaults{$ELSE}Generics.Collections,Generics.Defaults{$ENDIF};
+
+{$I ./ConfigAbstractMem.inc }
+
+type
+  EAbstractMemTList = Class(Exception);
+
+  TAbstractMemTList = Class
+  private
+    FAbstractMem : TAbstractMem;
+    FInitialZone : TAMZone; // Initial zone contains "magic signature", "elements of each block" and "first block pointer", must be at least 16 bytes size
+
+    FElementsOfEachBlock : Integer;
+    FFirstBlockPointer : TAbstractMemPosition;
+    FNextElementPosition : Integer;
+
+    FUseCache : Boolean;
+    FCacheData : TBytes;
+    FCacheUpdated : Boolean;
+
+    function GetPosition(AIndex: Integer): TAbstractMemPosition;
+    procedure SetPosition(AIndex: Integer; const Value: TAbstractMemPosition);
+
+    Procedure CheckInitialized;
+    procedure GetPointerTo(AIndex : Integer; AAllowIncrease : Boolean; out APreviousBlockPointer, ABlockPointer : TAbstractMemPosition; out AIndexInBlock : Integer);
+    procedure AddRange(AIndexStart, AInsertCount : Integer);
+    procedure RemoveRange(AIndexStart, ARemoveCount : Integer);
+    procedure LoadElements(AIndexStart : Integer; var AElements : TBytes);
+    procedure SetUseCache(const Value: Boolean);
+  protected
+    FAbstractMemTListLock : TCriticalSection;
+  public
+    Constructor Create(AAbstractMem : TAbstractMem; const AInitialZone : TAMZone; ADefaultElementsPerBlock : Integer); virtual;
+    destructor Destroy; override;
+
+    procedure FlushCache;
+
+    procedure Initialize(const AInitialZone : TAMZone; ADefaultElementsPerBlock : Integer);
+
+    Function Add(const APosition : TAbstractMemPosition) : Integer; //virtual;
+
+    Procedure Clear; //virtual;
+    Procedure Dispose;
+
+    Procedure Delete(index : Integer); //virtual;
+    Procedure Insert(AIndex : Integer; const APosition : TAbstractMemPosition); //virtual;
+
+    property Position[AIndex : Integer] : TAbstractMemPosition read GetPosition write SetPosition;
+
+    Function Count : Integer;
+    property AbstractMem : TAbstractMem read FAbstractMem;
+    property InitialiZone : TAMZone read FInitialZone;
+    property UseCache : Boolean read FUseCache write SetUseCache;
+    procedure LockList;
+    procedure UnlockList;
+  End;
+
+  TAbstractMemTListBaseAbstract<T> = Class
+  private
+    FAbstractMem: TAbstractMem;
+    function GetInitialZone: TAMZone;
+  protected
+    FList : TAbstractMemTList;
+    // POSSIBLE OVERRIDE METHODS
+    function GetItem(index : Integer) : T; virtual;
+    procedure SetItem(index : Integer; const AItem : T); virtual;
+    function ToString(const AItem : T) : String; overload; virtual;
+    // ABSTRACT METHODS NEED TO OVERRIDE
+    procedure LoadFrom(const ABytes : TBytes; var AItem : T); virtual; abstract;
+    procedure SaveTo(const AItem : T; AIsAddingItem : Boolean; var ABytes : TBytes); virtual; abstract;
+  public
+    Constructor Create(AAbstractMem : TAbstractMem; const AInitialZone : TAMZone; ADefaultElementsPerBlock : Integer); virtual;
+    Destructor Destroy; override;
+
+    Function Add(const AItem : T) : Integer; virtual;
+
+    function Count : Integer;
+    procedure Delete(index : Integer); virtual;
+
+    procedure FlushCache;
+    Procedure Clear;
+    Procedure Dispose;
+    property AbstractMem : TAbstractMem read FAbstractMem;
+    property InitialiZone : TAMZone read GetInitialZone;
+  End;
+
+
+  TAbstractMemTList<T> = Class(TAbstractMemTListBaseAbstract<T>)
+  public
+    property Item[index : Integer] : T read GetItem write SetItem;
+  End;
+
+  { TAbstractMemOrderedTList }
+
+  TAbstractMemOrderedTList<T> = Class(TAbstractMemTListBaseAbstract<T>)
+  private
+    FAllowDuplicates : Boolean;
+  protected
+    // ABSTRACT METHODS NEED TO OVERRIDE
+    function Compare(const ALeft, ARight : T) : Integer; virtual; abstract;
+  public
+    Constructor Create(AAbstractMem : TAbstractMem; const AInitialZone : TAMZone; ADefaultElementsPerBlock : Integer; AAllowDuplicates : Boolean); reintroduce;
+    function Find(const AItemToFind : T; out AIndex : Integer) : Boolean;
+    Function Add(const AItem : T) : Integer; reintroduce;
+    property Item[index : Integer] : T read GetItem;
+    function IndexOf(const AItem : T) : Integer;
+    property AllowDuplicates : Boolean read FAllowDuplicates;
+    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 }
+
+const
+  CT_AbstractMemTList_Magic = 'ABML'; // DO NOT LOCALIZE MUST BE 4 BYTES LENGTH
+
+function TAbstractMemTList.Add(const APosition: TAbstractMemPosition): Integer;
+begin
+  FAbstractMemTListLock.Acquire;
+  Try
+  Result := FNextElementPosition;
+  Insert(FNextElementPosition,APosition);
+  Finally
+    FAbstractMemTListLock.Release;
+  End;
+end;
+
+procedure TAbstractMemTList.AddRange(AIndexStart, AInsertCount: Integer);
+var LElements : TBytes;
+  LBlockPointer,LPreviousBlockPointer : TAbstractMemPosition;
+  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 (FUseCache) then begin
+    FCacheUpdated := True;
+    SetLength(FCacheData,Length(FCacheData)+(AInsertCount*4));
+    Move(FCacheData[AIndexStart*4],FCacheData[(AIndexStart+AInsertCount)*4],Length(FCacheData)-((AIndexStart+AInsertCount)*4));
+    Inc(FNextElementPosition,AInsertCount);
+    Exit;
+  end;
+  //
+  LoadElements(AIndexStart,LElements);
+  n := 0; // n = Elements moved
+  // Increase
+  i := AIndexStart+AInsertCount;
+  // i = first position to move "right"
+  repeat
+    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 );
+    inc(n,j);
+    inc(i,j);
+  until (i >= FNextElementPosition + AInsertCount) or (j=0);
+  Inc(FNextElementPosition,AInsertCount);
+  FAbstractMem.Write( FInitialZone.position + 8, FNextElementPosition, 4 );
+end;
+
+procedure TAbstractMemTList.CheckInitialized;
+begin
+  if (FElementsOfEachBlock<=0) then raise EAbstractMemTList.Create(FormaT('%s not initialized',[ClassName]));
+end;
+
+procedure TAbstractMemTList.Clear;
+var LBlockPointer, LNext : TAbstractMemPosition;
+begin
+  FAbstractMemTListLock.Acquire;
+  Try
+  CheckInitialized;
+  // Free mem
+  LBlockPointer := FFirstBlockPointer;
+  FFirstBlockPointer := 0;
+  FNextElementPosition := 0;
+  FAbstractMem.Write( FInitialZone.position + 12, FFirstBlockPointer, 4 );
+  while (LBlockPointer>0) do begin
+    // Read next
+    FAbstractMem.Read( LBlockPointer + (FElementsOfEachBlock * 4), LNext, 4);
+    FAbstractMem.Dispose(LBlockPointer);
+    LBlockPointer := LNext;
+  end;
+
+  SetLength(FCacheData,0);
+  FCacheUpdated := False;
+  Finally
+    FAbstractMemTListLock.Release;
+  End;
+end;
+
+function TAbstractMemTList.Count: Integer;
+begin
+  Result := FNextElementPosition;
+end;
+
+constructor TAbstractMemTList.Create(AAbstractMem: TAbstractMem; const AInitialZone: TAMZone; ADefaultElementsPerBlock : Integer);
+begin
+  SetLength(FCacheData,0);
+  FUseCache := True;
+  FCacheUpdated := False;
+
+  FAbstractMem := AAbstractMem;
+  FInitialZone.Clear;
+
+  FElementsOfEachBlock := 0;
+  FFirstBlockPointer := 0;
+  FNextElementPosition := 0;
+
+  FAbstractMemTListLock := TCriticalSection.Create;
+
+  Initialize(AInitialZone,ADefaultElementsPerBlock);
+end;
+
+procedure TAbstractMemTList.Delete(index: Integer);
+begin
+  RemoveRange(index,1);
+end;
+
+destructor TAbstractMemTList.Destroy;
+begin
+  if FUseCache then FlushCache;
+  FAbstractMemTListLock.Free;
+  inherited;
+end;
+
+procedure TAbstractMemTList.Dispose;
+begin
+  FAbstractMemTListLock.Acquire;
+  Try
+  if FInitialZone.position<=0 then Exit; // Nothing to dispose
+  Clear;
+  Try
+    if FInitialZone.size=0 then FAbstractMem.Dispose(FInitialZone.position)
+    else FAbstractMem.Dispose(FInitialZone);
+  Finally
+    FInitialZone.Clear;
+  End;
+  Finally
+    FAbstractMemTListLock.Release;
+  End;
+end;
+
+procedure TAbstractMemTList.FlushCache;
+var i : Integer;
+  LPreviousBlockPointer,LBlockPointer, LNext, LZero : TAbstractMemPosition;
+  LIndexInBlock, LElements : Integer;
+begin
+  FAbstractMemTListLock.Acquire;
+  try
+  if (Not FUseCache) or (Not FCacheUpdated) then Exit;
+  CheckInitialized;
+  LPreviousBlockPointer := 0;
+  LBlockPointer := 0;
+  LIndexInBlock := 0;
+  LNext := 0;
+  // Save full:
+  i := 0;
+  while ((i*4) < (Length(FCacheData))) do begin
+    GetPointerTo(i,True,LPreviousBlockPointer,LBlockPointer,LIndexInBlock);
+    if (i+FElementsOfEachBlock-1 >= FNextElementPosition) then begin
+      LElements := FNextElementPosition - i;
+    end else LElements := FElementsOfEachBlock;
+    FAbstractMem.Write(LBlockPointer,FCacheData[i*4],(LElements*4));
+    inc(i,LElements);
+    FAbstractMem.Read( LBlockPointer + (FElementsOfEachBlock * 4), LNext, 4);
+    LPreviousBlockPointer := LBlockPointer;
+  end;
+  // Save Header:
+  FAbstractMem.Write( FInitialZone.position + 8, FNextElementPosition, 4 );
+  // Free unused blocks:
+  if (FNextElementPosition=0) And (FFirstBlockPointer>0) then begin
+    // This is first block pointer
+    LNext := FFirstBlockPointer;
+    FFirstBlockPointer := 0;
+    FAbstractMem.Write( FInitialZone.position + 12, FFirstBlockPointer, 4 );
+    LPreviousBlockPointer := 0;
+  end;
+  while (LNext>0) do begin
+    if LPreviousBlockPointer>0 then begin
+      LZero := 0;
+      FAbstractMem.Write( LPreviousBlockPointer + (FElementsOfEachBlock * 4), LZero, 4);
+    end;
+    LPreviousBlockPointer := LBlockPointer;
+    LBlockPointer := LNext;
+    FAbstractMem.Read( LBlockPointer + (FElementsOfEachBlock * 4), LNext, 4);
+    FAbstractMem.Dispose(LBlockPointer);
+  end;
+  //
+  FCacheUpdated := False;
+  finally
+    FAbstractMemTListLock.Release;
+  end;
+end;
+
+procedure TAbstractMemTList.GetPointerTo(AIndex: Integer; AAllowIncrease : Boolean; out APreviousBlockPointer, ABlockPointer: TAbstractMemPosition; out AIndexInBlock: Integer);
+var LBlockIndex : Integer;
+  i : Integer;
+  LNewBlock : TAMZone;
+  LZero : Integer;
+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]));
+
+  // Search ABlockPointer
+  LBlockIndex := AIndex DIV FElementsOfEachBlock;
+  AIndexInBlock := AIndex MOD FElementsOfEachBlock;
+
+  APreviousBlockPointer := 0;
+  ABlockPointer := FFirstBlockPointer;
+  i := 0;
+  repeat
+    if (ABlockPointer<=0) then begin
+      // Create
+      LNewBlock := FAbstractMem.New( 4 + (FElementsOfEachBlock * 4) );
+      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 );
+      end else begin
+        // This is previous block
+        FAbstractMem.Write( APreviousBlockPointer + (FElementsOfEachBlock*4), LNewBlock.position, 4 );
+      end;
+      // Clear next
+      LZero := 0;
+      FAbstractMem.Write( ABlockPointer + (FElementsOfEachBlock*4), LZero, 4 );
+    end;
+    if (i<LBlockIndex) then begin
+      APreviousBlockPointer := ABlockPointer;
+      // Read
+      FAbstractMem.Read( ABlockPointer + (FElementsOfEachBlock*4), ABlockPointer, 4 );
+    end;
+    inc(i);
+  until (i > LBlockIndex);
+end;
+
+function TAbstractMemTList.GetPosition(AIndex: Integer): TAbstractMemPosition;
+var LBlockPointer,LPreviousBlockPointer : TAbstractMemPosition;
+  LIndexInBlock : Integer;
+begin
+  Result := 0;
+  FAbstractMemTListLock.Acquire;
+  try
+  if FUseCache 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);
+  end else begin
+    GetPointerTo(AIndex,False,LPreviousBlockPointer,LBlockPointer,LIndexInBlock);
+    FAbstractMem.Read( LBlockPointer + (LIndexInBlock*4), Result, 4);
+  end;
+  finally
+    FAbstractMemTListLock.Release;
+  end;
+end;
+
+procedure TAbstractMemTList.Initialize(const AInitialZone: TAMZone; ADefaultElementsPerBlock: Integer);
+var LBytes : TBytes;
+  i : Integer;
+begin
+  FInitialZone := AInitialZone;
+  // Try to read
+  FElementsOfEachBlock := 0;
+  FFirstBlockPointer := 0;
+  FNextElementPosition := 0;
+  SetLength(LBytes,CT_AbstractMemTList_HeaderSize);
+  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 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
+        if LBytes[i]<>Ord(CT_AbstractMemTList_Magic.Chars[i]) then Exit;
+      end;
+      // Capture Size
+      Move(LBytes[4],FElementsOfEachBlock,4);
+      Move(LBytes[8],FNextElementPosition,4);
+      Move(LBytes[12],FFirstBlockPointer,4);
+      if (FElementsOfEachBlock<=0) then begin
+        // Not valid
+        FElementsOfEachBlock := 0;
+        FFirstBlockPointer := 0;
+        FNextElementPosition := 0;
+      end;
+    end;
+  finally
+    if (FInitialZone.position>0) and (FElementsOfEachBlock<=0) and ((FInitialZone.size=0) or (FInitialZone.size>=CT_AbstractMemTList_HeaderSize))  then begin
+      // Need to initialize and save
+      FElementsOfEachBlock := ADefaultElementsPerBlock;
+      if FElementsOfEachBlock<=0 then raise EAbstractMemTList.Create('Invalid Default Elements per block');
+
+      for i := 0 to CT_AbstractMemTList_Magic.Length-1 do 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);
+      // Save header
+      FAbstractMem.Write( FInitialZone.position, LBytes[0], Length(LBytes) );
+    end;
+  end;
+  if (FUseCache) then begin
+    if (FElementsOfEachBlock>0) then begin
+      LoadElements(0,FCacheData);
+    end;
+    FCacheUpdated := False;
+  end;
+end;
+
+procedure TAbstractMemTList.Insert(AIndex: Integer; const APosition: TAbstractMemPosition);
+var LBlockPointer,LPreviousBlockPointer : TAbstractMemPosition;
+  LIndexInBlock : Integer;
+begin
+  FAbstractMemTListLock.Acquire;
+  try
+  AddRange(AIndex,1);
+  if FUseCache then begin
+    Move(APosition, FCacheData[AIndex*4], 4);
+    FCacheUpdated := True;
+  end else begin
+    GetPointerTo(AIndex,False,LPreviousBlockPointer,LBlockPointer,LIndexInBlock);
+    FAbstractMem.Write( LBlockPointer + (LIndexInBlock*4), APosition, 4 );
+  end;
+  finally
+    FAbstractMemTListLock.Release;
+  end;
+end;
+
+procedure TAbstractMemTList.LoadElements(AIndexStart: Integer; var AElements: TBytes);
+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]));
+
+  SetLength(AElements, (FNextElementPosition - AIndexStart)*4);
+
+  i := AIndexStart;
+  while (i<FNextElementPosition) do begin
+    GetPointerTo( i ,False,LPreviousBlockPointer,LBlockPointer,LIndexInBlock);
+    // Load this
+    j := FElementsOfEachBlock - LIndexInBlock;
+    if (i + j -1) >= FNextElementPosition then j := FNextElementPosition - i;
+
+    FAbstractMem.Read(LBlockPointer + (LindexInBlock * 4), AElements[ (i-AIndexStart)*4 ], (j)*4  );
+
+    inc(i,j);
+  end;
+end;
+
+procedure TAbstractMemTList.LockList;
+begin
+  FAbstractMemTListLock.Acquire;
+end;
+
+procedure TAbstractMemTList.RemoveRange(AIndexStart, ARemoveCount: Integer);
+var LBlockPointer, LPreviousBlockPointer, LNext : TAbstractMemPosition;
+  LIndexInBlock, i, j, n : Integer;
+  LElements : TBytes;
+  LBlocksBefore, LBlocksAfter : Integer;
+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]))
+    else raise EAbstractMemTList.Create(Format('%s remove %d..%d out of range (NO ELEMENTS)',[ClassName,AIndexStart,AIndexStart + ARemoveCount -1]))
+  end;
+
+  if FUseCache then begin
+    if (AIndexStart+ARemoveCount < FNextElementPosition) then begin
+      Move(FCacheData[(AIndexStart + ARemoveCount) *4],
+           FCacheData[(AIndexStart) *4],
+           Length(FCacheData)-((AIndexStart + ARemoveCount)*4));
+
+    end;
+    SetLength(FCacheData,Length(FCacheData) - (ARemoveCount*4));
+    FCacheUpdated := True;
+    Dec(FNextElementPosition,ARemoveCount);
+    Exit;
+  end;
+
+  LoadElements(AIndexStart+ARemoveCount,LElements);
+  n := 0; // n = Elements moved
+  //
+  i := AIndexStart+ARemoveCount-1;
+  // i = first position to move "left"
+
+  repeat
+    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 );
+    inc(n,j);
+    inc(i,j);
+  until (i >= FNextElementPosition - ARemoveCount);// or (j=0);
+
+  LBlocksBefore := ((FNextElementPosition DIV FElementsOfEachBlock)+1);
+  LBlocksAfter := (((FNextElementPosition-ARemoveCount) DIV FElementsOfEachBlock)+1);
+
+  if (LBlocksBefore<LBlocksAfter) then begin
+    GetPointerTo(FNextElementPosition-ARemoveCount,False,LPreviousBlockPointer,LBlockPointer,LIndexInBlock);
+    while (LBlockPointer>0) do begin
+      FAbstractMem.Read( LBlockPointer + (FElementsOfEachBlock * 4), LNext, 4);
+      FAbstractMem.Dispose(LBlockPointer);
+      LBlockPointer := LNext;
+      //
+      if LPreviousBlockPointer>0 then begin
+        LNext := 0;
+        FAbstractMem.Write( LPreviousBlockPointer + (FElementsOfEachBlock * 4), LNext, 4);
+      end else begin
+        // This is first block pointer
+        FFirstBlockPointer := 0;
+        FAbstractMem.Write( FInitialZone.position + 12, FFirstBlockPointer, 4 );
+      end;
+    end;
+
+  end;
+
+  // Save to header
+  Dec(FNextElementPosition,ARemoveCount);
+  FAbstractMem.Write( FInitialZone.position + 8, FNextElementPosition, 4 );
+  finally
+    FAbstractMemTListLock.Release;
+  end;
+end;
+
+procedure TAbstractMemTList.SetPosition(AIndex: Integer; const Value: TAbstractMemPosition);
+var LBlockPointer, LPreviousBlockPointer : TAbstractMemPosition;
+  LIndexInBlock : Integer;
+begin
+  FAbstractMemTListLock.Acquire;
+  try
+  if FUseCache then begin
+    Move( Value, FCacheData[AIndex*4], 4);
+    FCacheUpdated := True;
+  end else begin
+    GetPointerTo(AIndex,False,LPreviousBlockPointer,LBlockPointer,LIndexInBlock);
+    FAbstractMem.Write( LBlockPointer + (LIndexInBlock*4), Value, 4);
+  end;
+  finally
+    FAbstractMemTListLock.Release;
+  end;
+end;
+
+procedure TAbstractMemTList.SetUseCache(const Value: Boolean);
+begin
+  if (Value=FUseCache) then Exit;
+  if (FUseCache) then begin
+    FlushCache;
+    SetLength(FCacheData,0);
+  end else begin
+    LoadElements(0,FCacheData);
+    FCacheUpdated := False;
+  end;
+  FUseCache := Value;
+end;
+
+procedure TAbstractMemTList.UnlockList;
+begin
+  FAbstractMemTListLock.Release;
+end;
+
+{ TAbstractMemTListBaseAbstract<T> }
+
+function TAbstractMemTListBaseAbstract<T>.Add(const AItem: T): Integer;
+var
+  LBytes : TBytes;
+  LZone : TAMZone;
+begin
+  FList.LockList;
+  try
+  SetLength(LBytes,0);
+  Self.SaveTo(AItem,True,LBytes);
+  if (Length(LBytes)>0) then begin
+    LZone := FList.AbstractMem.New( Length(LBytes) );
+    FList.AbstractMem.Write( LZone.position, LBytes[0], Length(LBytes) );
+  end else LZone.Clear;
+  Result := FList.Add( LZone.position );
+  finally
+    FList.UnlockList;
+  end;
+end;
+
+procedure TAbstractMemTListBaseAbstract<T>.Clear;
+var i : Integer;
+  LPosition : TAbstractMemPosition;
+begin
+  FList.LockList;
+  try
+  for i := 0 to FList.Count-1 do begin
+    LPosition := FList.Position[ i ];
+    FList.AbstractMem.Dispose( LPosition );
+  end;
+  FList.Clear;
+  finally
+    FList.UnlockList;
+  end;
+end;
+
+function TAbstractMemTListBaseAbstract<T>.Count: Integer;
+begin
+  Result := FList.Count;
+end;
+
+constructor TAbstractMemTListBaseAbstract<T>.Create(AAbstractMem: TAbstractMem;
+  const AInitialZone: TAMZone; ADefaultElementsPerBlock: Integer);
+begin
+  FAbstractMem := AAbstractMem;
+  FList := TAbstractMemTList.Create(AAbstractMem,AInitialZone,ADefaultElementsPerBlock);
+end;
+
+procedure TAbstractMemTListBaseAbstract<T>.Delete(index: Integer);
+var LPosition : TAbstractMemPosition;
+begin
+  FList.LockList;
+  try
+  LPosition := FList.Position[ index ];
+  FList.AbstractMem.Dispose( LPosition );
+  FList.Delete( index );
+  finally
+    FList.UnlockList;
+  end;
+end;
+
+destructor TAbstractMemTListBaseAbstract<T>.Destroy;
+begin
+  FList.Free;
+  inherited;
+end;
+
+procedure TAbstractMemTListBaseAbstract<T>.Dispose;
+begin
+  Clear;
+  FList.Dispose;
+end;
+
+procedure TAbstractMemTListBaseAbstract<T>.FlushCache;
+begin
+  FList.FlushCache;
+end;
+
+function TAbstractMemTListBaseAbstract<T>.GetInitialZone: TAMZone;
+begin
+  Result := FList.InitialiZone;
+end;
+
+function TAbstractMemTListBaseAbstract<T>.GetItem(index: Integer): T;
+var
+  LPosition : TAbstractMemPosition;
+  LZone : TAMZone;
+  LBytes : TBytes;
+begin
+  FList.LockList;
+  try
+  LPosition := FList.Position[ index ];
+  if (LPosition>0) then begin
+    if Not FList.AbstractMem.GetUsedZoneInfo( LPosition, False, LZone) then
+      raise EAbstractMemTList.Create(Format('%s.GetItem Inconsistency error used zone info not found at index %d at pos %d',[Self.ClassName,index,LPosition]));
+    SetLength(LBytes,LZone.size);
+    if FList.AbstractMem.Read(LZone.position, LBytes[0], Length(LBytes) )<>Length(LBytes) then
+      raise EAbstractMemTList.Create(Format('%s.GetItem Inconsistency error cannot read %d bytes for index %d at pos %d',[Self.ClassName,LZone.size,index,LPosition]));
+  end else SetLength(LBytes,0);
+  LoadFrom(LBytes, Result );
+  finally
+    FList.UnlockList;
+  end;
+end;
+
+procedure TAbstractMemTListBaseAbstract<T>.SetItem(index: Integer;
+  const AItem: T);
+var
+  LBytes : TBytes;
+  LZone : TAMZone;
+  LPreviousElementPosition : TAbstractMemPosition;
+begin
+  FList.LockList;
+  try
+  LPreviousElementPosition := FList.Position[ index ];
+  if (LPreviousElementPosition>0) then begin
+    // Had value
+    if Not FList.AbstractMem.GetUsedZoneInfo( LPreviousElementPosition, False, LZone) then
+      raise EAbstractMemTList.Create(Format('%s.SetItem Inconsistency error used zone info not found at index %d at pos %d',[Self.ClassName,index,LPreviousElementPosition]));
+    SetLength(LBytes,LZone.size);
+    if FList.AbstractMem.Read(LZone.position, LBytes[0], Length(LBytes) )<>Length(LBytes) then
+      raise EAbstractMemTList.Create(Format('%s.SetItem Inconsistency error cannot read %d bytes for index %d at pos %d',[Self.ClassName,LZone.size,index,LPreviousElementPosition]));
+  end else begin
+    SetLength(LBytes,0);
+    LZone.Clear;
+  end;
+
+  Self.SaveTo(AItem,False,LBytes);
+
+  if (LPreviousElementPosition>0) and ((Length(LBytes)>LZone.size) or (Length(LBytes)=0)) then begin
+    // Dispose previous element
+    FList.AbstractMem.Dispose( LPreviousElementPosition );
+    LZone.Clear;
+  end;
+  if (Length(LBytes)>0) then begin
+    if (LZone.position=0) then begin
+      // Create new zone
+      LZone := FList.AbstractMem.New( Length(LBytes) );
+    end;
+    FList.AbstractMem.Write( LZone.position, LBytes[0], Length(LBytes) );
+    FList.Position[ index ] := LZone.position;
+  end else begin
+    // Save a 0 position
+    FList.Position[ index ] := 0;
+  end;
+  finally
+    FList.UnlockList;
+  end;
+end;
+
+function TAbstractMemTListBaseAbstract<T>.ToString(const AItem: T): String;
+begin
+  Result := Self.ClassName+'.T '+IntToStr(SizeOf(AItem));
+end;
+
+{ TAbstractMemOrderedTList<T> }
+
+function TAbstractMemOrderedTList<T>.Add(const AItem: T): Integer;
+var
+  LFound : Boolean;
+  LBytes : TBytes;
+  LZone : TAMZone;
+begin
+  FList.LockList;
+  try
+  LFound := Find(AItem,Result);
+  if (LFound and FAllowDuplicates) or (Not LFound) then begin
+    SetLength(LBytes,0);
+    Self.SaveTo(AItem,True,LBytes);
+    if (Length(LBytes)>0) then begin
+      LZone := FList.AbstractMem.New( Length(LBytes) );
+      FList.AbstractMem.Write( LZone.position, LBytes[0], Length(LBytes) );
+    end else LZone.Clear;
+    FList.Insert( Result , LZone.position );
+  end else Result := -1;
+  finally
+    FList.UnlockList;
+  end;
+end;
+
+constructor TAbstractMemOrderedTList<T>.Create(AAbstractMem: TAbstractMem;
+  const AInitialZone: TAMZone; ADefaultElementsPerBlock: Integer;
+  AAllowDuplicates: Boolean);
+begin
+  inherited Create(AAbstractMem, AInitialZone, ADefaultElementsPerBlock);
+  FAllowDuplicates := AAllowDuplicates;
+end;
+
+function TAbstractMemOrderedTList<T>.Find(const AItemToFind: T; out AIndex: Integer): Boolean;
+var L, H, I: Integer;
+  C : Int64;
+  LLeft : T;
+begin
+  FList.LockList;
+  try
+  Result := False;
+  L := 0;
+  H := FList.Count - 1;
+  // Optimization when inserting always a ordered list
+  if (H>0) then begin
+    LLeft := GetItem( H );
+    C := Compare(LLeft, AItemToFind);
+    if (C<0) then begin
+      AIndex := H+1;
+      Exit;
+    end else if (C=0) then begin
+      AIndex := H; // When equals, insert to the left
+      Result := True;
+      Exit;
+    end;
+  end;
+  while L <= H do
+  begin
+    I := (L + H) shr 1;
+
+    LLeft := GetItem( I );
+
+    C := Compare(LLeft, AItemToFind);
+
+    if C < 0 then L := I + 1 else
+    begin
+      H := I - 1;
+      if C = 0 then
+      begin
+        Result := True;
+        L := I;
+      end;
+    end;
+  end;
+  AIndex := L;
+  finally
+    FList.UnlockList;
+  end;
+end;
+
+function TAbstractMemOrderedTList<T>.Get(index: Integer): T;
+begin
+  Result := GetItem(index);
+end;
+
+function TAbstractMemOrderedTList<T>.IndexOf(const AItem: T): Integer;
+begin
+  If Not Find(AItem,Result) then Result := -1;
+end;
+
+end.

+ 967 - 0
src/libraries/abstractmem/UCacheMem.pas

@@ -0,0 +1,967 @@
+unit UCacheMem;
+
+{
+  This file is part of AbstractMem framework
+
+  Copyright (C) 2020 Albert Molina - [email protected]
+
+  https://github.com/PascalCoinDev/
+
+  *** BEGIN LICENSE BLOCK *****
+
+  The contents of this files are subject to the Mozilla Public License Version
+  2.0 (the "License"); you may not use this file except in compliance with
+  the License. You may obtain a copy of the License at
+  http://www.mozilla.org/MPL
+
+  Software distributed under the License is distributed on an "AS IS" basis,
+  WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
+  for the specific language governing rights and limitations under the License.
+
+  The Initial Developer of the Original Code is Albert Molina.
+
+  See ConfigAbstractMem.inc file for more info
+
+  ***** END LICENSE BLOCK *****
+}
+
+{$IFDEF FPC}
+  {$MODE DELPHI}
+{$ENDIF}
+
+interface
+
+uses
+  Classes, SysUtils,
+  {$IFNDEF FPC}{$IFDEF MSWINDOWS}windows,{$ENDIF}{$ENDIF}
+  UAbstractBTree, UOrderedList;
+
+{$I ./ConfigAbstractMem.inc }
+
+type
+  TCacheMem = Class;
+
+  PCacheMemData = ^TCacheMemData;
+
+  { TCacheMemData }
+
+  TCacheMemData = record
+    parent : PCacheMemData;
+    left : PCacheMemData;
+    right : PCacheMemData;
+    balance : Integer;
+    //
+    buffer : TBytes;
+    startPos : Integer;
+    used_previous : PCacheMemData;
+    used_next : PCacheMemData;
+    pendingToSave : Boolean;
+    function GetSize : Integer;
+    function GetEndPos : Integer;
+    procedure Clear;
+    function ToString : String;
+    procedure DoMark(const ACacheMem : TCacheMem; AMySelfPointer : PCacheMemData; AAddToList : Boolean);
+    procedure MarkAsUsed(const ACacheMem : TCacheMem; AMySelfPointer : PCacheMemData);
+    procedure UnMark(const ACacheMem : TCacheMem; AMySelfPointer : PCacheMemData);
+  end;
+
+  TCacheMemDataTree = Class( TAVLAbstractTree<PCacheMemData> )
+  private
+    FRoot : PCacheMemData;
+  protected
+    function GetRoot: PCacheMemData; override;
+    procedure SetRoot(const Value: PCacheMemData); override;
+    function HasPosition(const ANode : PCacheMemData; APosition : TAVLTreePosition) : Boolean; override;
+    procedure SetPosition(var ANode : PCacheMemData; APosition : TAVLTreePosition; const ANewValue : PCacheMemData); override;
+    procedure ClearPosition(var ANode : PCacheMemData; APosition : TAVLTreePosition); override;
+    function GetBalance(const ANode : PCacheMemData) : Integer; override;
+    procedure SetBalance(var ANode : PCacheMemData; ANewBalance : Integer); override;
+    function AreEquals(const ANode1, ANode2 : PCacheMemData) : Boolean; override;
+    procedure ClearNode(var ANode : PCacheMemData); override;
+    procedure DisposeNode(var ANode : PCacheMemData); override;
+  public
+    function IsNil(const ANode : PCacheMemData) : Boolean; override;
+    function ToString(const ANode: PCacheMemData) : String; override;
+    constructor Create; reintroduce;
+    //
+    function GetPosition(const ANode : PCacheMemData; APosition : TAVLTreePosition) : PCacheMemData; override;
+  End;
+
+
+  // TickCount is platform specific (32 or 64 bits)
+  TTickCount = {$IFDEF CPU64}QWord{$ELSE}Cardinal{$ENDIF};
+
+  TPlatform = Class
+  public
+    class function GetTickCount : TTickCount;
+    class function GetElapsedMilliseconds(Const previousTickCount : TTickCount) : Int64;
+  End;
+
+  {$IFDEF ABSTRACTMEM_ENABLE_STATS}
+  TCacheMemStats = record
+    flushCount : Integer;
+    flushSize : Integer;
+    flushElapsedMillis : Int64;
+    freememCount : Integer;
+    freememSize : Integer;
+    freememElaspedMillis : Int64;
+    maxUsedCacheSize : Integer;
+    procedure Clear;
+    function ToString : String;
+  end;
+  {$ENDIF}
+
+  TOnNeedDataProc = function(var ABuffer; AStartPos : Integer; ASize : Integer) : Boolean of object;
+  TOnSaveDataProc = function(const ABuffer; AStartPos : Integer; ASize : Integer) : Boolean of object;
+
+  ECacheMem = Class(Exception);
+
+  TCacheMem = Class
+  private
+    {$IFDEF ABSTRACTMEM_ENABLE_STATS}
+    FCacheMemStats : TCacheMemStats;
+    {$ENDIF}
+    FOldestUsed : PCacheMemData;
+    FNewestUsed : PCacheMemData;
+    FCacheData : TCacheMemDataTree;
+    FPendingToSaveBytes : Integer;
+    FCacheDataBlocks : Integer;
+    FCacheDataSize : Integer;
+    FOnNeedDataProc : TOnNeedDataProc;
+    FOnSaveDataProc : TOnSaveDataProc;
+    FMaxCacheSize: Integer;
+    FMaxCacheDataBlocks: Integer;
+    function FindCacheMemDataByPosition(APosition : Integer; out APCacheMemData : PCacheMemData) : Boolean;
+    procedure Delete(var APCacheMemData : PCacheMemData); overload;
+    function FlushCache(const AFlushCacheList : TOrderedList<PCacheMemData>) : Boolean; overload;
+    procedure CheckMaxMemUsage;
+  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;
+    function ToString : String; reintroduce;
+    function FlushCache : Boolean; overload;
+    function FreeMem(const AMaxMemSize, AMaxBlocks : Integer) : Boolean;
+
+    procedure ConsistencyCheck;
+
+    property CacheDataSize : Integer read FCacheDataSize;
+    // Bytes in cache
+
+    property PendingToSaveSize : Integer read FPendingToSaveBytes;
+    // Bytes in cache pending to flush
+
+    property CacheDataBlocks : Integer read FCacheDataBlocks;
+    // Blocks in cache
+
+    property MaxCacheSize : Integer read FMaxCacheSize write FMaxCacheSize;
+    property MaxCacheDataBlocks : Integer read FMaxCacheDataBlocks write FMaxCacheDataBlocks;
+    {$IFDEF ABSTRACTMEM_ENABLE_STATS}
+    procedure ClearStats;
+    property CacheMemStats : TCacheMemStats read FCacheMemStats;
+    {$ENDIF}
+  End;
+
+implementation
+
+{ TPlatform }
+
+class function TPlatform.GetElapsedMilliseconds(const previousTickCount: TTickCount): Int64;
+begin
+  Result := (Self.GetTickCount - previousTickCount);
+end;
+
+class function TPlatform.GetTickCount: TTickCount;
+begin
+  Result := {$IFDEF CPU64}GetTickCount64{$ELSE}
+   {$IFDEF FPC}SysUtils.GetTickCount{$ELSE}
+     {$IFDEF MSWINDOWS}Windows.GetTickCount{$ELSE}
+     TThread.GetTickCount;
+     {$ENDIF}
+   {$ENDIF}
+  {$ENDIF}
+end;
+
+type
+  TBytesHelper = record helper for TBytes
+    function ToString : String;
+  end;
+
+{ TBytesHelper }
+
+function TBytesHelper.ToString: String;
+var i : Integer;
+begin
+  Result := '';
+  for i := Low(Self) to High(Self) do begin
+    if Result<>'' then Result := Result + ',';
+    Result := Result + IntToStr(Self[i]);
+  end;
+  Result := '['+Result+']';
+end;
+
+{ TCacheMem }
+
+function _CacheMem_CacheData_Comparer(const Left, Right: PCacheMemData): Integer;
+begin
+  Result := Integer(Left^.startPos) - Integer(Right^.startPos);
+end;
+
+procedure TCacheMem.CheckMaxMemUsage;
+begin
+  if ((FMaxCacheSize < 0) or (FCacheDataSize<=FMaxCacheSize))
+     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);
+end;
+
+procedure TCacheMem.Clear;
+var P, PCurr : PCacheMemData;
+  i : Integer;
+begin
+  PCurr := FCacheData.FindLowest;
+  while (Assigned(PCurr)) do begin
+    P := PCurr;
+    PCurr := FCacheData.FindSuccessor(P);
+    FCacheData.Delete(P);
+  end;
+
+  FPendingToSaveBytes := 0;
+  FCacheDataSize := 0;
+  FCacheDataBlocks := 0;
+  FOldestUsed := Nil;
+  FNewestUsed := Nil;
+end;
+
+{$IFDEF ABSTRACTMEM_ENABLE_STATS}
+procedure TCacheMem.ClearStats;
+begin
+  FCacheMemStats.Clear;
+end;
+{$ENDIF}
+
+procedure TCacheMem.ConsistencyCheck;
+var i, iLOrderPos : Integer;
+  PLast, PCurrent : PCacheMemData;
+  LTotalSize, LTotalPendingSize, LTotalNodes : Integer;
+  LOrder : TOrderedList<PCacheMemData>;
+begin
+  //
+  PLast := Nil;
+  LTotalSize := 0;
+  LTotalPendingSize := 0;
+  LTotalNodes := 0;
+
+  PCurrent := FCacheData.FindLowest;
+  while (Assigned(PCurrent)) do begin
+    inc(LTotalNodes);
+    if PCurrent^.GetSize=0 then raise ECacheMem.Create(Format('Cache "%s" size 0',[PCurrent^.ToString]));
+
+    if Assigned(PLast) then begin
+      if PLast^.GetEndPos>=PCurrent^.startPos then raise ECacheMem.Create(Format('Cache "%s" end pos with previous "%s"',[PCurrent^.ToString,PLast^.ToString]));
+    end;
+    PLast := PCurrent;
+    inc(LTotalSize,PCurrent^.GetSize);
+    if PCurrent^.pendingToSave then begin
+      inc(LTotalPendingSize,PCurrent^.GetSize);
+    end;
+
+    PCurrent := FCacheData.FindSuccessor(PCurrent);
+  end;
+  if (LTotalNodes<>FCacheDataBlocks) then raise ECacheMem.Create(Format('Found cache blocks %d <> %d',[LTotalNodes,FCacheDataBlocks]));
+  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);
+  try
+    PLast := Nil;
+    PCurrent := FOldestUsed;
+    i := 0;
+    while (Assigned(PCurrent)) do begin
+      inc(i);
+      if PCurrent^.used_previous<>PLast then raise ECacheMem.Create(Format('Previous <> Last at %d for %s',[i,PCurrent^.ToString]));
+      if LOrder.Find( PCurrent, iLOrderPos ) then begin
+        raise ECacheMem.Create(Format('Circular in mark at %d for %s',[i,PCurrent^.ToString]));
+      end else if (iLOrderPos < LOrder.Count) then begin
+        if LOrder.Get(iLOrderPos)^.startPos<=PCurrent^.GetEndPos then begin
+          raise ECacheMem.Create(Format('Overused in mark at %d for %s vs (iLOrderPos=%d) %s',[i,PCurrent^.ToString, iLOrderPos, LOrder.Get(iLOrderPos)^.ToString]));
+        end;
+      end;
+      if LOrder.Add(PCurrent)<0 then raise ECacheMem.Create(Format('Circular in mark at %d for %s',[i,PCurrent^.ToString]));
+      PLast := PCurrent;
+      PCurrent := PCurrent^.used_next;
+    end;
+    // Check last
+    if (PLast<>FNewestUsed) then raise ECacheMem.Create(Format('Last <> Newest at %d/%d',[i,LTotalNodes]));
+    if (i<>LTotalNodes) then raise ECacheMem.Create(Format('Marked nodes %d <> CacheData nodes %d',[i,LTotalNodes]));
+
+  finally
+    LOrder.Free;
+  end;
+end;
+
+constructor TCacheMem.Create(AOnNeedDataProc : TOnNeedDataProc; AOnSaveDataProc : TOnSaveDataProc);
+begin
+  {$IFDEF ABSTRACTMEM_ENABLE_STATS}
+  FCacheMemStats.Clear;
+  {$ENDIF}
+  FMaxCacheSize := -1; // No limit by default
+  FMaxCacheDataBlocks := -1; // No limit by default
+  FCacheData := TCacheMemDataTree.Create;
+  FCacheDataBlocks := 0;
+  FPendingToSaveBytes := 0;
+  FCacheDataSize := 0;
+  FOnNeedDataProc := AOnNeedDataProc;
+  FOnSaveDataProc := AOnSaveDataProc;
+  FOldestUsed := Nil;
+  FNewestUsed := Nil;
+end;
+
+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);
+  if APCacheMemData^.pendingToSave then begin
+    Dec(FPendingToSaveBytes,APCacheMemData^.GetSize);
+  end;
+  SetLength(APCacheMemData^.buffer,0);
+  APCacheMemData^.UnMark(Self,APCacheMemData);
+  FCacheData.Delete(APCacheMemData);
+  Dec(FCacheDataBlocks);
+end;
+
+destructor TCacheMem.Destroy;
+begin
+  FlushCache;
+  Clear;
+  FreeAndNil(FCacheData);
+  inherited;
+end;
+
+function TCacheMem.FindCacheMemDataByPosition(APosition: Integer; out APCacheMemData: PCacheMemData): Boolean;
+  // Will return FCacheData index at AiCacheDataPos that contains APosition
+  // When returning FALSE, AiCacheDataPos will be index of previous FCacheData position to use
+var PSearch : PCacheMemData;
+begin
+  APCacheMemData := Nil;
+  Result := False;
+
+  New(PSearch);
+  try
+    PSearch^.Clear;
+    SetLength(PSearch^.buffer,0);
+    PSearch^.startPos := APosition;
+    PSearch^.pendingToSave := False;
+    // Will search a value
+    APCacheMemData := FCacheData.FindInsertPos(PSearch);
+    if (Assigned(APCacheMemData)) then begin
+      // Watch if is contained in it
+      if (APCacheMemData^.startPos>APosition) then begin
+        APCacheMemData := FCacheData.FindPrecessor(APCacheMemData);
+      end;
+      if (Assigned(APCacheMemData)) then begin
+        Result := (APCacheMemData^.startPos<=APosition) and (APCacheMemData^.GetEndPos >= APosition);
+      end;
+    end;
+  finally
+    Dispose(PSearch);
+  end;
+end;
+
+function TCacheMem.FlushCache(const AFlushCacheList : TOrderedList<PCacheMemData>) : Boolean;
+var i : Integer;
+  PToCurrent, PToNext : PCacheMemData;
+  LTotalBytesSaved, LTotalBytesError : Integer;
+  {$IFDEF ABSTRACTMEM_ENABLE_STATS}
+  LTickCount : TTickCount;
+  {$ENDIF}
+begin
+  {$IFDEF ABSTRACTMEM_ENABLE_STATS}
+  LTickCount := TPlatform.GetTickCount;
+  {$ENDIF}
+  LTotalBytesSaved := 0;
+  LTotalBytesError := 0;
+  Result := True;
+
+  if (FPendingToSaveBytes<=0) then Exit;
+
+  i := 0;
+  PToNext := FOldestUsed;
+
+  repeat
+    if Assigned(AFlushCacheList) then begin
+      if i < AFlushCacheList.Count then PToCurrent:=AFlushCacheList.Get(i)
+      else PToCurrent := Nil;
+      inc(i);
+    end else PToCurrent := PToNext;
+
+    if Assigned(PToCurrent) then begin
+      if (PToCurrent^.pendingToSave) then begin
+
+        if Not Assigned(FOnSaveDataProc) then Exit(False);
+        if Not FOnSaveDataProc(PToCurrent^.buffer[0],PToCurrent^.startPos,PToCurrent^.GetSize) then begin
+          Result := False;
+          inc(LTotalBytesError,PToCurrent^.GetSize);
+        end else begin
+          inc(LTotalBytesSaved,PToCurrent^.GetSize);
+          PToCurrent^.pendingToSave := False;
+          Dec(FPendingToSaveBytes,PToCurrent^.GetSize);
+        end;
+      end;
+      PToNext := PToCurrent^.used_next;
+    end;
+  until Not Assigned(PToCurrent);
+  if (LTotalBytesSaved>0) or (LTotalBytesError>0) then begin
+    {$IFDEF ABSTRACTMEM_ENABLE_STATS}
+    Inc(FCacheMemStats.flushCount);
+    Inc(FCacheMemStats.flushSize,LTotalBytesSaved);
+    Inc(FCacheMemStats.flushElapsedMillis,TPlatform.GetElapsedMilliseconds(LTickCount));
+    {$ENDIF}
+  end;
+  if (LTotalBytesError=0) and (Not Assigned(AFlushCacheList)) and (FPendingToSaveBytes<>0) then raise ECacheMem.Create(Format('Flush Inconsistency error Saved:%d Pending:%d',[LTotalBytesSaved,FPendingToSaveBytes]));
+
+end;
+
+function TCacheMem.FlushCache: Boolean;
+begin
+  Result := FlushCache(Nil); // FlushCache without a list, without order
+end;
+
+function TCacheMem.FreeMem(const AMaxMemSize, AMaxBlocks: Integer) : Boolean;
+var
+  i, LPreviousCacheDataSize, LTempCacheDataSize,
+  LFinalMaxMemSize, LMaxPendingRounds : Integer;
+  PToRemove, PToNext : PCacheMemData;
+  LListToFlush : TOrderedList<PCacheMemData>;
+  {$IFDEF ABSTRACTMEM_ENABLE_STATS}
+  LTickCount : TTickCount;
+  {$ENDIF}
+begin
+  // Will delete FCacheData until AMaxMemSize >= FCacheDataSize
+  if ((AMaxMemSize < 0) or (FCacheDataSize<=AMaxMemSize))
+     and
+     ((AMaxBlocks < 0) or (FCacheDataBlocks<=AMaxBlocks)) then Exit(True);
+  {$IFDEF ABSTRACTMEM_ENABLE_STATS}
+  LTickCount := TPlatform.GetTickCount;
+  {$ENDIF}
+  LPreviousCacheDataSize := FCacheDataSize;
+
+  if (AMaxMemSize<0) then LFinalMaxMemSize := FCacheDataSize
+  else LFinalMaxMemSize := AMaxMemSize;
+  if (AMaxBlocks<0) then LMaxPendingRounds := 0
+  else LMaxPendingRounds := FCacheDataBlocks - AMaxBlocks;
+  //
+  PToRemove := FOldestUsed;
+  LListToFlush := TOrderedList<PCacheMemData>.Create(False,_CacheMem_CacheData_Comparer);
+  try
+    LTempCacheDataSize := FCacheDataSize;
+    while (Assigned(PToRemove)) and
+      // Both conditions must be true
+      ((LTempCacheDataSize > LFinalMaxMemSize) or (LMaxPendingRounds>0))
+      do begin
+      Dec(LMaxPendingRounds);
+      PToNext := PToRemove^.used_next; // Capture now to avoid future PToRemove updates
+      Dec(LTempCacheDataSize, PToRemove^.GetSize);
+      if (PToRemove^.pendingToSave) then begin
+        // Add to list to flush
+        LListToFlush.Add(PToRemove);
+      end else Delete(PToRemove);
+      PToRemove := PToNext; // Point to next used
+    end;
+    // LListToFlush will have pending to save
+    Result := FlushCache(LListToFlush);
+    // Delete not deleted previously
+    for i:=0 to LListToFlush.Count-1 do begin
+      PToRemove := LListToFlush.Get(i);
+      Delete( PToRemove );
+    end;
+  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.freememElaspedMillis,TPlatform.GetElapsedMilliseconds(LTickCount));
+  {$ENDIF}
+end;
+
+function TCacheMem.LoadData(var ABuffer; const AStartPos, ASize: Integer): Boolean;
+  // Will return a Pointer to AStartPos
+
+  function _CaptureDataFromOnNeedDataProc(ACapturePosStart, ACaptureSize : Integer; var ACapturedData : TBytes) : Boolean;
+  {$IFDEF ABSTRACTMEM_TESTING_MODE}var i : integer;{$ENDIF}
+  begin
+    SetLength(ACapturedData,ACaptureSize);
+    if Not Assigned(FOnNeedDataProc) then begin
+      FillChar(ACapturedData[0],Length(ACapturedData),0);
+      {$IFDEF ABSTRACTMEM_TESTING_MODE}
+      // TESTING PURPOSE TESTING ONLY
+      for i := 0 to High(ACapturedData) do begin
+        ACapturedData[i] := Byte(ACapturePosStart + i);
+      end;
+      // END TESTING PURPOSE
+      {$ENDIF}
+      Exit(False);
+    end;
+    Result := FOnNeedDataProc(ACapturedData[0],ACapturePosStart,ACaptureSize);
+  end;
+
+
+var
+  LNewP, PCurrent, PToDelete : PCacheMemData;
+  LLastAddedPosition, LBytesCount, LSizeToStore : Integer;
+  LTempData : TBytes;
+  LTmpResult : Boolean;
+begin
+  if ASize<0 then raise ECacheMem.Create(Format('Invalid load size %d',[ASize]));
+  if ASize=0 then Exit(True);
+  if (FindCacheMemDataByPosition(AStartPos,PCurrent)) then begin
+    if (PCurrent^.GetSize - (AStartPos - PCurrent^.startPos)) >= ASize then begin
+      // PStart has all needed info
+      Move(PCurrent^.buffer[ AStartPos-PCurrent^.startPos ],ABuffer,ASize);
+      PCurrent^.MarkAsUsed(Self,PCurrent);
+      Result := True;
+      Exit;
+    end;
+  end;
+
+  // Will need to create a new "linar struct" because not found a linear struct previously
+  New( LNewP );
+  try
+    LNewP.Clear;
+
+    LSizeToStore := ASize;
+    SetLength(LNewP^.buffer, LSizeToStore);
+
+    LNewP.startPos := AStartPos;
+
+    Result := True;
+
+    LLastAddedPosition := AStartPos - 1;
+    while (Assigned(PCurrent)) and ( (LLastAddedPosition) < (LNewP^.GetEndPos) ) do begin
+      if (PCurrent^.GetEndPos <= LLastAddedPosition) then PCurrent := FCacheData.FindSuccessor(PCurrent)
+      else if (PCurrent^.startPos > LNewP^.GetEndPos) then break
+      else begin
+        // PCurrent will be used:
+        //
+        if (PCurrent^.startPos <= LLastAddedPosition) then begin
+          // PCurrent start before, increase buffer and set startPos
+          SetLength(LNewP^.buffer ,Length(LNewP^.buffer) + (LLastAddedPosition - PCurrent^.startPos + 1));
+          LNewP.startPos := PCurrent^.startPos;
+          LLastAddedPosition := PCurrent^.startPos-1;
+        end else if (PCurrent^.startPos > LLastAddedPosition+1) then begin
+          // Need data "between"
+          LBytesCount := PCurrent^.startPos - (LLastAddedPosition+1);
+          LTmpResult := _CaptureDataFromOnNeedDataProc(LLastAddedPosition+1,LBytesCount,LTempData);
+          Result := Result and LTmpResult;
+          Move(LTempData[0],LNewP^.buffer[ (LLastAddedPosition+1) - LNewP^.startPos ], LBytesCount);
+          inc(LLastAddedPosition,LBytesCount);
+        end;
+        // At this point (LLastAddedPosition+1 = PCurrent^.startPos)
+        // Add available data
+        if PCurrent^.GetEndPos>(LNewP^.GetEndPos) then begin
+          // Will need to increase buffer size:
+          SetLength( LNewP^.buffer , LNewP^.GetSize + (PCurrent^.GetEndPos - LNewP^.GetEndPos));
+        end;
+        LBytesCount := PCurrent^.GetEndPos - LLastAddedPosition;
+        Move(PCurrent^.buffer[ 0 ],LNewP^.buffer[ (LLastAddedPosition+1) - LNewP^.startPos ], LBytesCount);
+        inc(LLastAddedPosition,LBytesCount);
+
+        // Has been used, delete
+        LNewP.pendingToSave := (LNewP^.pendingToSave) or (PCurrent^.pendingToSave);
+        PToDelete := PCurrent;
+        PCurrent := FCacheData.FindSuccessor(PCurrent);
+        Delete( PToDelete );
+      end;
+    end;
+    if (LLastAddedPosition) < (LNewP^.GetEndPos) then begin
+      // That means there is no data available at cache
+      LBytesCount := LNewP^.GetSize - (LLastAddedPosition - LNewP^.startPos +1);
+      LTmpResult := _CaptureDataFromOnNeedDataProc(LLastAddedPosition+1,LBytesCount,LTempData);
+      Result := Result and LTmpResult;
+      Move(LTempData[0],LNewP^.buffer[ (LLastAddedPosition+1) - LNewP^.startPos ], LBytesCount);
+    end;
+  Except
+    on E:Exception do begin
+      LNewP.Clear;
+      Dispose(LNewP);
+      Raise;
+    end;
+  end;
+
+  // 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(FCacheDataBlocks);
+  //
+  if (LNewP^.pendingToSave) then begin
+    inc(FPendingToSaveBytes,LNewP^.GetSize);
+  end;
+
+  Move(LNewP^.buffer[ AStartPos-LNewP^.startPos ],ABuffer,ASize);
+
+  CheckMaxMemUsage;
+end;
+
+procedure TCacheMem.SaveToCache(const ABuffer: TBytes; AStartPos: Integer; AMarkAsPendingToSave : Boolean);
+begin
+  SaveToCache(ABuffer[0],Length(ABuffer),AStartPos,AMarkAsPendingToSave);
+end;
+
+function TCacheMem.ToString: String;
+var i : Integer;
+  LLines : TStrings;
+  LPct : Double;
+  PCurrent : PCacheMemData;
+begin
+  LLines := TStringList.Create;
+  try
+    LLines.Add(Format('%s.ToString',[ClassName]));
+    PCurrent := FCacheData.FindLowest;
+    while (Assigned(PCurrent)) do begin
+      LLines.Add( PCurrent^.ToString );
+      PCurrent := FCacheData.FindSuccessor(PCurrent);
+    end;
+    if FCacheDataSize>0 then LPct := (FPendingToSaveBytes / FCacheDataSize)*100
+    else LPct := 0.0;
+    LLines.Add(Format('Total size %d bytes in %d blocks - Pending to Save %d bytes (%.2n%%)',[FCacheDataSize,FCacheDataBlocks,FPendingToSaveBytes,LPct]));
+    Result := LLines.Text;
+  finally
+    LLines.Free;
+  end;
+end;
+
+procedure TCacheMem.SaveToCache(const ABuffer; ASize, AStartPos: Integer; AMarkAsPendingToSave : Boolean);
+var
+  LNewP, PCurrent, PToDelete : PCacheMemData;
+  LLastAddedPosition, LBytesCount : Integer;
+begin
+  if ASize<0 then raise ECacheMem.Create(Format('Invalid save size %d',[ASize]));
+  if ASize=0 then Exit;
+
+  if (FindCacheMemDataByPosition(AStartPos,PCurrent)) then begin
+    if (PCurrent^.GetSize - (AStartPos - PCurrent^.startPos)) >= ASize then begin
+      // PStart has all needed info
+      Move(ABuffer,PCurrent^.buffer[ AStartPos - PCurrent^.startPos ], ASize);
+      if (Not PCurrent^.pendingToSave) and (AMarkAsPendingToSave) then begin
+        PCurrent^.pendingToSave := True;
+        inc(FPendingToSaveBytes,PCurrent^.GetSize);
+      end;
+      PCurrent^.MarkAsUsed(Self,PCurrent);
+      Exit;
+    end;
+  end;
+
+  // Will need to create a new "linar struct" because not found a linear struct previously
+  New( LNewP );
+  try
+    LNewP.Clear;
+    SetLength(LNewP^.buffer, ASize);
+    LNewP.startPos := AStartPos;
+    LNewP^.pendingToSave := AMarkAsPendingToSave;
+
+    LLastAddedPosition := AStartPos - 1;
+    while (Assigned(PCurrent)) and ( (LLastAddedPosition+1) < (LNewP^.GetEndPos) ) do begin
+      if (PCurrent^.GetEndPos <= LLastAddedPosition) then PCurrent := FCacheData.FindSuccessor( PCurrent )
+      else if (PCurrent^.startPos > LNewP^.GetEndPos) then break
+      else begin
+        // PCurrent will be used:
+        if (PCurrent^.startPos <= LLastAddedPosition) then begin
+          // PCurrent start before, increase buffer and set startPos
+          SetLength(LNewP^.buffer ,Length(LNewP^.buffer) + (LLastAddedPosition - PCurrent^.startPos + 1));
+          LNewP.startPos := PCurrent^.startPos;
+          Move(PCurrent^.buffer[ 0 ],LNewP^.buffer[ 0 ], (LLastAddedPosition - PCurrent^.startPos +1));
+        end;
+        // At this point (LLastAddedPosition+1 = PCurrent^.startPos)
+        // Add available data
+        if PCurrent^.GetEndPos>(LNewP^.GetEndPos) then begin
+          // Will need to increase buffer size:
+          LBytesCount := (PCurrent^.GetEndPos - LNewP^.GetEndPos);
+          SetLength( LNewP^.buffer , LNewP^.GetSize + LBytesCount );
+          Move(PCurrent^.buffer[ PCurrent^.GetSize - LBytesCount ],LNewP^.buffer[ LNewP^.GetSize - LBytesCount ], LBytesCount);
+        end;
+
+        // Has been used, delete
+        LNewP.pendingToSave := (LNewP^.pendingToSave) or (PCurrent^.pendingToSave);
+        PToDelete := PCurrent;
+        PCurrent := FCacheData.FindSuccessor(PCurrent);
+        Delete( PToDelete );
+      end;
+    end;
+    // At this point LNewP^.buffer startPos <= AStartPos and LNewP^.buffer Size >= ASize
+    Move( ABuffer, LNewP^.buffer[ (LLastAddedPosition+1) - LNewP^.startPos ], ASize );
+  Except
+    on E:Exception do begin
+      LNewP.Clear;
+      Dispose(LNewP);
+      Raise;
+    end;
+  end;
+
+  // 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(FCacheDataBlocks);
+  //
+  if (LNewP^.pendingToSave) then begin
+    inc(FPendingToSaveBytes,LNewP^.GetSize);
+  end;
+
+  CheckMaxMemUsage;
+end;
+
+{ TCacheMemData }
+
+procedure TCacheMemData.Clear;
+begin
+  SetLength(Self.buffer,0);
+  Self.parent := Nil;
+  Self.left := Nil;
+  Self.right := Nil;
+  Self.balance := 0;
+  //
+  Self.startPos := 0;
+  Self.pendingToSave := False;
+  Self.used_previous := Nil;
+  Self.used_next := Nil;
+end;
+
+procedure TCacheMemData.DoMark(const ACacheMem: TCacheMem; AMySelfPointer: PCacheMemData; AAddToList: Boolean);
+{
+    O = ACacheMem.FOldest
+    N = ACacheMem.FNewest
+
+    O       N
+    A - B - C   ( D = New CacheMem )
+}
+
+begin
+  if Assigned(Self.used_previous) then begin
+    // B or C
+    if (Self.used_previous^.used_next<>AMySelfPointer) then raise ECacheMem.Create(Format('Inconsistent previous.next<>MySelf in %s',[Self.ToString]));
+    if (ACacheMem.FOldestUsed = AMySelfPointer) then raise ECacheMem.Create(Format('Inconsistent B,C Oldest = MySelf in %s',[Self.ToString]));
+    if Assigned(Self.used_next) then begin
+      // B only
+      if (Self.used_next^.used_previous<>AMySelfPointer) then raise ECacheMem.Create(Format('Inconsistent B next.previous<>MySelf in %s',[Self.ToString]));
+      if (ACacheMem.FNewestUsed = AMySelfPointer) then raise ECacheMem.Create(Format('Inconsistent B Newest = MySelf in %s',[Self.ToString]));
+      Self.used_previous^.used_next := Self.used_next;
+      Self.used_next^.used_previous := Self.used_previous;
+    end else begin
+      // C only
+      if (ACacheMem.FNewestUsed <> AMySelfPointer) then raise ECacheMem.Create(Format('Inconsistent Newest <> MySelf in %s',[Self.ToString]));
+      if (Not AAddToList) then begin
+        Self.used_previous^.used_next := Nil;
+      end;
+    end;
+  end else if assigned(Self.used_next) then begin
+    // A
+    if (Self.used_next^.used_previous<>AMySelfPointer) then raise ECacheMem.Create(Format('Inconsistent A next.previous<>MySelf in %s',[Self.ToString]));
+    if (ACacheMem.FOldestUsed <> AMySelfPointer) then raise ECacheMem.Create(Format('Inconsistent Oldest <> MySelf in %s',[Self.ToString]));
+    if (ACacheMem.FNewestUsed = AMySelfPointer) then raise ECacheMem.Create(Format('Inconsistent A Newest = MySelf in %s',[Self.ToString]));
+    Self.used_next^.used_previous := Self.used_previous; // = NIL
+    ACacheMem.FOldestUsed:=Self.used_next; // Set oldest
+  end else begin
+    // D
+    if (ACacheMem.FOldestUsed = AMySelfPointer) and (ACacheMem.FNewestUsed = AMySelfPointer) then begin
+      // D is the "only one", no previous, no next, but added or removed
+      if (Not AAddToList) then begin
+        ACacheMem.FOldestUsed := Nil;
+      end;
+    end else begin
+      if (ACacheMem.FOldestUsed = AMySelfPointer) then raise ECacheMem.Create(Format('Inconsistent D Oldest = MySelf in %s',[Self.ToString]));
+      if (ACacheMem.FNewestUsed = AMySelfPointer) then raise ECacheMem.Create(Format('Inconsistent D Newest = MySelf in %s',[Self.ToString]));
+    end;
+    if Not Assigned(ACacheMem.FOldestUsed) and (AAddToList) then begin
+        // D is first one to be added
+        ACacheMem.FOldestUsed := AMySelfPointer; // Set oldest
+    end;
+  end;
+  if Assigned(ACacheMem.FNewestUsed) then begin
+    if Assigned(ACacheMem.FNewestUsed^.used_next) then raise ECacheMem.Create(Format('Inconsistent Newest.next <> Nil in %s',[Self.ToString]));
+  end;
+  // Update Self.used_previous and Self.used_next
+  if AAddToList then begin
+    // Adding to list
+    if (ACacheMem.FNewestUsed<>AMySelfPointer) then begin
+      // Link to previous if newest <> MySelf
+      Self.used_previous := ACacheMem.FNewestUsed;
+    end;
+    if Assigned(ACacheMem.FNewestUsed) then begin
+      ACacheMem.FNewestUsed^.used_next:= AMySelfPointer;
+    end;
+    ACacheMem.FNewestUsed:=AMySelfPointer;
+  end else begin
+    // Removing from list
+    if ACacheMem.FNewestUsed = AMySelfPointer then begin
+      if (Assigned(Self.used_next)) then raise ECacheMem.Create(Format('Inconsistent next <> Nil when Self = Newest in %s',[Self.ToString]));
+      ACacheMem.FNewestUsed := Self.used_previous;
+    end;
+    Self.used_previous := Nil;
+  end;
+  Self.used_next := Nil;
+end;
+
+
+function TCacheMemData.GetEndPos: Integer;
+begin
+  Result := Self.startPos + Self.GetSize - 1;
+end;
+
+function TCacheMemData.GetSize: Integer;
+begin
+  Result := Length(Self.buffer);
+end;
+
+procedure TCacheMemData.MarkAsUsed(const ACacheMem: TCacheMem; AMySelfPointer : PCacheMemData);
+begin
+  DoMark(ACacheMem,AMySelfPointer,True);
+end;
+
+procedure TCacheMemData.UnMark(const ACacheMem: TCacheMem; AMySelfPointer: PCacheMemData);
+begin
+  DoMark(ACacheMem,AMySelfPointer,False);
+end;
+
+function TCacheMemData.ToString: String;
+var i : Integer;
+begin
+  Result := Format('%d bytes from %d to %d',[Self.GetSize,Self.startPos,Self.GetEndPos]);
+  if Self.pendingToSave then Result := Result + ' (updated)';
+  Result := Result +' [';
+  i := 0;
+  while (Length(Result)<100) and (i<Self.GetSize) do begin
+    if i>0 then Result := Result + ','+IntToStr(Self.buffer[i])
+    else Result := Result + IntToStr(Self.buffer[i]);
+    inc(i);
+  end;
+  if i<Self.GetSize then Result := Result + '...';
+  Result := Result +']';
+end;
+
+{$IFDEF ABSTRACTMEM_ENABLE_STATS}
+{ TCacheMemStats }
+
+procedure TCacheMemStats.Clear;
+begin
+  flushCount := 0;
+  flushSize := 0;
+  flushElapsedMillis := 0;
+  freememCount := 0;
+  freememSize := 0;
+  freememElaspedMillis := 0;
+end;
+
+function TCacheMemStats.ToString: String;
+begin
+  Result := Format('CacheMemStats Flush:%d %d bytes %d millis - FreeMem:%d %d bytes %d millis',[Self.flushCount,Self.flushSize,Self.flushElapsedMillis,Self.freememCount,Self.freememSize,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;
+end;
+
+procedure TCacheMemDataTree.ClearNode(var ANode: PCacheMemData);
+begin
+  ANode := Nil;
+end;
+
+procedure TCacheMemDataTree.ClearPosition(var ANode: PCacheMemData; APosition: TAVLTreePosition);
+begin
+  case APosition of
+    poParent: ANode.parent := Nil;
+    poLeft: ANode.left := Nil;
+    poRight: ANode.right := Nil;
+  end;
+end;
+
+constructor TCacheMemDataTree.Create;
+begin
+  FRoot := Nil;
+  inherited Create(_TCacheMemDataTree_Compare,False);
+end;
+
+procedure TCacheMemDataTree.DisposeNode(var ANode: PCacheMemData);
+begin
+  if Not Assigned(ANode) then Exit;
+  Dispose( ANode );
+  ANode := Nil;
+end;
+
+function TCacheMemDataTree.GetBalance(const ANode: PCacheMemData): Integer;
+begin
+  Result := ANode.balance;
+end;
+
+function TCacheMemDataTree.GetPosition(const ANode: PCacheMemData;
+  APosition: TAVLTreePosition): PCacheMemData;
+begin
+  case APosition of
+    poParent: Result := ANode.parent;
+    poLeft: Result := ANode.left;
+    poRight: Result := ANode.right;
+  end;
+end;
+
+function TCacheMemDataTree.GetRoot: PCacheMemData;
+begin
+  Result := FRoot;
+end;
+
+function TCacheMemDataTree.HasPosition(const ANode: PCacheMemData;
+  APosition: TAVLTreePosition): Boolean;
+begin
+  Result := Assigned(GetPosition(ANode,APosition));
+end;
+
+function TCacheMemDataTree.IsNil(const ANode: PCacheMemData): Boolean;
+begin
+  Result := Not Assigned(ANode);
+end;
+
+procedure TCacheMemDataTree.SetBalance(var ANode: PCacheMemData; ANewBalance: Integer);
+begin
+  ANode.balance := ANewBalance;
+end;
+
+procedure TCacheMemDataTree.SetPosition(var ANode: PCacheMemData;
+  APosition: TAVLTreePosition; const ANewValue: PCacheMemData);
+begin
+  case APosition of
+    poParent: ANode.parent := ANewValue;
+    poLeft: ANode.left := ANewValue;
+    poRight: ANode.right := ANewValue;
+  end;
+end;
+
+procedure TCacheMemDataTree.SetRoot(const Value: PCacheMemData);
+begin
+  FRoot := Value;
+end;
+
+function TCacheMemDataTree.ToString(const ANode: PCacheMemData): String;
+begin
+  Result := ANode.ToString;
+end;
+
+end.

+ 296 - 0
src/libraries/abstractmem/UFileMem.pas

@@ -0,0 +1,296 @@
+unit UFileMem;
+
+{
+  This file is part of AbstractMem framework
+
+  Copyright (C) 2020 Albert Molina - [email protected]
+
+  https://github.com/PascalCoinDev/
+
+  *** BEGIN LICENSE BLOCK *****
+
+  The contents of this files are subject to the Mozilla Public License Version
+  2.0 (the "License"); you may not use this file except in compliance with
+  the License. You may obtain a copy of the License at
+  http://www.mozilla.org/MPL
+
+  Software distributed under the License is distributed on an "AS IS" basis,
+  WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
+  for the specific language governing rights and limitations under the License.
+
+  The Initial Developer of the Original Code is Albert Molina.
+
+  See ConfigAbstractMem.inc file for more info
+
+  ***** END LICENSE BLOCK *****
+}
+
+{$IFDEF FPC}
+  {$MODE DELPHI}
+{$ENDIF}
+
+interface
+
+uses
+  Classes, SysUtils,
+  SyncObjs,
+  UAbstractBTree, UAbstractMem, UCacheMem;
+
+{$I ./ConfigAbstractMem.inc }
+
+type
+  EFileMem = Class(Exception);
+
+  TFileMem = Class(TAbstractMem)
+  private
+    FFileStream : TFileStream;
+    FCache : TCacheMem;
+    FFileName: String;
+    FIsStableCache: Boolean;
+    FIsFlushingCache : Boolean;
+    function OnCacheNeedDataProc(var ABuffer; AStartPos : Integer; ASize : Integer) : Boolean;
+    function OnCacheSaveDataProc(const ABuffer; AStartPos : Integer; ASize : Integer) : Boolean;
+    procedure SetMaxCacheSize(const Value: Integer);
+    function GetMaxCacheSize: Integer;
+    function GetMaxCacheDataBlocks: Integer;
+    procedure SetMaxCacheDataBlocks(const Value: Integer);
+    procedure CacheIsNOTStable; inline;
+  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 : Integer; ANeedSize : Integer); override;
+    function IsAbstractMemInfoStable : Boolean; override;
+  public
+    Constructor Create(const AFileName : String; AReadOnly : Boolean); reintroduce;
+    Destructor Destroy; override;
+    function New(AMemSize : Integer) : TAMZone; override;
+    procedure Write(const APosition : Integer; const ABuffer; ASize : Integer); overload; override;
+    function Read(const APosition : Integer; var ABuffer; ASize : Integer) : Integer; overload; override;
+    {$IFDEF ABSTRACTMEM_TESTING_MODE}
+    // Warning: Accessing Cache is not Safe Thread protected, use LockCache/UnlockCache instead
+    property Cache : TCacheMem read FCache;
+    {$ENDIF}
+    property MaxCacheSize : Integer read GetMaxCacheSize write SetMaxCacheSize;
+    property MaxCacheDataBlocks : Integer read GetMaxCacheDataBlocks write SetMaxCacheDataBlocks;
+    Function FlushCache : Boolean;
+    //
+    function LockCache : TCacheMem;
+    procedure UnlockCache;
+    property FileName : String read FFileName;
+  End;
+
+implementation
+
+{ TFileMem }
+
+function TFileMem.AbsoluteRead(const AAbsolutePosition: Int64; var ABuffer; ASize: Integer): Integer;
+begin
+  FFileStream.Seek(AAbsolutePosition,soFromBeginning);
+  Result := FFileStream.Read(ABuffer,ASize);
+end;
+
+function TFileMem.AbsoluteWrite(const AAbsolutePosition: Int64; const ABuffer; ASize: Integer): Integer;
+begin
+  FFileStream.Seek(AAbsolutePosition,soFromBeginning);
+  Result := FFileStream.Write(ABuffer,ASize);
+  CacheIsNOTStable;
+end;
+
+procedure TFileMem.CacheIsNOTStable;
+begin
+  If (FIsStableCache)          // Only will mark first time
+    And (Not FIsFlushingCache) // Only will mark when not Flushing cache
+    And (Assigned(FCache)) then begin
+    FIsStableCache := False;
+    SaveHeader;
+  end;
+end;
+
+constructor TFileMem.Create(const AFileName: String; AReadOnly: Boolean);
+var LFileMode : Integer;
+  LReadOnly : Boolean;
+begin
+  FIsStableCache := True;
+  FIsFlushingCache := False;
+  FFileName := AFileName;
+  if AReadOnly then LFileMode := fmOpenRead + fmShareDenyNone
+  else begin
+    if FileExists(AFileName) then LFileMode := fmOpenReadWrite else LFileMode := fmCreate;
+    LFileMode := LFileMode + fmShareDenyWrite;
+  end;
+
+  FCache := TCacheMem.Create(OnCacheNeedDataProc,OnCacheSaveDataProc);
+  LReadOnly := True;
+  try
+    FFileStream := TFileStream.Create(AFileName,LFileMode);
+    LReadOnly := AReadOnly; // To protect against raise exception
+  finally
+    inherited Create(0,LReadOnly);
+  end;
+end;
+
+destructor TFileMem.Destroy;
+begin
+  if Not ReadOnly then FlushCache;
+  FreeAndNil(FCache);
+  inherited;
+  FreeAndNil(FFileStream);
+  FreeAndNil(FCache);
+end;
+
+procedure TFileMem.DoIncreaseSize(var ANextAvailablePos, AMaxAvailablePos: Integer; ANeedSize: Integer);
+var LBuff : TBytes;
+begin
+  if (ANeedSize<=0) And (AMaxAvailablePos<=0) then begin
+    FCache.Clear;
+    FFileStream.Seek(0,soFromEnd);
+    FFileStream.Size := 0;
+    Exit;
+  end;
+
+  FFileStream.Seek(0,soFromEnd);
+  // GoTo ANextAvailablePos
+  if (FFileStream.Position<ANextAvailablePos) then begin
+    SetLength(LBuff,ANextAvailablePos - FFileStream.Position);
+    FillChar(LBuff[0],Length(LBuff),0);
+    FFileStream.Write(LBuff[0],Length(LBuff));
+  end;
+  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 (FFileStream.Size<AMaxAvailablePos) then begin
+    SetLength(LBuff,AMaxAvailablePos - FFileStream.Position);
+    FillChar(LBuff[0],Length(LBuff),0);
+    FFileStream.Write(LBuff[0],Length(LBuff));
+  end else AMaxAvailablePos := FFileStream.Size;
+  CacheIsNOTStable;
+end;
+
+function TFileMem.FlushCache: Boolean;
+begin
+  if Not Assigned(FCache) then Exit(True);
+  FLock.Acquire;
+  try
+    Result := FCache.FlushCache;
+  finally
+    FIsStableCache := True;
+    FIsFlushingCache := True;
+    try
+      SaveHeader;
+    finally
+      FIsFlushingCache := False;
+    end;
+    FLock.Release;
+  end;
+end;
+
+function TFileMem.GetMaxCacheDataBlocks: Integer;
+begin
+  if Not Assigned(FCache) then Exit(0);
+  Result := FCache.MaxCacheDataBlocks;
+end;
+
+function TFileMem.GetMaxCacheSize: Integer;
+begin
+  if Not Assigned(FCache) then Exit(0);
+  Result := FCache.MaxCacheSize;
+end;
+
+function TFileMem.IsAbstractMemInfoStable: Boolean;
+begin
+  Result := FIsStableCache;
+end;
+
+function TFileMem.LockCache: TCacheMem;
+begin
+  FLock.Acquire;
+  Result := FCache;
+end;
+
+function TFileMem.New(AMemSize: Integer): TAMZone;
+var LBuffer : TBytes;
+begin
+  Result := inherited New(AMemSize);
+  // Initialize cache
+  if Not Assigned(FCache) then Exit;
+  FLock.Acquire;
+  try
+    SetLength(LBuffer,Result.size);
+    FillChar(LBuffer[0],Result.size,0);
+    FCache.SaveToCache(LBuffer[0],Result.size,Result.position,True);
+  finally
+    FLock.Release;
+  end;
+end;
+
+function TFileMem.OnCacheNeedDataProc(var ABuffer; AStartPos, ASize: Integer): Boolean;
+begin
+  Result := inherited Read(AStartPos,ABuffer,ASize) = ASize;
+end;
+
+function TFileMem.OnCacheSaveDataProc(const ABuffer; AStartPos, ASize: Integer): Boolean;
+begin
+  inherited Write(AStartPos,ABuffer,ASize);
+  Result := True;
+end;
+
+function TFileMem.Read(const APosition: Integer; var ABuffer; ASize: Integer): Integer;
+begin
+  if Not Assigned(FCache) then begin
+    Result := inherited;
+    Exit;
+  end;
+
+  FLock.Acquire;
+  try
+    if FCache.LoadData(ABuffer,APosition,ASize) then Result := ASize
+    else Result := 0;
+  finally
+    FLock.Release;
+  end;
+end;
+
+procedure TFileMem.SetMaxCacheDataBlocks(const Value: Integer);
+begin
+  if Not Assigned(FCache) then Exit;
+  FLock.Acquire;
+  Try
+    FCache.MaxCacheDataBlocks := Value;
+  Finally
+    FLock.Release;
+  End;
+end;
+
+procedure TFileMem.SetMaxCacheSize(const Value: Integer);
+begin
+  if Not Assigned(FCache) then Exit;
+  FLock.Acquire;
+  Try
+    FCache.MaxCacheSize := Value;
+  Finally
+    FLock.Release;
+  End;
+end;
+
+procedure TFileMem.UnlockCache;
+begin
+  FLock.Release;
+end;
+
+procedure TFileMem.Write(const APosition: Integer; const ABuffer; ASize: Integer);
+begin
+  if (Not Assigned(FCache)) Or (FIsFlushingCache) then begin
+    inherited;
+    Exit;
+  end;
+
+  CheckInitialized(True);
+  FLock.Acquire;
+  try
+    FCache.SaveToCache(ABuffer,ASize,APosition,True);
+  finally
+    FLock.Release;
+  end;
+end;
+
+end.

+ 236 - 0
src/libraries/abstractmem/UOrderedList.pas

@@ -0,0 +1,236 @@
+unit UOrderedList;
+
+{
+  This file is part of AbstractMem framework
+
+  Copyright (C) 2020 Albert Molina - [email protected]
+
+  https://github.com/PascalCoinDev/
+
+  *** BEGIN LICENSE BLOCK *****
+
+  The contents of this files are subject to the Mozilla Public License Version
+  2.0 (the "License"); you may not use this file except in compliance with
+  the License. You may obtain a copy of the License at
+  http://www.mozilla.org/MPL
+
+  Software distributed under the License is distributed on an "AS IS" basis,
+  WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
+  for the specific language governing rights and limitations under the License.
+
+  The Initial Developer of the Original Code is Albert Molina.
+
+  See ConfigAbstractMem.inc file for more info
+
+  ***** END LICENSE BLOCK *****
+}
+
+{$ifdef FPC}
+  {$mode DELPHI}
+{$endif}
+{$H+}
+
+interface
+
+uses
+  Classes, SysUtils
+  // NOTE ABOUT FREEPASCAL (2020-03-10)
+  // Current version 3.0.4 does not contain valid support for Generics, using Generics from this:
+  // https://github.com/PascalCoinDev/PascalCoin/tree/master/src/libraries/generics.collections
+  // (Download and set folder as a "units include folder" in compiler options)
+  {$IFNDEF FPC},System.Generics.Collections,System.Generics.Defaults{$ELSE},Generics.Collections,Generics.Defaults{$ENDIF};
+
+{$I ./ConfigAbstractMem.inc }
+
+
+type
+  {$IFDEF FPC}
+  TComparison<T> = function(const Left, Right: T): Integer;
+  {$ENDIF}
+
+  TOrderedList<T> = Class
+  private
+    FOnCompare: TComparison<T>;
+    FAllowDuplicates : Boolean;
+    FOrderedList : TList<T>;
+  public
+    Constructor Create(AAllowDuplicates : Boolean; const AOnCompareMethod: TComparison<T>); virtual;
+    Destructor Destroy; override;
+
+    Function Add(const AValue : T) : Integer; virtual;
+    Procedure Remove(const AValue : T; ARemoveDuplicates : Boolean = False); virtual;
+    Procedure Clear; virtual;
+    Procedure Delete(index : Integer); virtual;
+
+    Function Get(index : Integer) : T;
+    Function Count : Integer;
+    Function Find(const AValue: T; out Index: Integer): Boolean;
+    function FindPrecessor(const AValue : T; out Index : Integer) : Boolean;
+    function FindSuccessor(const AValue : T; out Index : Integer) : Boolean;
+    Function IndexOf(const AValue: T) : Integer;
+    property AllowDuplicates : Boolean read FAllowDuplicates;
+    property OnComparer : TComparison<T> read FOnCompare;
+  End;
+
+// Default Ordered functions
+function TComparison_Integer(const ALeft, ARight: Integer): Integer;
+function TComparison_Cardinal(const ALeft, ARight: Cardinal): Integer;
+function TComparison_Word(const ALeft, ARight: Word): Integer;
+function TComparison_Byte(const ALeft, ARight: Byte): Integer;
+function TComparison_Pointer(const ALeft, ARight: Pointer): Integer;
+function TComparison_String(const ALeft, ARight: String): Integer;
+
+implementation
+
+function TComparison_Integer(const ALeft, ARight: Integer): Integer;
+begin
+  Result := ALeft - ARight;
+end;
+function TComparison_Cardinal(const ALeft, ARight: Cardinal): Integer;
+begin
+  Result := ALeft - ARight;
+end;
+function TComparison_Word(const ALeft, ARight: Word): Integer;
+begin
+  Result := ALeft - ARight;
+end;
+function TComparison_Byte(const ALeft, ARight: Byte): Integer;
+begin
+  Result := ALeft - ARight;
+end;
+function TComparison_Pointer(const ALeft, ARight: Pointer): Integer;
+begin
+{$IFNDEF FPC}
+  Result := NativeInt(ALeft) - NativeInt(ARight);
+{$ELSE}
+  Result := PtrInt(ALeft) - PtrInt(ARight);
+{$ENDIF}
+end;
+function TComparison_String(const ALeft, ARight: String): Integer;
+begin
+  Result := CompareText(ALeft,ARight);
+end;
+
+{ TOrderedList<T> }
+
+function TOrderedList<T>.Add(const AValue: T): Integer;
+var
+  LFound : Boolean;
+begin
+  LFound := Find(AValue,Result);
+  if (LFound and FAllowDuplicates) or (Not LFound) then begin
+    FOrderedList.Insert(Result,AValue);
+  end else Result := -1;
+end;
+
+procedure TOrderedList<T>.Clear;
+begin
+  FOrderedList.Clear;
+end;
+
+function TOrderedList<T>.Count: Integer;
+begin
+  Result := FOrderedList.Count;
+end;
+
+constructor TOrderedList<T>.Create(AAllowDuplicates: Boolean;
+  const AOnCompareMethod: TComparison<T>);
+begin
+  FOnCompare := AOnCompareMethod;
+  FAllowDuplicates := AAllowDuplicates;
+  FOrderedList := TList<T>.Create;
+  inherited Create;
+end;
+
+procedure TOrderedList<T>.Delete(index: Integer);
+begin
+  FOrderedList.Delete(index);
+end;
+
+destructor TOrderedList<T>.Destroy;
+begin
+  Clear;
+  FOrderedList.Free;
+  inherited;
+end;
+
+function TOrderedList<T>.Find(const AValue: T; out Index: Integer): Boolean;
+var L, H, I: Integer;
+  C : Int64;
+begin
+  Result := False;
+  L := 0;
+  H := FOrderedList.Count - 1;
+  // Optimization when inserting always a ordered list
+  if (H>0) then begin
+    C := FOnCompare(FOrderedList[H],AValue);
+    if (C<0) then begin
+      Index := H+1;
+      Exit;
+    end else if (C=0) then begin
+      Index := H; // When equals, insert to the left
+      Result := True;
+      Exit;
+    end;
+  end;
+  while L <= H do
+  begin
+    I := (L + H) shr 1;
+    C := FOnCompare(FOrderedList[I],AValue);
+    if C < 0 then L := I + 1 else
+    begin
+      H := I - 1;
+      if C = 0 then
+      begin
+        Result := True;
+        L := I;
+      end;
+    end;
+  end;
+  Index := L;
+end;
+
+function TOrderedList<T>.FindPrecessor(const AValue: T; out Index: Integer): Boolean;
+begin
+  if Find(AValue,Index) then begin
+    if (Index>0) then begin
+      Dec(Index);
+      Result := True;
+    end else Result := False;
+  end else Result := False;
+end;
+
+function TOrderedList<T>.FindSuccessor(const AValue: T; out Index: Integer): Boolean;
+begin
+  if Find(AValue,Index) then begin
+    if (Index+1<Count) then begin
+      Inc(Index);
+      Result := True;
+    end else Result := False;
+  end else Result := False;
+end;
+
+function TOrderedList<T>.Get(index: Integer): T;
+begin
+  Result := FOrderedList[index];
+end;
+
+function TOrderedList<T>.IndexOf(const AValue: T): Integer;
+begin
+  if Not Find(AValue,Result) then Result := -1;
+end;
+
+procedure TOrderedList<T>.Remove(const AValue: T; ARemoveDuplicates : Boolean = False);
+var i : Integer;
+begin
+  while Find(AValue,i) do begin
+    FOrderedList.Delete(i);
+    if (Not FAllowDuplicates) or (Not ARemoveDuplicates) then Exit; // No need to continue while
+  end;
+end;
+
+initialization
+
+finalization
+
+end.

Some files were not shown because too many files changed in this diff