unit UCTRLSyncronization; {$mode delphi} { Copyright (c) 2018 Sphere 10 Software Distributed under the MIT software license, see the accompanying file LICENSE or visit http://www.opensource.org/licenses/mit-license.php. Acknowledgements: - Herman Schoenfeld: unit creator, implementation } interface {$I ..\config.inc} uses Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls, ComCtrls, Buttons, UCommon.UI; type { TSyncMode } TSyncMode = (smUnset, smInitialising, smReady); { TCTRLSyncronization } TCTRLSyncronization = class(TApplicationForm) btnBack: TSpeedButton; GroupBox1: TGroupBox; imgSplash: TImage; Label16: TLabel; Label4: TLabel; Label8: TLabel; lblBlockAgeLabel: TLabel; lblBlockAgeValue: TLabel; lblBlocksFound: TLabel; lblBlockTargetLabel: TLabel; lblBlockTargetValue: TLabel; lblCurrentDifficultyCaption1: TLabel; lblCurrentDifficultyCaption2: TLabel; lblMinersClientsValue: TLabel; lblMiningStatusCaption: TLabel; lblNetProtocolVersion: TLabel; lblNodeStatus: TLabel; lblPendingOperationsLabel: TLabel; lblPendingOperationsValue: TLabel; lblProtocolVersion: TLabel; lblReceivedMessages: TLabel; lblTimeAverage: TLabel; lblTimeAverageAux: TLabel; lblTotalAccountsLabel: TLabel; lblTotalAccountsValue: TLabel; lblTotalBlocksLabel: TLabel; lblTotalBlocksValue: TLabel; paSplash: TPanel; paSync: TPanel; procedure btnBackClick(Sender: TObject); procedure lblReceivedMessagesClick(Sender:TObject); private FMinedBlocksCount: Integer; FMode : TSyncMode; procedure SetMinedBlocksCount(const Value: Integer); procedure SetSyncMode(AMode : TSyncMode); protected procedure ActivateFirstTime; override; public property MinedBlocksCount : Integer read FMinedBlocksCount write SetMinedBlocksCount; property SyncMode : TSyncMode read FMode write SetSyncMode; procedure UpdateNodeStatus; procedure UpdateBlockChainState; procedure OnFinishedLoadingDatabase; end; implementation {$R *.lfm} uses UNetProtocol,UTime,UConst, UUserInterface; procedure TCTRLSyncronization.ActivateFirstTime; begin FMode := smInitialising; paSplash.Visible:= true; paSync.Visible := false; end; procedure TCTRLSyncronization.SetSyncMode(AMode : TSyncMode); begin if FMode = AMode then exit; case AMode of smInitialising: begin TUserInterface.Enabled := false; paSplash.Visible:= true; paSync.Visible := false; end; smReady: begin TUserInterface.Enabled := true; paSplash.Visible:= false; paSync.Visible := true; end; end; end; procedure TCTRLSyncronization.UpdateNodeStatus; Var status : AnsiString; begin if not TUserInterface.Started then exit; If Not Assigned(TUserInterface.Node) then begin lblNodeStatus.Font.Color := clRed; lblNodeStatus.Caption := 'Initializing...'; end else begin SyncMode:=smReady; If TUserInterface.Node.IsReady(status) then begin if TNetData.NetData.NetStatistics.ActiveConnections>0 then begin lblNodeStatus.Font.Color := clGreen; if TNetData.NetData.IsDiscoveringServers then begin lblNodeStatus.Caption := 'Discovering servers'; end else if TNetData.NetData.IsGettingNewBlockChainFromClient then begin lblNodeStatus.Caption := 'Obtaining new blockchain'; end else begin lblNodeStatus.Caption := 'Running'; end; end else begin lblNodeStatus.Font.Color := clRed; lblNodeStatus.Caption := 'Alone in the world...'; end; end else begin lblNodeStatus.Font.Color := clRed; lblNodeStatus.Caption := status; end; end; lblProtocolVersion.Caption := Format('%d (%d)', [TUserInterface.Node.Bank.SafeBox.CurrentProtocol,CT_BlockChain_Protocol_Available]); lblNetProtocolVersion.Caption := Format('%d (%d)', [CT_NetProtocol_Version, CT_NetProtocol_Available]); if NOT btnBack.Enabled then begin lblNodeStatus.Caption := 'Please wait until finished - ' + lblNodeStatus.Caption; end; end; procedure TCTRLSyncronization.UpdateBlockChainState; Var f, favg : real; begin if not TUserInterface.Started then exit; UpdateNodeStatus; if Assigned(TUserInterface.Node) then begin if TUserInterface.Node.Bank.BlocksCount>0 then begin lblTotalBlocksValue.Caption := Inttostr(TUserInterface.Node.Bank.BlocksCount)+' (0..'+Inttostr(TUserInterface.Node.Bank.BlocksCount-1)+')'; ; end else lblTotalBlocksValue.Caption := '(none)'; lblTotalAccountsValue.Caption := Inttostr(TUserInterface.Node.Bank.AccountsCount); lblBlockAgeValue.Caption := UnixTimeToLocalElapsedTime(TUserInterface.Node.Bank.LastOperationBlock.timestamp); lblPendingOperationsValue.Caption := Inttostr(TUserInterface.Node.Operations.Count); lblBlockTargetValue.Caption := InttoHex(TUserInterface.Node.Operations.OperationBlock.compact_target,8); favg := TUserInterface.Node.Bank.GetActualTargetSecondsAverage(CT_CalcNewTargetBlocksAverage); f := (CT_NewLineSecondsAvg - favg) / CT_NewLineSecondsAvg; lblTimeAverage.Caption := 'Last '+Inttostr(CT_CalcNewTargetBlocksAverage)+': '+FormatFloat('0.0',favg)+' sec. (Optimal '+Inttostr(CT_NewLineSecondsAvg)+'s) Deviation '+FormatFloat('0.00%',f*100); if favg>=CT_NewLineSecondsAvg then begin lblTimeAverage.Font.Color := clNavy; end else begin lblTimeAverage.Font.Color := clOlive; end; lblTimeAverageAux.Caption := Format('Last %d: %s sec. - %d: %s sec. - %d: %s sec. - %d: %s sec. - %d: %s sec.',[ CT_CalcNewTargetBlocksAverage * 2 ,FormatFloat('0.0',TUserInterface.Node.Bank.GetActualTargetSecondsAverage(CT_CalcNewTargetBlocksAverage * 2)), ((CT_CalcNewTargetBlocksAverage * 3) DIV 2) ,FormatFloat('0.0',TUserInterface.Node.Bank.GetActualTargetSecondsAverage((CT_CalcNewTargetBlocksAverage * 3) DIV 2)), ((CT_CalcNewTargetBlocksAverage DIV 4)*3),FormatFloat('0.0',TUserInterface.Node.Bank.GetActualTargetSecondsAverage(((CT_CalcNewTargetBlocksAverage DIV 4)*3))), CT_CalcNewTargetBlocksAverage DIV 2,FormatFloat('0.0',TUserInterface.Node.Bank.GetActualTargetSecondsAverage(CT_CalcNewTargetBlocksAverage DIV 2)), CT_CalcNewTargetBlocksAverage DIV 4,FormatFloat('0.0',TUserInterface.Node.Bank.GetActualTargetSecondsAverage(CT_CalcNewTargetBlocksAverage DIV 4))]); end else begin lblTotalBlocksValue.Caption := ''; lblTotalAccountsValue.Caption := ''; lblBlockAgeValue.Caption := ''; lblPendingOperationsValue.Caption := ''; lblBlockTargetValue.Caption := ''; lblTimeAverage.Caption := ''; lblTimeAverageAux.Caption := ''; end; if (Assigned(TUserInterface.PoolMiningServer)) And (TUserInterface.PoolMiningServer.Active) then begin If TUserInterface.PoolMiningServer.ClientsCount>0 then begin lblMinersClientsValue.Caption := IntToStr(TUserInterface.PoolMiningServer.ClientsCount)+' connected JSON-RPC clients'; lblMinersClientsValue.Font.Color := clNavy; end else begin lblMinersClientsValue.Caption := 'No JSON-RPC clients'; lblMinersClientsValue.Font.Color := clDkGray; end; MinedBlocksCount := TUserInterface.PoolMiningServer.ClientsWins; end else begin MinedBlocksCount := 0; lblMinersClientsValue.Caption := 'JSON-RPC server not active'; lblMinersClientsValue.Font.Color := clRed; end; end; procedure TCTRLSyncronization.SetMinedBlocksCount(const Value: Integer); begin FMinedBlocksCount := Value; lblBlocksFound.Caption := Inttostr(Value); if Value>0 then lblBlocksFound.Font.Color := clGreen else lblBlocksFound.Font.Color := clDkGray; end; procedure TCTRLSyncronization.OnFinishedLoadingDatabase; begin btnBack.Enabled:=true; TUserInterface.ShowWallet; end; procedure TCTRLSyncronization.lblReceivedMessagesClick(Sender:TObject); begin TUserInterface.ShowMessagesForm; end; procedure TCTRLSyncronization.btnBackClick(Sender: TObject); begin TUserInterface.ShowWallet; end; end.