Browse Source

Build 1.0.7

Introducint JSON-RPC for GPU mining
PascalCoin 8 years ago
parent
commit
ee3e16e0fb

+ 125 - 0
HOWTO_DEVELOP_GPU_MINER_FOR_PASCALCOIN.txt

@@ -0,0 +1,125 @@
+What do you need to develop a GPU miner for PascalCoin
+
+
+(If you like it, make a donation to PascalCoin project: BTC 16K3HCZRhFUtM8GdWRcfKeaa6KsuyxZaYk ... Thanks! The PascalCoin dev.)
+
+
+**************************
+First:
+**************************
+- Download and install a PascalCoin node Build 1.0.7   (Released on 2016-10-10, perhaps there are some newer versions when you read this)
+- Execute it and Wait until ready (downloaded blockhain)
+- Configure it (options menu) with you preferred ports, and include a Miner name
+- Open JSON-RPC Server miner port (By default 4009)
+
+**************************
+Second:  Test JSON-RPC server
+**************************
+- Open a telnet terminal (for example, Putty)
+- Connect with your Application with telnet mode (By default, localhost and port 4009)
+- You will receive a "miner-notify" message written in JSON-RPC (version 1.0)
+
+Example of JSON-RPC received: (Note: JSON-RPC has no whitespaces)
+{"method":"miner-notify","params":[{"block":20110,"version":1,"part1":"8F4E0000C                     A022000DC01BE5ACD50092CA653D0763CCCE7A9E408908B2F7D177C080C78186D3558FC2000A48CE                     C0E7031689D40AF8C7C73330E06E27788F0339729F53A3AF4ED47C2E45040420F000000000001000                     000B74D7926","payload_start":"546573744A534F4E32","part3":"0D1F997AB584AF8A86476                     135A9F091073A3FE28A6A07D4112BF8595144F0E666E3B0C44298FC1C149AFBF4C8996FB92427AE4                     1E4649B934CA495991B7852B85500000000","target":645483959,"target_pow":"0000000003                     0D6490000000000000000000000000000000000000000000000000","timestamp":1476103385}]                     
+,"id":null}
+
+- while connected, everytime a change in PoW calculation is produced, you will receive a "miner-notify" message
+
+**************************
+Third:  Try sending "miner-submit" messages to the server
+**************************
+
+"miner-submit" JSON-RPC messages are to notify server a valid PoW found... and integrate to the block.
+
+- In Telnet, try to send this messages:
+
+EXAMPLE 1: Send first "miner-submit" message (copy/paste)
+SEND --> {"method":"miner-submit","params":[{"payload":"5744","timestamp":1234567890,"nonce":1234}]}
+
+And you will receive a message similar to this:
+RECEIVE <--- {"result":null,"error":"Invalid payload (WD). Need start with: TestJSON","id":null}
+
+Explanation: You received a JSON-RPC error. Error is explained in plain text. In above example, you've sent a "miner-submit" message with a not valid payload. Note that payload must be equal or greater than param "payload_start" provided on a "miner-notify" message.
+
+EXAMPLE 2:
+Now we will correct example 1, sending this message: (copy/paste)
+SEND --> {"method":"miner-submit","params":[{"payload":"546573744A534F4E32","timestamp":1234567890,"nonce":1234}]}
+
+You will receive a message similar tho this:
+RECEIVE <-- {"result":null,"error":"Error: Invalid timestamp (New timestamp:1234567890 last timestamp (20110):1476103364)","id":null}
+Explanation: timestamp provided is invalid, because its lower than "1476103364" (JSON-RPC server time)
+So: Remember that server and clients must be time syncrhonized!
+
+EXAMPLE 3:
+Now we will correct example 1 and 2, sending this message: (copy/paste)
+SEND --> {"method":"miner-submit","params":[{"payload":"546573744A534F4E32","timestamp":1476106610,"nonce":1234}]}
+RECEIVE <-- {"result":null,"error":"Error: Invalid timestamp (Future time 1476106610-1476105971=639 > 180)","id":null}
+This error is similar to Example 2, but in this case we have sent a invalid timestamp, greater than 180 seconds than server time
+
+EXAMPLE 4:
+Sending a valid timestamp sending this message: (copy/paste)
+SEND --> {"method":"miner-submit","params":[{"payload":"546573744A534F4E32","timestamp":1476106050,"nonce":1234}]}
+RECEIVE <-- {"result":null,"error":"Error: Proof of work is higher than target","id":null}
+This is a valid PoW. So... your payload is good, your timestamp is good, but your nonce is not good
+
+EXAMPLE 5:
+Sending an invalid JSON-RPC... you will not receive anything
+SEND --> {"no_method":"bla","params":[{"payload":"546573744A534F4E32","timestamp":1476106050,"nonce":1234}]}
+RECEIVE <-- (... Anything ...)
+You will not receive anything because this JSON is not a JSON-RPC (standard 1.0). It must include "method" param!
+Server will log this event, and delete its buffer, but you will still be connected... Try again with a "method" param
+
+EXAMPLE 6:
+Sending a valid JSON-RPC... but invalid method:
+SEND --> {"method":"INCORRECTa","params":[{"payload":"546573744A534F4E32","timestamp":1476106050,"nonce":1234}]}
+RECEIVE <-- (... Anything ...)
+You will not receive anything because this is a JSON-RPC with a "method" but WITHOUT "id"
+
+EXAMPLE 7:
+Sending a valid JSON-RPC... but invalid method and including "id"
+SEND --> {"method":"NONE","params":[{"payload":"546573744A534F4E32","timestamp":1476106050,"nonce":1234}],"id":999}
+RECEIVE <-- {"result":null,"error":"method not found: NONE","id":999}
+This indicates that method "NONE" is not a valid method
+
+
+**************************
+Third:  How to generate a valid nonce
+**************************
+
+Take a look at "miner-notify" params (message received from server)
+
+{"method":"miner-notify","params":[{"block":20110,"version":1,"part1":"8F4E0000C                     A022000DC01BE5ACD50092CA653D0763CCCE7A9E408908B2F7D177C080C78186D3558FC2000A48CE                     C0E7031689D40AF8C7C73330E06E27788F0339729F53A3AF4ED47C2E45040420F000000000001000                     000B74D7926","payload_start":"546573744A534F4E32","part3":"0D1F997AB584AF8A86476                     135A9F091073A3FE28A6A07D4112BF8595144F0E666E3B0C44298FC1C149AFBF4C8996FB92427AE4                     1E4649B934CA495991B7852B85500000000","target":645483959,"target_pow":"0000000003                     0D6490000000000000000000000000000000000000000000000000","timestamp":1476103385}]                     
+,"id":null}
+
+You need this params:
+"block": This is the next block number to generate... you will not use it
+"version": This is the PascalCoin core version. If in future it changes... you would need to develop a new GPU miner... check that allways is 1
+"part1" : This is a Hexa string, you must convert it to RAW and store to a buffer called "buffer_part1"
+"payload_start": This is the miner name included in the payload when mining. You can ADD characters (only from ASCII from 23 to 255). Store it in a buffer "buffer_payload"
+"part3" : equal to part1
+"timestamp": This is the server timestamp. You must use allways a timestamp equal or higher than the server... so... be synchronized
+"target_pow": This is a hexa string with the PoW target you must to generate
+"target": This is the target in original format. You will not use it.
+
+
+Then, your GPU miner, must do this:
+
+Create a buffer with:
+"buffer_part1" + "buffer_payload" + "buffer_part3" + UNIX_TIMESTAMP + NONCE
+(UNIX_TIMESTAMP and NONCE are 32bits unsigned integers, saved in LITTLE ENDIAN)
+
+Make a Double SHA512 and save it to "buffer_pow"
+
+Check if "buffer_pow" is lower or equal to "target_pow" provided by server in "miner-notify"
+
+If NO, then create a new buffer changing NONCE or UNIX_TIMESAMP (or also, adding valid ASCII chars to buffer_payload), and check again
+If YES: Submit a "miner-submit" like example 4... and check if you win
+
+
+THAT'S ALL!!!
+
+If you like it, make a donation to PascalCoin project: BTC 16K3HCZRhFUtM8GdWRcfKeaa6KsuyxZaYk
+
+
+
+Thanks!!!

+ 5 - 2
PascalCoinWallet.dpr

@@ -6,7 +6,6 @@ uses
   UCrypto in 'Units\PascalCoin\UCrypto.pas',
   UCrypto in 'Units\PascalCoin\UCrypto.pas',
   UTime in 'Units\PascalCoin\UTime.pas',
   UTime in 'Units\PascalCoin\UTime.pas',
   UWalletKeys in 'Units\PascalCoin\UWalletKeys.pas',
   UWalletKeys in 'Units\PascalCoin\UWalletKeys.pas',
-  UMiner in 'Units\PascalCoin\UMiner.pas',
   UOpTransaction in 'Units\PascalCoin\UOpTransaction.pas',
   UOpTransaction in 'Units\PascalCoin\UOpTransaction.pas',
   UNetProtocol in 'Units\PascalCoin\UNetProtocol.pas',
   UNetProtocol in 'Units\PascalCoin\UNetProtocol.pas',
   UAccounts in 'Units\PascalCoin\UAccounts.pas',
   UAccounts in 'Units\PascalCoin\UAccounts.pas',
@@ -29,7 +28,11 @@ uses
   UFRMPayloadDecoder in 'Units\Forms\UFRMPayloadDecoder.pas' {FRMPayloadDecoder},
   UFRMPayloadDecoder in 'Units\Forms\UFRMPayloadDecoder.pas' {FRMPayloadDecoder},
   UFRMNodesIp in 'Units\Forms\UFRMNodesIp.pas' {FRMNodesIp},
   UFRMNodesIp in 'Units\Forms\UFRMNodesIp.pas' {FRMNodesIp},
   UDBGridUtils in 'Units\Utils\UDBGridUtils.pas',
   UDBGridUtils in 'Units\Utils\UDBGridUtils.pas',
-  UTCPIP in 'Units\PascalCoin\UTCPIP.pas';
+  UTCPIP in 'Units\PascalCoin\UTCPIP.pas',
+  UJSONFunctions in 'Units\Utils\UJSONFunctions.pas',
+  URPC in 'Units\PascalCoin\URPC.pas',
+  UPoolMining in 'Units\PascalCoin\UPoolMining.pas',
+  UMiner in 'Units\PascalCoin\UMiner.pas';
 
 
 {$R *.res}
 {$R *.res}
 
 

BIN
PascalCoinWallet.res


+ 7 - 0
README.md

@@ -38,6 +38,13 @@ If you like it, consider a donation using BitCoin:
 
 
 History:
 History:
 
 
+Build 1.0.7.0 - 2016-10-10
+--------------------------
+- Introducing basic JSON-RPC to allow GPU miners development (Third party).
+- See file "HOWTO_DEVELOP_GPU_MINER_FOR_PASCALCOIN.txt"
+- No more CPU mining due exists GPU mining
+
+
 Build 1.0.6.0 - 2016-10-04
 Build 1.0.6.0 - 2016-10-04
 --------------------------
 --------------------------
 - Memory leaks corrections
 - Memory leaks corrections

+ 14 - 0
README.txt

@@ -38,6 +38,20 @@ If you like it, consider a donation using BitCoin:
 
 
 History:
 History:
 
 
+Build 1.0.7.0 - 2016-10-10
+--------------------------
+- Introducing basic JSON-RPC to allow GPU miners development (Third party).
+- See file "HOWTO_DEVELOP_GPU_MINER_FOR_PASCALCOIN.txt"
+- No more CPU mining due exists GPU mining
+
+
+Build 1.0.6.0 - 2016-10-04
+--------------------------
+- Memory leaks corrections
+- Introducing net protocol 2-3
+- Source code modified, next build will be compiled with Lazarus and FPC
+
+
 Build 1.0.5.0 - 2016-09-21
 Build 1.0.5.0 - 2016-09-21
 --------------------------
 --------------------------
 - Massive operations, selecting multiple accounts
 - Massive operations, selecting multiple accounts

+ 10 - 10
Units/Forms/UFRMPascalCoinWalletConfig.dfm

@@ -61,23 +61,23 @@ object FRMPascalCoinWalletConfig: TFRMPascalCoinWalletConfig
   object Label5: TLabel
   object Label5: TLabel
     Left = 30
     Left = 30
     Top = 176
     Top = 176
-    Width = 58
+    Width = 73
     Height = 13
     Height = 13
-    Caption = 'CPUs to use'
+    Caption = 'JSON-RPC Port'
   end
   end
-  object lblMaxCPUS: TLabel
+  object lblDefaultJSONRPCMinerServerPort: TLabel
     Left = 248
     Left = 248
     Top = 176
     Top = 176
     Width = 70
     Width = 70
     Height = 13
     Height = 13
     Caption = '(Default XXXX)'
     Caption = '(Default XXXX)'
   end
   end
-  object cbAutomaticMiningWhenConnectedToNodes: TCheckBox
+  object cbJSONRPCMinerServerActive: TCheckBox
     Left = 15
     Left = 15
     Top = 150
     Top = 150
     Width = 261
     Width = 261
     Height = 17
     Height = 17
-    Caption = 'Allow automatic mining when connected to nodes'
+    Caption = 'JSON-RPC Server Miner (TCP/IP, no HTTP)'
     TabOrder = 4
     TabOrder = 4
   end
   end
   object ebDefaultFee: TEdit
   object ebDefaultFee: TEdit
@@ -234,19 +234,19 @@ object FRMPascalCoinWalletConfig: TFRMPascalCoinWalletConfig
     Caption = 'Show modal messages'
     Caption = 'Show modal messages'
     TabOrder = 13
     TabOrder = 13
   end
   end
-  object udCPUs: TUpDown
+  object udJSONRPCMinerServerPort: TUpDown
     Left = 226
     Left = 226
     Top = 173
     Top = 173
     Width = 16
     Width = 16
     Height = 21
     Height = 21
-    Associate = ebCPUs
+    Associate = ebJSONRPCMinerServerPort
     Min = 1
     Min = 1
-    Max = 6
+    Max = 40000
     Position = 1
     Position = 1
     TabOrder = 6
     TabOrder = 6
     Thousands = False
     Thousands = False
   end
   end
-  object ebCPUs: TEdit
+  object ebJSONRPCMinerServerPort: TEdit
     Left = 170
     Left = 170
     Top = 173
     Top = 173
     Width = 56
     Width = 56
@@ -260,7 +260,7 @@ object FRMPascalCoinWalletConfig: TFRMPascalCoinWalletConfig
     Top = 200
     Top = 200
     Width = 334
     Width = 334
     Height = 121
     Height = 121
-    Caption = ' Miner Private Key: '
+    Caption = ' Miner Server Private Key: '
     TabOrder = 14
     TabOrder = 14
     object rbGenerateANewPrivateKeyEachBlock: TRadioButton
     object rbGenerateANewPrivateKeyEachBlock: TRadioButton
       Left = 20
       Left = 20

+ 12 - 10
Units/Forms/UFRMPascalCoinWalletConfig.pas

@@ -21,7 +21,7 @@ uses
 
 
 type
 type
   TFRMPascalCoinWalletConfig = class(TForm)
   TFRMPascalCoinWalletConfig = class(TForm)
-    cbAutomaticMiningWhenConnectedToNodes: TCheckBox;
+    cbJSONRPCMinerServerActive: TCheckBox;
     ebDefaultFee: TEdit;
     ebDefaultFee: TEdit;
     Label1: TLabel;
     Label1: TLabel;
     cbSaveLogFiles: TCheckBox;
     cbSaveLogFiles: TCheckBox;
@@ -38,9 +38,9 @@ type
     Label4: TLabel;
     Label4: TLabel;
     cbShowModalMessages: TCheckBox;
     cbShowModalMessages: TCheckBox;
     Label5: TLabel;
     Label5: TLabel;
-    udCPUs: TUpDown;
-    ebCPUs: TEdit;
-    lblMaxCPUS: TLabel;
+    udJSONRPCMinerServerPort: TUpDown;
+    ebJSONRPCMinerServerPort: TEdit;
+    lblDefaultJSONRPCMinerServerPort: TLabel;
     gbMinerPrivateKey: TGroupBox;
     gbMinerPrivateKey: TGroupBox;
     rbGenerateANewPrivateKeyEachBlock: TRadioButton;
     rbGenerateANewPrivateKeyEachBlock: TRadioButton;
     rbUseARandomKey: TRadioButton;
     rbUseARandomKey: TRadioButton;
@@ -75,6 +75,8 @@ Var df : Int64;
   mpk : TMinerPrivateKey;
   mpk : TMinerPrivateKey;
   i : Integer;
   i : Integer;
 begin
 begin
+  if udInternetServerPort.Position = udJSONRPCMinerServerPort.Position then raise Exception.Create('Server port and JSON-RPC Server miner port are equal!');
+
   if TAccountComp.TxtToMoney(ebDefaultFee.Text,df) then begin
   if TAccountComp.TxtToMoney(ebDefaultFee.Text,df) then begin
     AppParams.ParamByName[CT_PARAM_DefaultFee].SetAsInt64(df);
     AppParams.ParamByName[CT_PARAM_DefaultFee].SetAsInt64(df);
   end else begin
   end else begin
@@ -91,14 +93,15 @@ begin
     if (i<0) Or (i>=FWalletKeys.Count) then raise Exception.Create('Invalid private key');
     if (i<0) Or (i>=FWalletKeys.Count) then raise Exception.Create('Invalid private key');
     AppParams.ParamByName[CT_PARAM_MinerPrivateKeySelectedPublicKey].SetAsString( TAccountComp.AccountKey2RawString( FWalletKeys.Key[i].AccountKey ) );
     AppParams.ParamByName[CT_PARAM_MinerPrivateKeySelectedPublicKey].SetAsString( TAccountComp.AccountKey2RawString( FWalletKeys.Key[i].AccountKey ) );
   end else mpk := mpk_Random;
   end else mpk := mpk_Random;
+
   AppParams.ParamByName[CT_PARAM_MinerPrivateKeyType].SetAsInteger(integer(mpk));
   AppParams.ParamByName[CT_PARAM_MinerPrivateKeyType].SetAsInteger(integer(mpk));
-  AppParams.ParamByName[CT_PARAM_AutomaticMineWhenConnectedToNodes].SetAsBoolean(cbAutomaticMiningWhenConnectedToNodes.Checked );
+  AppParams.ParamByName[CT_PARAM_JSONRPCMinerServerActive].SetAsBoolean(cbJSONRPCMinerServerActive.Checked );
   AppParams.ParamByName[CT_PARAM_SaveLogFiles].SetAsBoolean(cbSaveLogFiles.Checked );
   AppParams.ParamByName[CT_PARAM_SaveLogFiles].SetAsBoolean(cbSaveLogFiles.Checked );
   AppParams.ParamByName[CT_PARAM_ShowLogs].SetAsBoolean(cbShowLogs.Checked );
   AppParams.ParamByName[CT_PARAM_ShowLogs].SetAsBoolean(cbShowLogs.Checked );
   AppParams.ParamByName[CT_PARAM_SaveDebugLogs].SetAsBoolean(cbSaveDebugLogs.Checked);
   AppParams.ParamByName[CT_PARAM_SaveDebugLogs].SetAsBoolean(cbSaveDebugLogs.Checked);
   AppParams.ParamByName[CT_PARAM_MinerName].SetAsString(ebMinerName.Text);
   AppParams.ParamByName[CT_PARAM_MinerName].SetAsString(ebMinerName.Text);
   AppParams.ParamByName[CT_PARAM_ShowModalMessages].SetAsBoolean(cbShowModalMessages.Checked);
   AppParams.ParamByName[CT_PARAM_ShowModalMessages].SetAsBoolean(cbShowModalMessages.Checked);
-  AppParams.ParamByName[CT_PARAM_MaxCPUs].SetAsInteger(udCPUs.Position);
+  AppParams.ParamByName[CT_PARAM_JSONRPCMinerServerPort].SetAsInteger(udJSONRPCMinerServerPort.Position);
 end;
 end;
 
 
 procedure TFRMPascalCoinWalletConfig.bbUpdatePasswordClick(Sender: TObject);
 procedure TFRMPascalCoinWalletConfig.bbUpdatePasswordClick(Sender: TObject);
@@ -142,8 +145,7 @@ begin
   ebMinerName.Text := '';
   ebMinerName.Text := '';
   bbUpdatePassword.Enabled := false;
   bbUpdatePassword.Enabled := false;
   UpdateWalletConfig;
   UpdateWalletConfig;
-  udCPUs.Max := CPUCount;
-  lblMaxCPUS.Caption := '(Avail. '+inttostr(CPUCount)+' cpu''s)';
+  lblDefaultJSONRPCMinerServerPort.Caption := Format('(Default %d)',[CT_JSONRPCMinerServer_Port]);
 end;
 end;
 
 
 procedure TFRMPascalCoinWalletConfig.SetAppParams(const Value: TAppParams);
 procedure TFRMPascalCoinWalletConfig.SetAppParams(const Value: TAppParams);
@@ -154,7 +156,7 @@ begin
   Try
   Try
     udInternetServerPort.Position := AppParams.ParamByName[CT_PARAM_InternetServerPort].GetAsInteger(CT_NetServer_Port);
     udInternetServerPort.Position := AppParams.ParamByName[CT_PARAM_InternetServerPort].GetAsInteger(CT_NetServer_Port);
     ebDefaultFee.Text := TAccountComp.FormatMoney(AppParams.ParamByName[CT_PARAM_DefaultFee].GetAsInt64(0));
     ebDefaultFee.Text := TAccountComp.FormatMoney(AppParams.ParamByName[CT_PARAM_DefaultFee].GetAsInt64(0));
-    cbAutomaticMiningWhenConnectedToNodes.Checked := AppParams.ParamByName[CT_PARAM_AutomaticMineWhenConnectedToNodes].GetAsBoolean(true);
+    cbJSONRPCMinerServerActive.Checked := AppParams.ParamByName[CT_PARAM_JSONRPCMinerServerActive].GetAsBoolean(true);
     case TMinerPrivateKey(AppParams.ParamByName[CT_PARAM_MinerPrivateKeyType].GetAsInteger(Integer(mpk_Random))) of
     case TMinerPrivateKey(AppParams.ParamByName[CT_PARAM_MinerPrivateKeyType].GetAsInteger(Integer(mpk_Random))) of
       mpk_NewEachTime : rbGenerateANewPrivateKeyEachBlock.Checked := true;
       mpk_NewEachTime : rbGenerateANewPrivateKeyEachBlock.Checked := true;
       mpk_Random : rbUseARandomKey.Checked := true;
       mpk_Random : rbUseARandomKey.Checked := true;
@@ -167,7 +169,7 @@ begin
     cbSaveDebugLogs.Checked := AppParams.ParamByName[CT_PARAM_SaveDebugLogs].GetAsBoolean(false);
     cbSaveDebugLogs.Checked := AppParams.ParamByName[CT_PARAM_SaveDebugLogs].GetAsBoolean(false);
     ebMinerName.Text := AppParams.ParamByName[CT_PARAM_MinerName].GetAsString('');
     ebMinerName.Text := AppParams.ParamByName[CT_PARAM_MinerName].GetAsString('');
     cbShowModalMessages.Checked := AppParams.ParamByName[CT_PARAM_ShowModalMessages].GetAsBoolean(false);
     cbShowModalMessages.Checked := AppParams.ParamByName[CT_PARAM_ShowModalMessages].GetAsBoolean(false);
-    udCPUs.Position := AppParams.ParamByName[CT_PARAM_MaxCPUs].GetAsInteger(1);
+    udJSONRPCMinerServerPort.Position := AppParams.ParamByName[CT_PARAM_JSONRPCMinerServerPort].GetAsInteger(CT_JSONRPCMinerServer_Port);
   Except
   Except
     On E:Exception do begin
     On E:Exception do begin
       TLog.NewLog(lterror,ClassName,'Exception at SetAppParams: '+E.Message);
       TLog.NewLog(lterror,ClassName,'Exception at SetAppParams: '+E.Message);

+ 44 - 67
Units/Forms/UFRMWallet.dfm

@@ -1,7 +1,7 @@
 object FRMWallet: TFRMWallet
 object FRMWallet: TFRMWallet
   Left = 360
   Left = 360
   Top = 328
   Top = 328
-  Caption = 'Pascal Coin Wallet, Miner & Explorer'
+  Caption = 'Pascal Coin Wallet, JSON-RPC Miner & Explorer'
   ClientHeight = 545
   ClientHeight = 545
   ClientWidth = 903
   ClientWidth = 903
   Color = clBtnFace
   Color = clBtnFace
@@ -25,7 +25,6 @@ object FRMWallet: TFRMWallet
     Align = alTop
     Align = alTop
     BevelOuter = bvNone
     BevelOuter = bvNone
     TabOrder = 0
     TabOrder = 0
-    ExplicitWidth = 899
     object Image1: TImage
     object Image1: TImage
       Left = 15
       Left = 15
       Top = 15
       Top = 15
@@ -204,11 +203,11 @@ object FRMWallet: TFRMWallet
     object lblMiningStatusCaption: TLabel
     object lblMiningStatusCaption: TLabel
       Left = 90
       Left = 90
       Top = 56
       Top = 56
-      Width = 67
+      Width = 68
       Height = 13
       Height = 13
-      Caption = 'Mining status:'
+      Caption = 'Miners clients:'
     end
     end
-    object lblMiningStatus: TLabel
+    object lblMinersClients: TLabel
       Left = 163
       Left = 163
       Top = 56
       Top = 56
       Width = 18
       Width = 18
@@ -329,8 +328,8 @@ object FRMWallet: TFRMWallet
       OnClick = lblReceivedMessagesClick
       OnClick = lblReceivedMessagesClick
     end
     end
     object lblBuild: TLabel
     object lblBuild: TLabel
-      Left = 717
-      Top = 6
+      Left = 586
+      Top = 3
       Width = 49
       Width = 49
       Height = 23
       Height = 23
       Caption = 'Build'
       Caption = 'Build'
@@ -341,15 +340,6 @@ object FRMWallet: TFRMWallet
       Font.Style = [fsBold]
       Font.Style = [fsBold]
       ParentFont = False
       ParentFont = False
     end
     end
-    object cbAllowMining: TCheckBox
-      Left = 620
-      Top = 10
-      Width = 91
-      Height = 17
-      Caption = 'Allow Mining'
-      TabOrder = 0
-      OnClick = cbAllowMiningClick
-    end
   end
   end
   object StatusBar: TStatusBar
   object StatusBar: TStatusBar
     Left = 0
     Left = 0
@@ -370,24 +360,22 @@ object FRMWallet: TFRMWallet
         Text = 'Blocks'
         Text = 'Blocks'
         Width = 50
         Width = 50
       end>
       end>
-    ExplicitTop = 539
-    ExplicitWidth = 899
   end
   end
   object PageControl: TPageControl
   object PageControl: TPageControl
     Left = 0
     Left = 0
     Top = 91
     Top = 91
     Width = 903
     Width = 903
     Height = 435
     Height = 435
-    ActivePage = tsAccountsExplorer
+    ActivePage = tsNodeStats
     Align = alClient
     Align = alClient
     TabOrder = 2
     TabOrder = 2
     OnChange = PageControlChange
     OnChange = PageControlChange
-    ExplicitWidth = 899
-    ExplicitHeight = 448
     object tsAccountsExplorer: TTabSheet
     object tsAccountsExplorer: TTabSheet
       Caption = 'Accounts Explorer'
       Caption = 'Accounts Explorer'
-      ExplicitWidth = 891
-      ExplicitHeight = 420
+      ExplicitLeft = 0
+      ExplicitTop = 0
+      ExplicitWidth = 0
+      ExplicitHeight = 0
       object Splitter1: TSplitter
       object Splitter1: TSplitter
         Left = 380
         Left = 380
         Top = 66
         Top = 66
@@ -403,7 +391,6 @@ object FRMWallet: TFRMWallet
         Height = 66
         Height = 66
         Align = alTop
         Align = alTop
         TabOrder = 0
         TabOrder = 0
-        ExplicitWidth = 891
         object Label18: TLabel
         object Label18: TLabel
           Left = 11
           Left = 11
           Top = 35
           Top = 35
@@ -487,7 +474,6 @@ object FRMWallet: TFRMWallet
         Align = alLeft
         Align = alLeft
         BevelOuter = bvNone
         BevelOuter = bvNone
         TabOrder = 1
         TabOrder = 1
-        ExplicitHeight = 354
         object dgAccounts: TDrawGrid
         object dgAccounts: TDrawGrid
           Left = 0
           Left = 0
           Top = 0
           Top = 0
@@ -498,7 +484,6 @@ object FRMWallet: TFRMWallet
           OnClick = dgAccountsClick
           OnClick = dgAccountsClick
           OnColumnMoved = dgAccountsColumnMoved
           OnColumnMoved = dgAccountsColumnMoved
           OnFixedCellClick = dgAccountsFixedCellClick
           OnFixedCellClick = dgAccountsFixedCellClick
-          ExplicitHeight = 320
           ColWidths = (
           ColWidths = (
             64
             64
             64
             64
@@ -514,7 +499,6 @@ object FRMWallet: TFRMWallet
           Align = alBottom
           Align = alBottom
           BevelOuter = bvNone
           BevelOuter = bvNone
           TabOrder = 1
           TabOrder = 1
-          ExplicitTop = 320
           DesignSize = (
           DesignSize = (
             380
             380
             34)
             34)
@@ -595,12 +579,12 @@ object FRMWallet: TFRMWallet
         ActivePage = tsMultiSelectAccounts
         ActivePage = tsMultiSelectAccounts
         Align = alClient
         Align = alClient
         TabOrder = 2
         TabOrder = 2
-        ExplicitWidth = 508
-        ExplicitHeight = 354
         object tsAccountOperations: TTabSheet
         object tsAccountOperations: TTabSheet
           Caption = 'Operations of selected Account'
           Caption = 'Operations of selected Account'
-          ExplicitWidth = 500
-          ExplicitHeight = 326
+          ExplicitLeft = 0
+          ExplicitTop = 0
+          ExplicitWidth = 0
+          ExplicitHeight = 0
           object dgAccountOperations: TDrawGrid
           object dgAccountOperations: TDrawGrid
             Left = 0
             Left = 0
             Top = 0
             Top = 0
@@ -609,8 +593,6 @@ object FRMWallet: TFRMWallet
             Align = alClient
             Align = alClient
             TabOrder = 0
             TabOrder = 0
             OnDblClick = MiDecodePayloadClick
             OnDblClick = MiDecodePayloadClick
-            ExplicitWidth = 500
-            ExplicitHeight = 326
             RowHeights = (
             RowHeights = (
               24
               24
               24
               24
@@ -622,8 +604,10 @@ object FRMWallet: TFRMWallet
         object tsMultiSelectAccounts: TTabSheet
         object tsMultiSelectAccounts: TTabSheet
           Caption = 'Selected accounts for massive operations'
           Caption = 'Selected accounts for massive operations'
           ImageIndex = 1
           ImageIndex = 1
-          ExplicitWidth = 500
-          ExplicitHeight = 326
+          ExplicitLeft = 0
+          ExplicitTop = 0
+          ExplicitWidth = 0
+          ExplicitHeight = 0
           object dgSelectedAccounts: TDrawGrid
           object dgSelectedAccounts: TDrawGrid
             Left = 41
             Left = 41
             Top = 31
             Top = 31
@@ -631,7 +615,6 @@ object FRMWallet: TFRMWallet
             Height = 256
             Height = 256
             Align = alLeft
             Align = alLeft
             TabOrder = 0
             TabOrder = 0
-            ExplicitHeight = 269
             RowHeights = (
             RowHeights = (
               24
               24
               24
               24
@@ -653,7 +636,6 @@ object FRMWallet: TFRMWallet
             Font.Style = [fsBold]
             Font.Style = [fsBold]
             ParentFont = False
             ParentFont = False
             TabOrder = 1
             TabOrder = 1
-            ExplicitWidth = 500
             object Label15: TLabel
             object Label15: TLabel
               Left = 41
               Left = 41
               Top = 4
               Top = 4
@@ -670,8 +652,6 @@ object FRMWallet: TFRMWallet
             Align = alBottom
             Align = alBottom
             BevelOuter = bvNone
             BevelOuter = bvNone
             TabOrder = 2
             TabOrder = 2
-            ExplicitTop = 300
-            ExplicitWidth = 500
             object Label20: TLabel
             object Label20: TLabel
               Left = 41
               Left = 41
               Top = 6
               Top = 6
@@ -709,7 +689,6 @@ object FRMWallet: TFRMWallet
             Align = alLeft
             Align = alLeft
             BevelOuter = bvNone
             BevelOuter = bvNone
             TabOrder = 3
             TabOrder = 3
-            ExplicitHeight = 269
             object sbSelectedAccountsAdd: TSpeedButton
             object sbSelectedAccountsAdd: TSpeedButton
               Left = 2
               Left = 2
               Top = 0
               Top = 0
@@ -818,8 +797,10 @@ object FRMWallet: TFRMWallet
     object tsPendingOperations: TTabSheet
     object tsPendingOperations: TTabSheet
       Caption = 'Pending Operations'
       Caption = 'Pending Operations'
       ImageIndex = 5
       ImageIndex = 5
-      ExplicitWidth = 891
-      ExplicitHeight = 420
+      ExplicitLeft = 0
+      ExplicitTop = 0
+      ExplicitWidth = 0
+      ExplicitHeight = 0
       object dgPendingOperations: TDrawGrid
       object dgPendingOperations: TDrawGrid
         Left = 0
         Left = 0
         Top = 86
         Top = 86
@@ -838,7 +819,6 @@ object FRMWallet: TFRMWallet
         BevelOuter = bvNone
         BevelOuter = bvNone
         BorderWidth = 10
         BorderWidth = 10
         TabOrder = 1
         TabOrder = 1
-        ExplicitWidth = 891
         object Label10: TLabel
         object Label10: TLabel
           Left = 10
           Left = 10
           Top = 10
           Top = 10
@@ -868,8 +848,10 @@ object FRMWallet: TFRMWallet
     object tsBlockChain: TTabSheet
     object tsBlockChain: TTabSheet
       Caption = 'BlockChain Explorer'
       Caption = 'BlockChain Explorer'
       ImageIndex = 1
       ImageIndex = 1
-      ExplicitWidth = 891
-      ExplicitHeight = 420
+      ExplicitLeft = 0
+      ExplicitTop = 0
+      ExplicitWidth = 0
+      ExplicitHeight = 0
       object Panel2: TPanel
       object Panel2: TPanel
         Left = 0
         Left = 0
         Top = 0
         Top = 0
@@ -877,7 +859,6 @@ object FRMWallet: TFRMWallet
         Height = 41
         Height = 41
         Align = alTop
         Align = alTop
         TabOrder = 0
         TabOrder = 0
-        ExplicitWidth = 891
         object Label9: TLabel
         object Label9: TLabel
           Left = 306
           Left = 306
           Top = 10
           Top = 10
@@ -954,8 +935,10 @@ object FRMWallet: TFRMWallet
     object tsOperations: TTabSheet
     object tsOperations: TTabSheet
       Caption = 'Operations Explorer'
       Caption = 'Operations Explorer'
       ImageIndex = 1
       ImageIndex = 1
-      ExplicitWidth = 891
-      ExplicitHeight = 420
+      ExplicitLeft = 0
+      ExplicitTop = 0
+      ExplicitWidth = 0
+      ExplicitHeight = 0
       object Panel1: TPanel
       object Panel1: TPanel
         Left = 0
         Left = 0
         Top = 0
         Top = 0
@@ -963,7 +946,6 @@ object FRMWallet: TFRMWallet
         Height = 41
         Height = 41
         Align = alTop
         Align = alTop
         TabOrder = 0
         TabOrder = 0
-        ExplicitWidth = 891
         object Label1: TLabel
         object Label1: TLabel
           Left = 11
           Left = 11
           Top = 10
           Top = 10
@@ -1057,8 +1039,10 @@ object FRMWallet: TFRMWallet
     object tsLogs: TTabSheet
     object tsLogs: TTabSheet
       Caption = 'Logs'
       Caption = 'Logs'
       ImageIndex = 2
       ImageIndex = 2
-      ExplicitWidth = 891
-      ExplicitHeight = 420
+      ExplicitLeft = 0
+      ExplicitTop = 0
+      ExplicitWidth = 0
+      ExplicitHeight = 0
       object pnlTopLogs: TPanel
       object pnlTopLogs: TPanel
         Left = 0
         Left = 0
         Top = 0
         Top = 0
@@ -1066,7 +1050,6 @@ object FRMWallet: TFRMWallet
         Height = 41
         Height = 41
         Align = alTop
         Align = alTop
         TabOrder = 0
         TabOrder = 0
-        ExplicitWidth = 891
         object cbShowDebugLogs: TCheckBox
         object cbShowDebugLogs: TCheckBox
           Left = 15
           Left = 15
           Top = 10
           Top = 10
@@ -1084,15 +1067,15 @@ object FRMWallet: TFRMWallet
         Align = alClient
         Align = alClient
         ScrollBars = ssBoth
         ScrollBars = ssBoth
         TabOrder = 1
         TabOrder = 1
-        ExplicitWidth = 891
-        ExplicitHeight = 379
       end
       end
     end
     end
     object tsNodeStats: TTabSheet
     object tsNodeStats: TTabSheet
       Caption = 'Node Stats'
       Caption = 'Node Stats'
       ImageIndex = 3
       ImageIndex = 3
-      ExplicitWidth = 891
-      ExplicitHeight = 420
+      ExplicitLeft = 0
+      ExplicitTop = 0
+      ExplicitWidth = 0
+      ExplicitHeight = 0
       DesignSize = (
       DesignSize = (
         895
         895
         407)
         407)
@@ -1130,8 +1113,6 @@ object FRMWallet: TFRMWallet
         ReadOnly = True
         ReadOnly = True
         ScrollBars = ssVertical
         ScrollBars = ssVertical
         TabOrder = 0
         TabOrder = 0
-        ExplicitWidth = 860
-        ExplicitHeight = 122
       end
       end
       object memoNetServers: TMemo
       object memoNetServers: TMemo
         Left = 15
         Left = 15
@@ -1142,8 +1123,6 @@ object FRMWallet: TFRMWallet
         ReadOnly = True
         ReadOnly = True
         ScrollBars = ssVertical
         ScrollBars = ssVertical
         TabOrder = 1
         TabOrder = 1
-        ExplicitTop = 300
-        ExplicitWidth = 859
       end
       end
       object memoNetBlackLists: TMemo
       object memoNetBlackLists: TMemo
         Left = 15
         Left = 15
@@ -1154,15 +1133,15 @@ object FRMWallet: TFRMWallet
         ReadOnly = True
         ReadOnly = True
         ScrollBars = ssVertical
         ScrollBars = ssVertical
         TabOrder = 2
         TabOrder = 2
-        ExplicitTop = 196
-        ExplicitWidth = 859
       end
       end
     end
     end
     object tsMessages: TTabSheet
     object tsMessages: TTabSheet
       Caption = 'Messages'
       Caption = 'Messages'
       ImageIndex = 6
       ImageIndex = 6
-      ExplicitWidth = 891
-      ExplicitHeight = 420
+      ExplicitLeft = 0
+      ExplicitTop = 0
+      ExplicitWidth = 0
+      ExplicitHeight = 0
       DesignSize = (
       DesignSize = (
         895
         895
         407)
         407)
@@ -1238,8 +1217,6 @@ object FRMWallet: TFRMWallet
         ReadOnly = True
         ReadOnly = True
         ScrollBars = ssBoth
         ScrollBars = ssBoth
         TabOrder = 2
         TabOrder = 2
-        ExplicitWidth = 860
-        ExplicitHeight = 231
       end
       end
       object memoMessageToSend: TMemo
       object memoMessageToSend: TMemo
         Left = 315
         Left = 315
@@ -1393,7 +1370,7 @@ object FRMWallet: TFRMWallet
     Left = 105
     Left = 105
     Top = 180
     Top = 180
     Bitmap = {
     Bitmap = {
-      494C010102000800240110003000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600
+      494C010102000800480110003000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600
       0000000000003600000028000000400000003000000001002000000000000030
       0000000000003600000028000000400000003000000001002000000000000030
       0000000000000000000000000000000000000000000000000000000000000000
       0000000000000000000000000000000000000000000000000000000000000000
       0000000000000000002A292929D60B0B0BF4111111EE0000006B000000000000
       0000000000000000002A292929D60B0B0BF4111111EE0000006B000000000000

+ 47 - 82
Units/Forms/UFRMWallet.pas

@@ -20,32 +20,9 @@ uses
   Dialogs, pngimage, ExtCtrls, ComCtrls, UWalletKeys, ShlObj, ADOInt, StdCtrls,
   Dialogs, pngimage, ExtCtrls, ComCtrls, UWalletKeys, ShlObj, ADOInt, StdCtrls,
   ULog, DB, ADODB, Grids, DBGrids, DBCGrids, UAppParams,
   ULog, DB, ADODB, Grids, DBGrids, DBCGrids, UAppParams,
   UBlockChain, UNode, DBCtrls, UGridUtils, UDBGridUtils, UMiner, UAccounts, Menus, ImgList,
   UBlockChain, UNode, DBCtrls, UGridUtils, UDBGridUtils, UMiner, UAccounts, Menus, ImgList,
-  AppEvnts, UNetProtocol, UCrypto, Buttons;
-
-Const
-  CT_PARAM_GridAccountsStream = 'GridAccountsStream';
-  CT_PARAM_GridAccountsPos = 'GridAccountsPos';
-
-  CT_PARAM_DefaultFee = 'DefaultFee';
-  CT_PARAM_InternetServerPort = 'InternetServerPort';
-  CT_PARAM_AutomaticMineWhenConnectedToNodes = 'AutomaticMineWhenConnectedToNodes';
-  CT_PARAM_MinerPrivateKeyType = 'MinerPrivateKeyType';
-  CT_PARAM_MinerPrivateKeySelectedPublicKey = 'MinerPrivateKeySelectedPublicKey';
-  CT_PARAM_SaveLogFiles = 'SaveLogFiles';
-  CT_PARAM_SaveDebugLogs = 'SaveDebugLogs';
-  CT_PARAM_ShowLogs = 'ShowLogs';
-  CT_PARAM_MinerName = 'MinerName';
-  CT_PARAM_FirstTime = 'FirstTime';
-  CT_PARAM_ShowModalMessages = 'ShowModalMessages';
-  CT_PARAM_MaxCPUs = 'MaxCPUs';
-  CT_PARAM_PeerCache = 'PeerCache';
-  CT_PARAM_TryToConnectOnlyWithThisFixedServers = 'TryToConnectOnlyWithFixedServers';
+  AppEvnts, UNetProtocol, UCrypto, Buttons, UPoolMining;
 
 
 type
 type
-  TStringListAux = Class(TStringList)
-
-  End;
-
   TMinerPrivateKey = (mpk_NewEachTime, mpk_Random, mpk_Selected);
   TMinerPrivateKey = (mpk_NewEachTime, mpk_Random, mpk_Selected);
 
 
   TFRMWallet = class(TForm)
   TFRMWallet = class(TForm)
@@ -76,7 +53,6 @@ type
     Panel1: TPanel;
     Panel1: TPanel;
     Label1: TLabel;
     Label1: TLabel;
     dbgridOperations: TDBGrid;
     dbgridOperations: TDBGrid;
-    cbAllowMining: TCheckBox;
     ebFilterOperationsAccount: TEdit;
     ebFilterOperationsAccount: TEdit;
     Label2: TLabel;
     Label2: TLabel;
     ebFilterOperationsStartBlock: TEdit;
     ebFilterOperationsStartBlock: TEdit;
@@ -98,7 +74,7 @@ type
     lblOperationsPendingCaption: TLabel;
     lblOperationsPendingCaption: TLabel;
     lblOperationsPending: TLabel;
     lblOperationsPending: TLabel;
     lblMiningStatusCaption: TLabel;
     lblMiningStatusCaption: TLabel;
-    lblMiningStatus: TLabel;
+    lblMinersClients: TLabel;
     lblCurrentDifficultyCaption: TLabel;
     lblCurrentDifficultyCaption: TLabel;
     lblCurrentDifficulty: TLabel;
     lblCurrentDifficulty: TLabel;
     lblTimeAverage: TLabel;
     lblTimeAverage: TLabel;
@@ -200,7 +176,6 @@ type
     procedure ebBlockChainBlockStartExit(Sender: TObject);
     procedure ebBlockChainBlockStartExit(Sender: TObject);
     procedure ebBlockChainBlockStartKeyPress(Sender: TObject; var Key: Char);
     procedure ebBlockChainBlockStartKeyPress(Sender: TObject; var Key: Char);
     procedure cbBlockChainFilterByDateClick(Sender: TObject);
     procedure cbBlockChainFilterByDateClick(Sender: TObject);
-    procedure cbAllowMiningClick(Sender: TObject);
     procedure cbExploreMyAccountsClick(Sender: TObject);
     procedure cbExploreMyAccountsClick(Sender: TObject);
     procedure MiCloseClick(Sender: TObject);
     procedure MiCloseClick(Sender: TObject);
     procedure MiDecodePayloadClick(Sender: TObject);
     procedure MiDecodePayloadClick(Sender: TObject);
@@ -232,13 +207,13 @@ type
     FMinersBlocksFound: Integer;
     FMinersBlocksFound: Integer;
     procedure SetMinersBlocksFound(const Value: Integer);
     procedure SetMinersBlocksFound(const Value: Integer);
     Procedure CheckIsReady;
     Procedure CheckIsReady;
+    Procedure FinishedLoadingApp;
   protected
   protected
     { Private declarations }
     { Private declarations }
     FNode : TNode;
     FNode : TNode;
     FIsActivated : Boolean;
     FIsActivated : Boolean;
     FWalletKeys : TWalletKeys;
     FWalletKeys : TWalletKeys;
     FLog : TLog;
     FLog : TLog;
-    FMaxCPUs : Integer;
     FAppParams : TAppParams;
     FAppParams : TAppParams;
     FNodeNotifyEvents : TNodeNotifyEvents;
     FNodeNotifyEvents : TNodeNotifyEvents;
     FAccountsGrid : TAccountsGrid;
     FAccountsGrid : TAccountsGrid;
@@ -253,7 +228,8 @@ type
     FMessagesUnreadCount : Integer;
     FMessagesUnreadCount : Integer;
     FMinAccountBalance : Int64;
     FMinAccountBalance : Int64;
     FMaxAccountBalance : Int64;
     FMaxAccountBalance : Int64;
-    Procedure CheckMining;
+    FPoolMiningServer : TPoolMiningServer;
+    //Procedure CheckMining;
     Procedure OnNewAccount(Sender : TObject);
     Procedure OnNewAccount(Sender : TObject);
     Procedure OnReceivedHelloMessage(Sender : TObject);
     Procedure OnReceivedHelloMessage(Sender : TObject);
     Procedure OnNetStatisticsChanged(Sender : TObject);
     Procedure OnNetStatisticsChanged(Sender : TObject);
@@ -312,6 +288,7 @@ begin
   TNode.Node.AutoDiscoverNodes(CT_Discover_IPs);
   TNode.Node.AutoDiscoverNodes(CT_Discover_IPs);
   TNode.Node.NetServer.Active := true;
   TNode.Node.NetServer.Active := true;
   Synchronize( FRMWallet.DoUpdateAccounts );
   Synchronize( FRMWallet.DoUpdateAccounts );
+  Synchronize( FRMWallet.FinishedLoadingApp );
 end;
 end;
 
 
 { TFRMWallet }
 { TFRMWallet }
@@ -485,25 +462,6 @@ begin
     'Message: '+#10+m),PChar(Application.Title),MB_ICONINFORMATION+MB_OK);
     'Message: '+#10+m),PChar(Application.Title),MB_ICONINFORMATION+MB_OK);
 end;
 end;
 
 
-procedure TFRMWallet.cbAllowMiningClick(Sender: TObject);
-begin
-  if Not Assigned(FNode) then exit;
-  if cbAllowMining.Checked then begin
-    if (TNetData.NetData.NetStatistics.ClientsConnections<=0) then begin
-      Application.MessageBox(PChar(Format(
-        'In order to mine is necessary that you open your external port %d from the Internet to allow other Pascal Coin nodes to connect to you.'+#10+
-        '(Note: This is not mandatory... but it will work better with open ports)'+#10+
-        #10+
-        'To do this you must configure your Router/Firewall and enable NAT to your local machine at port: %d'+#10+#10+
-        'After allowing incoming connections... you must wait until other nodes connect to you to mine'+#10+
-        #10+
-        'PLEASE... BE PATIENT !!!'+#10+#10+
-        'Help mining Pascal Coin and win Pascal Coins!',[FNode.NetServer.Port,FNode.NetServer.Port])),
-        PChar(Application.Title),MB_ICONINFORMATION+MB_OK);
-    end;
-  end;
-end;
-
 procedure TFRMWallet.cbBlockChainFilterByDateClick(Sender: TObject);
 procedure TFRMWallet.cbBlockChainFilterByDateClick(Sender: TObject);
 begin
 begin
   dtpBlockChainDateStart.Enabled := cbBlockChainFilterByDate.Checked;
   dtpBlockChainDateStart.Enabled := cbBlockChainFilterByDate.Checked;
@@ -545,6 +503,7 @@ begin
   end;
   end;
 end;
 end;
 
 
+{
 procedure TFRMWallet.CheckMining;
 procedure TFRMWallet.CheckMining;
   Procedure Stop;
   Procedure Stop;
   var i : Integer;
   var i : Integer;
@@ -591,7 +550,7 @@ begin
         end;
         end;
         if n<FMaxCPUs then begin
         if n<FMaxCPUs then begin
           MT := FNode.AddMiner(GetAccountKeyForMiner);
           MT := FNode.AddMiner(GetAccountKeyForMiner);
-          MT.OnNewAccountFound := OnMinerNewBlockFound;
+          MT.OnThreadSafeNewBlockFound := OnMinerNewBlockFound;
           MT.Paused := false;
           MT.Paused := false;
         end else begin
         end else begin
           while (mtl.Count>FMaxCPUs) do FNode.DeleteMiner(mtl.Count-1);
           while (mtl.Count>FMaxCPUs) do FNode.DeleteMiner(mtl.Count-1);
@@ -605,6 +564,8 @@ begin
   end else Stop;
   end else Stop;
 end;
 end;
 
 
+}
+
 procedure TFRMWallet.dgAccountsClick(Sender: TObject);
 procedure TFRMWallet.dgAccountsClick(Sender: TObject);
 begin
 begin
   UpdateOperations;
   UpdateOperations;
@@ -779,6 +740,16 @@ begin
   ebFindAccountNumber.Text := '';
   ebFindAccountNumber.Text := '';
 end;
 end;
 
 
+procedure TFRMWallet.FinishedLoadingApp;
+begin
+  FPoolMiningServer := TPoolMiningServer.Create;
+  FPoolMiningServer.Port := FAppParams.ParamByName[CT_PARAM_JSONRPCMinerServerPort].GetAsInteger(CT_JSONRPCMinerServer_Port);
+  FPoolMiningServer.MinerAccountKey := GetAccountKeyForMiner;
+  FPoolMiningServer.MinerPayload := FAppParams.ParamByName[CT_PARAM_MinerName].GetAsString('');
+  FNode.Operations.AccountKey := GetAccountKeyForMiner;
+  FPoolMiningServer.Active := FAppParams.ParamByName[CT_PARAM_JSONRPCMinerServerActive].GetAsBoolean(true);
+end;
+
 function TFRMWallet.ForceMining: Boolean;
 function TFRMWallet.ForceMining: Boolean;
 begin
 begin
   Result := false;
   Result := false;
@@ -788,8 +759,6 @@ procedure TFRMWallet.FormCreate(Sender: TObject);
 Var i : Integer;
 Var i : Integer;
   fvi : TFileVersionInfo;
   fvi : TFileVersionInfo;
 begin
 begin
-  if CPUCount>1 then FMaxCPUs := CPUCount-1
-  else FMaxCPUs := 1;
   FMinAccountBalance := 0;
   FMinAccountBalance := 0;
   FMaxAccountBalance := CT_MaxWalletAmount;
   FMaxAccountBalance := CT_MaxWalletAmount;
   FMessagesUnreadCount := 0;
   FMessagesUnreadCount := 0;
@@ -858,6 +827,7 @@ begin
   MinersBlocksFound := 0;
   MinersBlocksFound := 0;
   fvi := TFolderHelper.GetTFileVersionInfo(Application.ExeName);
   fvi := TFolderHelper.GetTFileVersionInfo(Application.ExeName);
   lblBuild.Caption := 'Build: '+fvi.FileVersion;
   lblBuild.Caption := 'Build: '+fvi.FileVersion;
+  FPoolMiningServer := Nil;
 end;
 end;
 
 
 procedure TFRMWallet.FormDestroy(Sender: TObject);
 procedure TFRMWallet.FormDestroy(Sender: TObject);
@@ -867,6 +837,7 @@ Var i : Integer;
 begin
 begin
   TLog.NewLog(ltinfo,Classname,'Destroying form - START');
   TLog.NewLog(ltinfo,Classname,'Destroying form - START');
   Try
   Try
+  FreeAndNil(FPoolMiningServer);
   step := 'Saving params';
   step := 'Saving params';
   SaveAppParams;
   SaveAppParams;
   FreeAndNil(FAppParams);
   FreeAndNil(FAppParams);
@@ -1253,7 +1224,7 @@ begin
       sRS.Free;
       sRS.Free;
       sDisc.Free;
       sDisc.Free;
     End;
     End;
-    CheckMining;
+    //CheckMining;
   finally
   finally
     TNetData.NetData.NetConnections.UnlockList;
     TNetData.NetData.NetConnections.UnlockList;
   end;
   end;
@@ -1302,7 +1273,7 @@ end;
 procedure TFRMWallet.OnNetStatisticsChanged(Sender: TObject);
 procedure TFRMWallet.OnNetStatisticsChanged(Sender: TObject);
 Var NS : TNetStatistics;
 Var NS : TNetStatistics;
 begin
 begin
-  CheckMining;
+  //CheckMining;
   if Assigned(FNode) then begin
   if Assigned(FNode) then begin
     If FNode.NetServer.Active then begin
     If FNode.NetServer.Active then begin
       StatusBar.Panels[0].Text := 'Active (Port '+Inttostr(FNode.NetServer.Port)+')';
       StatusBar.Panels[0].Text := 'Active (Port '+Inttostr(FNode.NetServer.Port)+')';
@@ -1372,7 +1343,7 @@ Var nsarr : TNodeServerAddressArray;
   i : Integer;
   i : Integer;
   s : AnsiString;
   s : AnsiString;
 begin
 begin
-  CheckMining;
+  //CheckMining;
   // Update node servers Peer Cache
   // Update node servers Peer Cache
   nsarr := TNetData.NetData.GetValidNodeServers;
   nsarr := TNetData.NetData.GetValidNodeServers;
   s := '';
   s := '';
@@ -1637,7 +1608,7 @@ end;
 
 
 procedure TFRMWallet.UpdateBlockChainState;
 procedure TFRMWallet.UpdateBlockChainState;
 Var isMining : boolean;
 Var isMining : boolean;
-  hr : Int64;
+//  hr : Int64;
   i,mc : Integer;
   i,mc : Integer;
   s : String;
   s : String;
   mtl : TList;
   mtl : TList;
@@ -1645,7 +1616,7 @@ Var isMining : boolean;
 begin
 begin
   UpdateNodeStatus;
   UpdateNodeStatus;
   mc := 0;
   mc := 0;
-  hr := 0;
+//  hr := 0;
   if Assigned(FNode) then begin
   if Assigned(FNode) then begin
     if FNode.Bank.BlocksCount>0 then begin
     if FNode.Bank.BlocksCount>0 then begin
       lblCurrentBlock.Caption :=  Inttostr(FNode.Bank.BlocksCount)+' (0..'+Inttostr(FNode.Bank.BlocksCount-1)+')'; ;
       lblCurrentBlock.Caption :=  Inttostr(FNode.Bank.BlocksCount)+' (0..'+Inttostr(FNode.Bank.BlocksCount-1)+')'; ;
@@ -1668,18 +1639,6 @@ begin
         ((CT_CalcNewTargetBlocksAverage DIV 4)*3),FormatFloat('0.0',FNode.Bank.GetActualTargetSecondsAverage(((CT_CalcNewTargetBlocksAverage DIV 4)*3))),
         ((CT_CalcNewTargetBlocksAverage DIV 4)*3),FormatFloat('0.0',FNode.Bank.GetActualTargetSecondsAverage(((CT_CalcNewTargetBlocksAverage DIV 4)*3))),
         CT_CalcNewTargetBlocksAverage DIV 2,FormatFloat('0.0',FNode.Bank.GetActualTargetSecondsAverage(CT_CalcNewTargetBlocksAverage DIV 2)),
         CT_CalcNewTargetBlocksAverage DIV 2,FormatFloat('0.0',FNode.Bank.GetActualTargetSecondsAverage(CT_CalcNewTargetBlocksAverage DIV 2)),
         CT_CalcNewTargetBlocksAverage DIV 4,FormatFloat('0.0',FNode.Bank.GetActualTargetSecondsAverage(CT_CalcNewTargetBlocksAverage DIV 4))]);
         CT_CalcNewTargetBlocksAverage DIV 4,FormatFloat('0.0',FNode.Bank.GetActualTargetSecondsAverage(CT_CalcNewTargetBlocksAverage DIV 4))]);
-    mtl := FNode.MinerThreads.LockList;
-    try
-      mc := mtl.Count;
-      If mc>0 then begin
-        isMining := Not TMinerThread(mtl[0]).Paused;
-        for i := 0 to mtl.Count - 1 do begin
-          hr := hr + TMinerThread(mtl[i]).HashRate;
-        end;
-      end else isMining :=false;
-    finally
-      FNode.MinerThreads.UnlockList;
-    end;
   end else begin
   end else begin
     isMining := false;
     isMining := false;
     lblCurrentBlock.Caption := '';
     lblCurrentBlock.Caption := '';
@@ -1690,16 +1649,20 @@ begin
     lblTimeAverage.Caption := '';
     lblTimeAverage.Caption := '';
     lblTimeAverageAux.Caption := '';
     lblTimeAverageAux.Caption := '';
   end;
   end;
-  if isMining then begin
-    if mc>1 then s := inttostr(mc)+' Miners at '
-    else s := 'Mining at ';
-    lblMiningStatus.Caption := s +FormatFloat('0.0',hr / 1024)+' Kh/s (R: '+FormatFloat('0.0',TMinerThread.AllMinersPlayCount / 1000000)+'G)';
-    lblMiningStatus.Font.Color := clNavy
+  if (Assigned(FPoolMiningServer)) And (FPoolMiningServer.Active) then begin
+    If FPoolMiningServer.ClientsCount>0 then begin
+      lblMinersClients.Caption := IntToStr(FPoolMiningServer.ClientsCount)+' connected JSON-RPC clients';
+      lblMinersClients.Font.Color := clNavy;
+    end else begin
+      lblMinersClients.Caption := 'No JSON-RPC clients';
+      lblMinersClients.Font.Color := clDkGray;
+    end;
+    MinersBlocksFound := FPoolMiningServer.ClientsWins;
   end else begin
   end else begin
-    lblMiningStatus.Caption := 'Not mining';
-    lblMiningStatus.Font.Color := clRed;
+    MinersBlocksFound := 0;
+    lblMinersClients.Caption := 'JSON-RPC server not active';
+    lblMinersClients.Font.Color := clRed;
   end;
   end;
-
 end;
 end;
 
 
 procedure TFRMWallet.UpdateConfigChanged;
 procedure TFRMWallet.UpdateConfigChanged;
@@ -1725,15 +1688,18 @@ begin
     FNode.NetServer.Active := wa;
     FNode.NetServer.Active := wa;
     FNode.Operations.BlockPayload := FAppParams.ParamByName[CT_PARAM_MinerName].GetAsString('');
     FNode.Operations.BlockPayload := FAppParams.ParamByName[CT_PARAM_MinerName].GetAsString('');
   end;
   end;
-  FMaxCPUs := FAppParams.ParamByName[CT_PARAM_MaxCPUs].GetAsInteger(1);
-  if FMaxCPUs>CPUCount then FMaxCPUs := CPUCount;
-  if FMaxCPUs<0 then FMaxCPUs := 0;
+  if Assigned(FPoolMiningServer) then begin
+    if FPoolMiningServer.Port<>FAppParams.ParamByName[CT_PARAM_JSONRPCMinerServerPort].GetAsInteger(CT_JSONRPCMinerServer_Port) then begin
+      FPoolMiningServer.Active := false;
+      FPoolMiningServer.Port := FAppParams.ParamByName[CT_PARAM_JSONRPCMinerServerPort].GetAsInteger(CT_JSONRPCMinerServer_Port);
+    end;
+    FPoolMiningServer.Active :=FAppParams.ParamByName[CT_PARAM_JSONRPCMinerServerActive].GetAsBoolean(true);
+    FPoolMiningServer.UpdateAccountAndPayload(GetAccountKeyForMiner,FAppParams.ParamByName[CT_PARAM_MinerName].GetAsString(''));
+  end;
 
 
   i := FAppParams.ParamByName[CT_PARAM_MinerPrivateKeyType].GetAsInteger(Integer(mpk_Random));
   i := FAppParams.ParamByName[CT_PARAM_MinerPrivateKeyType].GetAsInteger(Integer(mpk_Random));
   if (i>=Integer(Low(TMinerPrivatekey))) And (i<=Integer(High(TMinerPrivatekey))) then FMinerPrivateKeyType := TMinerPrivateKey(i)
   if (i>=Integer(Low(TMinerPrivatekey))) And (i<=Integer(High(TMinerPrivatekey))) then FMinerPrivateKeyType := TMinerPrivateKey(i)
   else FMinerPrivateKeyType := mpk_Random;
   else FMinerPrivateKeyType := mpk_Random;
-
-  cbAllowMining.Checked :=  (FAppParams.ParamByName[CT_PARAM_AutomaticMineWhenConnectedToNodes].GetAsBoolean(true));
 end;
 end;
 
 
 procedure TFRMWallet.UpdateConnectionStatus;
 procedure TFRMWallet.UpdateConnectionStatus;
@@ -1801,7 +1767,6 @@ begin
   cbMyPrivateKeys.items.BeginUpdate;
   cbMyPrivateKeys.items.BeginUpdate;
   Try
   Try
     cbMyPrivateKeys.Items.Clear;
     cbMyPrivateKeys.Items.Clear;
-//    cbMyPrivateKeys.Items.AddObject('(All my private keys)',TObject(-1));
     For i:=0 to FWalletKeys.Count-1 do begin
     For i:=0 to FWalletKeys.Count-1 do begin
       wk := FWalletKeys.Key[i];
       wk := FWalletKeys.Key[i];
       if assigned(FOrderedAccountsKeyList) then begin
       if assigned(FOrderedAccountsKeyList) then begin

+ 39 - 38
Units/PascalCoin/UBlockChain.pas

@@ -176,10 +176,12 @@ Type
     FSafeBoxTransaction : TPCSafeBoxTransaction;
     FSafeBoxTransaction : TPCSafeBoxTransaction;
     FOperationBlock: TOperationBlock;
     FOperationBlock: TOperationBlock;
     FOperationsHashTree : TOperationsHashTree;
     FOperationsHashTree : TOperationsHashTree;
-    FDigest_Basic : TRawBytes;
-    FDigest_Operations : TRawBytes;
+    FDigest_Part1 : TRawBytes;
+    FDigest_Part2_Payload : TRawBytes;
+    FDigest_Part3 : TRawBytes;
     FIsOnlyOperationBlock: Boolean;
     FIsOnlyOperationBlock: Boolean;
     FStreamPoW : TMemoryStream;
     FStreamPoW : TMemoryStream;
+    FDisableds : Integer;
     function GetOperation(index: Integer): TPCOperation;
     function GetOperation(index: Integer): TPCOperation;
     procedure SetBank(const value: TPCBank);
     procedure SetBank(const value: TPCBank);
     procedure SetnOnce(const value: Cardinal);
     procedure SetnOnce(const value: Cardinal);
@@ -188,8 +190,7 @@ Type
     function Gettimestamp: Cardinal;
     function Gettimestamp: Cardinal;
     procedure SetAccountKey(const value: TAccountKey);
     procedure SetAccountKey(const value: TAccountKey);
     function GetAccountKey: TAccountKey;
     function GetAccountKey: TAccountKey;
-    Procedure Calc_Digest_Basic;
-    Procedure Calc_Digest_Operations;
+    Procedure Calc_Digest_Parts;
     Procedure CalcProofOfWork(fullcalculation : Boolean; var PoW: TRawBytes);
     Procedure CalcProofOfWork(fullcalculation : Boolean; var PoW: TRawBytes);
     function GetBlockPayload: TRawBytes;
     function GetBlockPayload: TRawBytes;
     procedure SetBlockPayload(const Value: TRawBytes);
     procedure SetBlockPayload(const Value: TRawBytes);
@@ -232,6 +233,9 @@ Type
     //
     //
     Property SafeBoxTransaction : TPCSafeBoxTransaction read FSafeBoxTransaction;
     Property SafeBoxTransaction : TPCSafeBoxTransaction read FSafeBoxTransaction;
     Property OperationsHashTree : TOperationsHashTree read FOperationsHashTree;
     Property OperationsHashTree : TOperationsHashTree read FOperationsHashTree;
+    Property PoW_Digest_Part1 : TRawBytes read FDigest_Part1;
+    Property PoW_Digest_Part2_Payload : TRawBytes read FDigest_Part2_Payload;
+    Property PoW_Digest_Part3 : TRawBytes read FDigest_Part3;
   End;
   End;
 
 
   TPCBankLog = procedure(sender: TPCBank; Operations: TPCOperationsComp; Logtype: TLogType ; Logtxt: AnsiString) of object;
   TPCBankLog = procedure(sender: TPCBank; Operations: TPCOperationsComp; Logtype: TLogType ; Logtxt: AnsiString) of object;
@@ -300,8 +304,6 @@ Type
     FStorageClass: TStorageClass;
     FStorageClass: TStorageClass;
     function GetStorage: TStorage;
     function GetStorage: TStorage;
     procedure SetStorageClass(const Value: TStorageClass);
     procedure SetStorageClass(const Value: TStorageClass);
-//    function LoadFromStream(Stream: TStream; var errors: AnsiString): Boolean;
-//    procedure SaveToStream(Stream: TStream);
   protected
   protected
   public
   public
     Constructor Create(AOwner: TComponent); Override;
     Constructor Create(AOwner: TComponent); Override;
@@ -907,7 +909,7 @@ Begin
     FOperationsHashTree.AddOperationToHashTree(op);
     FOperationsHashTree.AddOperationToHashTree(op);
     FOperationBlock.fee := FOperationBlock.fee + op.OperationFee;
     FOperationBlock.fee := FOperationBlock.fee + op.OperationFee;
     FOperationBlock.operations_hash := FOperationsHashTree.HashTree;
     FOperationBlock.operations_hash := FOperationsHashTree.HashTree;
-    Calc_Digest_Operations;
+    if FDisableds<=0 then Calc_Digest_Parts;
   end;
   end;
 End;
 End;
 
 
@@ -919,30 +921,35 @@ begin
   Result := 0;
   Result := 0;
   errors := '';
   errors := '';
   if operations=FOperationsHashTree then exit;
   if operations=FOperationsHashTree then exit;
-  for i := 0 to operations.OperationsCount - 1 do begin
-    if not AddOperation(true,operations.GetOperation(i),e) then begin
-      if (errors<>'') then errors := errors+' ';
-      errors := errors + 'Op'+inttostr(i+1)+'/'+inttostr(operations.OperationsCount)+':'+e;
-    end else inc(Result);
+  inc(FDisableds);
+  try
+    for i := 0 to operations.OperationsCount - 1 do begin
+      if not AddOperation(true,operations.GetOperation(i),e) then begin
+        if (errors<>'') then errors := errors+' ';
+        errors := errors + 'Op'+inttostr(i+1)+'/'+inttostr(operations.OperationsCount)+':'+e;
+      end else inc(Result);
+    end;
+  finally
+    Dec(FDisableds);
+    Calc_Digest_Parts;
   end;
   end;
 end;
 end;
 
 
 Procedure TPCOperationsComp.CalcProofOfWork(fullcalculation : Boolean; var PoW: TRawBytes);
 Procedure TPCOperationsComp.CalcProofOfWork(fullcalculation : Boolean; var PoW: TRawBytes);
 begin
 begin
   if fullcalculation then begin
   if fullcalculation then begin
-    Calc_Digest_Basic;
-    Calc_Digest_Operations;
+    Calc_Digest_Parts;
   end;
   end;
-  // New at Build 1.0.2 to increase Hashing Speed instead of creating TMemoryStream due Delphi memory creation is slowly...
   FStreamPoW.Position := 0;
   FStreamPoW.Position := 0;
-  FStreamPoW.WriteBuffer(FDigest_Basic[1],length(FDigest_Basic));
-  FStreamPoW.WriteBuffer(FDigest_Operations[1],length(FDigest_Operations));
+  FStreamPoW.WriteBuffer(FDigest_Part1[1],length(FDigest_Part1));
+  FStreamPoW.WriteBuffer(FDigest_Part2_Payload[1],length(FDigest_Part2_Payload));
+  FStreamPoW.WriteBuffer(FDigest_Part3[1],length(FDigest_Part3));
   FStreamPoW.Write(FOperationBlock.timestamp,4);
   FStreamPoW.Write(FOperationBlock.timestamp,4);
   FStreamPoW.Write(FOperationBlock.nonce,4);
   FStreamPoW.Write(FOperationBlock.nonce,4);
-  TCrypto.DoDoubleSha256(FStreamPoW.Memory,length(FDigest_Basic)+length(FDigest_Operations)+8,PoW);
+  TCrypto.DoDoubleSha256(FStreamPoW.Memory,length(FDigest_Part1)+length(FDigest_Part2_Payload)+length(FDigest_Part3)+8,PoW);
 end;
 end;
 
 
-procedure TPCOperationsComp.Calc_Digest_Basic;
+procedure TPCOperationsComp.Calc_Digest_Parts;
 var ms : TMemoryStream;
 var ms : TMemoryStream;
   s : AnsiString;
   s : AnsiString;
 begin
 begin
@@ -955,28 +962,18 @@ begin
     ms.Write(FOperationBlock.protocol_version,Sizeof(FOperationBlock.protocol_version)); // Little endian
     ms.Write(FOperationBlock.protocol_version,Sizeof(FOperationBlock.protocol_version)); // Little endian
     ms.Write(FOperationBlock.protocol_available,Sizeof(FOperationBlock.protocol_available)); // Little endian
     ms.Write(FOperationBlock.protocol_available,Sizeof(FOperationBlock.protocol_available)); // Little endian
     ms.Write(FOperationBlock.compact_target,Sizeof(FOperationBlock.compact_target)); // Little endian
     ms.Write(FOperationBlock.compact_target,Sizeof(FOperationBlock.compact_target)); // Little endian
-    ms.WriteBuffer(FOperationBlock.block_payload[1],length(FOperationBlock.block_payload));
-    ms.WriteBuffer(FOperationBlock.initial_safe_box_hash[1],length(FOperationBlock.initial_safe_box_hash));
-    SetLength(FDigest_Basic,ms.Size);
+    SetLength(FDigest_Part1,ms.Size);
     ms.Position :=0;
     ms.Position :=0;
-    ms.ReadBuffer(FDigest_Basic[1],ms.Size);
-  finally
-    ms.Free;
-  end;
-end;
-
-procedure TPCOperationsComp.Calc_Digest_Operations;
-var ms : TMemoryStream;
-  buff: AnsiString;
-begin
-  ms := TMemoryStream.Create;
-  try
+    ms.ReadBuffer(FDigest_Part1[1],ms.Size);
+    ms.Clear;
+    FDigest_Part2_Payload := FOperationBlock.block_payload;
+    ms.WriteBuffer(FOperationBlock.initial_safe_box_hash[1],length(FOperationBlock.initial_safe_box_hash));
     ms.WriteBuffer(FOperationsHashTree.HashTree[1],length(FOperationsHashTree.HashTree));
     ms.WriteBuffer(FOperationsHashTree.HashTree[1],length(FOperationsHashTree.HashTree));
     // Note about fee: Fee is stored in 8 bytes, but only digest first 4 low bytes
     // Note about fee: Fee is stored in 8 bytes, but only digest first 4 low bytes
     ms.Write(FOperationBlock.fee,4);
     ms.Write(FOperationBlock.fee,4);
-    SetLength(FDigest_Operations,ms.Size);
+    SetLength(FDigest_Part3,ms.Size);
     ms.Position := 0;
     ms.Position := 0;
-    ms.ReadBuffer(FDigest_Operations[1],ms.Size);
+    ms.ReadBuffer(FDigest_Part3[1],ms.Size);
   finally
   finally
     ms.Free;
     ms.Free;
   end;
   end;
@@ -1029,6 +1026,9 @@ begin
   if Assigned(FSafeBoxTransaction) And Assigned(Operations.FSafeBoxTransaction) then begin
   if Assigned(FSafeBoxTransaction) And Assigned(Operations.FSafeBoxTransaction) then begin
     FSafeBoxTransaction.CopyFrom(Operations.FSafeBoxTransaction);
     FSafeBoxTransaction.CopyFrom(Operations.FSafeBoxTransaction);
   end;
   end;
+  FDigest_Part1 := Operations.FDigest_Part1;
+  FDigest_Part2_Payload := Operations.FDigest_Part2_Payload;
+  FDigest_Part3 := Operations.FDigest_Part3;
 end;
 end;
 
 
 function TPCOperationsComp.CopyFromAndValidate(Operations: TPCOperationsComp; var errors: AnsiString): Boolean;
 function TPCOperationsComp.CopyFromAndValidate(Operations: TPCOperationsComp; var errors: AnsiString): Boolean;
@@ -1084,7 +1084,7 @@ end;
 constructor TPCOperationsComp.Create(AOwner: TComponent);
 constructor TPCOperationsComp.Create(AOwner: TComponent);
 begin
 begin
   inherited Create(AOwner);
   inherited Create(AOwner);
-  // New at Build 1.0.2
+  FDisableds := 0;
   FStreamPoW := TMemoryStream.Create;
   FStreamPoW := TMemoryStream.Create;
   FStreamPoW.Position := 0;
   FStreamPoW.Position := 0;
   FOperationsHashTree := TOperationsHashTree.Create;
   FOperationsHashTree := TOperationsHashTree.Create;
@@ -1440,7 +1440,8 @@ procedure TPCOperationsComp.SetAccountKey(const value: TAccountKey);
 begin
 begin
   if TAccountComp.AccountKey2RawString(value)=TAccountComp.AccountKey2RawString(FOperationBlock.account_key) then exit;
   if TAccountComp.AccountKey2RawString(value)=TAccountComp.AccountKey2RawString(FOperationBlock.account_key) then exit;
   FOperationBlock.account_key := value;
   FOperationBlock.account_key := value;
-  Calc_Digest_Basic;
+//  Calc_Digest_Basic;
+  Calc_Digest_Parts;
 end;
 end;
 
 
 procedure TPCOperationsComp.SetBank(const value: TPCBank);
 procedure TPCOperationsComp.SetBank(const value: TPCBank);

+ 10 - 8
Units/PascalCoin/UConst.pas

@@ -17,7 +17,6 @@ unit UConst;
 
 
   }
   }
 
 
-{$DEFINE TESTNET}
 
 
 interface
 interface
 
 
@@ -29,13 +28,14 @@ Const
     '(c) Albert Molina - Genesis block at same time than BitCoin Block 424720 Hash 000000000000000001cc41ff7846264718ef0a15f97f532a98277bd5f6820b89';
     '(c) Albert Molina - Genesis block at same time than BitCoin Block 424720 Hash 000000000000000001cc41ff7846264718ef0a15f97f532a98277bd5f6820b89';
 
 
   CT_Zero_Block_Proof_of_work_in_Hexa =
   CT_Zero_Block_Proof_of_work_in_Hexa =
-    '00000003A29C32E84A539ADE24397D41D30116A6FAFEC17B7D9CED68A4238C92';
+    {$IFDEF PRODUCTION}'00000003A29C32E84A539ADE24397D41D30116A6FAFEC17B7D9CED68A4238C92'{$ELSE}{$IFDEF TESTNET}''{$ELSE}{$ENDIF}{$ENDIF};
 
 
 
 
-  CT_NetServer_Port = 4004;
+  CT_NetServer_Port = {$IFDEF PRODUCTION}4004{$ELSE}{$IFDEF TESTNET}4104{$ELSE}{$ENDIF}{$ENDIF};
+  CT_JSONRPCMinerServer_Port = {$IFDEF PRODUCTION}4009{$ELSE}{$IFDEF TESTNET}4109{$ELSE}{$ENDIF}{$ENDIF};
   CT_AccountsPerBlock = 5;
   CT_AccountsPerBlock = 5;
 
 
-  CT_NewLineSecondsAvg: Cardinal = 300;
+  CT_NewLineSecondsAvg: Cardinal = {$IFDEF PRODUCTION}300{$ELSE}{$IFDEF TESTNET}30{$ELSE}{$ENDIF}{$ENDIF};
     // 60*5=300 seconds -> 5 minutes avg
     // 60*5=300 seconds -> 5 minutes avg
     //   -> 1 day = 86400 seconds -> 1 year = 31536000 seconds (aprox)
     //   -> 1 day = 86400 seconds -> 1 year = 31536000 seconds (aprox)
     //   Each year = 105120 new blocks (aprox)
     //   Each year = 105120 new blocks (aprox)
@@ -53,7 +53,7 @@ Const
   CT_MaxTransactionFee = 100000000;
   CT_MaxTransactionFee = 100000000;
   CT_MaxWalletAmount = 10000000000000;
   CT_MaxWalletAmount = 10000000000000;
   //
   //
-  CT_MinCompactTarget: Cardinal = $19000000; // First compact target of block 0
+  CT_MinCompactTarget: Cardinal = {$IFDEF PRODUCTION}$19000000{$ELSE}{$IFDEF TESTNET}$17000000{$ELSE}{$ENDIF}{$ENDIF}; // First compact target of block 0
 
 
   CT_CalcNewTargetBlocksAverage: Cardinal = 100;
   CT_CalcNewTargetBlocksAverage: Cardinal = 100;
   CT_MaxBlock : Cardinal = $FFFFFFFF;
   CT_MaxBlock : Cardinal = $FFFFFFFF;
@@ -87,7 +87,7 @@ Const
   CT_Op_Changekey = $02;
   CT_Op_Changekey = $02;
   CT_Op_Recover = $03;
   CT_Op_Recover = $03;
 
 
-  CT_ClientAppVersion : AnsiString = '1.0.6';
+  CT_ClientAppVersion : AnsiString = {$IFDEF PRODUCTION}'1.0.7'{$ELSE}{$IFDEF TESTNET}'TESTNET'{$ELSE}{$ENDIF}{$ENDIF};
 
 
   CT_Discover_IPs =  'bpascal1.dynamic-dns.net;bpascal2.dynamic-dns.net;pascalcoin1.ddns.net;pascalcoin2.ddns.net;pascalcoin1.dynamic-dns.net;pascalcoin1.dns1.us';
   CT_Discover_IPs =  'bpascal1.dynamic-dns.net;bpascal2.dynamic-dns.net;pascalcoin1.ddns.net;pascalcoin2.ddns.net;pascalcoin1.dynamic-dns.net;pascalcoin1.dns1.us';
 
 
@@ -98,7 +98,7 @@ Const
   CT_PARAM_GridAccountsPos = 'GridAccountsPos';
   CT_PARAM_GridAccountsPos = 'GridAccountsPos';
   CT_PARAM_DefaultFee = 'DefaultFee';
   CT_PARAM_DefaultFee = 'DefaultFee';
   CT_PARAM_InternetServerPort = 'InternetServerPort';
   CT_PARAM_InternetServerPort = 'InternetServerPort';
-  CT_PARAM_AutomaticMineWhenConnectedToNodes = 'AutomaticMineWhenConnectedToNodes';
+  //CT_PARAM_AutomaticMineWhenConnectedToNodes = 'AutomaticMineWhenConnectedToNodes';
   CT_PARAM_MinerPrivateKeyType = 'MinerPrivateKeyType';
   CT_PARAM_MinerPrivateKeyType = 'MinerPrivateKeyType';
   CT_PARAM_MinerPrivateKeySelectedPublicKey = 'MinerPrivateKeySelectedPublicKey';
   CT_PARAM_MinerPrivateKeySelectedPublicKey = 'MinerPrivateKeySelectedPublicKey';
   CT_PARAM_SaveLogFiles = 'SaveLogFiles';
   CT_PARAM_SaveLogFiles = 'SaveLogFiles';
@@ -107,9 +107,11 @@ Const
   CT_PARAM_MinerName = 'MinerName';
   CT_PARAM_MinerName = 'MinerName';
   CT_PARAM_FirstTime = 'FirstTime';
   CT_PARAM_FirstTime = 'FirstTime';
   CT_PARAM_ShowModalMessages = 'ShowModalMessages';
   CT_PARAM_ShowModalMessages = 'ShowModalMessages';
-  CT_PARAM_MaxCPUs = 'MaxCPUs';
+  // CT_PARAM_MaxCPUs = 'MaxCPUs'; deprecated
   CT_PARAM_PeerCache = 'PeerCache';
   CT_PARAM_PeerCache = 'PeerCache';
   CT_PARAM_TryToConnectOnlyWithThisFixedServers = 'TryToConnectOnlyWithFixedServers';
   CT_PARAM_TryToConnectOnlyWithThisFixedServers = 'TryToConnectOnlyWithFixedServers';
+  CT_PARAM_JSONRPCMinerServerPort = 'JSONRPCMinerServerPort';
+  CT_PARAM_JSONRPCMinerServerActive = 'JSONRPCMinerServerActive';
 
 
 
 
 
 

+ 4 - 4
Units/PascalCoin/ULog.pas

@@ -51,14 +51,14 @@ type
     FFileName: AnsiString;
     FFileName: AnsiString;
     FSaveTypes: TLogTypes;
     FSaveTypes: TLogTypes;
     FThreadSafeLogEvent : TThreadSafeLogEvent;
     FThreadSafeLogEvent : TThreadSafeLogEvent;
-    Procedure NotifyNewLog(logtype : TLogType; Const sender, logtext : AnsiString);
+    Procedure NotifyNewLog(logtype : TLogType; Const sender, logtext : String);
     procedure SetFileName(const Value: AnsiString);
     procedure SetFileName(const Value: AnsiString);
   protected
   protected
     Procedure DoLog(logtype : TLogType; sender, logtext : AnsiString); virtual;
     Procedure DoLog(logtype : TLogType; sender, logtext : AnsiString); virtual;
   public
   public
     Constructor Create(AOwner : TComponent); override;
     Constructor Create(AOwner : TComponent); override;
     Destructor Destroy; override;
     Destructor Destroy; override;
-    Class Procedure NewLog(logtype : TLogType; Const sender, logtext : AnsiString);
+    Class Procedure NewLog(logtype : TLogType; Const sender, logtext : String);
     Property OnNewLog : TNewLogEvent read FOnNewLog write FOnNewLog;
     Property OnNewLog : TNewLogEvent read FOnNewLog write FOnNewLog;
     Property FileName : AnsiString read FFileName write SetFileName;
     Property FileName : AnsiString read FFileName write SetFileName;
     Property SaveTypes : TLogTypes read FSaveTypes write FSaveTypes;
     Property SaveTypes : TLogTypes read FSaveTypes write FSaveTypes;
@@ -125,7 +125,7 @@ begin
 //
 //
 end;
 end;
 
 
-class procedure TLog.NewLog(logtype: TLogType; Const sender, logtext: AnsiString);
+class procedure TLog.NewLog(logtype: TLogType; Const sender, logtext: String);
 var i : Integer;
 var i : Integer;
 begin
 begin
   if (Not Assigned(_logs)) then exit;
   if (Not Assigned(_logs)) then exit;
@@ -134,7 +134,7 @@ begin
   end;
   end;
 end;
 end;
 
 
-procedure TLog.NotifyNewLog(logtype: TLogType; Const sender, logtext: AnsiString);
+procedure TLog.NotifyNewLog(logtype: TLogType; Const sender, logtext: String);
 Var s,tid : AnsiString;
 Var s,tid : AnsiString;
   tsle : TThreadSafeLogEvent;
   tsle : TThreadSafeLogEvent;
   P : PLogData;
   P : PLogData;

+ 21 - 26
Units/PascalCoin/UMiner.pas

@@ -32,8 +32,8 @@ Type
 
 
   TMinerThread = Class;
   TMinerThread = Class;
 
 
-  TMinerNewAccountFound = procedure(sender : TMinerThread; Operations : TPCOperationsComp) of object;
-  TMinerErrorFound = procedure(sender : TMinerThread; Operations : TPCOperationsComp; errors : String) of object;
+  TMinerNewBlockFound = procedure(sender : TMinerThread; Operations : TPCOperationsComp; Var Correct : Boolean) of object;
+  TMinerNewBlockFoundNotify = procedure(sender : TMinerThread; Operations : TPCOperationsComp) of object;
 
 
   TMinerThread = Class(TPCThread)
   TMinerThread = Class(TPCThread)
   private
   private
@@ -44,23 +44,22 @@ Type
     FLastStartTickCount : Cardinal;
     FLastStartTickCount : Cardinal;
     //
     //
     errors : AnsiString;
     errors : AnsiString;
-    FOnNewAccountFound: TMinerNewAccountFound;
-    FOnErrorFound: TMinerErrorFound;
     FAccountKey: TAccountKey;
     FAccountKey: TAccountKey;
     FPaused: Boolean;
     FPaused: Boolean;
-    procedure SynchronizedNewBlockFound;
-    procedure SynchronizedError;
+    FOnNewBlockFound: TMinerNewBlockFound;
+    FOnThreadSafeNewBlockFound: TMinerNewBlockFoundNotify;
     procedure SetAccountKey(const Value: TAccountKey);
     procedure SetAccountKey(const Value: TAccountKey);
     Procedure CheckIfCanRecoverBlocks;
     Procedure CheckIfCanRecoverBlocks;
+    Procedure NotifyNewBlockFoundThreadSafe;
   protected
   protected
     procedure BCExecute; override;
     procedure BCExecute; override;
   public
   public
-    Constructor Create(Bank : TPCBank; minerAccountKey : TAccountKey; AOnNewAccountFound : TMinerNewAccountFound; AOnErrorFound : TMinerErrorFound);
+    Constructor Create(Bank : TPCBank; minerAccountKey : TAccountKey; AOnNewBlockFound : TMinerNewBlockFound; AOnThreadSafeNewBlockFound : TMinerNewBlockFoundNotify);
     destructor Destroy; override;
     destructor Destroy; override;
     Function MinerLockOperations : TPCOperationsComp;
     Function MinerLockOperations : TPCOperationsComp;
     Procedure MinerUnLockOperations(IsNewBlock : Boolean);
     Procedure MinerUnLockOperations(IsNewBlock : Boolean);
-    Property OnNewAccountFound : TMinerNewAccountFound read FOnNewAccountFound write FOnNewAccountFound;
-    Property OnErrorFound : TMinerErrorFound read FOnErrorFound write FOnErrorFound;
+    Property OnNewBlockFound : TMinerNewBlockFound read FOnNewBlockFound write FOnNewBlockFound;
+    Property OnThreadSafeNewBlockFound : TMinerNewBlockFoundNotify read FOnThreadSafeNewBlockFound write FOnThreadSafeNewBlockFound;
     Property PlayCount : Int64 read FPlayCount;
     Property PlayCount : Int64 read FPlayCount;
     Property AccountKey : TAccountKey read FAccountKey write SetAccountKey;
     Property AccountKey : TAccountKey read FAccountKey write SetAccountKey;
     Property Paused : Boolean read FPaused Write FPaused;
     Property Paused : Boolean read FPaused Write FPaused;
@@ -70,7 +69,7 @@ Type
 
 
 implementation
 implementation
 
 
-uses UNode, ULog, SysUtils, UConst, UOpTransaction, UCrypto;
+uses ULog, SysUtils, UConst, UOpTransaction, UCrypto;
 
 
 { TMinerThread }
 { TMinerThread }
 
 
@@ -104,7 +103,7 @@ Begin
   end;
   end;
 End;
 End;
 
 
-constructor TMinerThread.Create(Bank : TPCBank; minerAccountKey : TAccountKey; AOnNewAccountFound : TMinerNewAccountFound; AOnErrorFound : TMinerErrorFound);
+constructor TMinerThread.Create(Bank : TPCBank; minerAccountKey : TAccountKey; AOnNewBlockFound : TMinerNewBlockFound; AOnThreadSafeNewBlockFound : TMinerNewBlockFoundNotify);
 begin
 begin
   inherited Create(true);
   inherited Create(true);
   FTotalActiveTime := 0;
   FTotalActiveTime := 0;
@@ -116,8 +115,8 @@ begin
   FOperations := TPCOperationsComp.Create(nil);
   FOperations := TPCOperationsComp.Create(nil);
   FOperations.Bank := Bank;
   FOperations.Bank := Bank;
   FOperations.AccountKey := AccountKey;
   FOperations.AccountKey := AccountKey;
-  FOnNewAccountFound := AOnNewAccountFound;
-  FOnErrorFound := AOnErrorFound;
+  FOnNewBlockFound := AOnNewBlockFound;
+  FOnThreadSafeNewBlockFound := AOnThreadSafeNewBlockFound;
   Priority := tpLower;
   Priority := tpLower;
   Suspended := false;
   Suspended := false;
 end;
 end;
@@ -131,6 +130,7 @@ procedure TMinerThread.BCExecute;
 Var i : Integer;
 Var i : Integer;
   winner : Boolean;
   winner : Boolean;
   newBlockAccount : TBlockAccount;
   newBlockAccount : TBlockAccount;
+  c : Boolean;
 begin
 begin
   TLog.NewLog(ltinfo,ClassName,'New miner');
   TLog.NewLog(ltinfo,ClassName,'New miner');
   while (not Terminated) do begin
   while (not Terminated) do begin
@@ -161,11 +161,11 @@ begin
       end;
       end;
       if (winner) then begin
       if (winner) then begin
         Try
         Try
-          If TNode.Node.AddNewBlockChain(Self,nil,FOperations,newBlockAccount,errors) then begin
-            Synchronize(SynchronizedNewBlockFound);
-          end else begin
-            Synchronize(SynchronizedError);
+          c := true;
+          if Assigned(FOnNewBlockFound) then begin
+            FOnNewBlockFound(Self,FOperations,c);
           end;
           end;
+          if (c) And (Assigned(FOnThreadSafeNewBlockFound)) then Synchronize(NotifyNewBlockFoundThreadSafe);
         Except
         Except
           On E:Exception do begin
           On E:Exception do begin
             TLog.NewLog(lterror,Classname,'Exception on adding new block by miner: '+E.Message);
             TLog.NewLog(lterror,Classname,'Exception on adding new block by miner: '+E.Message);
@@ -209,19 +209,14 @@ begin
   if IsNewBlock then CheckIfCanRecoverBlocks;
   if IsNewBlock then CheckIfCanRecoverBlocks;
 end;
 end;
 
 
-procedure TMinerThread.SetAccountKey(const Value: TAccountKey);
+procedure TMinerThread.NotifyNewBlockFoundThreadSafe;
 begin
 begin
-  FAccountKey := Value;
+  if Assigned(FOnThreadSafeNewBlockFound) then FOnThreadSafeNewBlockFound(Self,FOperations);
 end;
 end;
 
 
-procedure TMinerThread.SynchronizedError;
-begin
-  if assigned(FOnErrorFound) then FOnErrorFound(self,FOperations,errors);
-end;
-
-procedure TMinerThread.SynchronizedNewBlockFound;
+procedure TMinerThread.SetAccountKey(const Value: TAccountKey);
 begin
 begin
-  if assigned(FOnNewAccountFound) then FOnNewAccountFound(self,FOperations);
+  FAccountKey := Value;
 end;
 end;
 
 
 initialization
 initialization

+ 32 - 37
Units/PascalCoin/UNetProtocol.pas

@@ -28,8 +28,6 @@ Uses
   UBlockChain, Classes, SysUtils, UAccounts, UThread, ExtCtrls,
   UBlockChain, Classes, SysUtils, UAccounts, UThread, ExtCtrls,
   UCrypto, UTCPIP, SyncObjs;
   UCrypto, UTCPIP, SyncObjs;
 
 
-{$DEFINE TESTNET}
-
 Const
 Const
   CT_MagicRequest = $0001;
   CT_MagicRequest = $0001;
   CT_MagicResponse = $0002;
   CT_MagicResponse = $0002;
@@ -878,7 +876,7 @@ Const CT_LogSender = 'GetNewBlockChainFromClient';
         end;
         end;
         Result := true;
         Result := true;
       end else begin
       end else begin
-        TLog.NewLog(lterror,CT_LogSender,Format('No received response after waiting request id %d operation %s',[request_id,TNetData.OperationToText(noperation)]));
+        TLog.NewLog(lterror,CT_LogSender,Format('No received response after waiting %d request id %d operation %s',[MaxWaitMilliseconds,request_id,TNetData.OperationToText(noperation)]));
       end;
       end;
     finally
     finally
       SendData.Free;
       SendData.Free;
@@ -1336,6 +1334,7 @@ constructor TNetServer.Create;
 begin
 begin
   inherited;
   inherited;
   MaxConnections := CT_MaxClientsConnected;
   MaxConnections := CT_MaxClientsConnected;
+  NetTcpIpClientClass := TBufferedNetTcpIpClient;
 end;
 end;
 
 
 procedure TNetServer.OnNewIncommingConnection(Sender : TObject; Client : TNetTcpIpClient);
 procedure TNetServer.OnNewIncommingConnection(Sender : TObject; Client : TNetTcpIpClient);
@@ -1374,12 +1373,12 @@ begin
       end;
       end;
     Finally
     Finally
       Try
       Try
-        TLog.NewLog(ltdebug,Classname,'Finalizing ServerAccept '+IntToHex(Integer(n),8));
+        TLog.NewLog(ltdebug,Classname,'Finalizing ServerAccept '+IntToHex(Integer(n),8)+' '+n.ClientRemoteAddr);
         DebugStep := 'Disconnecting NetServerClient';
         DebugStep := 'Disconnecting NetServerClient';
         n.Connected := false;
         n.Connected := false;
         sleep(10);
         sleep(10);
         DebugStep := 'Assigning old client';
         DebugStep := 'Assigning old client';
-        n.SetClient( TNetTcpIpClient.Create(Nil) );
+        n.SetClient( NetTcpIpClientClass.Create(Nil) );
       Finally
       Finally
         DebugStep := 'Freeing NetServerClient';
         DebugStep := 'Freeing NetServerClient';
         n.Free;
         n.Free;
@@ -1472,7 +1471,7 @@ begin
   FLastDataSendedTS := 0;
   FLastDataSendedTS := 0;
   FTcpIpClient := Nil;
   FTcpIpClient := Nil;
   FRemoteOperationBlock := CT_OperationBlock_NUL;
   FRemoteOperationBlock := CT_OperationBlock_NUL;
-  SetClient( TNetTcpIpClient.Create(Self) );
+  SetClient( TBufferedNetTcpIpClient.Create(Self) );
   TNetData.NetData.FNetConnections.Add(Self);
   TNetData.NetData.FNetConnections.Add(Self);
   TNetData.NetData.NotifyNetConnectionUpdated;
   TNetData.NetData.NotifyNetConnectionUpdated;
 end;
 end;
@@ -2128,20 +2127,6 @@ begin
       end;
       end;
       tc := GetTickCount;
       tc := GetTickCount;
       Repeat
       Repeat
-        if Not Client.WaitForData(100) then begin
-          If Client.SocketError<>0 then begin
-            TLog.NewLog(ltdebug,classname,'Broken connection by error '+Inttostr(Client.SocketError)+' to '+ClientRemoteAddr);
-            Connected := false;
-            exit;
-          end;
-          if (GetTickCount-tc < 50) then begin
-            // Broken!
-            TLog.NewLog(ltdebug,classname,'Broken connection to '+ClientRemoteAddr);
-            Connected := false;
-            exit;
-          end;
-          if (FClientBufferRead.Size=0) And (RequestId=0) then exit; // Nothing to read nor wait
-        end;
         if (ReadTcpClientBuffer(MaxWaitTime,HeaderData,ReceiveDataBuffer)) then begin
         if (ReadTcpClientBuffer(MaxWaitTime,HeaderData,ReceiveDataBuffer)) then begin
           l := TNetData.NetData.NodeServers.LockList;
           l := TNetData.NetData.NodeServers.LockList;
           try
           try
@@ -2227,12 +2212,14 @@ function TNetConnection.ReadTcpClientBuffer(MaxWaitMiliseconds: Cardinal; var He
 var buffer : Array[1..4096] of byte;
 var buffer : Array[1..4096] of byte;
   auxstream : TMemoryStream;
   auxstream : TMemoryStream;
   tc : Cardinal;
   tc : Cardinal;
-  last_bytes_read : Integer;
+  last_bytes_read : Int64;
   //
   //
   operation : Word;
   operation : Word;
   request_id : Integer;
   request_id : Integer;
   IsValidHeaderButNeedMoreData : Boolean;
   IsValidHeaderButNeedMoreData : Boolean;
   deletedBytes : Int64;
   deletedBytes : Int64;
+
+
 begin
 begin
   Result := false;
   Result := false;
   HeaderData := CT_NetHeaderData;
   HeaderData := CT_NetHeaderData;
@@ -2279,9 +2266,23 @@ begin
         if Not Client.WaitForData(100) then begin
         if Not Client.WaitForData(100) then begin
           exit;
           exit;
         end;
         end;
-        last_bytes_read := Client.ReceiveBuf(buffer,sizeof(buffer));
+
+        auxstream := (Client as TBufferedNetTcpIpClient).ReadBufferLock;
+        try
+          last_bytes_read := auxstream.size;
+          if last_bytes_read>0 then begin
+            FLastDataReceivedTS := GetTickCount;
+
+            FClientBufferRead.Position := FClientBufferRead.size; // Go to the end
+            auxstream.Position := 0;
+            FClientBufferRead.CopyFrom(auxstream,last_bytes_read);
+            FClientBufferRead.Position := 0;
+            auxstream.Size := 0;
+          end;
+        finally
+          (Client as TBufferedNetTcpIpClient).ReadBufferUnlock;
+        end;
         if last_bytes_read>0 then begin
         if last_bytes_read>0 then begin
-          FLastDataReceivedTS := GetTickCount;
           if Not FHasReceivedData then begin
           if Not FHasReceivedData then begin
             FHasReceivedData := true;
             FHasReceivedData := true;
             if (Self is TNetClient) then
             if (Self is TNetClient) then
@@ -2290,12 +2291,7 @@ begin
           end else begin
           end else begin
             TNetData.NetData.IncStatistics(0,0,0,0,last_bytes_read,0);
             TNetData.NetData.IncStatistics(0,0,0,0,last_bytes_read,0);
           end;
           end;
-
-
         end;
         end;
-        FClientBufferRead.Position := FClientBufferRead.size; // Go to the end
-        FClientBufferRead.Write(buffer,last_bytes_read);
-        FClientBufferRead.Position := 0;
       end;
       end;
     until (Result) Or ((GetTickCount > (tc+MaxWaitMiliseconds)) And (last_bytes_read=0));
     until (Result) Or ((GetTickCount > (tc+MaxWaitMiliseconds)) And (last_bytes_read=0));
   finally
   finally
@@ -2323,7 +2319,6 @@ Var l : Cardinal;
    w : Word;
    w : Word;
   Buffer : TStream;
   Buffer : TStream;
   s : AnsiString;
   s : AnsiString;
-  sendbytes : Int64;
 begin
 begin
   Buffer := TMemoryStream.Create;
   Buffer := TMemoryStream.Create;
   try
   try
@@ -2379,14 +2374,12 @@ begin
         TNetData.OperationToText(operation)+' id:'+Inttostr(request_id)+' errorcode:'+InttoStr(errorcode)+
         TNetData.OperationToText(operation)+' id:'+Inttostr(request_id)+' errorcode:'+InttoStr(errorcode)+
         ' Size:'+InttoStr(Buffer.Size)+'b '+s+'to '+
         ' Size:'+InttoStr(Buffer.Size)+'b '+s+'to '+
         ClientRemoteAddr);
         ClientRemoteAddr);
-      sendbytes := Client.SendStream(Buffer);
-      if sendbytes>0 then begin
-        FLastDataSendedTS := GetTickCount;
-        TNetData.NetData.IncStatistics(0,0,0,0,0,Buffer.Size);
-      end;
+      (Client as TBufferedNetTcpIpClient).WriteBufferToSend(Buffer);
+      FLastDataSendedTS := GetTickCount;
     Finally
     Finally
       FNetLock.Release;
       FNetLock.Release;
     End;
     End;
+    TNetData.NetData.IncStatistics(0,0,0,0,0,Buffer.Size);
   finally
   finally
     Buffer.Free;
     Buffer.Free;
   end;
   end;
@@ -2784,9 +2777,11 @@ begin
             end else inc(nactive);
             end else inc(nactive);
           end else if (netconn is TNetServerClient) then begin
           end else if (netconn is TNetServerClient) then begin
             inc(nserverclients);
             inc(nserverclients);
-            if not assigned(netserverclientstop) then netserverclientstop := TNetServerClient(netconn)
-            else if netconn.CreatedTime<netserverclientstop.CreatedTime then begin
-              netserverclientstop := TNetServerClient(netconn);
+            if (Not netconn.FDoFinalizeConnection) then begin
+              if not assigned(netserverclientstop) then netserverclientstop := TNetServerClient(netconn)
+              else if netconn.CreatedTime<netserverclientstop.CreatedTime then begin
+                netserverclientstop := TNetServerClient(netconn);
+              end;
             end;
             end;
           end;
           end;
         end;
         end;

+ 41 - 20
Units/PascalCoin/UNode.pas

@@ -51,6 +51,7 @@ Type
     FDisabledsNewBlocksCount : Integer;
     FDisabledsNewBlocksCount : Integer;
     Procedure OnBankNewBlock(Sender : TObject);
     Procedure OnBankNewBlock(Sender : TObject);
     Procedure OnMinerThreadTerminate(Sender : TObject);
     Procedure OnMinerThreadTerminate(Sender : TObject);
+    Procedure OnMinerNewBlockFound(sender : TMinerThread; Operations : TPCOperationsComp; Var Correct : Boolean);
   protected
   protected
     procedure Notification(AComponent: TComponent; Operation: TOperation); override;
     procedure Notification(AComponent: TComponent; Operation: TOperation); override;
   public
   public
@@ -149,7 +150,7 @@ Var op : TPCOperationsComp;
 begin
 begin
   Result := Nil;
   Result := Nil;
   TLog.NewLog(ltinfo,ClassName,'Creating a new miner');
   TLog.NewLog(ltinfo,ClassName,'Creating a new miner');
-  Result := TMinerThread.Create(Bank,AccountKey,nil,nil);
+  Result := TMinerThread.Create(Bank,AccountKey,OnMinerNewBlockFound,nil);
   Result.OnTerminate := OnMinerThreadTerminate;
   Result.OnTerminate := OnMinerThreadTerminate;
   op := Result.MinerLockOperations;
   op := Result.MinerLockOperations;
   try
   try
@@ -169,6 +170,7 @@ Var i : Integer;
   mtl : TList;
   mtl : TList;
   netConnectionsList : TList;
   netConnectionsList : TList;
   s : String;
   s : String;
+  errors2 : AnsiString;
 begin
 begin
   Result := false;
   Result := false;
   if FDisabledsNewBlocksCount>0 then begin
   if FDisabledsNewBlocksCount>0 then begin
@@ -190,8 +192,10 @@ begin
       Result := Bank.AddNewBlockChainBlock(NewBlockOperations,newBlockAccount,errors);
       Result := Bank.AddNewBlockChainBlock(NewBlockOperations,newBlockAccount,errors);
       FOperations.Clear(true);
       FOperations.Clear(true);
       ms.Position:=0;
       ms.Position:=0;
-      If Not FOperations.LoadBlockFromStream(ms,errors) then begin
-        TLog.NewLog(lterror,Classname,'Error recovering operations to sanitize: '+errors);
+      If Not FOperations.LoadBlockFromStream(ms,errors2) then begin
+        TLog.NewLog(lterror,Classname,'Error recovering operations to sanitize: '+errors2);
+        if Result then errors := errors2
+        else errors := errors +' - '+errors2;
       end;
       end;
     finally
     finally
       ms.Free;
       ms.Free;
@@ -622,6 +626,17 @@ begin
   FOperations.SanitizeOperations;
   FOperations.SanitizeOperations;
 end;
 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);
 procedure TNode.OnMinerThreadTerminate(Sender: TObject);
 begin
 begin
   FMinerThreads.Remove(Sender);
   FMinerThreads.Remove(Sender);
@@ -736,25 +751,31 @@ end;
 procedure TThreadSafeNodeNotifyEvent.SynchronizedProcess;
 procedure TThreadSafeNodeNotifyEvent.SynchronizedProcess;
 Var i : Integer;
 Var i : Integer;
 begin
 begin
-  If (Terminated) Or (Not Assigned(FNodeNotifyEvents)) then exit;
-  if FNotifyBlocksChanged then begin
-    FNotifyBlocksChanged := false;
-    if Assigned(FNodeNotifyEvents) And (Assigned(FNodeNotifyEvents.FOnBlocksChanged)) then
-      FNodeNotifyEvents.FOnBlocksChanged(FNodeNotifyEvents);
-  end;
-  if FNotifyOperationsChanged then begin
-    FNotifyOperationsChanged := false;
-    if Assigned(FNodeNotifyEvents) And (Assigned(FNodeNotifyEvents.FOnOperationsChanged)) then
-      FNodeNotifyEvents.FOnOperationsChanged(FNodeNotifyEvents);
-  end;
-  if FNodeNotifyEvents.FMessages.Count>0 then begin
-    if Assigned(FNodeNotifyEvents) And (Assigned(FNodeNotifyEvents.FOnNodeMessageEvent)) then begin
-      for i := 0 to FNodeNotifyEvents.FMessages.Count - 1 do begin
-        FNodeNotifyEvents.FOnNodeMessageEvent(TNetConnection(FNodeNotifyEvents.FMessages.Objects[i]),FNodeNotifyEvents.FMessages.Strings[i]);
+  Try
+    If (Terminated) Or (Not Assigned(FNodeNotifyEvents)) then exit;
+    if FNotifyBlocksChanged then begin
+      FNotifyBlocksChanged := false;
+      if Assigned(FNodeNotifyEvents) And (Assigned(FNodeNotifyEvents.FOnBlocksChanged)) then
+        FNodeNotifyEvents.FOnBlocksChanged(FNodeNotifyEvents);
+    end;
+    if FNotifyOperationsChanged then begin
+      FNotifyOperationsChanged := false;
+      if Assigned(FNodeNotifyEvents) And (Assigned(FNodeNotifyEvents.FOnOperationsChanged)) then
+        FNodeNotifyEvents.FOnOperationsChanged(FNodeNotifyEvents);
+    end;
+    if FNodeNotifyEvents.FMessages.Count>0 then begin
+      if Assigned(FNodeNotifyEvents) And (Assigned(FNodeNotifyEvents.FOnNodeMessageEvent)) then begin
+        for i := 0 to FNodeNotifyEvents.FMessages.Count - 1 do begin
+          FNodeNotifyEvents.FOnNodeMessageEvent(TNetConnection(FNodeNotifyEvents.FMessages.Objects[i]),FNodeNotifyEvents.FMessages.Strings[i]);
+        end;
       end;
       end;
+      FNodeNotifyEvents.FMessages.Clear;
     end;
     end;
-    FNodeNotifyEvents.FMessages.Clear;
-  end;
+  Except
+    On E:Exception do begin
+      TLog.NewLog(lterror,ClassName,'Exception inside a Synchronized process: '+E.ClassName+':'+E.Message);
+    end;
+  End;
 end;
 end;
 
 
 { TThreadNodeNotifyNewBlock }
 { TThreadNodeNotifyNewBlock }

+ 621 - 0
Units/PascalCoin/UPoolMining.pas

@@ -0,0 +1,621 @@
+unit UPoolMining;
+
+{ 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 UTCPIP, SysUtils, UThread, SyncObjs, Classes, Windows, UJSONFunctions, UNode, UCrypto,
+  UAccounts;
+
+Const
+  CT_PoolMining_Method_STATUS = 'status';
+  CT_PoolMining_Method_MINER_NOTIFY = 'miner-notify'; // Server message to clients to update miners PoW data
+  CT_PoolMining_Method_MINER_SUBMIT = 'miner-submit'; // Client message to server to notify a PoW found
+
+Type
+  TMinerValuesForWork = Record
+     block : Cardinal;
+     version : Word;
+     part1 : TRawBytes;
+     payload_start : TRawBytes;
+     part3 : TRawBytes;
+     target : Cardinal;
+     timestamp : Cardinal;
+     target_pow : TRawBytes;
+  End;
+
+  TJSONRPCTcpIpClient = Class(TBufferedNetTcpIpClient)
+  private
+    FWaitingForResponseId : Cardinal;
+    FMaxWaitingForResponseMiliseconds : Cardinal;
+    FLastId : Cardinal;
+    FReceivedBuffer : TBytes;
+  protected
+  public
+    Constructor Create(AOwner : TComponent); override;
+    Destructor Destroy; override;
+    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 GetNewId : Cardinal;
+  End;
+
+  TPoolMinerClient = Class(TJSONRPCTcpIpClient)
+  private
+    FMinerValuesForWork: TMinerValuesForWork;
+    FOnMinerMustChangeValues: TNotifyEvent;
+    procedure SetMinerValuesForWork(const Value: TMinerValuesForWork);
+  protected
+  public
+    Constructor Create(AOwner : TComponent); override;
+    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);
+  End;
+
+  TPoolMiningServer = Class(TNetTcpIpServer)
+  private
+    FIncomingsCounter : Integer;
+    FNodeNotifyEvents : TNodeNotifyEvents;
+    FMinerAccountKey: TAccountKey;
+    FMinerPayload: TRawBytes;
+    FClientsWins: Integer;
+    FClientsCount: Integer;
+    Procedure DoProcessJSON(json : TPCJSONObject; Client : TJSONRPCTcpIpClient);
+    Procedure OnNodeNewBlock(Sender : TObject);
+    Procedure OnNodeOperationsChanged(Sender : TObject);
+    Procedure Send_mine_values_to_all;
+    Procedure FillMineValue(mine_values : TPCJSONObject; Client : TJSONRPCTcpIpClient);
+    Function MinerSubmit(Client : TJSONRPCTcpIpClient; params : TPCJSONObject; const id : Variant) : Boolean;
+    procedure SetMinerAccountKey(const Value: TAccountKey);
+    procedure SetMinerPayload(const Value: TRawBytes);
+  protected
+    Procedure OnNewIncommingConnection(Sender : TObject; Client : TNetTcpIpClient); override;
+    procedure SetActive(const Value: Boolean); override;
+  public
+    Constructor Create; override;
+    Destructor Destroy; override;
+    Property MinerAccountKey : TAccountKey read FMinerAccountKey write SetMinerAccountKey;
+    Property MinerPayload : TRawBytes read FMinerPayload write SetMinerPayload;
+    Procedure UpdateAccountAndPayload(AMinerAccountKey : TAccountKey; AMinerPayload : TRawBytes);
+    Property ClientsCount : Integer read FClientsCount;
+    Property ClientsWins : Integer read FClientsWins;
+  End;
+
+Const
+  CT_TMinerValuesForWork_NULL : TMinerValuesForWork = (block:0;version:0;part1:'';payload_start:'';part3:'';target:0;timestamp:0;target_pow:'');
+
+implementation
+
+Uses ULog, Variants, UTime, UBlockChain;
+
+{ TJSONRPCTcpIpClient }
+
+constructor TJSONRPCTcpIpClient.Create(AOwner: TComponent);
+begin
+  inherited;
+  FLastId := 1;
+  FWaitingForResponseId := 0;
+  FMaxWaitingForResponseMiliseconds := 0;
+  SetLength(FReceivedBuffer,0);
+end;
+
+destructor TJSONRPCTcpIpClient.Destroy;
+begin
+  SetLength(FReceivedBuffer,0);
+  inherited;
+end;
+
+function TJSONRPCTcpIpClient.DoProcessBuffer(SenderThread : TPCThread; MaxWaitMiliseconds : Cardinal; DeleteBufferOnExit : Boolean) : TPCJSONObject;
+var last_bytes_read : Integer;
+  jsonData : TPCJSONData;
+  tc : Cardinal;
+  ms : TMemoryStream;
+  pac : PAnsiChar;
+  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;
+      end;
+    finally
+      ReadBufferUnlock;
+    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 else begin
+        TLog.NewLog(ltDebug,ClassName,Format('Read %d bytes but no valid JSON inside',[last_bytes_read]));
+      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',[length(FReceivedBuffer),MaxWaitMiliseconds])));
+    SetLength(FReceivedBuffer,0);
+  end;
+end;
+
+function TJSONRPCTcpIpClient.GetNewId: Cardinal;
+begin
+  inc(FLastId);
+  Result := FLastId;
+end;
+
+procedure TJSONRPCTcpIpClient.SendJSONRPCErrorResponse(const id: Variant; const error: String);
+Var response : TPCJSONObject;
+  stream : TMemoryStream;
+  b : Byte;
+begin
+  TLog.NewLog(lterror,ClassName,'Sending Error JSON RPC id ('+VarToStr(id)+') : '+error);
+  response := TPCJSONObject.Create;
+  Try
+    response.GetAsVariant('result').Value := Null;
+    response.GetAsVariant('error').Value := error;
+    response.GetAsVariant('id').Value := id;
+    stream := TMemoryStream.Create;
+    try
+      response.SaveToStream(stream);
+      b := 13;
+      stream.Write(b,1);
+      b := 10;
+      stream.Write(b,1);
+      b := 0;
+      stream.Write(b,1);
+      stream.Position := 0;
+      WriteBufferToSend(stream);
+    finally
+      stream.Free;
+    end;
+  Finally
+    response.Free;
+  End;
+end;
+
+procedure TJSONRPCTcpIpClient.SendJSONRPCMethod(const method: String; params: TPCJSONObject; const id: Variant);
+Var json : TPCJSONObject;
+  stream : TMemoryStream;
+  b : Byte;
+begin
+  json := TPCJSONObject.Create;
+  Try
+    json.GetAsVariant('method').Value := method;
+    if Assigned(params) then begin
+      json.GetAsArray('params').GetAsObject(0).Assign(params);
+    end;
+    json.GetAsVariant('id').Value := id;
+    stream := TMemoryStream.Create;
+    try
+      json.SaveToStream(stream);
+      b := 13;
+      stream.Write(b,1);
+      b := 10;
+      stream.Write(b,1);
+      b := 0;
+      stream.Write(b,1);
+      stream.Position := 0;
+      WriteBufferToSend(stream);
+    finally
+      stream.Free;
+    end;
+  Finally
+    json.Free;
+  End;
+end;
+
+function TJSONRPCTcpIpClient.SendJSONRPCMethodAndWait(const method: String; params: TPCJSONObject; MaxWaitMiliseconds: Cardinal; resultObject : TPCJSONObject) : Boolean;
+Var nId : Cardinal;
+  tc : Cardinal;
+  json : TPCJSONObject;
+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;
+    finally
+      json.Free;
+    end;
+  end;
+end;
+
+procedure TJSONRPCTcpIpClient.SendJSONRPCResponse(result: TPCJSONObject; const id: Variant);
+Var response : TPCJSONObject;
+  stream : TMemoryStream;
+  b : Byte;
+begin
+  response := TPCJSONObject.Create;
+  Try
+    response.GetAsObject('result').Assign(result);
+    response.GetAsVariant('error').Value := Null;
+    response.GetAsVariant('id').Value := id;
+    stream := TMemoryStream.Create;
+    try
+      response.SaveToStream(stream);
+      b := 13;
+      stream.Write(b,1);
+      b := 10;
+      stream.Write(b,1);
+      b := 0;
+      stream.Write(b,1);
+      stream.Position := 0;
+      WriteBufferToSend(stream);
+    finally
+      stream.Free;
+    end;
+  Finally
+    response.Free;
+  End;
+end;
+
+{ TPoolMiningServer }
+
+constructor TPoolMiningServer.Create;
+begin
+  inherited;
+  FIncomingsCounter := 0;
+  FClientsWins := 0;
+  FClientsCount := 0;
+  NetTcpIpClientClass := TJSONRPCTcpIpClient;
+  FNodeNotifyEvents := TNodeNotifyEvents.Create(Nil);
+  FNodeNotifyEvents.OnBlocksChanged := OnNodeNewBlock;
+  FNodeNotifyEvents.OnOperationsChanged := OnNodeOperationsChanged;
+  FNodeNotifyEvents.Node := TNode.Node;
+end;
+
+destructor TPoolMiningServer.Destroy;
+begin
+  FNodeNotifyEvents.Node := Nil;
+  FNodeNotifyEvents.OnBlocksChanged := Nil;
+  FNodeNotifyEvents.OnOperationsChanged := Nil;
+  FreeAndNil(FNodeNotifyEvents);
+  inherited;
+end;
+
+procedure TPoolMiningServer.DoProcessJSON(json: TPCJSONObject; Client : TJSONRPCTcpIpClient);
+Var method : String;
+    params : TPCJSONArray;
+    id_value : Variant;
+    i : Integer;
+  response_result : TPCJSONObject;
+begin
+  method := json.AsString('method','');
+  params := json.GetAsArray('params');
+  i := json.IndexOfName('id');
+  if i<0 then begin
+    id_value := Null;
+  end else begin
+    id_value := json.GetAsVariant('id').Value;
+  end;
+  if method=CT_PoolMining_Method_STATUS then begin
+    response_result := TPCJSONObject.Create;
+    Try
+      response_result.GetAsVariant('block').Value := FNodeNotifyEvents.Node.Bank.LastBlockFound.OperationBlock.block;
+      response_result.GetAsVariant('account_key').Value := TCrypto.ToHexaString( TAccountComp.AccountKey2RawString(FNodeNotifyEvents.Node.Bank.LastBlockFound.OperationBlock.account_key) );
+      response_result.GetAsVariant('reward').Value := FNodeNotifyEvents.Node.Bank.LastBlockFound.OperationBlock.reward;
+      response_result.GetAsVariant('fee').Value := FNodeNotifyEvents.Node.Bank.LastBlockFound.OperationBlock.fee;
+      response_result.GetAsVariant('p_version').Value := FNodeNotifyEvents.Node.Bank.LastBlockFound.OperationBlock.protocol_version;
+      response_result.GetAsVariant('p_available').Value := FNodeNotifyEvents.Node.Bank.LastBlockFound.OperationBlock.protocol_available;
+      response_result.GetAsVariant('timestamp').Value := FNodeNotifyEvents.Node.Bank.LastBlockFound.OperationBlock.timestamp;
+      response_result.GetAsVariant('target').Value := FNodeNotifyEvents.Node.Bank.LastBlockFound.OperationBlock.compact_target;
+      response_result.GetAsVariant('nonce').Value := FNodeNotifyEvents.Node.Bank.LastBlockFound.OperationBlock.nonce;
+      response_result.GetAsVariant('payload').Value := TCrypto.ToHexaString( FNodeNotifyEvents.Node.Bank.LastBlockFound.OperationBlock.block_payload );
+      response_result.GetAsVariant('initial_sbh').Value := TCrypto.ToHexaString( FNodeNotifyEvents.Node.Bank.LastBlockFound.OperationBlock.initial_safe_box_hash );
+      response_result.GetAsVariant('operations_hash').Value := TCrypto.ToHexaString( FNodeNotifyEvents.Node.Bank.LastBlockFound.OperationBlock.operations_hash );
+      response_result.GetAsVariant('pow').Value := TCrypto.ToHexaString( FNodeNotifyEvents.Node.Bank.LastBlockFound.OperationBlock.proof_of_work );
+      Client.SendJSONRPCResponse(response_result,id_value);
+    Finally
+      response_result.Free;
+    End;
+  end else if method=CT_PoolMining_Method_MINER_NOTIFY then begin
+    response_result := TPCJSONObject.Create;
+    Try
+      FillMineValue(response_result,Client);
+      Client.SendJSONRPCResponse(response_result,id_value);
+    Finally
+      response_result.Free;
+    End;
+  end else if method=CT_PoolMining_Method_MINER_SUBMIT then begin
+    // Try to submit a PoW
+    if params.Count=1 then MinerSubmit(Client,params.GetAsObject(0),id_value)
+    else TLog.NewLog(lterror,ClassName,'Invalid params array of method '+method);
+  end else begin
+    // Invalid command
+    if (not VarIsNull(id_value)) then begin
+      Client.SendJSONRPCErrorResponse(id_value,'method not found: '+method);
+    end;
+  end;
+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('version').Value := FNodeNotifyEvents.Node.Operations.OperationBlock.protocol_version;
+  Op := TPCOperationsComp.Create(Nil);
+  try
+    Op.CopyFrom(FNodeNotifyEvents.Node.Operations);
+    Op.AccountKey := FMinerAccountKey;
+    Op.BlockPayload := FMinerPayload+IntToStr(Client.Tag);
+    mine_values.GetAsVariant('part1').Value := TCrypto.ToHexaString( Op.PoW_Digest_Part1 );
+    mine_values.GetAsVariant('payload_start').Value := TCrypto.ToHexaString( Op.OperationBlock.block_payload );
+    mine_values.GetAsVariant('part3').Value := TCrypto.ToHexaString( Op.PoW_Digest_Part3 );
+    mine_values.GetAsVariant('target').Value := Op.OperationBlock.compact_target;
+    mine_values.GetAsVariant('target_pow').Value := TCrypto.ToHexaString(FNodeNotifyEvents.Node.Bank.GetActualTargetHash);
+  finally
+    Op.Free;
+  end;
+  mine_values.GetAsVariant('timestamp').Value := UnivDateTimeToUnix(DateTime2UnivDateTime(now));
+end;
+
+function TPoolMiningServer.MinerSubmit(Client: TJSONRPCTcpIpClient; params: TPCJSONObject; const id : Variant): Boolean;
+Var s : String;
+  nbOperations : TPCOperationsComp;
+  errors : AnsiString;
+  nba : TBlockAccount;
+  payload : TRawBytes;
+  json : TPCJSONObject;
+  p1,p2,p3 : TRawBytes;
+begin
+  { Miner params must submit:
+    - "payload" as an Hexadecimal
+    - "timestamp" as an unsigned integer 32 bits
+    - "nonce" as an unsigned integer 32 bits
+    If payload length is < Node payload then error
+    If Node payload is not included in first bytes of payload then error
+    If timestamp is not valid then error
+    If calculated PoW does not match valid PoW then error
+    If all ok... congrats!!! }
+  Result := false;
+  nbOperations := TPCOperationsComp.Create(Nil);
+  try
+    nbOperations.bank := FNodeNotifyEvents.Node.Bank;
+    nbOperations.CopyFrom(FNodeNotifyEvents.Node.Operations);
+    nbOperations.AccountKey := MinerAccountKey;
+    s := params.AsString('payload','');
+    payload := TCrypto.HexaToRaw(AnsiString(s));
+    if FMinerPayload<>'' then begin
+      if (copy(payload,1,length(FMinerPayload))<>FMinerPayload) then begin
+        Client.SendJSONRPCErrorResponse(id,'Invalid payload ('+payload+'). Need start with: '+FMinerPayload);
+        exit;
+      end;
+    end;
+    nbOperations.BlockPayload := payload;
+    nbOperations.timestamp := params.AsInteger('timestamp',0);
+    nbOperations.nonce := params.AsInteger('nonce',0);
+    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
+      // CONGRATS !!!
+      json := TPCJSONObject.Create;
+      try
+        json.GetAsVariant('block').Value := FNodeNotifyEvents.Node.Bank.LastOperationBlock.block;
+        json.GetAsVariant('pow').Value := TCrypto.ToHexaString( FNodeNotifyEvents.Node.Bank.LastOperationBlock.proof_of_work );
+        inc(FClientsWins);
+        Client.SendJSONRPCResponse(json,id);
+      finally
+        json.Free;
+      end;
+    end else begin
+      Client.SendJSONRPCErrorResponse(id,'Error: '+errors);
+    end;
+  finally
+    nbOperations.Free;
+  end;
+end;
+
+procedure TPoolMiningServer.OnNewIncommingConnection(Sender: TObject; Client: TNetTcpIpClient);
+var bClient : TJSONRPCTcpIpClient;
+  init_json : TPCJSONObject;
+  jsonobj : TPCJSONObject;
+  doDelete : Boolean;
+begin
+  inherited;
+  inc(FClientsCount);
+  Try
+    TLog.NewLog(ltinfo,ClassName,'New Mining Pool Connection: '+Client.ClientRemoteAddr);
+    bClient := TJSONRPCTcpIpClient(Client);
+    inc(FIncomingsCounter);
+    bClient.Tag := FIncomingsCounter;
+    init_json := TPCJSONObject.Create;
+    Try
+      FillMineValue(init_json,bClient);
+      bClient.SendJSONRPCMethod(CT_PoolMining_Method_MINER_NOTIFY,init_json,null);
+    Finally
+      init_json.Free;
+    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;
+        end;
+      end;
+      sleep(10);
+    end;
+  Finally
+    Dec(FClientsCount);
+    TLog.NewLog(ltinfo,ClassName,'Finalizing Mining Pool Connection: '+Client.ClientRemoteAddr);
+  End;
+end;
+
+procedure TPoolMiningServer.OnNodeNewBlock(Sender: TObject);
+begin
+  // Send mine values to all clients
+  Send_mine_values_to_all;
+end;
+
+procedure TPoolMiningServer.OnNodeOperationsChanged(Sender: TObject);
+begin
+  // Send mine values to all clients
+  Send_mine_values_to_all;
+end;
+
+procedure TPoolMiningServer.Send_mine_values_to_all;
+var params : TPCJSONObject;
+  i : Integer;
+  l : TList;
+begin
+  params := TPCJSONObject.Create;
+  Try
+    l := NetTcpIpClientsLock;
+    Try
+      for i := 0 to l.Count - 1 do begin
+        if Not Active then exit;
+        FillMineValue(params,TJSONRPCTcpIpClient(l[i]));
+        TJSONRPCTcpIpClient(l[i]).SendJSONRPCMethod(CT_PoolMining_Method_MINER_NOTIFY,params,Null);
+      end;
+    Finally
+      NetTcpIpClientsUnlock;
+    End;
+  Finally
+    params.Free;
+  End;
+end;
+
+procedure TPoolMiningServer.SetActive(const Value: Boolean);
+begin
+  inherited;
+  if (Not Value) then begin
+    WaitUntilNetTcpIpClientsFinalized;
+  end;
+end;
+
+
+procedure TPoolMiningServer.SetMinerAccountKey(const Value: TAccountKey);
+begin
+  FMinerAccountKey := Value;
+  TLog.NewLog(ltdebug,ClassName,'Assigning Miner account key to: '+TCrypto.ToHexaString(TAccountComp.AccountKey2RawString(Value)));
+  Send_mine_values_to_all;
+end;
+
+procedure TPoolMiningServer.SetMinerPayload(const Value: TRawBytes);
+begin
+  FMinerPayload := Value;
+  TLog.NewLog(ltdebug,ClassName,'Assigning Miner new Payload: '+TCrypto.ToHexaString(Value));
+  Send_mine_values_to_all;
+end;
+
+procedure TPoolMiningServer.UpdateAccountAndPayload(
+  AMinerAccountKey: TAccountKey; AMinerPayload: TRawBytes);
+begin
+  FMinerAccountKey := AMinerAccountKey;
+  TLog.NewLog(ltdebug,ClassName,'Assigning Miner account key to: '+TCrypto.ToHexaString(TAccountComp.AccountKey2RawString(AMinerAccountKey)));
+  FMinerPayload := AMinerPayload;
+  TLog.NewLog(ltdebug,ClassName,'Assigning Miner new Payload: '+TCrypto.ToHexaString(AMinerPayload));
+  Send_mine_values_to_all;
+end;
+
+{ TPoolMinerClient }
+
+constructor TPoolMinerClient.Create(AOwner: TComponent);
+begin
+  FMinerValuesForWork := CT_TMinerValuesForWork_NULL;
+  inherited;
+end;
+
+procedure TPoolMinerClient.DoProcessJSONObject(json: TPCJSONObject);
+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');
+  i := json.IndexOfName('id');
+  if i<0 then begin
+    id_value := Null;
+  end else 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);
+    mvfw.part1 := TCrypto.HexaToRaw(params_object.AsString('part1',''));
+    mvfw.payload_start := TCrypto.HexaToRaw(params_object.AsString('payload_start',''));
+    mvfw.part3 := TCrypto.HexaToRaw(params_object.AsString('part3',''));
+    mvfw.target := params_object.AsInteger('target',0);
+    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
+      SendJSONRPCResponse(params_object,id_value);
+    end;
+    MinerValuesForWork := mvfw;
+  end;
+end;
+
+procedure TPoolMinerClient.SetMinerValuesForWork(const Value: TMinerValuesForWork);
+begin
+  FMinerValuesForWork := Value;
+  if Assigned(FOnMinerMustChangeValues) then FOnMinerMustChangeValues(Self);
+end;
+
+procedure TPoolMinerClient.SubmitBlockFound(const Payload: TRawBytes; Timestamp, NOnce: Cardinal);
+Var json : TPCJSONObject;
+begin
+  json := TPCJSONObject.Create;
+  Try
+    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}]}
+  Finally
+    json.Free;
+  End;
+end;
+
+end.

+ 18 - 0
Units/PascalCoin/URPC.pas

@@ -0,0 +1,18 @@
+unit URPC;
+
+interface
+
+Uses UTCPIP;
+
+{Type
+  {TRPCServer = Class(TNetTcpIpServer)
+  protected
+    Procedure OnNewIncommingConnection(Sender : TObject; Client : TNetTcpIpClient); override;
+    procedure SetActive(const Value: Boolean); override;
+  public
+    Constructor Create; override;
+  End;}
+
+implementation
+
+end.

+ 262 - 25
Units/PascalCoin/UTCPIP.pas

@@ -36,7 +36,7 @@ uses
   Sockets,
   Sockets,
   {$ENDIF}
   {$ENDIF}
   Classes, Sysutils,
   Classes, Sysutils,
-  UThread;
+  UThread, SyncObjs;
 
 
 type
 type
   {$IFDEF DelphiSockets}
   {$IFDEF DelphiSockets}
@@ -66,6 +66,10 @@ type
     {$IFDEF DelphiSockets}
     {$IFDEF DelphiSockets}
     procedure TCustomIpClient_OnError(Sender: TObject; ASocketError: Integer);
     procedure TCustomIpClient_OnError(Sender: TObject; ASocketError: Integer);
     {$ENDIF}
     {$ENDIF}
+  protected
+    function ReceiveBuf(var Buf; BufSize: Integer): Integer;
+    Function SendStream(Stream : TStream) : Int64;
+    Procedure DoWaitForData(WaitMilliseconds : Integer; var HasData : Boolean); virtual;
   public
   public
     Constructor Create(AOwner : TComponent); override;
     Constructor Create(AOwner : TComponent); override;
     Destructor Destroy; override;
     Destructor Destroy; override;
@@ -77,8 +81,6 @@ type
     Function Connect : Boolean;
     Function Connect : Boolean;
     //
     //
     Function WaitForData(WaitMilliseconds : Integer) : Boolean;
     Function WaitForData(WaitMilliseconds : Integer) : Boolean;
-    function ReceiveBuf(var Buf; BufSize: Integer): Integer;
-    Function SendStream(Stream : TStream) : Int64;
     //
     //
     Property OnConnect : TNotifyEvent read FOnConnect write SetOnConnect;
     Property OnConnect : TNotifyEvent read FOnConnect write SetOnConnect;
     Property OnDisconnect : TNotifyEvent read FOnDisconnect write SetOnDisconnect;
     Property OnDisconnect : TNotifyEvent read FOnDisconnect write SetOnDisconnect;
@@ -87,6 +89,37 @@ type
     Property SocketError : Integer read FSocketError write SetSocketError;
     Property SocketError : Integer read FSocketError write SetSocketError;
   End;
   End;
 
 
+  TNetTcpIpClientClass = Class of TNetTcpIpClient;
+
+  TBufferedNetTcpIpClient = Class;
+
+  TBufferedNetTcpIpClientThread = Class(TPCThread)
+    FBufferedNetTcpIpClient : TBufferedNetTcpIpClient;
+  protected
+    procedure BCExecute; override;
+  public
+    Constructor Create(ABufferedNetTcpIpClient : TBufferedNetTcpIpClient);
+  End;
+
+  TBufferedNetTcpIpClient = Class(TNetTcpIpClient)
+  private
+    FSendBuffer : TMemoryStream;
+    FReadBuffer : TMemoryStream;
+    FCritical : TCriticalSection;
+    FLastReadTC : Cardinal;
+    FBufferedNetTcpIpClientThread : TBufferedNetTcpIpClientThread;
+  protected
+    Function DoWaitForDataInherited(WaitMilliseconds : Integer) : Boolean;
+    Procedure DoWaitForData(WaitMilliseconds : Integer; var HasData : Boolean); override;
+  public
+    Constructor Create(AOwner : TComponent); override;
+    Destructor Destroy; override;
+    Procedure WriteBufferToSend(SendData : TStream);
+    Function ReadBufferLock : TMemoryStream;
+    Procedure ReadBufferUnlock;
+    Property LastReadTC : Cardinal read FLastReadTC;
+  End;
+
   {$IFDEF Synapse}
   {$IFDEF Synapse}
   TNetTcpIpServer = Class;
   TNetTcpIpServer = Class;
   TTcpIpServerListenerThread = Class;
   TTcpIpServerListenerThread = Class;
@@ -127,10 +160,12 @@ type
     {$ENDIF}
     {$ENDIF}
     FNetClients : TPCThreadList;
     FNetClients : TPCThreadList;
     FMaxConnections : Integer;
     FMaxConnections : Integer;
+    FNetTcpIpClientClass : TNetTcpIpClientClass;
     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(Sender: TObject; ClientSocket: TTCPBlockSocket);
     procedure OnTcpServerAccept(Sender: TObject; ClientSocket: TTCPBlockSocket);
+    procedure SetNetTcpIpClientClass(const Value: TNetTcpIpClientClass);
   protected
   protected
     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;
@@ -140,12 +175,16 @@ type
     Property Active : Boolean read GetActive write SetActive;
     Property Active : Boolean read GetActive write SetActive;
     Property Port : Word read GetPort Write SetPort;
     Property Port : Word read GetPort Write SetPort;
     Property MaxConnections : Integer read FMaxConnections Write FMaxConnections;
     Property MaxConnections : Integer read FMaxConnections Write FMaxConnections;
+    Property NetTcpIpClientClass : TNetTcpIpClientClass read FNetTcpIpClientClass write SetNetTcpIpClientClass;
+    Function NetTcpIpClientsLock : TList;
+    Procedure NetTcpIpClientsUnlock;
+    Procedure WaitUntilNetTcpIpClientsFinalized;
   End;
   End;
 
 
 
 
 implementation
 implementation
 
 
-uses UConst, ULog;
+uses UConst, ULog, Windows;
 
 
 { TNetTcpIpClient }
 { TNetTcpIpClient }
 
 
@@ -186,6 +225,7 @@ end;
 function TNetTcpIpClient.Connect: Boolean;
 function TNetTcpIpClient.Connect: Boolean;
 begin
 begin
   {$IFDEF DelphiSockets}
   {$IFDEF DelphiSockets}
+  FSocketError := 0;
   Result := FTcpBlockSocket.Connect;
   Result := FTcpBlockSocket.Connect;
   {$ENDIF}
   {$ENDIF}
   {$IFDEF Synapse}
   {$IFDEF Synapse}
@@ -240,9 +280,6 @@ procedure TNetTcpIpClient.Disconnect;
 begin
 begin
   {$IFDEF DelphiSockets}
   {$IFDEF DelphiSockets}
   FTcpBlockSocket.Disconnect;
   FTcpBlockSocket.Disconnect;
-  FTcpBlockSocket.OnConnect := Nil;
-  FTcpBlockSocket.OnDisconnect := Nil;
-  FTcpBlockSocket.OnError := Nil;
   {$ENDIF}
   {$ENDIF}
   {$IFDEF Synapse}
   {$IFDEF Synapse}
   if Not FConnected then exit;
   if Not FConnected then exit;
@@ -252,6 +289,25 @@ begin
   {$ENDIF}
   {$ENDIF}
 end;
 end;
 
 
+procedure TNetTcpIpClient.DoWaitForData(WaitMilliseconds: Integer; var HasData: Boolean);
+Begin
+  {$IFDEF DelphiSockets}
+  FSocketError := 0;
+  HasData := FTcpBlockSocket.WaitForData(WaitMilliseconds);
+  {$ENDIF}
+  {$IFDEF Synapse}
+  Try
+    HasData := FTcpBlockSocket.CanRead(WaitMilliseconds);
+  Except
+    On E:Exception do begin
+      FSocketError := FTcpBlockSocket.LastError;
+      TLog.NewLog(lterror,ClassName,'Error WaitingForData from '+ClientRemoteAddr+': '+FTcpBlockSocket.GetErrorDescEx);
+      Disconnect;
+    end;
+  End;
+  {$ENDIF}
+end;
+
 function TNetTcpIpClient.GetConnected: Boolean;
 function TNetTcpIpClient.GetConnected: Boolean;
 begin
 begin
   {$IFDEF DelphiSockets}
   {$IFDEF DelphiSockets}
@@ -287,6 +343,7 @@ end;
 function TNetTcpIpClient.ReceiveBuf(var Buf; BufSize: Integer): Integer;
 function TNetTcpIpClient.ReceiveBuf(var Buf; BufSize: Integer): Integer;
 begin
 begin
   {$IFDEF DelphiSockets}
   {$IFDEF DelphiSockets}
+  FSocketError := 0;
   Result := FTcpBlockSocket.ReceiveBuf(Buf,BufSize);
   Result := FTcpBlockSocket.ReceiveBuf(Buf,BufSize);
   {$ENDIF}
   {$ENDIF}
   {$IFDEF Synapse}
   {$IFDEF Synapse}
@@ -311,6 +368,7 @@ Var sp : Int64;
 begin
 begin
   sp := Stream.Position;
   sp := Stream.Position;
   {$IFDEF DelphiSockets}
   {$IFDEF DelphiSockets}
+  FSocketError := 0;
   FTcpBlockSocket.SendStream(Stream);
   FTcpBlockSocket.SendStream(Stream);
   Result := Stream.Position - sp;
   Result := Stream.Position - sp;
   {$ENDIF}
   {$ENDIF}
@@ -339,7 +397,7 @@ procedure TNetTcpIpClient.SetOnConnect(const Value: TNotifyEvent);
 begin
 begin
   FOnConnect := Value;
   FOnConnect := Value;
   {$IFDEF DelphiSockets}
   {$IFDEF DelphiSockets}
-  FTcpBlockSocket.OnConnect := OnConnect;
+  FTcpBlockSocket.OnConnect := FOnConnect;
   {$ENDIF}
   {$ENDIF}
 end;
 end;
 
 
@@ -347,7 +405,7 @@ procedure TNetTcpIpClient.SetOnDisconnect(const Value: TNotifyEvent);
 begin
 begin
   FOnDisconnect := Value;
   FOnDisconnect := Value;
   {$IFDEF DelphiSockets}
   {$IFDEF DelphiSockets}
-  FTcpBlockSocket.OnDisconnect := OnDisconnect;
+  FTcpBlockSocket.OnDisconnect := FOnDisconnect;
   {$ENDIF}
   {$ENDIF}
 end;
 end;
 
 
@@ -382,32 +440,173 @@ end;
 procedure TNetTcpIpClient.TCustomIpClient_OnError(Sender: TObject; ASocketError: Integer);
 procedure TNetTcpIpClient.TCustomIpClient_OnError(Sender: TObject; ASocketError: Integer);
 begin
 begin
   SocketError := ASocketError;
   SocketError := ASocketError;
+  Disconnect;
 end;
 end;
 {$ENDIF}
 {$ENDIF}
 
 
 function TNetTcpIpClient.WaitForData(WaitMilliseconds: Integer): Boolean;
 function TNetTcpIpClient.WaitForData(WaitMilliseconds: Integer): Boolean;
 begin
 begin
-  {$IFDEF DelphiSockets}
-  Result := FTcpBlockSocket.WaitForData(WaitMilliseconds);
-  {$ENDIF}
-  {$IFDEF Synapse}
-  Try
-    Result := FTcpBlockSocket.CanRead(WaitMilliseconds);
-  Except
-    On E:Exception do begin
-      FSocketError := FTcpBlockSocket.LastError;
-      TLog.NewLog(lterror,ClassName,'Error WaitingForData from '+ClientRemoteAddr+': '+FTcpBlockSocket.GetErrorDescEx);
-      Disconnect;
+  DoWaitForData(WaitMilliseconds,Result);
+end;
+
+{ TBufferedNetTcpIpClientThread }
+
+procedure TBufferedNetTcpIpClientThread.BCExecute;
+var SendBuffStream : TStream;
+  ReceiveBuffer : Array[0..4095] of byte;
+  Procedure DoReceiveBuf;
+  var last_bytes_read : Integer;
+    ms : TMemoryStream;
+    lastpos : Int64;
+  begin
+    If FBufferedNetTcpIpClient.DoWaitForDataInherited(10) then begin
+      last_bytes_read := 0;
+      repeat
+        if last_bytes_read<>0 then begin
+          // This is to prevent a 4096 buffer transmission only... and a loop
+          If Not FBufferedNetTcpIpClient.DoWaitForDataInherited(10) then begin
+            if FBufferedNetTcpIpClient.SocketError<>0 then FBufferedNetTcpIpClient.Disconnect
+            else exit;
+          end;
+        end;
+
+        last_bytes_read := FBufferedNetTcpIpClient.ReceiveBuf(ReceiveBuffer,sizeof(ReceiveBuffer));
+        if (last_bytes_read>0) then begin
+          ms := FBufferedNetTcpIpClient.ReadBufferLock;
+          Try
+            FBufferedNetTcpIpClient.FLastReadTC := GetTickCount;
+            lastpos := ms.Position;
+            ms.Position := ms.Size;
+            ms.Write(ReceiveBuffer,last_bytes_read);
+            ms.Position := lastpos;
+            TLog.NewLog(ltdebug,ClassName,Format('Received %d bytes. Buffer length: %d bytes',[last_bytes_read,ms.Size]));
+          Finally
+            FBufferedNetTcpIpClient.ReadBufferUnlock;
+          End;
+        end;
+      until (last_bytes_read<sizeof(ReceiveBuffer));
+    end else begin
+      if FBufferedNetTcpIpClient.SocketError<>0 then FBufferedNetTcpIpClient.Disconnect;
     end;
     end;
-  End;
-  {$ENDIF}
+  end;
+  Procedure DoSendBuf;
+  begin
+    FBufferedNetTcpIpClient.FCritical.Acquire;
+    Try
+      if FBufferedNetTcpIpClient.FSendBuffer.Size>0 then begin
+        SendBuffStream.Size := 0;
+        SendBuffStream.CopyFrom(FBufferedNetTcpIpClient.FSendBuffer,0);
+        FBufferedNetTcpIpClient.FSendBuffer.Size := 0;
+      end;
+    Finally
+      FBufferedNetTcpIpClient.FCritical.Release;
+    End;
+    if (SendBuffStream.Size>0) then begin
+      SendBuffStream.Position := 0;
+      FBufferedNetTcpIpClient.SendStream(SendBuffStream);
+      TLog.NewLog(ltdebug,ClassName,Format('Sent %d bytes',[SendBuffStream.Size]));
+      SendBuffStream.Size := 0;
+    end;
+  end;
+begin
+  SendBuffStream := TMemoryStream.Create;
+  try
+    while (Not Terminated) do begin
+      while (Not Terminated) And (Not FBufferedNetTcpIpClient.Connected) do sleep(100);
+      if (FBufferedNetTcpIpClient.Connected) then begin
+        // Receive data
+        DoReceiveBuf;
+        // Send Data
+        DoSendBuf;
+      end else FBufferedNetTcpIpClient.FLastReadTC := GetTickCount;
+      // Sleep
+      Sleep(10); // Slepp 10 is better than sleep 1
+    end;
+  Finally
+    SendBuffStream.Free;
+  end;
 end;
 end;
 
 
+constructor TBufferedNetTcpIpClientThread.Create(
+  ABufferedNetTcpIpClient: TBufferedNetTcpIpClient);
+begin
+  FBufferedNetTcpIpClient := ABufferedNetTcpIpClient;
+  inherited Create(false);
+end;
+
+{ TBufferedNetTcpIpClient }
+
+constructor TBufferedNetTcpIpClient.Create(AOwner: TComponent);
+begin
+  inherited;
+  FLastReadTC := GetTickCount;
+  FCritical := TCriticalSection.Create;
+  FSendBuffer := TMemoryStream.Create;
+  FReadBuffer := TMemoryStream.Create;
+  FBufferedNetTcpIpClientThread := TBufferedNetTcpIpClientThread.Create(Self);
+end;
+
+destructor TBufferedNetTcpIpClient.Destroy;
+begin
+  FBufferedNetTcpIpClientThread.Terminate;
+  FBufferedNetTcpIpClientThread.WaitFor;
+  FreeAndNil(FBufferedNetTcpIpClientThread);
+  FreeAndNil(FCritical);
+  FreeAndNil(FReadBuffer);
+  FreeAndNil(FSendBuffer);
+  inherited;
+end;
+
+procedure TBufferedNetTcpIpClient.DoWaitForData(WaitMilliseconds: Integer; var HasData: Boolean);
+begin
+  FCritical.Acquire;
+  try
+    if FReadBuffer.Size>0 then begin
+      HasData := True;
+      exit;
+    end;
+  finally
+    FCritical.Release;
+  end;
+  inherited DoWaitForData(WaitMilliseconds,HasData);
+end;
+
+function TBufferedNetTcpIpClient.DoWaitForDataInherited(WaitMilliseconds : Integer) : Boolean;
+begin
+  inherited DoWaitForData(WaitMilliseconds,Result);
+end;
+
+function TBufferedNetTcpIpClient.ReadBufferLock: TMemoryStream;
+begin
+  FCritical.Acquire;
+  Result := FReadBuffer;
+end;
+
+procedure TBufferedNetTcpIpClient.ReadBufferUnlock;
+begin
+  FCritical.Release;
+end;
+
+procedure TBufferedNetTcpIpClient.WriteBufferToSend(SendData: TStream);
+var lastpos : Int64;
+begin
+  FCritical.Acquire;
+  try
+    lastpos := FSendBuffer.Position;
+    FSendBuffer.Position := FSendBuffer.Size;
+    SendData.Position := 0;
+    FSendBuffer.CopyFrom(SendData,SendData.Size);
+    FSendBuffer.Position := lastpos;
+  finally
+    FCritical.Release;
+  end;
+end;
 
 
 { TNetTcpIpServer }
 { TNetTcpIpServer }
 
 
 constructor TNetTcpIpServer.Create;
 constructor TNetTcpIpServer.Create;
 begin
 begin
+  FNetTcpIpClientClass := TNetTcpIpClient;
   FTcpIpServer := Nil;
   FTcpIpServer := Nil;
   FMaxConnections := 10;
   FMaxConnections := 10;
   {$IFDEF DelphiSockets}
   {$IFDEF DelphiSockets}
@@ -417,6 +616,7 @@ begin
   {$ELSE}
   {$ELSE}
   FActive := false;
   FActive := false;
   {$ENDIF}
   {$ENDIF}
+  FNetClients := TPCThreadList.Create;
 end;
 end;
 
 
 destructor TNetTcpIpServer.Destroy;
 destructor TNetTcpIpServer.Destroy;
@@ -447,6 +647,16 @@ begin
   {$ENDIF}
   {$ENDIF}
 end;
 end;
 
 
+function TNetTcpIpServer.NetTcpIpClientsLock: TList;
+begin
+  Result := FNetClients.LockList;
+end;
+
+procedure TNetTcpIpServer.NetTcpIpClientsUnlock;
+begin
+  FNetClients.UnlockList;
+end;
+
 procedure TNetTcpIpServer.OnNewIncommingConnection(Sender: TObject; Client: TNetTcpIpClient);
 procedure TNetTcpIpServer.OnNewIncommingConnection(Sender: TObject; Client: TNetTcpIpClient);
 begin
 begin
   //
   //
@@ -461,7 +671,7 @@ begin
       FTcpIpServer.ServerSocketThread.ThreadCacheSize := MaxConnections;
       FTcpIpServer.ServerSocketThread.ThreadCacheSize := MaxConnections;
   {$ENDIF}
   {$ENDIF}
 
 
-  n := TNetTcpIpClient.Create(Nil);
+  n := FNetTcpIpClientClass.Create(Nil);
   Try
   Try
     oldSocket := n.FTcpBlockSocket;
     oldSocket := n.FTcpBlockSocket;
     n.FTcpBlockSocket := ClientSocket;
     n.FTcpBlockSocket := ClientSocket;
@@ -470,7 +680,12 @@ begin
     n.RemoteHost := ClientSocket.GetRemoteSinIP;
     n.RemoteHost := ClientSocket.GetRemoteSinIP;
     n.RemotePort := ClientSocket.GetRemoteSinPort;
     n.RemotePort := ClientSocket.GetRemoteSinPort;
     {$ENDIF}
     {$ENDIF}
-    OnNewIncommingConnection(Sender,n);
+    FNetClients.Add(n);
+    try
+      OnNewIncommingConnection(Sender,n);
+    finally
+      FNetClients.Remove(n);
+    end;
   Finally
   Finally
     n.FTcpBlockSocket := oldSocket;
     n.FTcpBlockSocket := oldSocket;
     FreeAndNil(n);
     FreeAndNil(n);
@@ -496,6 +711,13 @@ begin
   {$ENDIF}
   {$ENDIF}
 end;
 end;
 
 
+procedure TNetTcpIpServer.SetNetTcpIpClientClass(const Value: TNetTcpIpClientClass);
+begin
+  if FNetTcpIpClientClass=Value then exit;
+  FNetTcpIpClientClass := Value;
+  Active := false;
+end;
+
 procedure TNetTcpIpServer.SetPort(const Value: Word);
 procedure TNetTcpIpServer.SetPort(const Value: Word);
 begin
 begin
   {$IFDEF DelphiSockets}
   {$IFDEF DelphiSockets}
@@ -505,6 +727,21 @@ begin
   {$ENDIF}
   {$ENDIF}
 end;
 end;
 
 
+procedure TNetTcpIpServer.WaitUntilNetTcpIpClientsFinalized;
+Var l : TList;
+begin
+  if Active then Active := false;
+  Repeat
+    l := FNetClients.LockList;
+    try
+      if (l.Count=0) then exit;
+    finally
+      FNetClients.UnlockList;
+    end;
+    sleep(10);
+  Until false;
+end;
+
 {$IFDEF Synapse}
 {$IFDEF Synapse}
 { TTcpIpServerListenerThread }
 { TTcpIpServerListenerThread }
 
 
@@ -547,7 +784,7 @@ begin
         end;
         end;
       end;
       end;
       // Wait
       // Wait
-      sleep(1);
+      sleep(10); // Sleep 10 is better than sleep 1
     End;
     End;
   finally
   finally
     // Finalize all threads
     // Finalize all threads

+ 1 - 0
Units/PascalCoin/UThread.pas

@@ -48,6 +48,7 @@ Type
     Class Function TryProtectEnterCriticalSection(Const Sender : TObject; MaxWaitMilliseconds : Cardinal; var Lock : TCriticalSection) : Boolean;
     Class Function TryProtectEnterCriticalSection(Const Sender : TObject; MaxWaitMilliseconds : Cardinal; var Lock : TCriticalSection) : Boolean;
     Class Procedure ThreadsListInfo(list: TStrings);
     Class Procedure ThreadsListInfo(list: TStrings);
     Property DebugStep : String read FDebugStep write FDebugStep;
     Property DebugStep : String read FDebugStep write FDebugStep;
+    property Terminated;
   End;
   End;
 
 
   TPCThreadList = class
   TPCThreadList = class

+ 922 - 0
Units/Utils/UJSONFunctions.pas

@@ -0,0 +1,922 @@
+unit UJSONFunctions;
+
+{ 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 DBXJSON, SysUtils, DateUtils, Variants, Classes;
+
+Type
+  TPCJSONData = Class
+  private
+    FParent : TPCJSONData;
+  protected
+    Function ToJSONFormatted(pretty:Boolean;Const prefix : AnsiString) : AnsiString; virtual; abstract;
+  public
+    Constructor Create; virtual;
+    Destructor Destroy; override;
+    Class Function ParseJSONValue(Const JSONObject : String) : TPCJSONData; overload;
+    Class Function ParseJSONValue(Const JSONObject : TBytes) : TPCJSONData; overload;
+    Class Function _GetCount : Integer;
+    Function ToJSON(pretty : Boolean) : AnsiString;
+    Procedure SaveToStream(Stream : TStream);
+    Procedure Assign(PCJSONData : TPCJSONData);
+  End;
+
+  TPCJSONDataClass = Class of TPCJSONData;
+
+  TPCJSONVariantValue = Class(TPCJSONData)
+  private
+    FOldValue : Variant;
+    FWritable : Boolean;
+    FValue: Variant;
+    procedure SetValue(const Value: Variant);
+  protected
+    Function ToJSONFormatted(pretty:Boolean;const prefix : AnsiString) : AnsiString; override;
+  public
+    Constructor Create; override;
+    Constructor CreateFromJSONValue(JSONValue : TJSONValue);
+    Property Value : Variant read FValue write SetValue;
+    Function AsString(DefValue : String) : String;
+    Function AsInteger(DefValue : Integer) : Integer;
+    Function AsDouble(DefValue : Double) : Double;
+    Function AsBoolean(DefValue : Boolean) : Boolean;
+    Function AsDateTime(DefValue : TDateTime) : TDateTime;
+    Function AsCurrency(DefValue : Currency) : Currency;
+  End;
+
+  TPCJSONNameValue = Class(TPCJSONData)
+  private
+    FName: String;
+    FValue: TPCJSONData;
+    FFreeValue : Boolean;
+    procedure SetValue(const Value: TPCJSONData);
+  protected
+    Function ToJSONFormatted(pretty:Boolean;const prefix : AnsiString) : AnsiString; override;
+  public
+    Constructor Create(AName : String);
+    Destructor Destroy; override;
+    Property Name : String read FName;
+    Property Value : TPCJSONData read FValue write SetValue;
+  End;
+
+  TPCJSONArray = class;
+  TPCJSONObject = Class;
+
+  TPCJSONList = Class(TPCJSONData)
+  private
+    FList : TList;
+    function GetItems(Index: Integer): TPCJSONData;
+    procedure SetItems(Index: Integer; const Value: TPCJSONData);
+  protected
+    Function GetIndexAsVariant(Index : Integer) : TPCJSONVariantValue;
+    Function GetIndexAsArray(Index : Integer) : TPCJSONArray;
+    Function GetIndexAsObject(Index : Integer) : TPCJSONObject;
+    Procedure CheckCanInsert(Index:Integer; PCJSONData:TPCJSONData); virtual;
+  public
+    Constructor Create; override;
+    Destructor Destroy; override;
+    Property Items[Index:Integer] : TPCJSONData read GetItems write SetItems;
+    Procedure Insert(Index:Integer; PCJSONData:TPCJSONData);
+    Procedure Delete(index : Integer);
+    function Count : Integer;
+    Procedure Clear;
+  End;
+
+  TPCJSONArray = class(TPCJSONList)
+  private
+    Procedure GrowToIndex(index : Integer);
+    function GetItemOfType(Index: Integer; DataClass:TPCJSONDataClass): TPCJSONData;
+  protected
+    Function ToJSONFormatted(pretty:Boolean;const prefix : AnsiString) : AnsiString; override;
+  public
+    Constructor Create; override;
+    Constructor CreateFromJSONArray(JSONArray : TJSONArray);
+    Destructor Destroy; override;
+    Function GetAsVariant(index : Integer) : TPCJSONVariantValue;
+    Function GetAsObject(index : Integer) : TPCJSONObject;
+    Function GetAsArray(index : Integer) : TPCJSONArray;
+  end;
+
+  TPCJSONObject = Class(TPCJSONList)
+  private
+    Function GetIndexOrCreateName(Name : String) : Integer;
+    Function GetByName(Name : String) : TPCJSONNameValue;
+  protected
+    Function ToJSONFormatted(pretty:Boolean;const prefix : AnsiString) : AnsiString; override;
+    Procedure CheckCanInsert(Index:Integer; PCJSONData:TPCJSONData); override;
+    Procedure CheckValidName(Name : String);
+  public
+    Constructor Create; override;
+    Constructor CreateFromJSONObject(JSONObject : TJSONObject);
+    Destructor Destroy; override;
+    Function FindName(Name : String) : TPCJSONNameValue;
+    Function IndexOfName(Name : String) : Integer;
+    Procedure DeleteName(Name : String);
+    Function GetAsVariant(Name : String) : TPCJSONVariantValue;
+    Function GetAsObject(Name : String) : TPCJSONObject;
+    Function GetAsArray(Name : String) : TPCJSONArray;
+    Function AsString(ParamName : String; DefValue : String) : String;
+    Function AsInteger(ParamName : String; DefValue : Integer) : Integer;
+    Function AsDouble(ParamName : String; DefValue : Double) : Double;
+    Function AsBoolean(ParamName : String; DefValue : Boolean) : Boolean;
+    Function AsDateTime(ParamName : String; DefValue : TDateTime) : TDateTime;
+    Function AsCurrency(ParamName : String; DefValue : Currency) : Currency;
+    Function SaveAsStream(ParamName : String; Stream : TStream) : Integer;
+    Function LoadAsStream(ParamName : String; Stream : TStream) : Integer;
+    Function GetNameValue(index : Integer) : TPCJSONNameValue;
+    Procedure SetAs(Name : String; Value : TPCJSONData);
+  End;
+
+  EPCParametresError = Class(Exception);
+
+implementation
+
+Function UTF8JSONEncode(plainTxt : String; includeSeparator : Boolean) : String;
+Var ws : WideString;
+  i : Integer;
+Begin
+   ws := UTF8Encode(plainTxt);
+   {ALERT:
+    UTF8Encode function deletes last char if equal to #0, so we put it manually
+    }
+   if copy(plainTxt,length(plainTxt),1)=#0 then ws := ws + #0;
+        i := 1;
+        result := '"';
+        while i <= length(ws) do
+          begin
+            case ws[i] of
+              '/', '\', '"': result := result + '\' + ws[i];
+              #8: result := result + '\b';
+              #9: result := result + '\t';
+              #10: result := result + '\n';
+              #13: result := result + '\r';
+              #12: result := result + '\f';
+            else
+              if (ord(ws[i]) < 32) Or (ord(ws[i])>122) then
+                result := result + '\u' + inttohex(ord(ws[i]), 4)
+              else
+                result := result + ws[i];
+            end;
+            inc(i);
+          end;
+        result := result + '"';
+End;
+
+{ TPCJSONArray }
+
+constructor TPCJSONArray.Create;
+begin
+  inherited;
+
+end;
+
+constructor TPCJSONArray.CreateFromJSONArray(JSONArray: TJSONArray);
+Var i : Integer;
+begin
+  Create;
+  for i := 0 to JSONArray.Size - 1 do begin
+    if (JSONArray.Get(i) is TJSONArray) then begin
+      Insert(i,TPCJSONArray.CreateFromJSONArray(TJSONArray(JSONArray.Get(i))));
+    end else if (JSONArray.Get(i) is TJSONObject) then begin
+      Insert(i,TPCJSONObject.CreateFromJSONObject(TJSONObject(JSONArray.Get(i))));
+    end else if (JSONArray.Get(i) is TJSONValue) then begin
+      Insert(i,TPCJSONVariantValue.CreateFromJSONValue(TJSONValue(JSONArray.Get(i))));
+    end else raise EPCParametresError.Create('Invalid TJSON Data: '+JSONArray.Get(i).ClassName);
+  end;
+end;
+
+destructor TPCJSONArray.Destroy;
+begin
+  inherited;
+end;
+
+function TPCJSONArray.GetAsArray(index: Integer): TPCJSONArray;
+begin
+  Result := GetItemOfType(index,TPCJSONArray) as TPCJSONArray;
+end;
+
+function TPCJSONArray.GetAsObject(index: Integer): TPCJSONObject;
+begin
+  Result := GetItemOfType(index,TPCJSONObject) as TPCJSONObject;
+end;
+
+function TPCJSONArray.GetAsVariant(index: Integer): TPCJSONVariantValue;
+begin
+  Result := GetItemOfType(index,TPCJSONVariantValue) as TPCJSONVariantValue;
+end;
+
+function TPCJSONArray.GetItemOfType(Index: Integer;
+  DataClass: TPCJSONDataClass): TPCJSONData;
+Var V,New : TPCJSONData;
+begin
+  GrowToIndex(Index);
+  V := GetItems(index);
+  if Not (V is DataClass) then begin
+    New := DataClass.Create;
+    Items[index] := New;
+    V := New;
+  end;
+  Result := V as DataClass;
+end;
+
+procedure TPCJSONArray.GrowToIndex(index: Integer);
+begin
+  While (index>=Count) do Insert(Count,TPCJSONVariantValue.Create);
+end;
+
+function TPCJSONArray.ToJSONFormatted(pretty: Boolean; const prefix: AnsiString): AnsiString;
+Var i : Integer;
+begin
+  If pretty then Result := prefix+'['
+  else Result := '[';
+  for i := 0 to Count - 1 do begin
+    if (i>0) then begin
+      Result := Result+',';
+      If pretty then Result :=Result +#10+prefix;
+    end;
+    Result := Result + Items[i].ToJSONFormatted(pretty,prefix+'   ');
+  end;
+  Result := Result+']';
+end;
+
+{ TPCJSONList }
+
+procedure TPCJSONList.CheckCanInsert(Index: Integer; PCJSONData: TPCJSONData);
+begin
+  if (Index<0) Or (Index>Count) then raise Exception.Create('Invalid insert at index '+Inttostr(Index)+' (Count:'+Inttostr(Count)+')');
+end;
+
+procedure TPCJSONList.Clear;
+begin
+  while (FList.Count>0) do Delete(FList.Count-1);
+end;
+
+function TPCJSONList.Count: Integer;
+begin
+  Result := FList.Count;
+end;
+
+constructor TPCJSONList.Create;
+begin
+  inherited;
+  FParent := Nil;
+  FList := TList.Create;
+end;
+
+procedure TPCJSONList.Delete(index: Integer);
+Var M : TPCJSONData;
+begin
+  M := GetItems(index);
+  FList.Delete(index);
+  M.Free;
+end;
+
+destructor TPCJSONList.Destroy;
+begin
+  Clear;
+  FList.Free;
+  inherited;
+end;
+
+function TPCJSONList.GetIndexAsArray(Index: Integer): TPCJSONArray;
+Var D : TPCJSONData;
+begin
+  D := GetItems(Index);
+  if (Not (D is TPCJSONArray)) then begin
+    Result := TPCJSONArray.Create;
+    SetItems(Index,Result);
+    D.Free;
+  end else Result := TPCJSONArray(D);
+end;
+
+function TPCJSONList.GetIndexAsObject(Index: Integer): TPCJSONObject;
+Var D : TPCJSONData;
+begin
+  D := GetItems(Index);
+  if (Not (D is TPCJSONObject)) then begin
+    Result := TPCJSONObject.Create;
+    SetItems(Index,Result);
+    D.Free;
+  end else Result := TPCJSONObject(D);
+end;
+
+function TPCJSONList.GetIndexAsVariant(Index: Integer): TPCJSONVariantValue;
+Var D : TPCJSONData;
+begin
+  D := GetItems(Index);
+  if (Not (D is TPCJSONVariantValue)) then begin
+    Result := TPCJSONVariantValue.Create;
+    SetItems(Index,Result);
+    D.Free;
+  end else Result := TPCJSONVariantValue(D);
+end;
+
+function TPCJSONList.GetItems(Index: Integer): TPCJSONData;
+begin
+  Result := FList.Items[Index];
+end;
+
+procedure TPCJSONList.Insert(Index: Integer; PCJSONData: TPCJSONData);
+begin
+  CheckCanInsert(Index,PCJSONData);
+  FList.Insert(Index,PCJSONData);
+end;
+
+procedure TPCJSONList.SetItems(Index: Integer; const Value: TPCJSONData);
+Var OldP : TPCJSONData;
+begin
+  OldP := FList.Items[Index];
+  Try
+    FList.Items[Index] := Value;
+  Finally
+    OldP.Free;
+  End;
+end;
+
+{ TPCJSONVariantValue }
+
+Function VariantToDouble(Value : Variant) : Double;
+Var s : String;
+Begin
+  Result := 0;
+  Case varType(Value) of
+    varSmallint, varInteger, varSingle, varDouble,
+      varCurrency : Result := Value;
+  Else
+    Begin
+      s := VarToStr(Value);
+      If s='' Then Abort
+      Else Result := StrToFloat(s);
+    End;
+  End;
+End;
+
+function TPCJSONVariantValue.AsBoolean(DefValue: Boolean): Boolean;
+begin
+  try
+    Result := VarAsType(Value,varBoolean);
+  except
+    Result := DefValue;
+  end;
+end;
+
+function TPCJSONVariantValue.AsCurrency(DefValue: Currency): Currency;
+begin
+  try
+    Result := VariantToDouble(Value);
+  except
+    Result := DefValue;
+  end;
+end;
+
+function TPCJSONVariantValue.AsDateTime(DefValue: TDateTime): TDateTime;
+begin
+  try
+    Result := VarAsType(Value,varDate);
+  except
+    Result := DefValue;
+  end;
+end;
+
+function TPCJSONVariantValue.AsDouble(DefValue: Double): Double;
+begin
+  try
+    Result := VariantToDouble(Value);
+  except
+    Result := DefValue;
+  end;
+end;
+
+function TPCJSONVariantValue.AsInteger(DefValue: Integer): Integer;
+begin
+  try
+    Result := VarAsType(Value,varInteger);
+  except
+    Result := DefValue;
+  end;
+end;
+
+function TPCJSONVariantValue.AsString(DefValue: String): String;
+begin
+  try
+    Case VarType(Value) of
+      varNull : Result := '';
+      varSmallint, varInteger :
+        Begin
+          Result := inttostr(Value);
+        End;
+      varSingle, varDouble,varCurrency :
+        Begin
+          Result := FloatToStr(VariantToDouble(Value));
+        End;
+      varDate : Result := DateTimeToStr(Value);
+    Else Result := VarToStr(Value);
+    End;
+  except
+    Result := DefValue;
+  end;
+end;
+
+constructor TPCJSONVariantValue.Create;
+begin
+  inherited;
+  FValue := Null;
+  FOldValue := Unassigned;
+  FWritable := False;
+end;
+
+constructor TPCJSONVariantValue.CreateFromJSONValue(JSONValue: TJSONValue);
+Var d : Double;
+    i : Integer;
+  ds,ts : Char;
+begin
+  Create;
+  if JSONValue is TJSONNumber then begin
+    d := TJSONNumber(JSONValue).AsDouble;
+    if Pos('.',JSONValue.ToString)>0 then i := 0
+    else i := TJSONNumber(JSONValue).AsInt;
+    ds := DecimalSeparator;
+    ts := ThousandSeparator;
+    DecimalSeparator := '.';
+    ThousandSeparator := ',';
+    Try
+      if FormatFloat('0.###########',d)=inttostr(i) then
+        Value := i
+      else Value := d;
+    Finally
+      DecimalSeparator := ds;
+      ThousandSeparator := ts;
+    End;
+  end else if JSONValue is TJSONTrue then Value := true
+  else if JSONValue is TJSONFalse then Value := false
+  else if JSONValue is TJSONNull then Value := Null
+  else Value := JSONValue.Value;
+end;
+
+procedure TPCJSONVariantValue.SetValue(const Value: Variant);
+begin
+  FOldValue := FValue;
+  FValue := Value;
+end;
+
+function TPCJSONVariantValue.ToJSONFormatted(pretty: Boolean; const prefix: AnsiString): AnsiString;
+Var   ds,ts : Char;
+begin
+  Case VarType(Value) of
+    varSmallint,varInteger,varByte,varWord : Result := IntToStr(Value);
+    varLongWord,varInt64 : Result := UIntToStr(Value);
+    varBoolean : if (Value) then Result := 'true' else Result:='false';
+    varNull : Result := 'null';
+    varDate,varDouble : begin
+      ds := DecimalSeparator;
+      ts := ThousandSeparator;
+      DecimalSeparator := '.';
+      ThousandSeparator := ',';
+      try
+        Result := FormatFloat('0.###########',Value);
+      finally
+        DecimalSeparator := ds;
+        ThousandSeparator := ts;
+      end;
+    end
+  else
+    Result := UTF8JSONEncode(VarToStr(Value),true);
+  end;
+end;
+
+{ TPCJSONObject }
+
+function TPCJSONObject.AsBoolean(ParamName: String; DefValue: Boolean): Boolean;
+Var v : Variant;
+  VV : TPCJSONVariantValue;
+begin
+  VV := GetAsVariant(ParamName);
+  if (VarType(VV.Value)=varNull) AND (VarType( VV.FOldValue ) = varEmpty) then begin
+    Result := DefValue;
+    Exit;
+  end;
+  v := GetAsVariant(ParamName).Value;
+  try
+    if VarIsNull(v) then Result := DefValue
+    else Result := VarAsType(v,varBoolean);
+  except
+    Result := DefValue;
+  end;
+end;
+
+function TPCJSONObject.AsCurrency(ParamName: String; DefValue: Currency): Currency;
+Var v : Variant;
+  VV : TPCJSONVariantValue;
+begin
+  VV := GetAsVariant(ParamName);
+  if (VarType(VV.Value)=varNull) AND (VarType( VV.FOldValue ) = varEmpty) then begin
+    Result := DefValue;
+    Exit;
+  end;
+  v := GetAsVariant(ParamName).Value;
+  try
+    if VarIsNull(v) then Result := DefValue
+    else Result := VariantToDouble(v);
+  except
+    Result := DefValue;
+  end;
+end;
+
+function TPCJSONObject.AsDateTime(ParamName: String;
+  DefValue: TDateTime): TDateTime;
+Var v : Variant;
+  VV : TPCJSONVariantValue;
+begin
+  VV := GetAsVariant(ParamName);
+  if (VarType(VV.Value)=varNull) AND (VarType( VV.FOldValue ) = varEmpty) then begin
+    Result := DefValue;
+    Exit;
+  end;
+  v := GetAsVariant(ParamName).Value;
+  try
+    if VarIsNull(v) then Result := DefValue
+    else Result := VarAsType(v,varDate);
+  except
+    Result := DefValue;
+  end;
+end;
+
+function TPCJSONObject.AsDouble(ParamName: String; DefValue: Double): Double;
+Var v : Variant;
+  VV : TPCJSONVariantValue;
+begin
+  VV := GetAsVariant(ParamName);
+  if (VarType(VV.Value)=varNull) AND (VarType( VV.FOldValue ) = varEmpty) then begin
+    Result := DefValue;
+    Exit;
+  end;
+  v := GetAsVariant(ParamName).Value;
+  try
+    if VarIsNull(v) then Result := DefValue
+    else Result := VariantToDouble(v);
+  except
+    Result := DefValue;
+  end;
+end;
+
+function TPCJSONObject.AsInteger(ParamName: String; DefValue: Integer): Integer;
+Var v : Variant;
+  VV : TPCJSONVariantValue;
+begin
+  VV := GetAsVariant(ParamName);
+  if (VarType(VV.Value)=varNull) AND (VarType( VV.FOldValue ) = varEmpty) then begin
+    Result := DefValue;
+    Exit;
+  end;
+  v := GetAsVariant(ParamName).Value;
+  try
+    if VarIsNull(v) then Result := DefValue
+    else Result := VarAsType(v,varInteger);
+  except
+    Result := DefValue;
+  end;
+end;
+
+function TPCJSONObject.AsString(ParamName, DefValue: String): String;
+Var v : Variant;
+  VV : TPCJSONVariantValue;
+begin
+  VV := GetAsVariant(ParamName);
+  if (VarType(VV.Value)=varNull) AND (VarType( VV.FOldValue ) = varEmpty) then begin
+    Result := DefValue;
+    Exit;
+  end;
+  v := GetAsVariant(ParamName).Value;
+  try
+    Case VarType(V) of
+      varNull : Result := '';
+      varSmallint, varInteger :
+        Begin
+          Result := inttostr(v);
+        End;
+      varSingle, varDouble,varCurrency :
+        Begin
+          Result := FloatToStr(VariantToDouble(v));
+        End;
+      varDate : Result := DateTimeToStr(v);
+    Else Result := VarToStr(v);
+    End;
+  except
+    Result := DefValue;
+  end;
+end;
+
+
+procedure TPCJSONObject.CheckCanInsert(Index: Integer; PCJSONData: TPCJSONData);
+begin
+  inherited;
+  if Not Assigned(PCJSONData) then raise Exception.Create('Object is nil');
+  if Not (PCJSONData is TPCJSONNameValue) then raise Exception.Create('Object inside a '+TPCJSONData.ClassName+' must be a '+TPCJSONNameValue.ClassName+' (currently '+PCJSONData.ClassName+')');
+end;
+
+procedure TPCJSONObject.CheckValidName(Name: String);
+Var i : Integer;
+begin
+  for i := 1 to Length(Name) do begin
+    if i=1 then begin
+      if Not (Name[i] in ['a'..'z','A'..'Z','0'..'9','_','.']) then raise Exception.Create(Format('Invalid char %s at pos %d/%d',[Name[i],i,length(Name)]));
+    end else begin
+      if Not (Name[i] in ['a'..'z','A'..'Z','0'..'9','_','-','.']) then raise Exception.Create(Format('Invalid char %s at pos %d/%d',[Name[i],i,length(Name)]));
+    end;
+  end;
+end;
+
+constructor TPCJSONObject.Create;
+begin
+  inherited;
+end;
+
+constructor TPCJSONObject.CreateFromJSONObject(JSONObject: TJSONObject);
+var i,i2 : Integer;
+begin
+  Create;
+  for i := 0 to JSONObject.Size - 1 do begin
+    i2 := GetIndexOrCreateName(JSONObject.Get(i).JsonString.Value);
+    if (JSONObject.Get(i).JsonValue is TJSONArray) then begin
+      (Items[i2] as TPCJSONNameValue).Value := TPCJSONArray.CreateFromJSONArray(TJSONArray(JSONObject.Get(i).JsonValue));
+    end else if (JSONObject.Get(i).JsonValue is TJSONObject) then begin
+      (Items[i2] as TPCJSONNameValue).Value := TPCJSONObject.CreateFromJSONObject(TJSONObject(JSONObject.Get(i).JsonValue));
+    end else if (JSONObject.Get(i).JsonValue is TJSONValue) then begin
+      (Items[i2] as TPCJSONNameValue).Value := TPCJSONVariantValue.CreateFromJSONValue(TJSONValue(JSONObject.Get(i).JsonValue));
+    end else raise EPCParametresError.Create('Invalid TJSON Data in JSONObject.'+JSONObject.Get(i).JsonString.Value+': '+JSONObject.Get(i).ClassName);
+  end;
+end;
+
+procedure TPCJSONObject.DeleteName(Name: String);
+Var i : Integer;
+begin
+  i := IndexOfName(Name);
+  if (i>=0) then begin
+    Delete(i);
+  end;
+end;
+
+destructor TPCJSONObject.Destroy;
+begin
+
+  inherited;
+end;
+
+function TPCJSONObject.FindName(Name: String): TPCJSONNameValue;
+Var i : Integer;
+begin
+  i := IndexOfName(Name);
+  Result := Nil;
+  if (i>=0) then Result := Items[i] as TPCJSONNameValue;
+end;
+
+function TPCJSONObject.GetAsArray(Name: String): TPCJSONArray;
+Var NV : TPCJSONNameValue;
+  V : TPCJSONData;
+begin
+  NV := GetByName(Name);
+  if Not (NV.Value is TPCJSONArray) then begin
+    NV.Value := TPCJSONArray.Create;
+  end;
+  Result := NV.Value as TPCJSONArray;
+end;
+
+function TPCJSONObject.GetAsObject(Name: String): TPCJSONObject;
+Var NV : TPCJSONNameValue;
+  V : TPCJSONData;
+begin
+  NV := GetByName(Name);
+  if Not (NV.Value is TPCJSONObject) then begin
+    NV.Value := TPCJSONObject.Create;
+  end;
+  Result := NV.Value as TPCJSONObject;
+end;
+
+function TPCJSONObject.GetAsVariant(Name: String): TPCJSONVariantValue;
+Var NV : TPCJSONNameValue;
+  V : TPCJSONData;
+begin
+  NV := GetByName(Name);
+  if Not (NV.Value is TPCJSONVariantValue) then begin
+    NV.Value := TPCJSONVariantValue.Create;
+  end;
+  Result := NV.Value as TPCJSONVariantValue;
+end;
+
+function TPCJSONObject.GetByName(Name: String): TPCJSONNameValue;
+Var i : Integer;
+begin
+  i := GetIndexOrCreateName(Name);
+  Result := Items[i] as TPCJSONNameValue;
+end;
+
+function TPCJSONObject.GetIndexOrCreateName(Name: String): Integer;
+Var
+  NV : TPCJSONNameValue;
+Begin
+  Result := IndexOfName(Name);
+  if (Result<0) then begin
+    CheckValidName(Name);
+    NV := TPCJSONNameValue.Create(Name);
+    Result := FList.Add(NV);
+  end;
+end;
+
+function TPCJSONObject.GetNameValue(index: Integer): TPCJSONNameValue;
+begin
+  Result := Items[index] as TPCJSONNameValue;
+end;
+
+function TPCJSONObject.IndexOfName(Name: String): Integer;
+begin
+  for Result := 0 to FList.Count - 1 do begin
+    if (Assigned(FList.Items[Result])) And (TObject(FList.Items[Result]) is TPCJSONNameValue) then begin
+      If TPCJSONNameValue( FList.Items[Result] ).Name = Name then begin
+        exit;
+      end;
+    end;
+  end;
+  Result := -1;
+end;
+
+function TPCJSONObject.LoadAsStream(ParamName: String; Stream: TStream): Integer;
+Var s : AnsiString;
+begin
+  s := AsString(ParamName,'');
+  if (s<>'') then begin
+    Stream.Write(s[1],length(s));
+  end;
+  Result := Length(s);
+end;
+
+function TPCJSONObject.SaveAsStream(ParamName: String; Stream: TStream): Integer;
+Var s : AnsiString;
+begin
+  Stream.Position := 0;
+  SetLength(s,Stream.Size);
+  Stream.Read(s[1],Stream.Size);
+  GetAsVariant(ParamName).Value := s;
+end;
+
+procedure TPCJSONObject.SetAs(Name: String; Value: TPCJSONData);
+ // When assigning a object with SetAs this will not be freed automatically
+Var NV : TPCJSONNameValue;
+  V : TPCJSONData;
+  i : Integer;
+begin
+  i := GetIndexOrCreateName(Name);
+  NV := Items[i] as TPCJSONNameValue;
+  NV.Value := Value;
+  NV.FFreeValue := false;
+end;
+
+function TPCJSONObject.ToJSONFormatted(pretty: Boolean; const prefix: AnsiString): AnsiString;
+Var i : Integer;
+begin
+  if pretty then Result := prefix+'{'
+  else Result := '{';
+  for i := 0 to Count - 1 do begin
+    if (i>0) then Begin
+      Result := Result+',';
+      If pretty then Result :=Result +#10+prefix;
+    End;
+    Result := Result + Items[i].ToJSONFormatted(pretty,prefix+'   ');
+  end;
+  Result := Result+'}';
+end;
+
+{ TPCJSONNameValue }
+
+constructor TPCJSONNameValue.Create(AName: String);
+begin
+  inherited Create;
+  FName := AName;
+  FValue := TPCJSONData.Create;
+  FFreeValue := True;
+end;
+
+destructor TPCJSONNameValue.Destroy;
+begin
+  if FFreeValue then FValue.Free;
+  inherited;
+end;
+
+procedure TPCJSONNameValue.SetValue(const Value: TPCJSONData);
+Var old : TPCJSONData;
+begin
+  if FValue=Value then exit;
+  old := FValue;
+  FValue := Value;
+  if FFreeValue then old.Free;
+  FFreeValue := true;
+end;
+
+function TPCJSONNameValue.ToJSONFormatted(pretty: Boolean; const prefix: AnsiString): AnsiString;
+begin
+  if pretty then Result := prefix else Result := '';
+  Result := Result + UTF8JSONEncode(name,true)+':'+Value.ToJSONFormatted(pretty,prefix+'   ');
+end;
+
+{ TPCJSONData }
+
+Var _objectsCount : Integer;
+
+procedure TPCJSONData.Assign(PCJSONData: TPCJSONData);
+Var i : Integer;
+  NV : TPCJSONNameValue;
+  JSOND : TPCJSONData;
+  s : AnsiString;
+begin
+  if Not Assigned(PCJSONData) then Abort;
+  if (PCJSONData is TPCJSONObject) AND (Self is TPCJSONObject) then begin
+    for i := 0 to TPCJSONObject(PCJSONData).Count - 1 do begin
+      NV := TPCJSONObject(PCJSONData).Items[i] as TPCJSONNameValue;
+      if NV.Value is TPCJSONObject then begin
+        TPCJSONObject(Self).GetAsObject(NV.Name).Assign(NV.Value);
+      end else if NV.Value is TPCJSONArray then begin
+        TPCJSONObject(Self).GetAsArray(NV.Name).Assign(NV.Value);
+      end else if NV.Value is TPCJSONVariantValue then begin
+        TPCJSONObject(Self).GetAsVariant(NV.Name).Assign(NV.Value);
+      end else raise Exception.Create('Error in TPCJSONData.Assign decoding '+NV.Name+' ('+NV.Value.ClassName+')');
+    end;
+  end else if (PCJSONData is TPCJSONArray) AND (Self is TPCJSONArray) then begin
+    for i := 0 to TPCJSONArray(PCJSONData).Count - 1 do begin
+      JSOND := TPCJSONArray(PCJSONData).Items[i];
+      s := JSOND.ToJSON(false);
+      TPCJSONArray(Self).Insert(TPCJSONArray(Self).Count,TPCJSONData.ParseJSONValue(s));
+    end;
+  end else if (PCJSONData is TPCJSONVariantValue) AND (Self is TPCJSONVariantValue) then begin
+    TPCJSONVariantValue(Self).Value := TPCJSONVariantValue(PCJSONData).Value;
+  end else begin
+    raise Exception.Create('Error in TPCJSONData.Assign assigning a '+PCJSONData.ClassName+' to a '+ClassName);
+  end;
+
+end;
+
+constructor TPCJSONData.Create;
+begin
+   inc(_objectsCount);
+end;
+
+destructor TPCJSONData.Destroy;
+begin
+  dec(_objectsCount);
+  inherited;
+end;
+
+class function TPCJSONData.ParseJSONValue(Const JSONObject: TBytes): TPCJSONData;
+Var JS : TJSONValue;
+begin
+  Result := Nil;
+  JS := TJSONObject.ParseJSONValue(JSONObject,0);
+  if Not Assigned(JS) then exit;
+  Try
+    if JS is TJSONObject then begin
+      Result := TPCJSONObject.CreateFromJSONObject(TJSONObject(JS));
+    end else if JS is TJSONArray then begin
+      Result := TPCJSONArray.CreateFromJSONArray(TJSONArray(JS));
+    end else if JS is TJSONValue then begin
+      Result := TPCJSONVariantValue.CreateFromJSONValue(TJSONValue(JS));
+    end else raise EPCParametresError.Create('Invalid TJSON Data type '+JS.ClassName);
+  Finally
+    JS.Free;
+  End;
+end;
+
+procedure TPCJSONData.SaveToStream(Stream: TStream);
+Var s : AnsiString;
+begin
+  s := ToJSON(false);
+  Stream.Write(s[1],length(s));
+end;
+
+class function TPCJSONData.ParseJSONValue(Const JSONObject: String): TPCJSONData;
+begin
+  Result := ParseJSONValue( TEncoding.ASCII.GetBytes(JSONObject) );
+end;
+
+function TPCJSONData.ToJSON(pretty: Boolean): AnsiString;
+begin
+  Result := ToJSONFormatted(pretty,'');
+end;
+
+class function TPCJSONData._GetCount: Integer;
+begin
+  Result := _objectsCount;
+end;
+
+initialization
+  _objectsCount := 0;
+end.