Browse Source

Merge pull request #197 from PascalCoinDev/abstractmem

Abstractmem
Pascal Coin 5 years ago
parent
commit
514d07d4d6
3 changed files with 91 additions and 10 deletions
  1. 17 0
      src/core/UAccounts.pas
  2. 68 10
      src/core/UTCPIP.pas
  3. 6 0
      src/core/UThread.pas

+ 17 - 0
src/core/UAccounts.pas

@@ -45,6 +45,7 @@ Type
     Class Function MinimumTarget(protocol_version : Integer): Cardinal;
     Class Function MinimumTarget(protocol_version : Integer): Cardinal;
     Class Function ResetTarget(current_target : Cardinal; protocol_version : Integer): Cardinal;
     Class Function ResetTarget(current_target : Cardinal; protocol_version : Integer): Cardinal;
     Class Function GetRewardForNewLine(line_index: Cardinal): UInt64;
     Class Function GetRewardForNewLine(line_index: Cardinal): UInt64;
+    Class Function CalcTotalBalance(ABlockCount : Cardinal): Int64;
     Class Function TargetToCompact(target: TRawBytes; protocol_version : Integer): Cardinal;
     Class Function TargetToCompact(target: TRawBytes; protocol_version : Integer): Cardinal;
     Class Function TargetFromCompact(encoded: Cardinal; protocol_version : Integer): TRawBytes;
     Class Function TargetFromCompact(encoded: Cardinal; protocol_version : Integer): TRawBytes;
     Class Function GetNewTarget(vteorical, vreal: Cardinal; protocol_version : Integer; isSlowMovement : Boolean; Const actualTarget: TRawBytes): TRawBytes;
     Class Function GetNewTarget(vteorical, vreal: Cardinal; protocol_version : Integer; isSlowMovement : Boolean; Const actualTarget: TRawBytes): TRawBytes;
@@ -753,6 +754,21 @@ begin
   end;
   end;
 end;
 end;
 
 
+class function TPascalCoinProtocol.CalcTotalBalance(ABlockCount: Cardinal): Int64;
+var LCurrReward : Int64;
+  LNextBlock : Integer;
+begin
+  LCurrReward := CT_FirstReward;
+  LNextBlock := CT_NewLineRewardDecrease;
+  Result := 0;
+  while (LNextBlock < ABlockCount) do begin
+    inc(Result, Int64(CT_NewLineRewardDecrease * LCurrReward));
+    LCurrReward := LCurrReward DIV 2;
+    inc(LNextBlock,CT_NewLineRewardDecrease);
+  end;
+  inc(Result, Int64(Int64(ABlockCount MOD CT_NewLineRewardDecrease) * LCurrReward));
+end;
+
 class function TPascalCoinProtocol.AllowUseHardcodedRandomHashTable(
 class function TPascalCoinProtocol.AllowUseHardcodedRandomHashTable(
   const AHardcodedFileName: String;
   const AHardcodedFileName: String;
   const AHardcodedSha256Value: TRawBytes): Boolean;
   const AHardcodedSha256Value: TRawBytes): Boolean;
@@ -2782,6 +2798,7 @@ begin
     FWorkSum := LOpBl.accumulatedWork;
     FWorkSum := LOpBl.accumulatedWork;
   end else FCurrentProtocol := CT_PROTOCOL_1;
   end else FCurrentProtocol := CT_PROTOCOL_1;
   FSafeBoxHash := CalcSafeBoxHash;
   FSafeBoxHash := CalcSafeBoxHash;
+  FTotalBalance := TPascalCoinProtocol.CalcTotalBalance(FPCAbstractMem.BlocksCount);
 end;
 end;
 
 
 procedure TPCSafeBox.SaveCheckpointing(ACheckpointingSafeboxFileName : String);
 procedure TPCSafeBox.SaveCheckpointing(ACheckpointingSafeboxFileName : String);

+ 68 - 10
src/core/UTCPIP.pas

@@ -51,9 +51,11 @@ type
   TTCPBlockSocket = TIdTCPConnection;
   TTCPBlockSocket = TIdTCPConnection;
   {$ENDIF}
   {$ENDIF}
 
 
+  TNetTcpIpServer = Class;
+
   { TNetTcpIpClient }
   { TNetTcpIpClient }
 
 
-  TNetTcpIpClient = Class(TComponent)
+  TNetTcpIpClient = Class(TComponent) // TODO: Convert to TInterfacedObject
   private
   private
     FTcpBlockSocket : TTCPBlockSocket;
     FTcpBlockSocket : TTCPBlockSocket;
     FBytesReceived, FBytesSent : Int64;
     FBytesReceived, FBytesSent : Int64;
@@ -80,6 +82,8 @@ type
     procedure TCustomIpClient_OnError(Sender: TObject; ASocketError: Integer);
     procedure TCustomIpClient_OnError(Sender: TObject; ASocketError: Integer);
     {$ENDIF}
     {$ENDIF}
   protected
   protected
+    FNetTcpIpServer : TNetTcpIpServer;
+    Procedure DoOnDisconnect; Virtual;
     Procedure DoOnConnect; Virtual;
     Procedure DoOnConnect; Virtual;
     function ReceiveBuf(var Buf; BufSize: Integer): Integer;
     function ReceiveBuf(var Buf; BufSize: Integer): Integer;
     Function SendStream(Stream : TStream) : Int64;
     Function SendStream(Stream : TStream) : Int64;
@@ -123,7 +127,9 @@ type
     FCritical : TPCCriticalSection;
     FCritical : TPCCriticalSection;
     FLastReadTC : TTickCount;
     FLastReadTC : TTickCount;
     FBufferedNetTcpIpClientThread : TBufferedNetTcpIpClientThread;
     FBufferedNetTcpIpClientThread : TBufferedNetTcpIpClientThread;
+    FOnReceivedData: TNotifyEvent;
   protected
   protected
+    Procedure DoReceivedData; virtual;
     Function DoWaitForDataInherited(WaitMilliseconds : Integer) : Boolean;
     Function DoWaitForDataInherited(WaitMilliseconds : Integer) : Boolean;
     Procedure DoWaitForData(WaitMilliseconds : Integer; var HasData : Boolean); override;
     Procedure DoWaitForData(WaitMilliseconds : Integer; var HasData : Boolean); override;
   public
   public
@@ -133,10 +139,10 @@ type
     Function ReadBufferLock : TMemoryStream;
     Function ReadBufferLock : TMemoryStream;
     Procedure ReadBufferUnlock;
     Procedure ReadBufferUnlock;
     Property LastReadTC : TTickCount read FLastReadTC;
     Property LastReadTC : TTickCount read FLastReadTC;
+    Property OnReceivedData : TNotifyEvent read FOnReceivedData write FOnReceivedData;
   End;
   End;
 
 
   {$IFDEF Synapse}
   {$IFDEF Synapse}
-  TNetTcpIpServer = Class;
   TTcpIpServerListenerThread = Class;
   TTcpIpServerListenerThread = Class;
 
 
   TTcpIpSocketThread = Class(TPCThread)
   TTcpIpSocketThread = Class(TPCThread)
@@ -164,7 +170,9 @@ type
 
 
   { TNetTcpIpServer }
   { TNetTcpIpServer }
 
 
-  TNetTcpIpServer = Class(TObject)
+  TOnClientUpdated = procedure(Sender : TNetTcpIpServer; AClient : TNetTcpIpClient) of object;
+
+  TNetTcpIpServer = Class(TInterfacedObject)
   private
   private
     {$IFDEF DelphiSockets}
     {$IFDEF DelphiSockets}
     FTcpIpServer : TIdTcpServer;
     FTcpIpServer : TIdTcpServer;
@@ -177,15 +185,21 @@ type
     FNetClients : TPCThreadList<TNetTcpIpClient>;
     FNetClients : TPCThreadList<TNetTcpIpClient>;
     FMaxConnections : Integer;
     FMaxConnections : Integer;
     FNetTcpIpClientClass : TNetTcpIpClientClass;
     FNetTcpIpClientClass : TNetTcpIpClientClass;
+    FOnConnectionsChanged: TNotifyEvent;
+    FOnClientFinalized: TOnClientUpdated;
+    FOnClientStarted: TOnClientUpdated;
     function GetActive: Boolean;
     function GetActive: Boolean;
     procedure SetPort(const Value: Word);  // When a connection is established to a new client, a TNetConnection is created (p2p)
     procedure SetPort(const Value: Word);  // When a connection is established to a new client, a TNetConnection is created (p2p)
     function GetPort: Word;
     function GetPort: Word;
     procedure OnTcpServerAccept({$IFDEF DelphiSockets}AContext: TIdContext{$ELSE}Sender: TObject; ClientSocket: TTCPBlockSocket{$ENDIF});
     procedure OnTcpServerAccept({$IFDEF DelphiSockets}AContext: TIdContext{$ELSE}Sender: TObject; ClientSocket: TTCPBlockSocket{$ENDIF});
     procedure SetNetTcpIpClientClass(const Value: TNetTcpIpClientClass);
     procedure SetNetTcpIpClientClass(const Value: TNetTcpIpClientClass);
   protected
   protected
+    Procedure DoAddClient(AClient : TNetTcpIpClient); virtual;
+    Procedure DoRemoveClient(AClient : TNetTcpIpClient); virtual;
     Procedure OnNewIncommingConnection(Sender : TObject; Client : TNetTcpIpClient); virtual;
     Procedure OnNewIncommingConnection(Sender : TObject; Client : TNetTcpIpClient); virtual;
     procedure SetActive(const Value: Boolean); virtual;
     procedure SetActive(const Value: Boolean); virtual;
     procedure SetMaxConnections(AValue: Integer); virtual;
     procedure SetMaxConnections(AValue: Integer); virtual;
+    function GetNewClient : TNetTcpIpClient; virtual;
   public
   public
     Constructor Create; virtual;
     Constructor Create; virtual;
     Destructor Destroy; override;
     Destructor Destroy; override;
@@ -195,7 +209,11 @@ type
     Property NetTcpIpClientClass : TNetTcpIpClientClass read FNetTcpIpClientClass write SetNetTcpIpClientClass;
     Property NetTcpIpClientClass : TNetTcpIpClientClass read FNetTcpIpClientClass write SetNetTcpIpClientClass;
     Function NetTcpIpClientsLock : TList<TNetTcpIpClient>;
     Function NetTcpIpClientsLock : TList<TNetTcpIpClient>;
     Procedure NetTcpIpClientsUnlock;
     Procedure NetTcpIpClientsUnlock;
+    Function NetTcpIpClientsCount : Integer;
     Procedure WaitUntilNetTcpIpClientsFinalized;
     Procedure WaitUntilNetTcpIpClientsFinalized;
+    property OnClientStarted : TOnClientUpdated read FOnClientStarted write FOnClientStarted;
+    property OnClientFinalized : TOnClientUpdated read FOnClientFinalized write FOnClientFinalized;
+    Property OnConnectionsChanged : TNotifyEvent read FOnConnectionsChanged write FOnConnectionsChanged;
   End;
   End;
 
 
 
 
@@ -276,15 +294,16 @@ begin
   finally
   finally
     FLock.Release;
     FLock.Release;
   end;
   end;
-  Result := FConnected;
   if FConnected then begin
   if FConnected then begin
     DoOnConnect;
     DoOnConnect;
   end;
   end;
+  Result := FConnected;
 end;
 end;
 
 
 constructor TNetTcpIpClient.Create(AOwner : TComponent);
 constructor TNetTcpIpClient.Create(AOwner : TComponent);
 begin
 begin
   inherited;
   inherited;
+  FNetTcpIpServer := Nil;
   FOnConnect := Nil;
   FOnConnect := Nil;
   FOnDisconnect := Nil;
   FOnDisconnect := Nil;
   FTcpBlockSocket := Nil;
   FTcpBlockSocket := Nil;
@@ -350,12 +369,11 @@ begin
       DebugStep := 'Relasing flock';
       DebugStep := 'Relasing flock';
       FConnected := false;
       FConnected := false;
       DebugStep := 'Calling OnDisconnect';
       DebugStep := 'Calling OnDisconnect';
-      if Assigned(FOnDisconnect) then FOnDisconnect(Self)
-      else TLog.NewLog(ltError,ClassName,'OnDisconnect is nil');
       {$ENDIF}
       {$ENDIF}
     Finally
     Finally
       FLock.Release;
       FLock.Release;
     End;
     End;
+    DoOnDisconnect;
   Except
   Except
     On E:Exception do begin
     On E:Exception do begin
       E.Message := 'Exception at TNetTcpIpClient.Discconnect step '+DebugStep+' - '+E.Message;
       E.Message := 'Exception at TNetTcpIpClient.Discconnect step '+DebugStep+' - '+E.Message;
@@ -369,6 +387,11 @@ begin
   If (Assigned(FOnConnect)) then FOnConnect(Self);
   If (Assigned(FOnConnect)) then FOnConnect(Self);
 end;
 end;
 
 
+procedure TNetTcpIpClient.DoOnDisconnect;
+begin
+  if (Assigned(FOnDisconnect)) then FOnDisconnect(Self);
+end;
+
 procedure TNetTcpIpClient.DoWaitForData(WaitMilliseconds: Integer; var HasData: Boolean);
 procedure TNetTcpIpClient.DoWaitForData(WaitMilliseconds: Integer; var HasData: Boolean);
 Begin
 Begin
   FLock.Acquire;
   FLock.Acquire;
@@ -631,6 +654,9 @@ var SendBuffStream : TStream;
         end;
         end;
       until (last_bytes_read<sizeof(ReceiveBuffer)) Or (Terminated) Or (Not FBufferedNetTcpIpClient.Connected);
       until (last_bytes_read<sizeof(ReceiveBuffer)) Or (Terminated) Or (Not FBufferedNetTcpIpClient.Connected);
       {$IFDEF HIGHLOG}If total_read>0 then TLog.NewLog(ltdebug,ClassName,Format('Received %d bytes. Buffer length: %d bytes',[total_read,total_size]));{$ENDIF}
       {$IFDEF HIGHLOG}If total_read>0 then TLog.NewLog(ltdebug,ClassName,Format('Received %d bytes. Buffer length: %d bytes',[total_read,total_size]));{$ENDIF}
+      if (total_read>0) and (Not Terminated) and (FBufferedNetTcpIpClient.Connected) then begin
+        FBufferedNetTcpIpClient.DoReceivedData;
+      end;
     end else begin
     end else begin
       if FBufferedNetTcpIpClient.SocketError<>0 then FBufferedNetTcpIpClient.Disconnect;
       if FBufferedNetTcpIpClient.SocketError<>0 then FBufferedNetTcpIpClient.Disconnect;
     end;
     end;
@@ -648,7 +674,7 @@ var SendBuffStream : TStream;
       FBufferedNetTcpIpClient.FCritical.Release;
       FBufferedNetTcpIpClient.FCritical.Release;
     End;
     End;
     if (SendBuffStream.Size>0) then begin
     if (SendBuffStream.Size>0) then begin
-      SendBuffStream.Position := 0;
+       SendBuffStream.Position := 0;
       FBufferedNetTcpIpClient.SendStream(SendBuffStream);
       FBufferedNetTcpIpClient.SendStream(SendBuffStream);
       {$IFDEF HIGHLOG}TLog.NewLog(ltdebug,ClassName,Format('Sent %d bytes',[SendBuffStream.Size]));{$ENDIF}
       {$IFDEF HIGHLOG}TLog.NewLog(ltdebug,ClassName,Format('Sent %d bytes',[SendBuffStream.Size]));{$ENDIF}
       SendBuffStream.Size := 0;
       SendBuffStream.Size := 0;
@@ -684,6 +710,7 @@ end;
 constructor TBufferedNetTcpIpClient.Create(AOwner: TComponent);
 constructor TBufferedNetTcpIpClient.Create(AOwner: TComponent);
 begin
 begin
   inherited;
   inherited;
+  FOnReceivedData := Nil;
   FLastReadTC := TPlatform.GetTickCount;
   FLastReadTC := TPlatform.GetTickCount;
   FCritical := TPCCriticalSection.Create('TBufferedNetTcpIpClient_Critical');
   FCritical := TPCCriticalSection.Create('TBufferedNetTcpIpClient_Critical');
   FSendBuffer := TMemoryStream.Create;
   FSendBuffer := TMemoryStream.Create;
@@ -702,6 +729,11 @@ begin
   inherited;
   inherited;
 end;
 end;
 
 
+procedure TBufferedNetTcpIpClient.DoReceivedData;
+begin
+  if Assigned(FOnReceivedData) then FOnReceivedData(Self);
+end;
+
 procedure TBufferedNetTcpIpClient.DoWaitForData(WaitMilliseconds: Integer; var HasData: Boolean);
 procedure TBufferedNetTcpIpClient.DoWaitForData(WaitMilliseconds: Integer; var HasData: Boolean);
 begin
 begin
   FCritical.Acquire;
   FCritical.Acquire;
@@ -751,6 +783,7 @@ end;
 
 
 constructor TNetTcpIpServer.Create;
 constructor TNetTcpIpServer.Create;
 begin
 begin
+  FOnConnectionsChanged := Nil;
   FNetTcpIpClientClass := TNetTcpIpClient;
   FNetTcpIpClientClass := TNetTcpIpClient;
   FTcpIpServer := Nil;
   FTcpIpServer := Nil;
   FMaxConnections := CT_MaxClientsConnected;
   FMaxConnections := CT_MaxClientsConnected;
@@ -774,6 +807,20 @@ begin
   FreeAndNil(FNetClients);
   FreeAndNil(FNetClients);
 end;
 end;
 
 
+procedure TNetTcpIpServer.DoAddClient(AClient: TNetTcpIpClient);
+begin
+  FNetClients.Add(AClient);
+  if Assigned(FOnClientStarted) then FOnClientStarted(Self,AClient);
+  if Assigned(FOnConnectionsChanged) then FOnConnectionsChanged(Self);
+end;
+
+procedure TNetTcpIpServer.DoRemoveClient(AClient: TNetTcpIpClient);
+begin
+  FNetClients.Remove(AClient);
+  if Assigned(FOnClientFinalized) then FOnClientFinalized(Self,AClient);
+  if Assigned(FOnConnectionsChanged) then FOnConnectionsChanged(Self);
+end;
+
 function TNetTcpIpServer.GetActive: Boolean;
 function TNetTcpIpServer.GetActive: Boolean;
 begin
 begin
   {$IFDEF DelphiSockets}
   {$IFDEF DelphiSockets}
@@ -783,6 +830,11 @@ begin
   {$ENDIF}
   {$ENDIF}
 end;
 end;
 
 
+function TNetTcpIpServer.GetNewClient: TNetTcpIpClient;
+begin
+  Result := FNetTcpIpClientClass.Create(Nil);
+end;
+
 procedure TNetTcpIpServer.SetMaxConnections(AValue: Integer);
 procedure TNetTcpIpServer.SetMaxConnections(AValue: Integer);
 begin
 begin
   if FMaxConnections=AValue then Exit;
   if FMaxConnections=AValue then Exit;
@@ -801,6 +853,11 @@ begin
   {$ENDIF}
   {$ENDIF}
 end;
 end;
 
 
+function TNetTcpIpServer.NetTcpIpClientsCount: Integer;
+begin
+  Result := FNetClients.Count;
+end;
+
 function TNetTcpIpServer.NetTcpIpClientsLock: TList<TNetTcpIpClient>;
 function TNetTcpIpServer.NetTcpIpClientsLock: TList<TNetTcpIpClient>;
 begin
 begin
   Result := FNetClients.LockList;
   Result := FNetClients.LockList;
@@ -820,10 +877,11 @@ procedure TNetTcpIpServer.OnTcpServerAccept({$IFDEF DelphiSockets}AContext: TIdC
 Var n : TNetTcpIpClient;
 Var n : TNetTcpIpClient;
   oldSocket : TTCPBlockSocket;
   oldSocket : TTCPBlockSocket;
 begin
 begin
-  n := FNetTcpIpClientClass.Create(Nil);
+  n := GetNewClient;
   Try
   Try
     n.FLock.Acquire;
     n.FLock.Acquire;
     try
     try
+      n.FNetTcpIpServer := Self;
       oldSocket := n.FTcpBlockSocket;
       oldSocket := n.FTcpBlockSocket;
       {$IFDEF DelphiSockets}
       {$IFDEF DelphiSockets}
       n.FTcpBlockSocket := AContext.Connection;
       n.FTcpBlockSocket := AContext.Connection;
@@ -840,11 +898,11 @@ begin
     finally
     finally
       n.FLock.Release;
       n.FLock.Release;
     end;
     end;
-    FNetClients.Add(n);
+    DoAddClient(n);
     try
     try
       OnNewIncommingConnection({$IFDEF DelphiSockets}Self{$ELSE}Sender{$ENDIF},n);
       OnNewIncommingConnection({$IFDEF DelphiSockets}Self{$ELSE}Sender{$ENDIF},n);
     finally
     finally
-      FNetClients.Remove(n);
+      DoRemoveClient(n);
     end;
     end;
   Finally
   Finally
     n.FTcpBlockSocket := oldSocket;
     n.FTcpBlockSocket := oldSocket;

+ 6 - 0
src/core/UThread.pas

@@ -92,6 +92,7 @@ Type
     constructor Create(const AName : String);
     constructor Create(const AName : String);
     destructor Destroy; override;
     destructor Destroy; override;
     function Add(Item: T) : Integer;
     function Add(Item: T) : Integer;
+    function Count : Integer;
     procedure Clear;
     procedure Clear;
     procedure Remove(Item: T); inline;
     procedure Remove(Item: T); inline;
     function LockList: TList<T>;
     function LockList: TList<T>;
@@ -384,6 +385,11 @@ begin
   FList := TList<T>.Create;
   FList := TList<T>.Create;
 end;
 end;
 
 
+function TPCThreadList<T>.Count : Integer;
+begin
+  Result := FList.Count;
+end;
+
 destructor TPCThreadList<T>.Destroy;
 destructor TPCThreadList<T>.Destroy;
 begin
 begin
   LockList;
   LockList;