ソースを参照

Build 1.4.1

Build 1.4.1
PascalCoin 8 年 前
コミット
400c8e35f8

+ 0 - 1
PascalCoinWallet.dpr

@@ -29,7 +29,6 @@ uses
   UJSONFunctions in 'Units\Utils\UJSONFunctions.pas',
   URPC in 'Units\PascalCoin\URPC.pas',
   UPoolMining in 'Units\PascalCoin\UPoolMining.pas',
-  UMiner in 'Units\PascalCoin\UMiner.pas',
   UFileStorage in 'Units\PascalCoin\UFileStorage.pas',
   UOpenSSL in 'Units\PascalCoin\UOpenSSL.pas',
   UOpenSSLdef in 'Units\PascalCoin\UOpenSSLdef.pas',

BIN
PascalCoinWallet.res


+ 0 - 1
PascalCoinWalletLazarus.dpr

@@ -40,7 +40,6 @@ uses
   UJSONFunctions in 'Units\Utils\UJSONFunctions.pas',
   URPC in 'Units\PascalCoin\URPC.pas',
   UPoolMining in 'Units\PascalCoin\UPoolMining.pas',
-  UMiner in 'Units\PascalCoin\UMiner.pas',
   UOpenSSL in 'Units\PascalCoin\UOpenSSL.pas',
   UOpenSSLdef in 'Units\PascalCoin\UOpenSSLdef.pas';
 

+ 1 - 0
PascalCoinWalletLazarus.lpi

@@ -207,6 +207,7 @@
     <SearchPaths>
       <IncludeFiles Value="$(ProjOutDir)"/>
       <OtherUnitFiles Value="Synapse\lib;Units\Forms;Units\PascalCoin"/>
+      <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
     </SearchPaths>
     <Parsing>
       <SyntaxOptions>

+ 6 - 0
README.md

@@ -34,6 +34,12 @@ Also, consider a donation at PascalCoin development account: "0-10"
 
 ## History:  
 
+### Build 1.4.1.0 - 2017-01-18
+
+- Improved JSON communications with Miner client (Port 4009 by default)
+- Deleted adding numeration to JSON miner clients (only sends miner name)
+- Minor changes
+
 ### Build 1.4.0.0 - 2016-12-30
 
 - JSON-RPC changes:

+ 6 - 0
README.txt

@@ -34,6 +34,12 @@ Also, consider a donation at PascalCoin development account: "0-10"
 
 ## History:  
 
+### Build 1.4.1.0 - 2017-01-18
+
+- Improved JSON communications with Miner client (Port 4009 by default)
+- Deleted adding numeration to JSON miner clients (only sends miner name)
+- Minor changes
+
 ### Build 1.4.0.0 - 2016-12-30
 
 - JSON-RPC changes:

+ 3 - 1
Units/Forms/UFRMPascalCoinWalletConfig.pas

@@ -31,6 +31,8 @@ uses
 
 type
 
+  TMinerPrivateKey = (mpk_NewEachTime, mpk_Random, mpk_Selected);
+
   { TFRMPascalCoinWalletConfig }
 
   TFRMPascalCoinWalletConfig = class(TForm)
@@ -81,7 +83,7 @@ type
 
 implementation
 
-uses UConst, UAccounts, ULog, UCrypto, UMiner, UFolderHelper;
+uses UConst, UAccounts, ULog, UCrypto, UFolderHelper;
 
 {$IFnDEF FPC}
   {$R *.dfm}

+ 13 - 1
Units/Forms/UFRMWallet.dfm

@@ -374,6 +374,10 @@ object FRMWallet: TFRMWallet
     OnChange = PageControlChange
     object tsMyAccounts: TTabSheet
       Caption = 'Accounts Explorer'
+      ExplicitLeft = 0
+      ExplicitTop = 0
+      ExplicitWidth = 0
+      ExplicitHeight = 0
       object Splitter1: TSplitter
         Left = 380
         Top = 66
@@ -977,6 +981,10 @@ object FRMWallet: TFRMWallet
     object tsNodeStats: TTabSheet
       Caption = 'Node Stats'
       ImageIndex = 3
+      ExplicitLeft = 0
+      ExplicitTop = 0
+      ExplicitWidth = 0
+      ExplicitHeight = 0
       DesignSize = (
         841
         404)
@@ -1039,6 +1047,10 @@ object FRMWallet: TFRMWallet
     object tsMessages: TTabSheet
       Caption = 'Messages'
       ImageIndex = 6
+      ExplicitLeft = 0
+      ExplicitTop = 0
+      ExplicitWidth = 0
+      ExplicitHeight = 0
       DesignSize = (
         841
         404)
@@ -1272,7 +1284,7 @@ object FRMWallet: TFRMWallet
     Left = 105
     Top = 180
     Bitmap = {
-      494C010102000800A40110003000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600
+      494C010102000800AC0110003000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600
       0000000000003600000028000000400000003000000001002000000000000030
       0000000000000000000000000000000000000000000000000000000000000000
       0000000000000000002A292929D60B0B0BF4111111EE0000006B000000000000

+ 5 - 18
Units/Forms/UFRMWallet.pas

@@ -28,7 +28,7 @@ uses
   Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
   Dialogs, ExtCtrls, ComCtrls, UWalletKeys, StdCtrls,
   ULog, Grids, UAppParams,
-  UBlockChain, UNode, UGridUtils, UMiner, UAccounts, Menus, ImgList,
+  UBlockChain, UNode, UGridUtils, UAccounts, Menus, ImgList,
   UNetProtocol, UCrypto, Buttons, UPoolMining, URPC;
 
 Const
@@ -239,18 +239,17 @@ type
     FRPCServer : TRPCServer;
     FMustProcessWalletChanged : Boolean;
     FMustProcessNetConnectionUpdated : Boolean;
-    //Procedure CheckMining;
     Procedure OnNewAccount(Sender : TObject);
     Procedure OnReceivedHelloMessage(Sender : TObject);
     Procedure OnNetStatisticsChanged(Sender : TObject);
     procedure OnNewLog(logtype : TLogType; Time : TDateTime; ThreadID : Cardinal; Const sender, logtext : AnsiString);
-    procedure OnMinerNewBlockFound(sender : TMinerThread; Operations : TPCOperationsComp);
     procedure OnWalletChanged(Sender : TObject);
     procedure OnNetConnectionsUpdated(Sender : TObject);
     procedure OnNetNodeServersUpdated(Sender : TObject);
     procedure OnNetBlackListUpdated(Sender : TObject);
     Procedure OnNodeMessageEvent(NetConnection : TNetConnection; MessageData : TRawBytes);
     Procedure OnSelectedAccountsGridUpdated(Sender : TObject);
+    Procedure OnMiningServerNewBlockFound(Sender : TObject);
     Procedure UpdateConnectionStatus;
     Procedure UpdateAccounts(RefreshData : Boolean);
     Procedure UpdateBlockChainState;
@@ -790,6 +789,7 @@ begin
   FPoolMiningServer.MinerPayload := FAppParams.ParamByName[CT_PARAM_MinerName].GetAsString('');
   FNode.Operations.AccountKey := GetAccountKeyForMiner;
   FPoolMiningServer.Active := FAppParams.ParamByName[CT_PARAM_JSONRPCMinerServerActive].GetAsBoolean(true);
+  FPoolMiningServer.OnMiningServerNewBlockFound := OnMiningServerNewBlockFound;
 end;
 
 function TFRMWallet.ForceMining: Boolean;
@@ -872,7 +872,6 @@ end;
 
 procedure TFRMWallet.FormDestroy(Sender: TObject);
 Var i : Integer;
-  MT : TMinerThread;
   step : String;
 begin
   TLog.NewLog(ltinfo,Classname,'Destroying form - START');
@@ -898,17 +897,6 @@ begin
   TNetData.NetData.OnBlackListUpdated := Nil;
   //
 
-  Repeat
-    i := TPCThread.ThreadClassFound(TMinerThread,nil);
-    if i>=0 then begin
-      step := 'Terminating Miner thread '+inttostr(i);
-      MT := TMinerThread( TPCThread.GetThread(i) );
-      MT.Paused := false;
-      MT.Terminate;
-      MT.WaitFor;
-    end;
-  Until i<0;
-
   step := 'Destroying NodeNotifyEvents';
   FreeAndNil(FNodeNotifyEvents);
   //
@@ -1183,10 +1171,9 @@ begin
   sbSelectedAccountsDelClick(Sender);
 end;
 
-procedure TFRMWallet.OnMinerNewBlockFound(sender: TMinerThread; Operations: TPCOperationsComp);
+procedure TFRMWallet.OnMiningServerNewBlockFound(Sender: TObject);
 begin
-  MinersBlocksFound := MinersBlocksFound+1;
-  Sender.AccountKey := GetAccountKeyForMiner;
+  FPoolMiningServer.MinerAccountKey := GetAccountKeyForMiner;
 end;
 
 procedure TFRMWallet.OnNetBlackListUpdated(Sender: TObject);

+ 1 - 0
Units/PascalCoin/UBlockChain.pas

@@ -21,6 +21,7 @@ interface
 
 uses
   Classes, UCrypto, UAccounts, ULog, UThread, SyncObjs;
+{$I config.inc}
 
 
 Type

+ 3 - 7
Units/PascalCoin/UConst.pas

@@ -17,15 +17,11 @@ unit UConst;
 
   }
 
-{$IFNDEF PRODUCTION}
-  {$IFNDEF TESTNET}
-    {$DEFINE PRODUCTION}
-  {$ENDIF}
-{$ENDIF}
-
 interface
 
 Uses UOpenSSLdef;
+{$I config.inc}
+
 
 {$IFNDEF FPC}
   // See http://wiki.freepascal.org/Code_Conversion_Guide
@@ -104,7 +100,7 @@ Const
   CT_Op_Changekey = $02;
   CT_Op_Recover = $03;
 
-  CT_ClientAppVersion : AnsiString = {$IFDEF PRODUCTION}'1.4.0'{$ELSE}{$IFDEF TESTNET}'TESTNET'{$ELSE}{$ENDIF}{$ENDIF};
+  CT_ClientAppVersion : AnsiString = {$IFDEF PRODUCTION}'1.4.1'{$ELSE}{$IFDEF TESTNET}'TESTNET'{$ELSE}{$ENDIF}{$ENDIF};
 
   CT_Discover_IPs =  'bpascal1.dynamic-dns.net;bpascal2.dynamic-dns.net;pascalcoin2.ddns.net;pascalcoin1.dynamic-dns.net;pascalcoin1.dns1.us';
 

+ 1 - 0
Units/PascalCoin/UFileStorage.pas

@@ -21,6 +21,7 @@ interface
 
 uses
   Classes, UBlockChain, SyncObjs;
+{$I config.inc}
 
 Type
   TBlockHeader = Record

+ 0 - 225
Units/PascalCoin/UMiner.pas

@@ -1,225 +0,0 @@
-unit UMiner;
-
-{$IFDEF FPC}
-  {$MODE Delphi}
-{$ENDIF}
-
-{ Copyright (c) 2016 by Albert Molina
-
-  Distributed under the MIT software license, see the accompanying file LICENSE
-  or visit http://www.opensource.org/licenses/mit-license.php.
-
-  This unit is a part of Pascal Coin, a P2P crypto currency without need of
-  historical operations.
-
-  If you like it, consider a donation using BitCoin:
-  16K3HCZRhFUtM8GdWRcfKeaa6KsuyxZaYk
-
-  }
-
-interface
-
-Uses
-{$IFnDEF FPC}
-  Windows,
-{$ELSE}
-  {LCLIntf, LCLType, LMessages,}
-{$ENDIF}
-  UBlockChain, Classes, SyncObjs, UAccounts, UThread;
-
-Type
-  TMinerPrivateKey = (mpk_NewEachTime, mpk_Random, mpk_Selected);
-
-  TMinerThread = Class;
-
-  TMinerNewBlockFound = procedure(sender : TMinerThread; Operations : TPCOperationsComp; Var Correct : Boolean) of object;
-  TMinerNewBlockFoundNotify = procedure(sender : TMinerThread; Operations : TPCOperationsComp) of object;
-
-  TMinerThread = Class(TPCThread)
-  private
-    FOperations : TPCOperationsComp;
-    FLock: TCriticalSection;
-    FPlayCount : Int64;
-    FTotalActiveTime : Int64;
-    FLastStartTickCount : Cardinal;
-    //
-    errors : AnsiString;
-    FAccountKey: TAccountKey;
-    FPaused: Boolean;
-    FOnNewBlockFound: TMinerNewBlockFound;
-    FOnThreadSafeNewBlockFound: TMinerNewBlockFoundNotify;
-    procedure SetAccountKey(const Value: TAccountKey);
-    Procedure CheckIfCanRecoverBlocks;
-    Procedure NotifyNewBlockFoundThreadSafe;
-  protected
-    procedure BCExecute; override;
-  public
-    Constructor Create(Bank : TPCBank; minerAccountKey : TAccountKey; AOnNewBlockFound : TMinerNewBlockFound; AOnThreadSafeNewBlockFound : TMinerNewBlockFoundNotify);
-    destructor Destroy; override;
-    Function MinerLockOperations : TPCOperationsComp;
-    Procedure MinerUnLockOperations(IsNewBlock : Boolean);
-    Property OnNewBlockFound : TMinerNewBlockFound read FOnNewBlockFound write FOnNewBlockFound;
-    Property OnThreadSafeNewBlockFound : TMinerNewBlockFoundNotify read FOnThreadSafeNewBlockFound write FOnThreadSafeNewBlockFound;
-    Property PlayCount : Int64 read FPlayCount;
-    Property AccountKey : TAccountKey read FAccountKey write SetAccountKey;
-    Property Paused : Boolean read FPaused Write FPaused;
-    Function HashRate : Int64;
-    Class function AllMinersPlayCount : Int64;
-  End;
-
-implementation
-
-uses ULog, SysUtils, UConst, UOpTransaction, UCrypto;
-
-{ TMinerThread }
-
-var _all_miners_play_count : Int64;
-
-procedure TMinerThread.CheckIfCanRecoverBlocks;
-Var n_account : Cardinal;
-  recover_block : Cardinal;
-  OpR : TOpRecoverFounds;
-  recover_q : UInt64;
-  errors : AnsiString;
-Begin
-  if FOperations.bank.SafeBox.BlocksCount<CT_RecoverFoundsWaitInactiveCount then exit;
-  recover_block := FOperations.bank.SafeBox.BlocksCount-CT_RecoverFoundsWaitInactiveCount;
-  n_account := 0;
-  while (n_account < FOperations.bank.SafeBox.AccountsCount) do begin
-   If FOperations.SafeBoxTransaction.Account(n_account).updated_block<recover_block then begin
-     recover_q := FOperations.SafeBoxTransaction.Account(n_account).balance;
-     if (recover_q>0) then begin
-       // Recover it!
-       if (recover_q > CT_MaxTransactionFee) then recover_q := CT_MaxTransactionFee;
-       OpR := TOpRecoverFounds.Create(n_account,FOperations.SafeBoxTransaction.Account(n_account).n_operation+1,recover_q);
-       If FOperations.AddOperation(true,OpR,errors) then begin
-         TLog.NewLog(ltinfo,Classname,Format('Recover founds executed at account: %d amount: %s Operation: %s',[n_account,TAccountComp.FormatMoney(recover_q),OpR.ToString]));
-       end else begin
-         TLog.NewLog(lterror,Classname,Format('Error recovering founds executed at account: %d amount: %s Error: %s',[n_account,TAccountComp.FormatMoney(recover_q),errors]));
-       end;
-     end;
-   end;
-   inc(n_account);
-  end;
-End;
-
-constructor TMinerThread.Create(Bank : TPCBank; minerAccountKey : TAccountKey; AOnNewBlockFound : TMinerNewBlockFound; AOnThreadSafeNewBlockFound : TMinerNewBlockFoundNotify);
-begin
-  inherited Create(true);
-  FTotalActiveTime := 0;
-  FLastStartTickCount := 0;
-  FPaused := true;
-  FPlayCount := 0;
-  FAccountKey := minerAccountKey;
-  FLock := TCriticalSection.Create;
-  FOperations := TPCOperationsComp.Create(nil);
-  FOperations.Bank := Bank;
-  FOperations.AccountKey := AccountKey;
-  FOnNewBlockFound := AOnNewBlockFound;
-  FOnThreadSafeNewBlockFound := AOnThreadSafeNewBlockFound;
-  Priority := tpLower;
-  Suspended := false;
-end;
-
-class function TMinerThread.AllMinersPlayCount: Int64;
-begin
-  Result := _all_miners_play_count;
-end;
-
-procedure TMinerThread.BCExecute;
-Var i : Integer;
-  winner : Boolean;
-  newBlockAccount : TBlockAccount;
-  c : Boolean;
-begin
-  TLog.NewLog(ltinfo,ClassName,'New miner');
-  while (not Terminated) do begin
-    while (FPaused) And (Not Terminated) do begin
-      sleep(1);
-    end;
-    FLastStartTickCount := GetTickCount;
-    Try
-      if Terminated then exit;
-      winner := false;
-      TPCThread.ProtectEnterCriticalSection(Self,FLock);
-      try
-        FOperations.UpdateTimestamp;
-        FOperations.AccountKey := FAccountKey;
-        for i := 0 to 100000 do begin
-          inc(FPlayCount);
-          inc(_all_miners_play_count);
-          if Terminated then exit;
-
-          if FOperations.IncrementNOnce then begin
-            winner := true;
-            break;
-          end;
-
-        end;
-      finally
-        FLock.Release;
-      end;
-      if (winner) then begin
-        Try
-          c := true;
-          if Assigned(FOnNewBlockFound) then begin
-            FOnNewBlockFound(Self,FOperations,c);
-          end;
-          if (c) And (Assigned(FOnThreadSafeNewBlockFound)) then Synchronize(NotifyNewBlockFoundThreadSafe);
-        Except
-          On E:Exception do begin
-            TLog.NewLog(lterror,Classname,'Exception on adding new block by miner: '+E.Message);
-            Raise;
-          end;
-        End;
-      end;
-    Finally
-      if FLastStartTickCount>0 then begin
-        FTotalActiveTime := FTotalActiveTime + (GetTickCount - FLastStartTickCount);
-      end;
-    End;
-    if Not Terminated then Sleep(1);
-  end;
-  TLog.NewLog(ltinfo,ClassName,'Destroying Miner');
-end;
-
-destructor TMinerThread.Destroy;
-begin
-  FreeAndNil(FLock);
-  FreeAndNil(FOperations);
-  inherited;
-end;
-
-function TMinerThread.HashRate: Int64;
-begin
-  if FTotalActiveTime>0 then
-    Result := (FPlayCount*1000) DIV FTotalActiveTime
-  else Result := 0;
-end;
-
-function TMinerThread.MinerLockOperations: TPCOperationsComp;
-begin
-  TPCThread.ProtectEnterCriticalSection(Self,FLock);
-  Result := FOperations;
-end;
-
-procedure TMinerThread.MinerUnLockOperations(IsNewBlock : Boolean);
-begin
-  FLock.Release;
-  if IsNewBlock then CheckIfCanRecoverBlocks;
-end;
-
-procedure TMinerThread.NotifyNewBlockFoundThreadSafe;
-begin
-  if Assigned(FOnThreadSafeNewBlockFound) then FOnThreadSafeNewBlockFound(Self,FOperations);
-end;
-
-procedure TMinerThread.SetAccountKey(const Value: TAccountKey);
-begin
-  FAccountKey := Value;
-end;
-
-initialization
-  _all_miners_play_count := 0;
-finalization
-end.

+ 3 - 2
Units/PascalCoin/UNetProtocol.pas

@@ -2135,7 +2135,7 @@ begin
           TNetData.NetData.GetNewBlockChainFromClient(Self);
         end else if (op.OperationBlock.block=TNode.Node.Bank.BlocksCount) then begin
           // New block candidate:
-          If Not TNode.Node.AddNewBlockChain(nil,Self,op,bacc,errors) then begin
+          If Not TNode.Node.AddNewBlockChain(Self,op,bacc,errors) then begin
             // Received a new invalid block... perhaps I'm an orphan blockchain
             TNetData.NetData.GetNewBlockChainFromClient(Self);
           end;
@@ -2568,7 +2568,8 @@ begin
         data.Write(nsa.last_connection,4);
       end;
       // Send client version
-      TStreamOp.WriteAnsiString(data,CT_ClientAppVersion{$IFDEF LINUX}+'l'{$ELSE}+'w'{$IFDEF Synapse}+'s'{$ENDIF}{$ENDIF}{$IFDEF OpenSSL10}+'0'{$ELSE}+'1'{$ENDIF});
+// XXXXXXXXXX      TStreamOp.WriteAnsiString(data,CT_ClientAppVersion{$IFDEF LINUX}+'l'{$ELSE}+'w'{$IFDEF FPC}+'F'{$IFDEF LCL}+'L'{$ENDIF}{$ELSE}{$IFDEF Synapse}+'s'{$ENDIF}{$ENDIF}{$IFDEF OpenSSL10}+'0'{$ELSE}+'1'{$ENDIF}{$ENDIF});
+     TStreamOp.WriteAnsiString(data,CT_ClientAppVersion{$IFDEF LINUX}+'l'{$ELSE}+'w'{$ENDIF});
     finally
       op.free;
     end;

+ 6 - 140
Units/PascalCoin/UNode.pas

@@ -30,7 +30,7 @@ unit UNode;
 interface
 
 uses
-  Classes, UBlockChain, UNetProtocol, UMiner, UAccounts, UCrypto, UThread, SyncObjs, ULog;
+  Classes, UBlockChain, UNetProtocol, UAccounts, UCrypto, UThread, SyncObjs, ULog;
 
 Type
 
@@ -44,13 +44,10 @@ Type
     FBank : TPCBank;
     FOperations : TPCOperationsComp;
     FNetServer : TNetServer;
-    FMinerThreads : TPCThreadList;
     FBCBankNotify : TPCBankNotify;
     FPeerCache : AnsiString;
     FDisabledsNewBlocksCount : Integer;
     Procedure OnBankNewBlock(Sender : TObject);
-    Procedure OnMinerThreadTerminate(Sender : TObject);
-    Procedure OnMinerNewBlockFound(sender : TMinerThread; Operations : TPCOperationsComp; Var Correct : Boolean);
     procedure SetNodeLogFilename(const Value: AnsiString);
     function GetNodeLogFilename: AnsiString;
   protected
@@ -63,15 +60,11 @@ Type
     Destructor Destroy; override;
     Property Bank : TPCBank read FBank;
     Function NetServer : TNetServer;
-    Function MinersCount : Integer;
-    Property MinerThreads : TPCThreadList read FMinerThreads;
-    Function AddMiner(AccountKey : TAccountKey) : TMinerThread;
-    Procedure DeleteMiner(index : Integer);
     Procedure NotifyNetClientMessage(Sender : TNetConnection; Const TheMessage : AnsiString);
     //
     Property Operations : TPCOperationsComp read FOperations;
     //
-    Function AddNewBlockChain(SenderMiner : TMinerThread; SenderConnection : TNetConnection; NewBlockOperations: TPCOperationsComp; var newBlockAccount: TBlockAccount; var errors: AnsiString): Boolean;
+    Function AddNewBlockChain(SenderConnection : TNetConnection; NewBlockOperations: TPCOperationsComp; var newBlockAccount: TBlockAccount; var errors: AnsiString): Boolean;
     Function AddOperations(SenderConnection : TNetConnection; Operations : TOperationsHashTree; OperationsResult : TOperationsResumeList; var errors: AnsiString): Integer;
     Function AddOperation(SenderConnection : TNetConnection; Operation : TPCOperation; var errors: AnsiString): Boolean;
     Function SendNodeMessage(Target : TNetConnection; TheMessage : AnsiString; var errors : AnsiString) : Boolean;
@@ -150,40 +143,23 @@ var _Node : TNode;
 
 { TNode }
 
-function TNode.AddMiner(AccountKey : TAccountKey) : TMinerThread;
-Var op : TPCOperationsComp;
-begin
-  Result := Nil;
-  TLog.NewLog(ltinfo,ClassName,'Creating a new miner');
-  Result := TMinerThread.Create(Bank,AccountKey,OnMinerNewBlockFound,nil);
-  Result.OnTerminate := OnMinerThreadTerminate;
-  op := Result.MinerLockOperations;
-  try
-    op.CopyFromExceptAddressKey(FOperations);
-  finally
-    Result.MinerUnLockOperations(True);
-  end;
-  FMinerThreads.Add(Result);
-end;
-
-function TNode.AddNewBlockChain(SenderMiner: TMinerThread; SenderConnection: TNetConnection; NewBlockOperations: TPCOperationsComp;
+function TNode.AddNewBlockChain(SenderConnection: TNetConnection; NewBlockOperations: TPCOperationsComp;
   var newBlockAccount: TBlockAccount; var errors: AnsiString): Boolean;
 Var i : Integer;
   operationscomp : TPCOperationsComp;
   nc : TNetConnection;
   ms : TMemoryStream;
-  mtl : TList;
   netConnectionsList : TList;
   s : String;
   errors2 : AnsiString;
 begin
   Result := false;
   if FDisabledsNewBlocksCount>0 then begin
-    TLog.NewLog(ltinfo,Classname,Format('Cannot Add new BlockChain due is adding disabled - Miner:%s Connection:%s NewBlock:%s',[Inttohex(PtrInt(SenderMiner),8),
+    TLog.NewLog(ltinfo,Classname,Format('Cannot Add new BlockChain due is adding disabled - Connection:%s NewBlock:%s',[
     Inttohex(PtrInt(SenderConnection),8),TPCOperationsComp.OperationBlockToText(NewBlockOperations.OperationBlock)]));
     exit;
   end;
-  TLog.NewLog(ltdebug,Classname,Format('AddNewBlockChain Miner:%s Connection:%s NewBlock:%s',[Inttohex(PtrInt(SenderMiner),8),
+  TLog.NewLog(ltdebug,Classname,Format('AddNewBlockChain Connection:%s NewBlock:%s',[
     Inttohex(PtrInt(SenderConnection),8),TPCOperationsComp.OperationBlockToText(NewBlockOperations.OperationBlock)]));
   If Not TPCThread.TryProtectEnterCriticalSection(Self,2000,FLockNodeOperations) then begin
     s := 'Cannot AddNewBlockChain due blocking lock operations node';
@@ -214,25 +190,6 @@ begin
     end;
     if Result then begin
       FOperations.SanitizeOperations;
-      // Notify to all clients and other miners
-      mtl := FMinerThreads.LockList;
-      try
-        for i := 0 to mtl.Count - 1 do begin
-          if (mtl[i]<>SenderMiner) then begin
-            TLog.NewLog(ltdebug,Classname,'Sending new Operations to miner '+inttostr(i+1)+'/'+inttostr(mtl.Count));
-            operationscomp := TMinerThread(mtl[i]).MinerLockOperations;
-            try
-              operationscomp.CopyFromExceptAddressKey(FOperations);
-            finally
-              TMinerThread(mtl[i]).MinerUnLockOperations(true);
-            end;
-          end else begin
-            //
-          end;
-        end;
-      finally
-        FMinerThreads.UnlockList;
-      end;
       // Notify to clients
       netConnectionsList := TNetData.NetData.ConnectionsLock;
       Try
@@ -248,35 +205,10 @@ begin
     end else begin
       // If error is on a SenderMiner its a hole
       FOperations.SanitizeOperations;
-      if Assigned(SenderMiner) then begin
-        TLog.NewLog(lterror,SenderMiner.Classname,'Invalid calculated PoW... reseting from Node Operations: '+TPCOperationsComp.OperationBlockToText(FOperations.OperationBlock));
-        operationscomp := SenderMiner.MinerLockOperations;
-        try
-          operationscomp.CopyFromExceptAddressKey(FOperations);
-        finally
-          SenderMiner.MinerUnLockOperations(true);
-        end;
-        // Reset others:
-        mtl := FMinerThreads.LockList;
-        try
-          for i := 0 to mtl.Count - 1 do begin
-            if (TMinerThread(mtl[i])<>SenderMiner) then begin
-              operationscomp := TMinerThread(mtl[i]).MinerLockOperations;
-              try
-                operationscomp.CopyFromExceptAddressKey(FOperations);
-              finally
-                TMinerThread(mtl[i]).MinerUnLockOperations(true);
-              end;
-            end;
-          end;
-        finally
-          FMinerThreads.UnlockList;
-        end;
-      end;
     end;
   finally
     FLockNodeOperations.Release;
-    TLog.NewLog(ltdebug,Classname,Format('Finalizing AddNewBlockChain Miner:%s Connection:%s NewBlock:%s',[Inttohex(PtrInt(SenderMiner),8),
+    TLog.NewLog(ltdebug,Classname,Format('Finalizing AddNewBlockChain Connection:%s NewBlock:%s',[
       Inttohex(PtrInt(SenderConnection),8),TPCOperationsComp.OperationBlockToText(NewBlockOperations.OperationBlock) ]));
   End;
   if Result then begin
@@ -357,20 +289,6 @@ begin
         end;
       end;
       if Result=0 then exit;
-      // Send to miners
-      mtl := FMinerThreads.LockList;
-      Try
-        for i := 0 to mtl.Count - 1 do begin
-          operationscomp := TMinerThread(mtl[i]).MinerLockOperations;
-          try
-            operationscomp.CopyFromExceptAddressKey(FOperations);
-          finally
-            TMinerThread(mtl[i]).MinerUnLockOperations(false);
-          end;
-        end;
-      Finally
-        FMinerThreads.UnlockList;
-      End;
       // Send to other nodes
       netConnectionsList := TNetData.NetData.ConnectionsLock;
       Try
@@ -425,7 +343,6 @@ begin
   FBCBankNotify.Bank := FBank;
   FBCBankNotify.OnNewBlock := OnBankNewBlock;
   FNetServer := TNetServer.Create;
-  FMinerThreads := TPCThreadList.Create;
   FOperations := TPCOperationsComp.Create(Self);
   FOperations.bank := FBank;
   FNotifyList := TList.Create;
@@ -479,24 +396,6 @@ begin
   until (ips_string='');
 end;
 
-procedure TNode.DeleteMiner(index: Integer);
-Var m : TMinerThread;
-  mtl : TList;
-begin
-  mtl := FMinerThreads.LockList;
-  Try
-    m := TMinerThread(mtl[index]);
-    m.Suspended := false;
-    m.Paused := false;
-    mtl.Delete(index);
-  Finally
-    FMinerThreads.UnlockList;
-  End;
-  m.Terminate;
-  m.WaitFor;
-  m.Free;
-end;
-
 destructor TNode.Destroy;
 Var step : String;
 begin
@@ -508,13 +407,8 @@ begin
     step := 'Desactivating server';
     FNetServer.Active := false;
 
-    step := 'Deleting miners';
-    while (MinersCount>0) do DeleteMiner(0);
-
     step := 'Destroying NetServer';
     FreeAndNil(FNetServer);
-    step := 'Destroying MinerThreads';
-    FreeAndNil(FMinerThreads);
 
     step := 'Destroying NotifyList';
     FreeAndNil(FNotifyList);
@@ -614,17 +508,6 @@ begin
   end;
 end;
 
-function TNode.MinersCount : Integer;
-Var mtl : TList;
-begin
-  mtl := FMinerThreads.LockList;
-  Try
-    Result := mtl.Count;
-  Finally
-    FMinerThreads.UnlockList;
-  End;
-end;
-
 function TNode.NetServer: TNetServer;
 begin
   Result := FNetServer;
@@ -798,23 +681,6 @@ begin
   FOperations.SanitizeOperations;
 end;
 
-procedure TNode.OnMinerNewBlockFound(sender: TMinerThread;
-  Operations: TPCOperationsComp; var Correct: Boolean);
-Var nba : TBlockAccount;
-  errors : AnsiString;
-begin
-  correct := true;
-  If Not AddNewBlockChain(sender,nil,Operations,nba,errors) then begin
-    Correct := false;
-    TLog.NewLog(lterror,ClassName,'Invalid block found by miner: '+errors);
-  end;
-end;
-
-procedure TNode.OnMinerThreadTerminate(Sender: TObject);
-begin
-  FMinerThreads.Remove(Sender);
-end;
-
 function TNode.SendNodeMessage(Target: TNetConnection; TheMessage: AnsiString; var errors: AnsiString): Boolean;
 Var i : Integer;
   nc : TNetConnection;

+ 7 - 2
Units/PascalCoin/UOpenSSL.pas

@@ -36,8 +36,13 @@ var
   {$ENDIF}
 {$ELSE}
   {$IFDEF FPC}
-  // Windows + Lazarus uses a OpenSSL v1.0 64 bits
-  SSL_C_LIB : AnsiString = 'libeay64.dll';
+  // Windows + Lazarus uses a OpenSSL v1.0 32 or 64 bits
+    {$ifdef CPU32}
+	SSL_C_LIB : AnsiString = 'libeay32.dll';
+    {$ENDIF}
+    {$ifdef CPU64}
+	SSL_C_LIB : AnsiString = 'libeay64.dll';
+    {$ENDIF}
   {$ELSE}
   // Windows + Delphi only allows OpenSSL v1.0 32 bits
   SSL_C_LIB : AnsiString = 'libeay32.dll';

+ 276 - 82
Units/PascalCoin/UPoolMining.pas

@@ -26,7 +26,7 @@ Uses
   {LCLIntf, LCLType, LMessages,}
 {$ENDIF}
   UTCPIP, SysUtils, UThread, SyncObjs, Classes, UJSONFunctions, UAES, UNode,
-  UCrypto, UAccounts;
+  UCrypto, UAccounts, UConst;
 
 Const
   CT_PoolMining_Method_STATUS = 'status';
@@ -45,12 +45,15 @@ Type
      target_pow : TRawBytes;
   End;
 
+  TProcessJSONObjectEvent = Procedure (json : TPCJSONObject; method : String) of object;
+
   TJSONRPCTcpIpClient = Class(TBufferedNetTcpIpClient)
   private
-    FWaitingForResponseId : Cardinal;
-    FMaxWaitingForResponseMiliseconds : Cardinal;
     FLastId : Cardinal;
+    FLockProcessBuffer : TCriticalSection;
     FReceivedBuffer : TBytes;
+    FLockReceivedBuffer : TCriticalSection;
+    FPendingResponseMessages : TPCThreadList;
   protected
   public
     Constructor Create(AOwner : TComponent); override;
@@ -58,8 +61,8 @@ Type
     Procedure SendJSONRPCErrorResponse(const id : Variant; const error : String);
     Procedure SendJSONRPCResponse(result : TPCJSONObject; const id : Variant);
     Procedure SendJSONRPCMethod(const method : String; params : TPCJSONObject; const id : Variant);
-    Function SendJSONRPCMethodAndWait(const method : String; params : TPCJSONObject; MaxWaitMiliseconds : Cardinal; resultObject : TPCJSONObject) : Boolean;
-    Function DoProcessBuffer(SenderThread : TPCThread; MaxWaitMiliseconds : Cardinal; DeleteBufferOnExit : Boolean) : TPCJSONObject;
+    Function SendJSONRPCMethodAndWait(const method : String; params : TPCJSONObject; MaxWaitMiliseconds : Cardinal; resultObject : TPCJSONObject; processEventOnInvalid : TProcessJSONObjectEvent = Nil) : Boolean;
+    Function DoProcessBuffer(SenderThread : TPCThread; MaxWaitMiliseconds : Cardinal; DeleteBufferOnExit : Boolean; var ResponseMethod : String; var jsonObject : TPCJSONObject) : Boolean;
     Function GetNewId : Cardinal;
   End;
 
@@ -74,7 +77,7 @@ Type
     Property OnMinerMustChangeValues : TNotifyEvent read FOnMinerMustChangeValues write FOnMinerMustChangeValues;
     Property MinerValuesForWork : TMinerValuesForWork read FMinerValuesForWork write SetMinerValuesForWork;
     Procedure SubmitBlockFound(Const Payload : TRawBytes; Timestamp, NOnce : Cardinal);
-    Procedure DoProcessJSONObject(json : TPCJSONObject);
+    Procedure DoProcessJSONObject(json : TPCJSONObject; ResponseMethod : String);
   End;
 
   TPoolMiningServer = Class(TNetTcpIpServer)
@@ -85,7 +88,8 @@ Type
     FMinerPayload: TRawBytes;
     FClientsWins: Integer;
     FClientsCount: Integer;
-    Procedure DoProcessJSON(json : TPCJSONObject; Client : TJSONRPCTcpIpClient);
+    FOnMiningServerNewBlockFound: TNotifyEvent;
+    Procedure DoProcessJSON(json : TPCJSONObject; ResponseMethod : String; Client : TJSONRPCTcpIpClient);
     Procedure OnNodeNewBlock(Sender : TObject);
     Procedure OnNodeOperationsChanged(Sender : TObject);
     Procedure Send_mine_values_to_all;
@@ -104,8 +108,11 @@ Type
     Procedure UpdateAccountAndPayload(AMinerAccountKey : TAccountKey; AMinerPayload : TRawBytes);
     Property ClientsCount : Integer read FClientsCount;
     Property ClientsWins : Integer read FClientsWins;
+    Property OnMiningServerNewBlockFound : TNotifyEvent read FOnMiningServerNewBlockFound write FOnMiningServerNewBlockFound;
   End;
 
+Function TBytesToString(Const bytes : TBytes):AnsiString;
+
 Const
   CT_TMinerValuesForWork_NULL : TMinerValuesForWork = (block:0;version:0;part1:'';payload_start:'';part3:'';target:0;timestamp:0;target_pow:'');
 
@@ -113,82 +120,191 @@ implementation
 
 Uses ULog, Variants, UTime, UBlockChain;
 
+Type TPendingResponseMessage = Record
+       sendDateTime : TDateTime;
+       maxDateTime : TDateTime;
+       id : Integer;
+       method : String;
+     end;
+  PPendingResponseMessage = ^TPendingResponseMessage;
+
+Function TBytesToString(Const bytes : TBytes):AnsiString;
+Var i : Integer;
+Begin
+  Result := '';
+  for i := 0 to high(bytes) do begin
+    if (bytes[i]<32) then Result := Result+'#'+IntToHex(bytes[i],2)
+    else if bytes[i]=ord('#') then Result := Result+'##'
+    else Result := Result + ansichar(bytes[i]);
+  end;
+End;
+
 { TJSONRPCTcpIpClient }
 
 constructor TJSONRPCTcpIpClient.Create(AOwner: TComponent);
 begin
   inherited;
   FLastId := 1;
-  FWaitingForResponseId := 0;
-  FMaxWaitingForResponseMiliseconds := 0;
   SetLength(FReceivedBuffer,0);
+  FLockProcessBuffer := TCriticalSection.Create;
+  FLockReceivedBuffer := TCriticalSection.Create;
+  FPendingResponseMessages := TPCThreadList.Create;
 end;
 
 destructor TJSONRPCTcpIpClient.Destroy;
+var P : PPendingResponseMessage;
+  l : TList;
+  i : Integer;
 begin
+  l := FPendingResponseMessages.LockList;
+  try
+    for i:=0 to l.count-1 do begin
+      P:=l[i];
+      Dispose(P);
+    end;
+    l.clear;
+  finally
+    FPendingResponseMessages.UnlockList;
+  end;
+  FreeAndNil(FLockReceivedBuffer);
+  FreeAndNil(FLockProcessBuffer);
   SetLength(FReceivedBuffer,0);
+  FreeAndNil(FPendingResponseMessages);
   inherited;
 end;
 
-function TJSONRPCTcpIpClient.DoProcessBuffer(SenderThread : TPCThread; MaxWaitMiliseconds : Cardinal; DeleteBufferOnExit : Boolean) : TPCJSONObject;
+function TJSONRPCTcpIpClient.DoProcessBuffer(SenderThread : TPCThread; MaxWaitMiliseconds : Cardinal; DeleteBufferOnExit : Boolean; var ResponseMethod : String; var jsonObject : TPCJSONObject) : Boolean;
 var last_bytes_read : Integer;
   jsonData : TPCJSONData;
   tc : Cardinal;
   ms : TMemoryStream;
-  pac : PAnsiChar;
-  lasti : Integer;
+  i,lasti : Integer;
   continue : Boolean;
-begin
-  Result := Nil;
-  tc := GetTickCount;
-  if Assigned(SenderThread) then continue := Not SenderThread.Terminated
-  else continue := true;
-  while (Connected) And ((GetTickCount<=(tc+MaxWaitMiliseconds)) Or (MaxWaitMiliseconds=0)) And (continue) do begin
-    last_bytes_read := 0;
-    ms := ReadBufferLock;
-    try
-      if (ms.Size)>0 then begin
-        lasti := length(FReceivedBuffer);
-        setLength(FReceivedBuffer,length(FReceivedBuffer)+ms.Size);
-        CopyMemory(@FReceivedBuffer[lasti],ms.Memory,ms.Size);
-        last_bytes_read := ms.Size;
-        ms.Size := 0;
+  procedure FlushBufferPendingMessages(doSearchId : Boolean; idValue : Integer);
+  var l : TList;
+    i : Integer;
+    P : PPendingResponseMessage;
+  Begin
+    l := FPendingResponseMessages.LockList;
+    Try
+      for i := l.count-1 downto 0 do begin
+        P := l[i];
+        if (doSearchId) And (idValue=P^.id) then begin
+          ResponseMethod:=P^.method;
+          Dispose(P);
+          l.Delete(i);
+        end else if (P^.maxDateTime<now) then begin
+          TLog.NewLog(lterror,Classname,'Deleting a Pending response message id:'+inttostr(P^.id)+' method:'+P^.method);
+          Dispose(P);
+          l.Delete(i);
+        end;
       end;
     finally
-      ReadBufferUnlock;
+      FPendingResponseMessages.UnlockList;
     end;
-    if (last_bytes_read>0) then begin
-      // Delete possible CR+LF or #0 at the end
-      while (length(FReceivedBuffer)>1) And (FReceivedBuffer[length(FReceivedBuffer)-1] in [10,13,0]) do setLength(FReceivedBuffer,length(FReceivedBuffer)-1);
-      // Decode
-      jsonData := TPCJSONData.ParseJSONValue(FReceivedBuffer);
-      if Assigned(jsonData) then begin
-        setlength(FReceivedBuffer,0);
-        if jsonData is TPCJSONObject then begin
-          Result := TPCJSONObject(jsonData);
-          exit;
-        end else begin
-          TLog.NewLog(lterror,ClassName,'Invalid JSON data: '+jsonData.ClassName);
-          jsonData.Free;
-        End;
+  end;
+var PartialBuffer : TBytes;
+  Function ProcessPartialBuffer : Boolean;
+  Var i,istart : Integer;
+    aux : TBytes;
+  begin
+    result := false;
+    i := 0; istart :=0;
+    while (i<=high(FReceivedBuffer)) do begin
+      if FReceivedBuffer[i]<32 then begin
+        if i=istart then inc(istart)
+        else break;
       end else begin
-        TLog.NewLog(ltDebug,ClassName,Format('Read %d bytes but no valid JSON inside',[last_bytes_read]));
       end;
+      inc(i);
     end;
-    sleep(1);
+    if (i>0) And (i>istart) And (i<=High(FReceivedBuffer)) then begin
+      SetLength(PartialBuffer,i-istart);
+      move(FReceivedBuffer[istart],PartialBuffer[0],i-istart);
+      // Inc i until valid char
+      while (i<=High(FReceivedBuffer)) And (FReceivedBuffer[i]<32) do inc(i);
+      // i is the first valid pos for next buffer
+      if i<=High(FReceivedBuffer) then begin
+        setlength(aux,length(FReceivedBuffer)-i);
+        move(FReceivedBuffer[i],aux[0],length(aux));
+        SetLength(FReceivedBuffer,length(aux));
+        move(aux[0],FReceivedBuffer[0],length(aux));
+      end else begin
+        // empty next buffer
+        SetLength(FReceivedBuffer,0);
+      end;
+      Result := true;
+    end;
+  end;
+var islocked : Boolean;
+begin
+  Result := false;
+  ResponseMethod := '';
+  tc := GetTickCount;
+  Repeat
+    islocked := FLockProcessBuffer.TryEnter;
+  until (islocked) Or ((GetTickCount>(tc+MaxWaitMiliseconds)) And (MaxWaitMiliseconds<>0));
+  If Not islocked then exit;
+  try
     if Assigned(SenderThread) then continue := Not SenderThread.Terminated
     else continue := true;
-  end;
-  if (length(FReceivedBuffer)>0) And (DeleteBufferOnExit) then begin
-    TLog.NewLog(lterror,ClassName,AnsiString( Format('Deleting %d bytes from buffer after waiting %d milis',[length(FReceivedBuffer),MaxWaitMiliseconds])));
-    SetLength(FReceivedBuffer,0);
+    while (Connected) And ((GetTickCount<=(tc+MaxWaitMiliseconds)) Or (MaxWaitMiliseconds=0)) And (continue) do begin
+      last_bytes_read := 0;
+      ms := ReadBufferLock;
+      try
+        if (ms.Size)>0 then begin
+          lasti := length(FReceivedBuffer);
+          setLength(FReceivedBuffer,length(FReceivedBuffer)+ms.Size);
+          CopyMemory(@FReceivedBuffer[lasti],ms.Memory,ms.Size);
+          last_bytes_read := ms.Size;
+          ms.Size := 0;
+        end;
+      finally
+        ReadBufferUnlock;
+      end;
+      If ProcessPartialBuffer then begin
+        // Decode
+        jsonData := TPCJSONData.ParseJSONValue(PartialBuffer);
+        if Assigned(jsonData) then begin
+          if jsonData is TPCJSONObject then begin
+            jsonObject.Assign(jsonData);
+            If (jsonObject.IndexOfName('id')>=0) And (jsonObject.IndexOfName('method')<0) then begin
+              // Is a Response!
+              FlushBufferPendingMessages(true,jsonObject.AsInteger('id',0));
+            end;
+            Result := true;
+            exit;
+          end else begin
+            TLog.NewLog(lterror,ClassName,'Invalid JSON class: '+jsonData.ClassName+' json: '+TBytesToString(PartialBuffer));
+            jsonData.Free;
+          End;
+        end else begin
+          TLog.NewLog(lterror,ClassName,Format('Read %d bytes but no valid JSON inside: %s',[last_bytes_read,TBytesToString(PartialBuffer)]));
+        end;
+      end;
+      sleep(1);
+      if Assigned(SenderThread) then continue := Not SenderThread.Terminated
+      else continue := true;
+    end;
+    if (length(FReceivedBuffer)>0) And (DeleteBufferOnExit) then begin
+      TLog.NewLog(lterror,ClassName,AnsiString( Format('Deleting %d bytes from buffer after waiting %d milis: %s',[length(FReceivedBuffer),MaxWaitMiliseconds,TBytesToString(FReceivedBuffer)])));
+      SetLength(FReceivedBuffer,0);
+    end;
+  finally
+    FlushBufferPendingMessages(false,0);
+    FLockProcessBuffer.Release;
   end;
 end;
 
 function TJSONRPCTcpIpClient.GetNewId: Cardinal;
 begin
-  inc(FLastId);
-  Result := FLastId;
+  FLockReceivedBuffer.Acquire;
+  try
+    inc(FLastId);
+    Result := FLastId;
+  finally
+    FLockReceivedBuffer.Release;
+  end;
 end;
 
 procedure TJSONRPCTcpIpClient.SendJSONRPCErrorResponse(const id: Variant; const error: String);
@@ -225,6 +341,8 @@ procedure TJSONRPCTcpIpClient.SendJSONRPCMethod(const method: String; params: TP
 Var json : TPCJSONObject;
   stream : TMemoryStream;
   b : Byte;
+  P : PPendingResponseMessage;
+  l : TList;
 begin
   json := TPCJSONObject.Create;
   Try
@@ -233,6 +351,15 @@ begin
       json.GetAsArray('params').GetAsObject(0).Assign(params);
     end;
     json.GetAsVariant('id').Value := id;
+    if (Not VarIsNull(id)) then begin
+      new(P);
+      P^.id:=id;
+      P^.sendDateTime:=Now;
+      P^.maxDateTime:=Now + encodetime(0,0,30,0);
+      P^.method:=method;
+      FPendingResponseMessages.Add(P);
+    end;
+    TLog.NewLog(ltdebug,Classname,'Sending JSON-RPC: '+json.ToJSON(false));
     stream := TMemoryStream.Create;
     try
       json.SaveToStream(stream);
@@ -252,23 +379,45 @@ begin
   End;
 end;
 
-function TJSONRPCTcpIpClient.SendJSONRPCMethodAndWait(const method: String; params: TPCJSONObject; MaxWaitMiliseconds: Cardinal; resultObject : TPCJSONObject) : Boolean;
+function TJSONRPCTcpIpClient.SendJSONRPCMethodAndWait(const method: String; params: TPCJSONObject; MaxWaitMiliseconds: Cardinal; resultObject : TPCJSONObject; processEventOnInvalid : TProcessJSONObjectEvent = Nil) : Boolean;
 Var nId : Cardinal;
-  tc : Cardinal;
+  tc,maxw : Cardinal;
   json : TPCJSONObject;
+  rm : String;
 begin
-  nId := GetNewId;
   Result := false;
-  SendJSONRPCMethod(method,params,nId);
-  tc := GetTickCount;
-  json := DoProcessBuffer(nil,MaxWaitMiliseconds,true);
-  if Assigned(json) then begin
-    try
-      resultObject.Assign(json);
-      Result := true;
+  FLockProcessBuffer.Acquire;
+  try
+    nId := GetNewId;
+    SendJSONRPCMethod(method,params,nId);
+    tc := GetTickCount;
+    json := TPCJSONObject.Create;
+    Try
+      repeat
+        maxw := MaxWaitMiliseconds - (GetTickCount - tc);
+        if maxw<1 then maxw := 1
+        else if maxw>10000 then maxw := 10000;
+        If DoProcessBuffer(nil,maxw,true,rm,json) then begin
+          If json.AsCardinal('id',0)=nId then begin
+            resultObject.Assign(json);
+            Result := true;
+          end else begin
+            TLog.NewLog(ltdebug,classname,'Received a unexpected JSON while waiting for response Id:'+inttostr(nId)+' Received:'+json.ToJSON(false));
+            If Assigned(processEventOnInvalid) then begin
+              TLog.NewLog(ltdebug,classname,'Sending to process unexpected JSON:'+json.ToJSON(false));
+              processEventOnInvalid(json,rm);
+            end else TLog.NewLog(ltdebug,Classname,'Lost JSON message! '+json.ToJSON(false));
+          end;
+        end;
+      until (Result) Or (GetTickCount > (tc+MaxWaitMiliseconds));
     finally
-      json.Free;
+      json.free;
+    end;
+    if (Not Result) then begin
+      TLog.NewLog(ltdebug,classname,'Not received a JSON response Id:'+inttostr(nId)+' for method:'+method);
     end;
+  finally
+    FLockProcessBuffer.Release;
   end;
 end;
 
@@ -306,6 +455,7 @@ end;
 constructor TPoolMiningServer.Create;
 begin
   inherited;
+  FOnMiningServerNewBlockFound := Nil;
   FIncomingsCounter := 0;
   FClientsWins := 0;
   FClientsCount := 0;
@@ -325,15 +475,20 @@ begin
   inherited;
 end;
 
-procedure TPoolMiningServer.DoProcessJSON(json: TPCJSONObject; Client : TJSONRPCTcpIpClient);
+procedure TPoolMiningServer.DoProcessJSON(json: TPCJSONObject; ResponseMethod : String; Client : TJSONRPCTcpIpClient);
 Var method : String;
     params : TPCJSONArray;
     id_value : Variant;
     i : Integer;
   response_result : TPCJSONObject;
 begin
-  method := json.AsString('method','');
-  params := json.GetAsArray('params');
+  If ResponseMethod<>'' then begin
+    method := ResponseMethod;
+    params := json.GetAsArray('result');
+  end else begin
+    method := json.AsString('method','');
+    params := json.GetAsArray('params');
+  end;
   i := json.IndexOfName('id');
   if i<0 then begin
     id_value := Null;
@@ -383,7 +538,7 @@ end;
 procedure TPoolMiningServer.FillMineValue(mine_values: TPCJSONObject; Client : TJSONRPCTcpIpClient);
 Var Op : TPCOperationsComp;
 begin
-  mine_values.GetAsVariant('block').Value := FNodeNotifyEvents.Node.Bank.LastBlockFound.OperationBlock.block;
+  mine_values.GetAsVariant('block').Value := FNodeNotifyEvents.Node.Bank.LastBlockFound.OperationBlock.block+1;
   mine_values.GetAsVariant('version').Value := FNodeNotifyEvents.Node.Operations.OperationBlock.protocol_version;
   Op := TPCOperationsComp.Create(Nil);
   try
@@ -439,7 +594,7 @@ begin
     p1 := nbOperations.PoW_Digest_Part1;
     p2 := nbOperations.PoW_Digest_Part2_Payload;
     p3 := nbOperations.PoW_Digest_Part3;
-    If FNodeNotifyEvents.Node.AddNewBlockChain(nil,nil,nbOperations,nba,errors) then begin
+    If FNodeNotifyEvents.Node.AddNewBlockChain(nil,nbOperations,nba,errors) then begin
       // CONGRATS !!!
       json := TPCJSONObject.Create;
       try
@@ -453,6 +608,7 @@ begin
       finally
         json.Free;
       end;
+      if Assigned(FOnMiningServerNewBlockFound) then FOnMiningServerNewBlockFound(Self);
     end else begin
       Client.SendJSONRPCErrorResponse(id,'Error: '+errors+' payload:'+nbOperations.BlockPayload+' timestamp:'+InttoStr(nbOperations.timestamp)+' nonce:'+IntToStr(nbOperations.nonce));
     end;
@@ -466,6 +622,7 @@ var bClient : TJSONRPCTcpIpClient;
   init_json : TPCJSONObject;
   jsonobj : TPCJSONObject;
   doDelete : Boolean;
+  rmethod : String;
 begin
   inherited;
   inc(FClientsCount);
@@ -483,13 +640,13 @@ begin
     End;
     while (Active) And (Client.Connected) do begin
       doDelete := bClient.LastReadTC+1000<GetTickCount;  // TODO: Protect GetTickCount overflow
-      jsonobj := bClient.DoProcessBuffer(nil,100,doDelete);
-      if assigned(jsonobj) then begin
-        try
-          DoProcessJSON(jsonobj,bClient);
-        finally
-          jsonobj.Free;
+      jsonobj := TPCJSONObject.Create;
+      try
+        if bClient.DoProcessBuffer(nil,1000,doDelete,rmethod,jsonobj) then begin
+          DoProcessJSON(jsonobj,rmethod,bClient);
         end;
+      finally
+        jsonobj.free;
       end;
       sleep(10);
     end;
@@ -574,17 +731,22 @@ begin
   inherited;
 end;
 
-procedure TPoolMinerClient.DoProcessJSONObject(json: TPCJSONObject);
+procedure TPoolMinerClient.DoProcessJSONObject(json: TPCJSONObject; ResponseMethod : String);
 Var method : String;
-    params : TPCJSONArray;
     id_value : Variant;
     i : Integer;
   params_object : TPCJSONObject;
   mvfw : TMinerValuesForWork;
 begin
   TLog.NewLog(ltdebug,ClassName,'Received JSON: '+json.ToJSON(false));
-  method := json.AsString('method','');
-  params := json.GetAsArray('params');
+  if (ResponseMethod<>'') then begin
+    method := ResponseMethod;
+    params_object := json.GetAsObject('result');
+    TLog.NewLog(ltinfo,classname,'Received response method:'+ResponseMethod+' JSON:'+json.ToJSON(false));
+  end else begin
+    method := json.AsString('method','');
+    params_object := json.GetAsArray('params').GetAsObject(0);
+  end;
   i := json.IndexOfName('id');
   if i<0 then begin
     id_value := Null;
@@ -592,7 +754,6 @@ begin
     id_value := json.GetAsVariant('id').Value;
   end;
   if method=CT_PoolMining_Method_MINER_NOTIFY then begin
-    params_object := params.GetAsObject(0);
     mvfw := CT_TMinerValuesForWork_NULL;
     mvfw.block := params_object.AsInteger('block',0);
     mvfw.version := params_object.AsInteger('version',0);
@@ -603,7 +764,7 @@ begin
     mvfw.timestamp := params_object.AsInteger('timestamp',0);
     mvfw.part1 := TCrypto.HexaToRaw(params_object.AsString('part1',''));
     mvfw.target_pow := TCrypto.HexaToRaw(params_object.AsString('target_pow',''));
-    if Not VarIsNull(id_value) then begin
+    if (Not VarIsNull(id_value)) And (ResponseMethod='') then begin
       SendJSONRPCResponse(params_object,id_value);
     end;
     MinerValuesForWork := mvfw;
@@ -611,21 +772,54 @@ begin
 end;
 
 procedure TPoolMinerClient.SetMinerValuesForWork(const Value: TMinerValuesForWork);
+Var _t : Cardinal;
+  _t_pow : TRawBytes;
 begin
   FMinerValuesForWork := Value;
+  // Check that target and target_pow are equal!
+  _t_pow := TPCBank.TargetFromCompact(FMinerValuesForWork.target);
+  if (length(FMinerValuesForWork.target_pow)=32) then begin
+    _t := TPCBank.TargetToCompact(FMinerValuesForWork.target_pow);
+    if (FMinerValuesForWork.target<CT_MinCompactTarget) then begin
+      // target has no valid value... assigning compact_target!
+      FMinerValuesForWork.target:=TPCBank.TargetToCompact(_t_pow);
+    end else if (_t_pow<>FMinerValuesForWork.target_pow) Or (_t<>FMinerValuesForWork.target) then begin
+      TLog.NewLog(ltError,Classname,'Received bad values for target and target_pow!');
+      If (FMinerValuesForWork.target<CT_MinCompactTarget) then begin
+        FMinerValuesForWork.target_pow:=TPCBank.TargetFromCompact(FMinerValuesForWork.target);
+      end else begin
+        FMinerValuesForWork.target:=TPCBank.TargetToCompact(_t_pow);
+      end;
+    end;
+  end else begin
+    if (FMinerValuesForWork.target<CT_MinCompactTarget) then begin
+      // target_pow has no value... assigning target!
+      FMinerValuesForWork.target_pow:=TPCBank.TargetFromCompact(FMinerValuesForWork.target);
+    end else begin
+      // Invalid target and compact_target
+      FMinerValuesForWork.target := CT_TMinerValuesForWork_NULL.target;
+      FMinerValuesForWork.target_pow := CT_TMinerValuesForWork_NULL.target_pow;
+    end;
+  end;
   if Assigned(FOnMinerMustChangeValues) then FOnMinerMustChangeValues(Self);
 end;
 
 procedure TPoolMinerClient.SubmitBlockFound(const Payload: TRawBytes; Timestamp, NOnce: Cardinal);
-Var json : TPCJSONObject;
+Var json, resultJSON : TPCJSONObject;
+  nOnceAsSignedInt : Int32;
 begin
   json := TPCJSONObject.Create;
   Try
+    nOnceAsSignedInt := NOnce;
     json.GetAsVariant('payload').Value := TCrypto.ToHexaString(Payload);
     json.GetAsVariant('timestamp').Value := Timestamp;
-    json.GetAsVariant('nonce').Value := NOnce;
-    SendJSONRPCMethod(CT_PoolMining_Method_MINER_SUBMIT,json,5000);
-// Example: {"method":"miner-submit","params":[{"payload":"57617368696E67746F6E3117","timestamp":1234567890,"nonce":1234}]}
+    json.GetAsVariant('nonce').Value := nOnceAsSignedInt;
+    resultJSON := TPCJSONObject.Create;
+    try
+      SendJSONRPCMethod(CT_PoolMining_Method_MINER_SUBMIT,json,GetNewId);
+    Finally
+      resultJSON.free;
+    end;
   Finally
     json.Free;
   End;

+ 377 - 0
Units/PascalCoin/USha256.pas

@@ -0,0 +1,377 @@
+unit USha256;
+
+
+{$IFDEF FPC}
+  {$MODE delphi}
+{$ENDIF}
+
+interface
+
+uses Sysutils, Classes;
+
+type
+  TSHA256HASH = array[0..7] of Cardinal;
+  TChunk = array[0..15] of Cardinal;
+
+function CalcDoubleSHA256(Msg: AnsiString): TSHA256HASH;
+function CalcSHA256(Msg: AnsiString): TSHA256HASH; overload;
+function CalcSHA256(Stream: TStream): TSHA256HASH; overload;
+function SHA256ToStr(Hash: TSHA256HASH): String;
+
+
+Function CanBeModifiedOnLastChunk(MessageTotalLength : Int64; var startBytePos : integer) : Boolean;
+Procedure PascalCoinPrepareLastChunk(Const messageToHash : AnsiString; var stateForLastChunk : TSHA256HASH; var bufferForLastChunk : TChunk);
+Function ExecuteLastChunk(const stateForLastChunk : TSHA256HASH; const bufferForLastChunk : TChunk; nPos : Integer; nOnce,Timestamp : Cardinal) : TSHA256HASH;
+Function ExecuteLastChunkAndDoSha256(Const stateForLastChunk : TSHA256HASH; const bufferForLastChunk : TChunk; nPos : Integer; nOnce,Timestamp : Cardinal) : TSHA256HASH;
+Procedure PascalCoinExecuteLastChunkAndDoSha256(Const stateForLastChunk : TSHA256HASH; const bufferForLastChunk : TChunk; nPos : Integer; nOnce,Timestamp : Cardinal; var ResultSha256 : AnsiString);
+Function Sha256HashToRaw(Const hash : TSHA256HASH) : AnsiString;
+
+implementation
+
+type
+  PChunk = ^TChunk;
+
+const
+  k: array[0..63] of Cardinal = (
+   $428a2f98, $71374491, $b5c0fbcf, $e9b5dba5, $3956c25b, $59f111f1, $923f82a4, $ab1c5ed5,
+   $d807aa98, $12835b01, $243185be, $550c7dc3, $72be5d74, $80deb1fe, $9bdc06a7, $c19bf174,
+   $e49b69c1, $efbe4786, $0fc19dc6, $240ca1cc, $2de92c6f, $4a7484aa, $5cb0a9dc, $76f988da,
+   $983e5152, $a831c66d, $b00327c8, $bf597fc7, $c6e00bf3, $d5a79147, $06ca6351, $14292967,
+   $27b70a85, $2e1b2138, $4d2c6dfc, $53380d13, $650a7354, $766a0abb, $81c2c92e, $92722c85,
+   $a2bfe8a1, $a81a664b, $c24b8b70, $c76c51a3, $d192e819, $d6990624, $f40e3585, $106aa070,
+   $19a4c116, $1e376c08, $2748774c, $34b0bcb5, $391c0cb3, $4ed8aa4a, $5b9cca4f, $682e6ff3,
+   $748f82ee, $78a5636f, $84c87814, $8cc70208, $90befffa, $a4506ceb, $bef9a3f7, $c67178f2);
+
+{$IFDEF i386}
+
+  {$IFDEF FPC}
+    {$ASMMODE intel}
+  {$ENDIF}
+
+  function ror(x: Cardinal; y: Byte): Cardinal; assembler;
+  asm
+    mov cl,dl
+    ror eax,cl
+  end;
+
+  function bswap(x: Cardinal): Cardinal; assembler;
+  asm
+    bswap eax
+  end;
+
+  function swap64(x: int64): int64; assembler;
+  asm
+    mov edx,dword ptr[x]
+    mov eax,dword ptr[x+4]
+    bswap edx
+    bswap eax
+  end;
+{$ELSE}
+  function ror(x: Cardinal; y: Byte): Cardinal;
+  begin
+    ror:=
+      (x shr y) +
+      (x shl (32-y));
+  end;
+
+  function bswap(x: Cardinal): Cardinal;
+  begin
+    bswap:=
+      ((x and $000000FF) shl 24) +
+      ((x and $0000FF00) shl  8) +
+      ((x and $00FF0000) shr  8) +
+      ((x and $FF000000) shr 24);
+  end;
+
+  function swap64(x: int64): int64;
+  begin
+    swap64:=
+      ((x and $00000000000000FF) shl 56) +
+      ((x and $000000000000FF00) shl 40) +
+      ((x and $0000000000FF0000) shl 24) +
+      ((x and $00000000FF000000) shl 8) +
+      ((x and $000000FF00000000) shr 8) +
+      ((x and $0000FF0000000000) shr 24) +
+      ((x and $00FF000000000000) shr 40) +
+      ((x and $FF00000000000000) shr 56);
+  end;
+{$ENDIF}
+
+function CalcChunk(Hash: TSHA256HASH; const Chunk: TChunk): TSHA256HASH;
+var
+  i: Integer;
+  s0, s1, maj, t1, t2, ch: Cardinal;
+  w: array[0..63] of Cardinal;
+begin
+  for i:=0 to 15 do
+    w[i]:= bswap(Chunk[i]);
+  for i:= 16 to 63 do
+  begin
+    s0:=   ror(w[i-15],7) xor ror(w[i-15],18) xor (w[i-15] shr 3);
+    s1:=   ror(w[i-2],17) xor ror(w[i-2],19) xor (w[i-2] shr 10);
+    w[i]:= w[i-16] + s0 + w[i-7] + s1;
+  end;
+  for i:= 0 to 63 do
+  begin
+    s0:=  ror(Hash[0],2) xor ror(Hash[0],13) xor ror(Hash[0],22);
+    maj:= (Hash[0] and Hash[1]) xor (Hash[0] and Hash[2]) xor (Hash[1] and Hash[2]);
+    t2:=  s0 + maj;
+    s1:=  ror(Hash[4],6) xor ror(Hash[4],11) xor ror(Hash[4],25);
+    ch:=  (Hash[4] and Hash[5]) xor ((not Hash[4]) and Hash[6]);
+    t1:=  Hash[7] + s1 + ch + k[i] + w[i];
+    Hash[7]:= Hash[6];
+    Hash[6]:= Hash[5];
+    Hash[5]:= Hash[4];
+    Hash[4]:= Hash[3] + t1;
+    Hash[3]:= Hash[2];
+    Hash[2]:= Hash[1];
+    Hash[1]:= Hash[0];
+    Hash[0]:= t1 + t2;
+  end;
+  Result:= Hash;
+end;
+
+function CalcSHA256(Msg: AnsiString): TSHA256HASH; overload;
+var
+  Stream: TMemoryStream;
+begin
+  Stream:= TMemoryStream.Create;
+  try
+    Stream.WriteBuffer(PAnsiChar(Msg)^,Length(Msg));
+    Stream.Position:= 0;
+    Result:= CalcSHA256(Stream);
+  finally
+    Stream.Free;
+  end;
+end;
+
+function CalcDoubleSHA256(Msg: AnsiString): TSHA256HASH;
+var
+  Stream: TMemoryStream;
+  m : AnsiString;
+begin
+  Stream:= TMemoryStream.Create;
+  try
+    Stream.WriteBuffer(PAnsiChar(Msg)^,Length(Msg));
+    Stream.Position:= 0;
+    m := Sha256HashToRaw(CalcSHA256(Stream));
+    Stream.size := 0;
+    Stream.WriteBuffer(m[1],32);
+    Stream.Position:= 0;
+    Result := CalcSHA256(Stream);
+  finally
+    Stream.Free;
+  end;
+End;
+
+Const
+  rSha256 : Array[0..7] of Cardinal =
+   ($6a09e667,$bb67ae85,$3c6ef372,$a54ff53a,$510e527f,$9b05688c,$1f83d9ab,$5be0cd19);
+
+function CalcSHA256(Stream: TStream): TSHA256HASH; overload;
+var
+  i,j,k: Integer;
+  Size: int64;
+  P: PAnsiChar;
+  Chunk: PChunk;
+  H: TSHA256HASH;
+  PBuffer : Array[0..127] of byte;
+begin
+  Result[0]:= rSha256[0];
+  Result[1]:= rSha256[1];
+  Result[2]:= rSha256[2];
+  Result[3]:= rSha256[3];
+  Result[4]:= rSha256[4];
+  Result[5]:= rSha256[5];
+  Result[6]:= rSha256[6];
+  Result[7]:= rSha256[7];
+  Size:= 0;
+  // Positioning P to buffer start
+  P := @PBuffer[0];
+  Chunk:= PChunk(P);
+  // Fill
+  FillChar(P^,64*2,#0);
+  // Read first
+  i:= Stream.Read(P^,64);
+  while i = 64 do begin
+    H:= CalcChunk(Result,Chunk^);
+    for k:= 0 to 7 do
+      Result[k]:= Result[k] + H[k];
+    inc(Size,i);
+    FillChar(P^,64*2,#0);
+    i:= Stream.Read(P^,64);
+  end;
+  inc(Size,i);
+  P[i]:= #$80;
+  j:= i + 9;
+  if j mod 64 > 0 then
+   inc(j,64 - (j mod 64));
+  Size:= swap64(Size*8);
+  move(Size,P[j-8],8);
+  for i:= 1 to j div 64 do
+  begin
+    H:= CalcChunk(Result,Chunk^);
+    for k:= 0 to 7 do
+      Result[k]:= Result[k] + H[k];
+    inc(Chunk);
+  end;
+end;
+
+function SHA256ToStr(Hash: TSHA256HASH): String;
+var
+  i: Integer;
+begin
+  Result:= EmptyStr;
+  for i:= 0 to 6 do
+    Result:= Result + IntToHex(Hash[i],8) + #32;
+  Result:= Result + IntToHex(Hash[7],8);
+end;
+
+Function CanBeModifiedOnLastChunk(MessageTotalLength : Int64; var startBytePos : integer) : Boolean;
+Begin
+  { Sha256 process each round 512 bits (64 bytes)
+    Timestamp and nOnce are last 8 bytes of digest message, so must be processed on last round
+    last round, includes a reserved 9 bytes at the end :
+     - 1 byte for $80 (1 bit left padded)
+     - 8 bytes for length of digest message in bits
+    Start byte pos can be a number between 0..63 - (9 reserved bytes) = 0..54
+    Also, start byte must be MOD 4=0 because each value is 4 bytes in Sha256 calcs, so must discard last 4 bytes of left padded bit 0..51
+    Finally: Value between 0..51 and (MOD 4=0)
+    Valid values are: 0,4,8,12,16,20,24,28,32,36,40,44,48 = TOTAL 12 valid values of 64
+    }
+  startBytePos := (((((MessageTotalLength)*8)+72) MOD 512) DIV 8) - (8+9);
+  Result := (startBytePos >= 0) And ((startBytePos MOD 4)=0) And (startBytePos<=48);
+End;
+
+Procedure PascalCoinPrepareLastChunk(Const messageToHash : AnsiString; var stateForLastChunk : TSHA256HASH; var bufferForLastChunk : TChunk);
+var
+  i,j,k,iPos: Integer;
+  Size: int64;
+  P: PAnsiChar;
+  Chunk: PChunk;
+  H: TSHA256HASH;
+  PBuffer : Array[0..127] of byte;
+begin
+  //Will produce the TSHA256HASH ready for the last chunk
+  stateForLastChunk[0]:= rSha256[0];
+  stateForLastChunk[1]:= rSha256[1];
+  stateForLastChunk[2]:= rSha256[2];
+  stateForLastChunk[3]:= rSha256[3];
+  stateForLastChunk[4]:= rSha256[4];
+  stateForLastChunk[5]:= rSha256[5];
+  stateForLastChunk[6]:= rSha256[6];
+  stateForLastChunk[7]:= rSha256[7];
+  Size:= 0;
+  // Positioning P to buffer start
+  P := @PBuffer[0];
+  Chunk:= PChunk(P);
+  iPos := 0;
+  Repeat
+    FillChar(P^,64*2,#0);
+    i := length(messageToHash) - iPos;
+    if (i > 64) then i:=64;
+    Move(messageToHash[iPos+1],P[0],i);
+    if (i = 64) then
+    begin
+      inc(iPos,i);
+      H:= CalcChunk(stateForLastChunk,Chunk^);
+      for k:= 0 to 7 do
+        stateForLastChunk[k]:= stateForLastChunk[k] + H[k];
+      inc(Size,i);
+    end;
+  Until i<>64;
+  inc(Size,i);
+  P[i]:= #$80;
+  j:= i + 9;
+  if j mod 64 > 0 then
+   inc(j,64 - (j mod 64));
+  Size:= swap64(Size*8);
+  move(Size,P[j-8],8);
+  if (j div 64)>1 then begin
+    H:= CalcChunk(stateForLastChunk,Chunk^);
+    for k:= 0 to 7 do
+      stateForLastChunk[k]:= stateForLastChunk[k] + H[k];
+    inc(Chunk);
+  end;
+  FillChar(bufferForLastChunk,64,#0);
+  move(Chunk[0],bufferForLastChunk,64);
+end;
+
+
+Function ExecuteLastChunk(const stateForLastChunk : TSHA256HASH; const bufferForLastChunk : TChunk; nPos : Integer; nOnce,Timestamp : Cardinal) : TSHA256HASH;
+Var
+  bflc : TChunk;
+  P : PAnsiChar;
+  H: TSHA256HASH;
+  k : Integer;
+Begin
+  move(bufferForLastChunk[0],bflc[0],16*4);
+  P := @bflc[0];
+  move(Timestamp,P[nPos],4);
+  move(nOnce,P[nPos+4],4);
+  H := CalcChunk(stateForLastChunk,bflc);
+  for k:= 0 to 7 do
+    Result[k]:= stateForLastChunk[k] + H[k];
+End;
+
+Function ExecuteLastChunkAndDoSha256(Const stateForLastChunk : TSHA256HASH; const bufferForLastChunk : TChunk; nPos : Integer; nOnce,Timestamp : Cardinal) : TSHA256HASH;
+var
+  i,k: Integer;
+  Size: int64;
+  P: PAnsiChar;
+  Chunk: PChunk;
+  H,HSwapped: TSHA256HASH;
+  PBuffer : Array[0..127] of byte;
+Begin
+  H := ExecuteLastChunk(stateForLastChunk,bufferForLastChunk,nPos,nOnce,Timestamp);
+  // Prepare for a SHA256 with a single chunk on 32 bytes
+  Result[0]:= rSha256[0];
+  Result[1]:= rSha256[1];
+  Result[2]:= rSha256[2];
+  Result[3]:= rSha256[3];
+  Result[4]:= rSha256[4];
+  Result[5]:= rSha256[5];
+  Result[6]:= rSha256[6];
+  Result[7]:= rSha256[7];
+  Size:= 0;
+  // Positioning P to buffer start
+  P := @PBuffer[0];
+  Chunk:= PChunk(P);
+  FillChar(P^,64,#0);
+  for i := 0 to 7 do begin
+    HSwapped[i] := bSwap(H[i]);
+  end;
+  Move(HSwapped[0],P[0],32);
+  // Adding 1 bit
+  P[32]:= #$80;
+  // Save size as bigendian to the end
+  Size := swap64(32*8);
+  move(Size,P[56],8);
+  H:= CalcChunk(Result,Chunk^);
+  for k:= 0 to 7 do
+    Result[k]:= Result[k] + H[k];
+End;
+
+Procedure PascalCoinExecuteLastChunkAndDoSha256(Const stateForLastChunk : TSHA256HASH; const bufferForLastChunk : TChunk; nPos : Integer; nOnce,Timestamp : Cardinal; var ResultSha256 : AnsiString);
+Var  H: TSHA256HASH;
+Begin
+  H := ExecuteLastChunkAndDoSha256(stateForLastChunk,bufferForLastChunk,nPos,nOnce,Timestamp);
+  ResultSha256 := Sha256HashToRaw(H);
+End;
+
+Function Sha256HashToRaw(Const hash : TSHA256HASH) : AnsiString;
+var i: Integer;
+  c : Cardinal;
+begin
+  SetLength(Result,32);
+  for i:= 0 to 7 do begin
+    c := hash[i];
+    Result[4+(i*4)] := AnsiChar(c MOD 256);
+    Result[3+(i*4)] := AnsiChar((c SHR 8) MOD 256);
+    Result[2+(i*4)] := AnsiChar((c SHR 16) MOD 256);
+    Result[1+(i*4)] := AnsiChar((c SHR 24) MOD 256);
+  end;
+End;
+
+
+end.

+ 2 - 0
Units/PascalCoin/UTCPIP.pas

@@ -19,6 +19,8 @@ interface
   {$mode objfpc}
 {$ENDIF}
 
+{$I config.inc}
+
 {.$DEFINE DelphiSockets}
 {$DEFINE Synapse}
 {$IFDEF DelphiSockets}{$IFDEF Synapse}DelphiSockets and Synapse are defined! Choose one!{$ENDIF}{$ENDIF}

+ 7 - 0
Units/PascalCoin/config.inc

@@ -29,10 +29,17 @@
   {.$DEFINE Synapse_OpenSSLv10}
   {.$DEFINE Synapse_OpenSSLv11}
 
+  {$DEFINE PRODUCTION}
+  {.$DEFINE TESTNET}
+
 { ********************************************************************
   Don't touch more code, it will addapt based on your preferences
   ******************************************************************** }
 
+{$IFDEF TESTNET}{$IFDEF PRODUCTION}
+ERROR: You must select ONLY ONE option: PRODUCTION or TESTNET
+{$ENDIF}{$ELSE}{$DEFINE PRODUCTION}{$ENDIF}
+
 {$IFNDEF OPTIONS_BY_DEFAULT}{$IFNDEF DelphiSockets_OpenSSLv10}{$IFNDEF Synapse_OpenSSLv10}{$IFNDEF Synapse_OpenSSLv11}
 ERROR: You must select ONE option!
 {$ENDIF}{$ENDIF}{$ENDIF}{$ENDIF}

+ 6 - 0
Units/Utils/UFolderHelper.pas

@@ -65,6 +65,8 @@ uses
 {$ENDIF}
   SysUtils;
 
+{$I .\..\PascalCoin\config.inc}
+
 {$IFnDEF FPC}
 function SHGetFolderPath(hwnd: HWND; csidl: Integer; hToken: THandle;
   dwFlags: DWord; pszPath: LPWSTR): HRESULT; stdcall;
@@ -98,7 +100,11 @@ end;
 
 class function TFolderHelper.GetPascalCoinDataFolder: string;
 begin
+  {$IFDEF TESTNET}
+  Result := GetAppDataFolder+PathDelim+'PascalCoin_TESTNET';
+  {$ELSE}
   Result := GetAppDataFolder+PathDelim+'PascalCoin';
+  {$ENDIF}
 end;
 
 class function TFolderHelper.GetTFileVersionInfo(Const FileName: String): TFileVersionInfo;