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
 # 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
 ## Build 5.3.0 - 2020-03-12
 - Fixed "out of memory" error when downloading Safebox
 - Fixed "out of memory" error when downloading Safebox
 - Fixed freeze bug on GUI when updating accounts grid
 - 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. 
   // 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
   // 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
 interface
 
 
 uses
 uses
-  Classes, SysUtils, UAccounts, UThread, UBaseTypes,
+  Classes, SysUtils, UAccounts, UThread, UBaseTypes, UPCDataTypes,
   {$IFNDEF FPC}System.Generics.Collections{$ELSE}Generics.Collections{$ENDIF};
   {$IFNDEF FPC}System.Generics.Collections{$ELSE}Generics.Collections{$ENDIF};
 
 
 type
 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!
     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 Add(const ARawValue : TRawBytes) : TRawBytes; // Will concat a new RawBytes value to current value
     function IsEmpty : Boolean; // Will return TRUE when Length = 0
     function IsEmpty : Boolean; // Will return TRUE when Length = 0
+    function IsEqualTo(const ACompareTo : TRawBytes) : Boolean;
+    //
     procedure FromStream(AStream : TStream); overload;
     procedure FromStream(AStream : TStream); overload;
     procedure FromStream(AStream : TStream; AStartPos, ALength : Integer); 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;
   end;
 
 
 
 
@@ -91,8 +101,10 @@ Type
     function Compare(ABytesBuffer : TBytesBuffer) : Integer;
     function Compare(ABytesBuffer : TBytesBuffer) : Integer;
     procedure SetLength(ANewLength : Integer);
     procedure SetLength(ANewLength : Integer);
     function Memory : Pointer;
     function Memory : Pointer;
+    function MemoryLength : Integer;
     procedure Clear;
     procedure Clear;
     procedure CopyFrom(ABytesBuffer : TBytesBuffer);
     procedure CopyFrom(ABytesBuffer : TBytesBuffer);
+    function Capture(AStartPos, ALength : Integer) : TBytes;
   end;
   end;
 
 
 
 
@@ -195,11 +207,94 @@ begin
   end else Result := '';
   end else Result := '';
 end;
 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);
 procedure TRawBytesHelper.FromStream(AStream: TStream; AStartPos, ALength: Integer);
 begin
 begin
   System.SetLength(Self,ALength);
   System.SetLength(Self,ALength);
   AStream.Position := AStartPos;
   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;
 end;
 
 
 procedure TRawBytesHelper.FromStream(AStream: TStream);
 procedure TRawBytesHelper.FromStream(AStream: TStream);
@@ -230,6 +325,13 @@ begin
   Result := Length(Self)=0;
   Result := Length(Self)=0;
 end;
 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;
 function TRawBytesHelper.ToHexaString: String;
 Var i : Integer;
 Var i : Integer;
   rbs : RawByteString;
   rbs : RawByteString;
@@ -553,6 +655,18 @@ begin
   Result := Replace(Length,buffer);
   Result := Replace(Length,buffer);
 end;
 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;
 procedure TBytesBuffer.Clear;
 begin
 begin
   System.SetLength(FBytes,0);
   System.SetLength(FBytes,0);
@@ -616,6 +730,11 @@ begin
   Result := addr(FBytes[0]);
   Result := addr(FBytes[0]);
 end;
 end;
 
 
+function TBytesBuffer.MemoryLength: Integer;
+begin
+  Result := System.Length(FBytes);
+end;
+
 procedure TBytesBuffer.NotifyUpdated(AStartPos, ACountBytes: Integer);
 procedure TBytesBuffer.NotifyUpdated(AStartPos, ACountBytes: Integer);
 begin
 begin
   //
   //

+ 74 - 9
src/core/UBlockChain.pas

@@ -16,6 +16,8 @@ unit UBlockChain;
   THIS LICENSE HEADER MUST NOT BE REMOVED.
   THIS LICENSE HEADER MUST NOT BE REMOVED.
 }
 }
 
 
+{$I ./../config.inc}
+
 {$IFDEF FPC}
 {$IFDEF FPC}
   {$MODE Delphi}
   {$MODE Delphi}
 {$ENDIF}
 {$ENDIF}
@@ -25,8 +27,8 @@ interface
 uses
 uses
   Classes, UCrypto, UAccounts, ULog, UThread, SyncObjs, UBaseTypes, SysUtils,
   Classes, UCrypto, UAccounts, ULog, UThread, SyncObjs, UBaseTypes, SysUtils,
   {$IFNDEF FPC}System.Generics.Collections{$ELSE}Generics.Collections{$ENDIF},
   {$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;
   TOrphan = RawByteString;
 
 
+
+  TCheckPointStruct = {$IFDEF USE_ABSTRACTMEM}TPCAbstractMem{$ELSE}TStream{$ENDIF};
+
   { TStorage }
   { TStorage }
 
 
   TStorage = Class(TComponent)
   TStorage = Class(TComponent)
@@ -494,7 +499,7 @@ Type
     function GetFirstBlockNumber: Int64; virtual; abstract;
     function GetFirstBlockNumber: Int64; virtual; abstract;
     function GetLastBlockNumber: Int64; virtual; abstract;
     function GetLastBlockNumber: Int64; virtual; abstract;
     function DoInitialize:Boolean; 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 DoEraseStorage; virtual; abstract;
     Procedure DoSavePendingBufferOperations(OperationsHashTree : TOperationsHashTree); virtual; abstract;
     Procedure DoSavePendingBufferOperations(OperationsHashTree : TOperationsHashTree); virtual; abstract;
     Procedure DoLoadPendingBufferOperations(OperationsHashTree : TOperationsHashTree); virtual; abstract;
     Procedure DoLoadPendingBufferOperations(OperationsHashTree : TOperationsHashTree); virtual; abstract;
@@ -513,10 +518,10 @@ Type
     Property FirstBlock : Int64 read GetFirstBlockNumber;
     Property FirstBlock : Int64 read GetFirstBlockNumber;
     Property LastBlock : Int64 read GetLastBlockNumber;
     Property LastBlock : Int64 read GetLastBlockNumber;
     Function Initialize : Boolean;
     Function Initialize : Boolean;
-    Function CreateSafeBoxStream(blockCount : Cardinal) : TStream;
+    Function OpenSafeBoxCheckpoint(blockCount : Cardinal) : TCheckPointStruct;
     Function HasUpgradedToVersion2 : Boolean; virtual; abstract;
     Function HasUpgradedToVersion2 : Boolean; virtual; abstract;
     Procedure CleanupVersion1Data; virtual; abstract;
     Procedure CleanupVersion1Data; virtual; abstract;
-    Procedure EraseStorage;
+    Procedure EraseStorage; // Erase Blockchain storage
     Procedure SavePendingBufferOperations(OperationsHashTree : TOperationsHashTree);
     Procedure SavePendingBufferOperations(OperationsHashTree : TOperationsHashTree);
     Procedure LoadPendingBufferOperations(OperationsHashTree : TOperationsHashTree);
     Procedure LoadPendingBufferOperations(OperationsHashTree : TOperationsHashTree);
     Function BlockExists(Block : Cardinal) : Boolean;
     Function BlockExists(Block : Cardinal) : Boolean;
@@ -549,6 +554,7 @@ Type
     function GetActualTargetSecondsAverage(BackBlocks : Cardinal): Real;
     function GetActualTargetSecondsAverage(BackBlocks : Cardinal): Real;
     function GetTargetSecondsAverage(FromBlock,BackBlocks : Cardinal): Real;
     function GetTargetSecondsAverage(FromBlock,BackBlocks : Cardinal): Real;
     function GetTargetSecondsMedian(AFromBlock: Cardinal; ABackBlocks : Integer): 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;
     function LoadBankFromStream(Stream : TStream; useSecureLoad : Boolean; checkSafeboxHash : TRawBytes; previousCheckedSafebox : TPCSafebox; progressNotify : TProgressNotify; var errors : String) : Boolean;
     Procedure Clear;
     Procedure Clear;
     Function LoadOperations(Operations : TPCOperationsComp; Block : Cardinal) : Boolean;
     Function LoadOperations(Operations : TPCOperationsComp; Block : Cardinal) : Boolean;
@@ -929,6 +935,7 @@ Var
   LTmpPCOperationsComp : TPCOperationsComp;
   LTmpPCOperationsComp : TPCOperationsComp;
   i,j, LProgressBlock, LProgressEndBlock, LOpsInBlocks : Integer;
   i,j, LProgressBlock, LProgressEndBlock, LOpsInBlocks : Integer;
   LSafeboxTransaction : TPCSafeBoxTransaction;
   LSafeboxTransaction : TPCSafeBoxTransaction;
+  LTempSafebox : TPCSafeBox;
 begin
 begin
   if FIsRestoringFromFile then begin
   if FIsRestoringFromFile then begin
     TLog.NewLog(lterror,Classname,'Is Restoring!!!');
     TLog.NewLog(lterror,Classname,'Is Restoring!!!');
@@ -943,8 +950,9 @@ begin
     try
     try
       Clear;
       Clear;
       Storage.Initialize;
       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;
       else n := Storage.LastBlock;
+
       Storage.RestoreBank(n,restoreProgressNotify);
       Storage.RestoreBank(n,restoreProgressNotify);
       // Restore last blockchain
       // Restore last blockchain
       if (BlocksCount>0) And (SafeBox.CurrentProtocol=CT_PROTOCOL_1) then begin
       if (BlocksCount>0) And (SafeBox.CurrentProtocol=CT_PROTOCOL_1) then begin
@@ -955,6 +963,12 @@ begin
           FLastOperationBlock := FLastBlockCache.OperationBlock;
           FLastOperationBlock := FLastBlockCache.OperationBlock;
         end;
         end;
       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);
       NewLog(Nil, ltinfo,'Start restoring from disk operations (Max '+inttostr(max_block)+') BlockCount: '+inttostr(BlocksCount)+' Orphan: ' +Storage.Orphan);
       LBlocks := TList<TPCOperationsComp>.Create;
       LBlocks := TList<TPCOperationsComp>.Create;
       try
       try
@@ -1032,7 +1046,12 @@ begin
     finally
     finally
       FIsRestoringFromFile := False;
       FIsRestoringFromFile := False;
       FUpgradingToV2 := false;
       FUpgradingToV2 := false;
+      for i := 0 to FNotifyList.Count - 1 do begin
+        TPCBankNotify(FNotifyList.Items[i]).NotifyNewBlock;
+      end;
     end;
     end;
+
+
   finally
   finally
     FBankLock.Release;
     FBankLock.Release;
   end;
   end;
@@ -1168,7 +1187,7 @@ begin
   Result := FStorage;
   Result := FStorage;
 end;
 end;
 
 
-function TPCBank.IsReady(Var CurrentProcess: String): Boolean;
+function TPCBank.IsReady(var CurrentProcess: String): Boolean;
 begin
 begin
   Result := false;
   Result := false;
   CurrentProcess := '';
   CurrentProcess := '';
@@ -1180,6 +1199,52 @@ begin
   end else Result := true;
   end else Result := true;
 end;
 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;
 function TPCBank.LoadBankFromStream(Stream: TStream; useSecureLoad : Boolean; checkSafeboxHash : TRawBytes; previousCheckedSafebox : TPCSafebox; progressNotify : TProgressNotify; var errors: String): Boolean;
 Var LastReadBlock : TBlockAccount;
 Var LastReadBlock : TBlockAccount;
   i : Integer;
   i : Integer;
@@ -2894,9 +2959,9 @@ begin
   Result := DoInitialize;
   Result := DoInitialize;
 end;
 end;
 
 
-function TStorage.CreateSafeBoxStream(blockCount: Cardinal): TStream;
+function TStorage.OpenSafeBoxCheckpoint(blockCount: Cardinal): TCheckPointStruct;
 begin
 begin
-  Result := DoCreateSafeBoxStream(blockCount);
+  Result := DoOpenSafeBoxCheckpoint(blockCount);
 end;
 end;
 
 
 procedure TStorage.EraseStorage;
 procedure TStorage.EraseStorage;

+ 103 - 1
src/core/UChunk.pas

@@ -36,10 +36,12 @@ uses
   {$ELSE}
   {$ELSE}
   zlib,
   zlib,
   {$ENDIF}
   {$ENDIF}
-  UAccounts, ULog, UConst, UCrypto, UBaseTypes;
+  UAccounts, ULog, UConst, UCrypto, UBaseTypes, UPCDataTypes;
 
 
 type
 type
 
 
+  EPCChunk = Class(Exception);
+
   { TPCChunk }
   { TPCChunk }
 
 
   TPCChunk = Class
   TPCChunk = Class
@@ -49,8 +51,108 @@ type
     class function LoadSafeBoxFromChunk(Chunk, DestStream : TStream; var safeBoxHeader : TPCSafeBoxHeader; var errors : String) : Boolean;
     class function LoadSafeBoxFromChunk(Chunk, DestStream : TStream; var safeBoxHeader : TPCSafeBoxHeader; var errors : String) : Boolean;
   end;
   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
 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 }
 { TPCChunk }
 
 
 class function TPCChunk.SaveSafeBoxChunkFromSafeBox(SafeBoxStream, DestStream : TStream; fromBlock, toBlock: Cardinal; var errors : String) : Boolean;
 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_Signer                = 103;
   CT_OpSubtype_Data_Receiver              = 104;
   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'
   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};
                     {$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
 interface
 
 
-uses
-  Classes, {$IFnDEF FPC}Windows,{$ENDIF} UBlockChain, SyncObjs, UThread, UAccounts, UCrypto;
 {$I ./../config.inc}
 {$I ./../config.inc}
 
 
+uses
+  Classes, {$IFnDEF FPC}Windows,{$ENDIF} UBlockChain, SyncObjs, UThread, UAccounts, UCrypto, UPCDataTypes;
+
+
 Type
 Type
   TBlockHeader = Record
   TBlockHeader = Record
     BlockNumber : Cardinal;
     BlockNumber : Cardinal;
@@ -74,7 +76,7 @@ Type
     function GetFirstBlockNumber: Int64; override;
     function GetFirstBlockNumber: Int64; override;
     function GetLastBlockNumber: Int64; override;
     function GetLastBlockNumber: Int64; override;
     function DoInitialize : Boolean; override;
     function DoInitialize : Boolean; override;
-    Function DoCreateSafeBoxStream(blockCount : Cardinal) : TStream; override;
+    Function DoOpenSafeBoxCheckpoint(blockCount : Cardinal) : TCheckPointStruct; override;
     Procedure DoEraseStorage; override;
     Procedure DoEraseStorage; override;
     Procedure DoSavePendingBufferOperations(OperationsHashTree : TOperationsHashTree); override;
     Procedure DoSavePendingBufferOperations(OperationsHashTree : TOperationsHashTree); override;
     Procedure DoLoadPendingBufferOperations(OperationsHashTree : TOperationsHashTree); override;
     Procedure DoLoadPendingBufferOperations(OperationsHashTree : TOperationsHashTree); override;
@@ -92,12 +94,18 @@ Type
 
 
 implementation
 implementation
 
 
-Uses ULog, SysUtils, UConst;
-
+Uses ULog, SysUtils, UBaseTypes,
+  {$IFDEF USE_ABSTRACTMEM}
+  UPCAbstractMem,
+  {$ENDIF}
+  UConst;
 { TFileStorage }
 { TFileStorage }
 
 
 Const CT_TBlockHeader_NUL : TBlockHeader = (BlockNumber:0;StreamBlockRelStartPos:0;BlockSize:0);
 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_GroupBlockSize = 1000;
   CT_SizeOfBlockHeader = 16;
   CT_SizeOfBlockHeader = 16;
   {
   {
@@ -270,14 +278,18 @@ begin
   End;
   End;
 end;
 end;
 
 
-function TFileStorage.DoCreateSafeBoxStream(blockCount: Cardinal): TStream;
+function TFileStorage.DoOpenSafeBoxCheckpoint(blockCount: Cardinal): TCheckPointStruct;
 var fn : TFilename;
 var fn : TFilename;
   err : AnsiString;
   err : AnsiString;
 begin
 begin
   Result := Nil;
   Result := Nil;
   fn := GetSafeboxCheckpointingFileName(GetFolder(Orphan),blockCount);
   fn := GetSafeboxCheckpointingFileName(GetFolder(Orphan),blockCount);
   If (fn<>'') and (FileExists(fn)) then begin
   If (fn<>'') and (FileExists(fn)) then begin
+    {$IFDEF USE_ABSTRACTMEM}
+    Result := TPCAbstractMem.Create(fn,True);
+    {$ELSE}
     Result := TFileStream.Create(fn,fmOpenRead+fmShareDenyWrite);
     Result := TFileStream.Create(fn,fmOpenRead+fmShareDenyWrite);
+    {$ENDIF}
   end;
   end;
   If Not Assigned(Result) then begin
   If Not Assigned(Result) then begin
     err := 'Cannot load SafeBoxStream (block:'+IntToStr(blockCount)+') file:'+fn;
     err := 'Cannot load SafeBoxStream (block:'+IntToStr(blockCount)+') file:'+fn;
@@ -378,7 +390,7 @@ function TFileStorage.DoMoveBlockChain(Start_Block: Cardinal; const DestOrphan:
   begin
   begin
     FileAttrs := faArchive;
     FileAttrs := faArchive;
     folder := GetFolder(Orphan);
     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
       repeat
         if (sr.Attr and FileAttrs) = FileAttrs then begin
         if (sr.Attr and FileAttrs) = FileAttrs then begin
           sourcefn := GetFolder(Orphan)+PathDelim+sr.Name;
           sourcefn := GetFolder(Orphan)+PathDelim+sr.Name;
@@ -452,28 +464,66 @@ var
     sr: TSearchRec;
     sr: TSearchRec;
     FileAttrs: Integer;
     FileAttrs: Integer;
     folder : AnsiString;
     folder : AnsiString;
-    filename,auxfn : AnsiString;
+    Lfilename,auxfn : AnsiString;
     fs : TFileStream;
     fs : TFileStream;
     ms : TMemoryStream;
     ms : TMemoryStream;
     errors : String;
     errors : String;
-    blockscount : Cardinal;
+    LBlockscount : Cardinal;
     sbHeader, goodSbHeader : TPCSafeBoxHeader;
     sbHeader, goodSbHeader : TPCSafeBoxHeader;
+    {$IFDEF USE_ABSTRACTMEM}
+    LTempBlocksCount : Integer;
+    LSafeboxFileName : String;
+    {$ELSE}
+    {$ENDIF}
 begin
 begin
   LockBlockChainStream;
   LockBlockChainStream;
   Try
   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;
     FileAttrs := faArchive;
     folder := GetFolder(Orphan);
     folder := GetFolder(Orphan);
-    filename := '';
-    blockscount := 0;
+    Lfilename := '';
     if SysUtils.FindFirst(folder+PathDelim+'*.safebox', FileAttrs, sr) = 0 then begin
     if SysUtils.FindFirst(folder+PathDelim+'*.safebox', FileAttrs, sr) = 0 then begin
       repeat
       repeat
         if (sr.Attr and FileAttrs) = FileAttrs then begin
         if (sr.Attr and FileAttrs) = FileAttrs then begin
           auxfn := folder+PathDelim+sr.Name;
           auxfn := folder+PathDelim+sr.Name;
           If LoadBankFileInfo(auxfn,sbHeader) then begin
           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
               (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;
               goodSbHeader := sbHeader;
             end;
             end;
           end;
           end;
@@ -481,14 +531,14 @@ begin
       until FindNext(sr) <> 0;
       until FindNext(sr) <> 0;
       FindClose(sr);
       FindClose(sr);
     end;
     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
       try
         fs.Position := 0;
         fs.Position := 0;
         if LowMemoryUsage then begin
         if LowMemoryUsage then begin
           if not Bank.LoadBankFromStream(fs,False,Nil,Nil,restoreProgressNotify,errors) 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;
         end else begin
         end else begin
           ms := TMemoryStream.Create;
           ms := TMemoryStream.Create;
@@ -496,7 +546,7 @@ begin
             ms.CopyFrom(fs,0);
             ms.CopyFrom(fs,0);
             ms.Position := 0;
             ms.Position := 0;
             if not Bank.LoadBankFromStream(ms,False,Nil,Nil,restoreProgressNotify,errors) then begin
             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;
             end;
           Finally
           Finally
             ms.Free;
             ms.Free;
@@ -515,11 +565,15 @@ function TFileStorage.DoSaveBank: Boolean;
 var fs: TFileStream;
 var fs: TFileStream;
     bankfilename,aux_newfilename: AnsiString;
     bankfilename,aux_newfilename: AnsiString;
     ms : TMemoryStream;
     ms : TMemoryStream;
+  LTC : TTickCount;
 begin
 begin
   Result := true;
   Result := true;
   bankfilename := GetSafeboxCheckpointingFileName(GetFolder(Orphan),Bank.BlocksCount);
   bankfilename := GetSafeboxCheckpointingFileName(GetFolder(Orphan),Bank.BlocksCount);
   if (bankfilename<>'') then begin
   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);
     fs := TFileStream.Create(bankfilename,fmCreate);
     try
     try
       fs.Size := 0;
       fs.Size := 0;
@@ -539,9 +593,11 @@ begin
     finally
     finally
       fs.Free;
       fs.Free;
     end;
     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
     // 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
     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
       try
         {$IFDEF FPC}
         {$IFDEF FPC}
         DoCopyFile(bankfilename,aux_newfilename);
         DoCopyFile(bankfilename,aux_newfilename);
@@ -589,9 +645,9 @@ begin
   If not ForceDirectories(BaseDataFolder) then exit;
   If not ForceDirectories(BaseDataFolder) then exit;
   if TPCSafeBox.MustSafeBoxBeSaved(block) then begin
   if TPCSafeBox.MustSafeBoxBeSaved(block) then begin
     // We will store checkpointing
     // 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
   end else begin
-    Result := BaseDataFolder + PathDelim+'checkpoint_'+inttostr(block)+'.safebox';
+    Result := BaseDataFolder + PathDelim+'checkpoint_'+inttostr(block)+CT_Safebox_Extension;
   end;
   end;
 end;
 end;
 
 
@@ -1082,7 +1138,7 @@ end;
 function TFileStorage.HasUpgradedToVersion2: Boolean;
 function TFileStorage.HasUpgradedToVersion2: Boolean;
 var searchRec: TSearchRec;
 var searchRec: TSearchRec;
 begin
 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);
   FindClose(searchRec);
 end;
 end;
 
 

+ 166 - 107
src/core/UNetProtocol.pas

@@ -16,6 +16,8 @@ unit UNetProtocol;
   THIS LICENSE HEADER MUST NOT BE REMOVED.
   THIS LICENSE HEADER MUST NOT BE REMOVED.
 }
 }
 
 
+{$I ./../config.inc}
+
 {$IFDEF FPC}
 {$IFDEF FPC}
   {$MODE Delphi}
   {$MODE Delphi}
 {$ENDIF}
 {$ENDIF}
@@ -31,12 +33,12 @@ Uses
 {$ENDIF}
 {$ENDIF}
   UBlockChain, Classes, SysUtils, UAccounts, UThread,
   UBlockChain, Classes, SysUtils, UAccounts, UThread,
   UCrypto, UTCPIP, SyncObjs, UBaseTypes, UCommon, UPCOrderedLists,
   UCrypto, UTCPIP, SyncObjs, UBaseTypes, UCommon, UPCOrderedLists,
+  UPCDataTypes,
   {$IFNDEF FPC}System.Generics.Collections,System.Generics.Defaults
   {$IFNDEF FPC}System.Generics.Collections,System.Generics.Defaults
   {$ELSE}Generics.Collections,Generics.Defaults{$ENDIF},
   {$ELSE}Generics.Collections,Generics.Defaults{$ENDIF},
+  {$IFDEF USE_ABSTRACTMEM}UPCAbstractMem,{$ENDIF}
   UNetProtection;
   UNetProtection;
 
 
-{$I ./../config.inc}
-
 Const
 Const
   CT_MagicRequest = $0001;
   CT_MagicRequest = $0001;
   CT_MagicResponse = $0002;
   CT_MagicResponse = $0002;
@@ -161,6 +163,7 @@ Type
     procedure CleanNodeServersList;
     procedure CleanNodeServersList;
     Function LockList : TList<Pointer>;
     Function LockList : TList<Pointer>;
     Procedure UnlockList;
     Procedure UnlockList;
+    procedure ResetConnectAttempts;
     function IsBlackListed(const ip: String): Boolean;
     function IsBlackListed(const ip: String): Boolean;
     function GetNodeServerAddress(const ip : String; port:Word; CanAdd : Boolean; var nodeServerAddress : TNodeServerAddress) : Boolean;
     function GetNodeServerAddress(const ip : String; port:Word; CanAdd : Boolean; var nodeServerAddress : TNodeServerAddress) : Boolean;
     procedure SetNodeServerAddress(const nodeServerAddress : TNodeServerAddress);
     procedure SetNodeServerAddress(const nodeServerAddress : TNodeServerAddress);
@@ -846,6 +849,25 @@ begin
   Result := FListByIp;
   Result := FListByIp;
 end;
 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);
 procedure TOrderedServerAddressListTS.SecuredDeleteFromListByIp(index: Integer);
 Var P : PNodeServerAddress;
 Var P : PNodeServerAddress;
   i2 : Integer;
   i2 : Integer;
@@ -1625,13 +1647,24 @@ Const CT_LogSender = 'GetNewBlockChainFromClient';
       Bank.Storage.Orphan := TNode.Node.Bank.Storage.Orphan;
       Bank.Storage.Orphan := TNode.Node.Bank.Storage.Orphan;
       Bank.Storage.ReadOnly := true;
       Bank.Storage.ReadOnly := true;
       Bank.Storage.CopyConfiguration(TNode.Node.Bank.Storage);
       Bank.Storage.CopyConfiguration(TNode.Node.Bank.Storage);
+
+
       if start_block>=0 then begin
       if start_block>=0 then begin
         If (TNode.Node.Bank.SafeBox.HasSnapshotForBlock(start_block-1)) 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
           // Restore from a Snapshot (New on V3) instead of restore reading from File
           Bank.SafeBox.SetToPrevious(TNode.Node.Bank.SafeBox,start_block-1);
           Bank.SafeBox.SetToPrevious(TNode.Node.Bank.SafeBox,start_block-1);
           Bank.UpdateValuesFromSafebox;
           Bank.UpdateValuesFromSafebox;
           IsUsingSnapshot := True;
           IsUsingSnapshot := True;
+
+          Bank.Storage.Orphan := FormatDateTime('yyyymmddhhnnss',DateTime2UnivDateTime(now));
+          Bank.Storage.ReadOnly := false;
+
         end else begin
         end else begin
+          {$IFDEF USE_ABSTRACTMEM}
+          Bank.Storage.Orphan := FormatDateTime('yyyymmddhhnnss',DateTime2UnivDateTime(now));
+          Bank.Storage.ReadOnly := false;
+          {$ENDIF}
+
           // Restore a part from disk
           // Restore a part from disk
           Bank.DiskRestoreFromOperations(start_block-1);
           Bank.DiskRestoreFromOperations(start_block-1);
           Bank.Storage.SaveBank(True);
           Bank.Storage.SaveBank(True);
@@ -1647,8 +1680,10 @@ Const CT_LogSender = 'GetNewBlockChainFromClient';
         start_block := 0;
         start_block := 0;
       end;
       end;
       start_c := start;
       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:
       // Receive new blocks:
       finished := false;
       finished := false;
       repeat
       repeat
@@ -1738,6 +1773,11 @@ Const CT_LogSender = 'GetNewBlockChainFromClient';
               {$ENDIF}
               {$ENDIF}
             end else begin
             end else begin
               TLog.NewLog(ltInfo,CT_LogSender,'Restoring modified Safebox from Disk');
               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);
               TNode.Node.Bank.DiskRestoreFromOperations(CT_MaxBlock);
             end;
             end;
           Finally
           Finally
@@ -1844,105 +1884,75 @@ Const CT_LogSender = 'GetNewBlockChainFromClient';
     end;
     end;
   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;
     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;
     i : Integer;
-    LFirstSafebox : Boolean;
   Begin
   Begin
     Result := False;
     Result := False;
-    LFirstSafebox := TNode.Node.Bank.SafeBox.BlocksCount = 0;
-    safeboxStream.Size:=0;
-    safeboxStream.Position:=0;
+    ASafeboxChunks.Clear;
     // Will try to download penultimate saved safebox
     // 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;
       exit;
     end;
     end;
     // New Build 2.1.7 - Check valid operationblock
     // 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;
       Exit;
     end;
     end;
-    SetLength(chunks,0);
-    try
       // Will obtain chunks of 10000 blocks each -> Note: Maximum is CT_MAX_SAFEBOXCHUNK_BLOCKS
       // 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',
         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);
           TLog.NewLog(ltError,CT_LogSender,errors);
           Exit;
           Exit;
         end;
         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;
           end;
-          chunk1.Size := 0;
-          chunk1.CopyFrom(safeboxStream,0);
         end;
         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;
       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;
   Function DownloadSafeBox(IsMyBlockchainValid : Boolean) : Boolean;
-  var receiveData : TStream;
-    op : TOperationBlock;
+  var LChunks : TPCSafeboxChunks;
+    LSafeboxLastOperationBlock : TOperationBlock;
     errors : String;
     errors : String;
     request_id : Cardinal;
     request_id : Cardinal;
   Begin
   Begin
     Result := False;
     Result := False;
-    receiveData := TPCTemporalFileStream.Create('SAFEBOX_');
+    LChunks := TPCSafeboxChunks.Create;
     try
     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
       // Now receiveData is the ALL safebox
       TNode.Node.DisableNewBlocks;
       TNode.Node.DisableNewBlocks;
       try
       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!');
             TLog.NewLog(ltInfo,ClassName,'Received new safebox!');
             If Not IsMyBlockchainValid then begin
             If Not IsMyBlockchainValid then begin
               TNode.Node.Bank.Storage.EraseStorage;
               TNode.Node.Bank.Storage.EraseStorage;
@@ -1958,14 +1968,14 @@ Const CT_LogSender = 'GetNewBlockChainFromClient';
         TNode.Node.EnableNewBlocks;
         TNode.Node.EnableNewBlocks;
       end;
       end;
     finally
     finally
-      receiveData.Free;
+      LChunks.Free;
     end;
     end;
   end;
   end;
 
 
   procedure DownloadNewBlockchain(start_block : Int64; IsMyBlockChainOk : Boolean);
   procedure DownloadNewBlockchain(start_block : Int64; IsMyBlockChainOk : Boolean);
-  var safeboxStream : TStream;
+  var LChunks : TPCSafeboxChunks;
     newTmpBank : TPCBank;
     newTmpBank : TPCBank;
-    safebox_last_operation_block : TOperationBlock;
+    LSafeboxLastOperationBlock : TOperationBlock;
     opComp : TPCOperationsComp;
     opComp : TPCOperationsComp;
     errors : String;
     errors : String;
     blocksList : TList<TPCOperationsComp>;
     blocksList : TList<TPCOperationsComp>;
@@ -1981,10 +1991,12 @@ Const CT_LogSender = 'GetNewBlockChainFromClient';
     if (download_new_safebox) then begin
     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]));
       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
       // 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);
         newTmpBank := TPCBank.Create(Nil);
         try
         try
           newTmpBank.StorageClass := TNode.Node.Bank.StorageClass;
           newTmpBank.StorageClass := TNode.Node.Bank.StorageClass;
@@ -1993,7 +2005,7 @@ Const CT_LogSender = 'GetNewBlockChainFromClient';
           newTmpBank.Storage.CopyConfiguration(TNode.Node.Bank.Storage);
           newTmpBank.Storage.CopyConfiguration(TNode.Node.Bank.Storage);
           newTmpBank.Storage.Orphan := FormatDateTime('yyyymmddhhnnss',DateTime2UnivDateTime(now));
           newTmpBank.Storage.Orphan := FormatDateTime('yyyymmddhhnnss',DateTime2UnivDateTime(now));
           newTmpBank.Storage.ReadOnly := false;
           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;
             TNode.Node.DisableNewBlocks;
             try
             try
               TLog.NewLog(ltInfo,ClassName,'Received new safebox!');
               TLog.NewLog(ltInfo,ClassName,'Received new safebox!');
@@ -2001,8 +2013,8 @@ Const CT_LogSender = 'GetNewBlockChainFromClient';
               // Receive at least 1 new block
               // Receive at least 1 new block
               blocksList := TList<TPCOperationsComp>.Create;
               blocksList := TList<TPCOperationsComp>.Create;
               try
               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;
                   Exit;
                 end;
                 end;
                 for i:=0 to blocksList.Count-1 do begin
                 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.MoveBlockChainBlocks(start_block,IntToStr(start_block)+'_'+FormatDateTime('yyyymmddhhnnss',DateTime2UnivDateTime(now)),Nil);
               TNode.Node.Bank.Storage.DeleteBlockChainBlocks(start_block);
               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);
               TNode.Node.Bank.DiskRestoreFromOperations(CT_MaxBlock);
             Finally
             Finally
               TNode.Node.EnableNewBlocks;
               TNode.Node.EnableNewBlocks;
@@ -2037,12 +2049,11 @@ Const CT_LogSender = 'GetNewBlockChainFromClient';
             Connection.DisconnectInvalidClient(false,'Cannot load from stream! '+errors);
             Connection.DisconnectInvalidClient(false,'Cannot load from stream! '+errors);
             exit;
             exit;
           end;
           end;
-
         finally
         finally
           newTmpBank.Free;
           newTmpBank.Free;
         end;
         end;
       Finally
       Finally
-        safeboxStream.Free;
+        LChunks.Free;
       End;
       End;
     end else begin
     end else begin
       if IsMyBlockChainOk then begin
       if IsMyBlockChainOk then begin
@@ -2354,6 +2365,8 @@ begin
   NotifyConnectivityChanged;
   NotifyConnectivityChanged;
   if FNetConnectionsActive then DiscoverServers
   if FNetConnectionsActive then DiscoverServers
   else DisconnectClients;
   else DisconnectClients;
+  TNode.Node.NetServer.Active := Value;
+  NotifyConnectivityChanged;
 end;
 end;
 
 
 function TNetData.UnRegisterRequest(Sender: TNetConnection; operation: Word; request_id: Cardinal): Boolean;
 function TNetData.UnRegisterRequest(Sender: TNetConnection; operation: Word; request_id: Cardinal): Boolean;
@@ -2463,6 +2476,7 @@ begin
   inherited;
   inherited;
   if Active then begin
   if Active then begin
     // TNode.Node.AutoDiscoverNodes(CT_Discover_IPs);
     // TNode.Node.AutoDiscoverNodes(CT_Discover_IPs);
+    TNetData.NetData.NodeServersAddresses.ResetConnectAttempts;
   end else if TNetData.NetDataExists then begin
   end else if TNetData.NetDataExists then begin
     TNetData.NetData.DisconnectClients;
     TNetData.NetData.DisconnectClients;
   end;
   end;
@@ -3114,10 +3128,14 @@ procedure TNetConnection.DoProcess_GetSafeBox_Request(HeaderData: TNetHeaderData
 Var _blockcount : Cardinal;
 Var _blockcount : Cardinal;
     _safeboxHash : TRawBytes;
     _safeboxHash : TRawBytes;
     _from,_to : Cardinal;
     _from,_to : Cardinal;
+  {$IFDEF USE_ABSTRACTMEM}
+  Labstracmem : TPCAbstractMem;
+  {$ELSE}
+  sbHeader : TPCSafeBoxHeader;
+  {$ENDIF}
   sbStream : TStream;
   sbStream : TStream;
   responseStream : TStream;
   responseStream : TStream;
   antPos : Int64;
   antPos : Int64;
-  sbHeader : TPCSafeBoxHeader;
   errors : String;
   errors : String;
 begin
 begin
   {
   {
@@ -3142,16 +3160,54 @@ begin
     Exit;
     Exit;
   end;
   end;
   //
   //
-  sbStream := TNode.Node.Bank.Storage.CreateSafeBoxStream(_blockcount);
+
+  responseStream := TMemoryStream.Create;
   try
   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
     try
       If Not Assigned(sbStream) then begin
       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;
         exit;
       end;
       end;
       antPos := sbStream.Position;
       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
       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)]));
         DisconnectInvalidClient(false,Format('Invalid safeboxhash on GetSafeBox request (Real:%s > Requested:%s)',[TCrypto.ToHexaString(sbHeader.safeBoxHash),TCrypto.ToHexaString(_safeboxHash)]));
         exit;
         exit;
@@ -3162,14 +3218,15 @@ begin
         TLog.NewLog(ltError,Classname,'Error saving chunk: '+errors);
         TLog.NewLog(ltError,Classname,'Error saving chunk: '+errors);
         exit;
         exit;
       end;
       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
     finally
-      responseStream.Free;
+      FreeAndNil(sbStream);
     end;
     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
   finally
-    FreeAndNil(sbStream);
+    responseStream.Free;
   end;
   end;
 end;
 end;
 
 
@@ -3318,8 +3375,10 @@ begin
         opht.Free;
         opht.Free;
       end;
       end;
     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
   finally
     dataSend.Free;
     dataSend.Free;
     dataReceived.Free;
     dataReceived.Free;
@@ -3329,14 +3388,14 @@ end;
 procedure TNetConnection.DoProcess_GetPubkeyAccounts_Request(HeaderData: TNetHeaderData; DataBuffer: TStream);
 procedure TNetConnection.DoProcess_GetPubkeyAccounts_Request(HeaderData: TNetHeaderData; DataBuffer: TStream);
 Const CT_Max_Accounts_per_call = 1000;
 Const CT_Max_Accounts_per_call = 1000;
 var responseStream, accountsStream : TMemoryStream;
 var responseStream, accountsStream : TMemoryStream;
-  start,max,iPubKey : Integer;
+  start,max : Integer;
   c, nAccounts : Cardinal;
   c, nAccounts : Cardinal;
   acc : TAccount;
   acc : TAccount;
   DoDisconnect : Boolean;
   DoDisconnect : Boolean;
   errors : String;
   errors : String;
   pubKey : TAccountKey;
   pubKey : TAccountKey;
-  sbakl : TOrderedAccountKeysList;
-  ocl : TOrderedCardinalList;
+  sbakl : TSafeboxPubKeysAndAccounts;
+  ocl : TAccountsNumbersList;
 begin
 begin
   {
   {
   This call is used to obtain Accounts used by a Public key
   This call is used to obtain Accounts used by a Public key
@@ -3381,9 +3440,8 @@ begin
     nAccounts := 0;
     nAccounts := 0;
     sbakl := TNode.Node.Bank.SafeBox.OrderedAccountKeysList;
     sbakl := TNode.Node.Bank.SafeBox.OrderedAccountKeysList;
     if Assigned(sbakl) then begin
     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
         while (start<ocl.Count) And (max>0) do begin
           acc := TNode.Node.GetMempoolAccount(ocl.Get(start));
           acc := TNode.Node.GetMempoolAccount(ocl.Get(start));
           if (HeaderData.protocol.protocol_available>9) then
           if (HeaderData.protocol.protocol_available>9) then
@@ -4901,7 +4959,8 @@ begin
       i := 0;
       i := 0;
       if (candidates.Count>1) then i := Random(candidates.Count); // i = 0..count-1
       if (candidates.Count>1) then i := Random(candidates.Count); // i = 0..count-1
       nc := TNetConnection(candidates[i]);
       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;
     end;
   finally
   finally
     LMaxAggregatedHashrate.Free;
     LMaxAggregatedHashrate.Free;

+ 2 - 1
src/core/UNode.pas

@@ -35,7 +35,7 @@ interface
 
 
 uses
 uses
   Classes, SysUtils,
   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;
   UBlockChain, UNetProtocol, UAccounts, UCrypto, UThread, SyncObjs, ULog, UBaseTypes, UPCOrderedLists;
 
 
 {$I ./../config.inc}
 {$I ./../config.inc}
@@ -874,6 +874,7 @@ end;
 class function TNode.NodeVersion: String;
 class function TNode.NodeVersion: String;
 begin
 begin
   Result := CT_ClientAppVersion
   Result := CT_ClientAppVersion
+    {$IFDEF USE_ABSTRACTMEM}+'am'{$ENDIF}
     {$IFDEF LINUX}+'L'{$ELSE}+'W'{$ENDIF}
     {$IFDEF LINUX}+'L'{$ELSE}+'W'{$ENDIF}
     {$IFDEF FPC}{$IFDEF LCL}+'l'{$ELSE}+'f'{$ENDIF}{$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}
     {$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
 interface
 
 
 uses
 uses
-  Classes, SysUtils, UBaseTypes;
+  Classes, SysUtils, UBaseTypes, UConst;
 
 
 type
 type
 
 
@@ -38,6 +38,15 @@ type
      EC_OpenSSL_NID : Word;
      EC_OpenSSL_NID : Word;
      x: TRawBytes;
      x: TRawBytes;
      y: 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;
   end;
 
 
   { TECDSA_Public_Raw is a TECDSA_Public stored in a single TRawBytes
   { TECDSA_Public_Raw is a TECDSA_Public stored in a single TRawBytes
@@ -59,8 +68,269 @@ type
   end;
   end;
   PECDSA_Public = ^TECDSA_Public; // Pointer to a TECDSA_SIG
   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
 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 }
 { TECDSA_Public_Helper }
 
 
 function TECDSA_Public_Helper.ToRaw(var OECDSA_Public_Raw: TECDSA_Public_Raw): Boolean;
 function TECDSA_Public_Helper.ToRaw(var OECDSA_Public_Raw: TECDSA_Public_Raw): Boolean;
@@ -117,5 +387,56 @@ begin
   end;
   end;
 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.
 end.
 
 

+ 1 - 1
src/core/UPCOperationsBlockValidator.pas

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

+ 6 - 1
src/core/UPCOrderedLists.pas

@@ -27,6 +27,8 @@ uses
   {$IFNDEF FPC}System.Generics.Collections{$ELSE}Generics.Collections{$ENDIF};
   {$IFNDEF FPC}System.Generics.Collections{$ELSE}Generics.Collections{$ENDIF};
 
 
 Type
 Type
+  EOrderedList = Class(Exception);
+
   TCardinalsArray = Array of Cardinal;
   TCardinalsArray = Array of Cardinal;
 
 
   // Maintans a Cardinal ordered (without duplicates) list with TRawData each
   // Maintans a Cardinal ordered (without duplicates) list with TRawData each
@@ -298,6 +300,7 @@ end;
 procedure TOrderedRawList.Delete(index: Integer);
 procedure TOrderedRawList.Delete(index: Integer);
 Var P : PRawListData;
 Var P : PRawListData;
 begin
 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]);
   P := PRawListData(FList[index]);
   FList.Delete(index);
   FList.Delete(index);
   Dispose(P);
   Dispose(P);
@@ -337,11 +340,13 @@ end;
 
 
 function TOrderedRawList.Get(index: Integer): TRawBytes;
 function TOrderedRawList.Get(index: Integer): TRawBytes;
 begin
 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;
 end;
 
 
 function TOrderedRawList.GetTag(index: Integer): Integer;
 function TOrderedRawList.GetTag(index: Integer): Integer;
 begin
 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;
   Result := PRawListData(FList[index])^.tag;
 end;
 end;
 
 

+ 7 - 6
src/core/UPCRPCFindAccounts.pas

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

+ 1 - 1
src/core/UPCRPCOpData.pas

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

+ 7 - 0
src/core/UPCSafeBoxRootHash.pas

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

+ 1 - 1
src/core/UPCTNetDataExtraMessages.pas

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

+ 23 - 0
src/core/UPCTemporalFileStream.pas

@@ -36,6 +36,7 @@ Type
   public
   public
     Constructor Create(const AInitialName : String); reintroduce;
     Constructor Create(const AInitialName : String); reintroduce;
     Destructor Destroy; override;
     Destructor Destroy; override;
+    class function GetTemporalFileName(const AInitialName : String) : String;
   End;
   End;
 
 
 implementation
 implementation
@@ -78,4 +79,26 @@ begin
   end;
   end;
 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.
 end.

+ 1 - 1
src/core/UPoolMining.pas

@@ -31,7 +31,7 @@ Uses
   {LCLIntf, LCLType, LMessages,}
   {LCLIntf, LCLType, LMessages,}
 {$ENDIF}
 {$ENDIF}
   UTCPIP, SysUtils, UThread, SyncObjs, Classes, UJSONFunctions, UPCEncryption, UNode,
   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};
   {$IFNDEF FPC}System.Generics.Collections{$ELSE}Generics.Collections{$ENDIF};
 
 
 Const
 Const

+ 17 - 16
src/core/URPC.pas

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

+ 9 - 2
src/core/upcdaemon.pas

@@ -26,7 +26,7 @@ uses
   Classes, SysUtils, daemonapp,
   Classes, SysUtils, daemonapp,
   SyncObjs, UOpenSSL, UCrypto, UNode, UFileStorage, UFolderHelper, UWallet, UConst, ULog, UNetProtocol,
   SyncObjs, UOpenSSL, UCrypto, UNode, UFileStorage, UFolderHelper, UWallet, UConst, ULog, UNetProtocol,
   IniFiles, UBaseTypes,
   IniFiles, UBaseTypes,
-  UThread, URPC, UPoolMining, UAccounts;
+  UThread, URPC, UPoolMining, UAccounts, UPCDataTypes;
 
 
 Const
 Const
   CT_INI_SECTION_GLOBAL = 'GLOBAL';
   CT_INI_SECTION_GLOBAL = 'GLOBAL';
@@ -56,6 +56,7 @@ Type
     FMaxBlockToRead: Int64;
     FMaxBlockToRead: Int64;
     FLastNodesCacheUpdatedTS : TTickCount;
     FLastNodesCacheUpdatedTS : TTickCount;
     procedure OnNetDataReceivedHelloMessage(Sender : TObject);
     procedure OnNetDataReceivedHelloMessage(Sender : TObject);
+    procedure OnInitSafeboxProgressNotify(sender : TObject; const message : String; curPos, totalCount : Int64);
   protected
   protected
     Procedure BCExecute; override;
     Procedure BCExecute; override;
   public
   public
@@ -122,6 +123,12 @@ begin
   TNode.Node.PeerCache := s;
   TNode.Node.PeerCache := s;
 end;
 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;
 procedure TPCDaemonThread.BCExecute;
 var
 var
   FNode : TNode;
   FNode : TNode;
@@ -249,7 +256,7 @@ begin
         TNetData.NetData.OnReceivedHelloMessage:=@OnNetDataReceivedHelloMessage;
         TNetData.NetData.OnReceivedHelloMessage:=@OnNetDataReceivedHelloMessage;
         FNode.PeerCache:=  FIniFile.ReadString(CT_INI_SECTION_GLOBAL,CT_INI_IDENT_PEERCACHE,'');
         FNode.PeerCache:=  FIniFile.ReadString(CT_INI_SECTION_GLOBAL,CT_INI_IDENT_PEERCACHE,'');
         // Reading database
         // Reading database
-        FNode.InitSafeboxAndOperations(MaxBlockToRead);
+        FNode.InitSafeboxAndOperations(MaxBlockToRead,@OnInitSafeboxProgressNotify);
         FWalletKeys.SafeBox := FNode.Node.Bank.SafeBox;
         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.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);
         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}
 {$ELSE}
   LCLIntf, LCLType, LMessages,
   LCLIntf, LCLType, LMessages,
 {$ENDIF}
 {$ENDIF}
+  UPCDataTypes,
   Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
   Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
   Dialogs, UAccounts, Grids, StdCtrls, Buttons, ExtCtrls, UWallet, UNode,
   Dialogs, UAccounts, Grids, StdCtrls, Buttons, ExtCtrls, UWallet, UNode,
   UGridUtils, UConst, UThread, UPCOrderedLists, UBaseTypes;
   UGridUtils, UConst, UThread, UPCOrderedLists, UBaseTypes;

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

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

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

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

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

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

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

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

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

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