classe distincte pour Développement d’une application pour analyser les données de Rosprirodnadzor

NVOS.JsonParse.pas

unit NVOS.JsonParser;

interface

uses System.JSON.Builders,
  System.JSON.Types,
  System.JSON.Writers,
  System.JSON.Readers,
  System.SysUtils,
  System.StrUtils,
  System.DateUtils,
  System.Classes,
  System.Rtti,
  Generics.Collections;

type
  TNVOSObject = class;
  TOnGetTotal = procedure(ASender: TObject; AObjectsCount: integer;
    ATotal: double) of object;
  TOnGetMostPowerful = procedure(ASender: TObject; AObject, ACode: string;
    AAirObjectCount: integer; AObjectValue: double) of object;

  TRegistryType = (rtFederal, rtRegional);
  TStatisticType = (stCategory, stSubstance, stControl);

  TNVOSAirFact = class
  private
    FCode: integer;
    FName: string;
    FAnnualValue: double;
    FPower: double;
  public
    property Code: integer read FCode write FCode;
    property Name: string read FName write FName;
    property AnnualValue: double read FAnnualValue write FAnnualValue;
    property Power: double read FPower write FPower;
  end;

  TNVOSStatistic = class
  private type
    TCategories = record
      I: integer;
      II: integer;
      III: integer;
      IV: integer;
      procedure Clear;
      function Total: integer;
    end;
  private
    FRegional: TCategories;
    FFederal: TCategories;
    FAirFacts: TObjectList<TNVOSAirFact>;
    procedure AddFact(AirFact: TNVOSAirFact);
  public
    constructor Create;
    destructor Destroy; override;
    procedure Clear;
    procedure Add(AObject: TNVOSObject);
    property Federal: TCategories read FFederal write FFederal;
    property Regional: TCategories read FRegional write FRegional;
    property AirFacts: TObjectList<TNVOSAirFact> read FAirFacts;
  end;

  TNVOSProps = class
  private
    FCode: string;
    FRegType: TRegistryType;
    FCategory: byte;
    FRegDate: TDateTime;
    FRiskCategory: byte;
  public
    property Code: string read FCode write FCode;
    property RegType: TRegistryType read FRegType write FRegType;
    property Category: byte read FCategory write FCategory;
    property RegDate: TDateTime read FRegDate write FRegDate;
    property RiskCategory: byte read FRiskCategory write FRiskCategory;
  end;

  TNVOSAir = class
  private
    FObjectCount: integer;
    FTotalAnnualValue: double;
    FFacts: TObjectList<TNVOSAirFact>;
  public
    constructor Create;
    destructor Destroy; override;
    property ObjectCount: integer read FObjectCount write FObjectCount;
    property TotalAnnualValue: double read FTotalAnnualValue
      write FTotalAnnualValue;
    property Facts: TObjectList<TNVOSAirFact> read FFacts;
  end;

  TNVOSObject = class
  private
    FName: string;
    FOrganization: string;
    FRegistrationDate: TDateTime;
    FAir: TNVOSAir;
    FProps: TNVOSProps;
  public
    constructor Create;
    destructor Destroy; override;
    property Name: string read FName write FName;
    property Organization: string read FOrganization write FOrganization;
    property RegistrationDate: TDateTime read FRegistrationDate
      write FRegistrationDate;
    property Air: TNVOSAir read FAir;
    property Props: TNVOSProps read FProps;
  end;

  TNVOSParser = class
  private type
    TAirFactRec = record
      Code: integer;
      Name: string;
      Power: double;
      Annual: double;
    end;
  private type
    TCurrentRec = record
      Name: string;
      Organization: string;
      OrgRegDate: TDateTime;
      Code: string;
      RegType: TRegistryType;
      Category: byte;
      RegDate: TDateTime;
      RiskCategory: byte;
      AirObjects: integer;
      AirTotalAnnual: double;
      AirFacts: TArray<TAirFactRec>;
      procedure Clear;
    end;
  private
    FIterator: TJSONIterator;
    FReader: TJsonTextReader;
    FTextReader: TStreamReader;
    FStatistic: TNVOSStatistic;
    FFileName: string;
    FOktmo: integer;
    FTotal: double;

    FObjects: TObjectList<TNVOSObject>;
    FMostPowerfulObjectValue: double;

    FCurrentRec: TCurrentRec;

    FOnGetTotal: TOnGetTotal;
    FOnGetMostPowerful: TOnGetMostPowerful;

    function ParseRecord(): boolean;
    procedure ParseAirFacts;
    procedure ParseOrganization;
    procedure CreateObject;
    function GetObject(const ACode: string): TNVOSObject;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Parse(const AOKTMO: byte = 0);

    property FileName: string read FFileName write FFileName;
    property Objects: TObjectList<TNVOSObject> read FObjects;
    property Obj[const ACode: string]: TNVOSObject read GetObject;
    property OnGetTotal: TOnGetTotal read FOnGetTotal write FOnGetTotal;
    property Statistic: TNVOSStatistic read FStatistic;
    property OnGetMostPowerful: TOnGetMostPowerful read FOnGetMostPowerful
      write FOnGetMostPowerful;
  end;

implementation

uses Winapi.Windows;

const
  cNestedObjects: array [0 .. 3] of string = ('Organization', 'Record', 'Facts', 'MeasureTools');
  cRecordPairs: array [0 .. 5] of string = ('Code', 'RegistryType', 'RiskCategory', 'Timestamp', 'WasSigned', 'Category');
  cCategoryStr: array [0 .. 3] of string = ('I', 'II', 'III', 'IV');
  cFactsPairs: array [0 .. 3] of string = ('Air', 'Water', 'Waste', 'ValCo2');
  cAirFactsPairs: array [0 .. 2] of string = ('ObjectCount', 'Facts', 'TotalAnnualValue');
  cAirFactsArrayPairs: array [0 .. 3] of string = ('AnnualValue', 'Code', 'Name', 'Power');
  cOrganizationPairs: array [0 .. 1] of string = ('Name', 'RegistrationDate');

function TimeStampToDateTime(const ATimeStamp: string): TDateTime;
var
  myformat: TFormatSettings;
begin
  // 2016-12-16T11:02:41.383Z
  myformat.ShortDateFormat := 'yyyy-mm-dd';
  myformat.ShortTimeFormat := 'Thh:mm:ss.zzzZ';
  myformat.DateSeparator := '-';
  myformat.TimeSeparator := ':';
  Result := StrToDateTime(ATimeStamp, myformat);
end;

function StrIndex(const AStr: string; AArray: array of string): integer;
var
  I: integer;
begin
  Result := -1;
  for I := Low(AArray) to High(AArray) do
    if SameText(AStr, AArray[I]) then
      Exit(I)
end;

{ TNVOSParser }

function TNVOSParser.ParseRecord: boolean;
var
  AStrings: TArray<string>;
  Tmp: integer;
begin
  FIterator.Recurse;
  while FIterator.Next do
  begin
    case StrIndex(FIterator.Key, cRecordPairs) of
      0: begin
            AStrings := SplitString(FIterator.AsString, '-');
            if (not TryStrToInt(AStrings[0], Tmp)) or ((FOktmo > 0) and (AStrings[0].ToInteger <> FOktmo)) then
            begin
              Result := True;
              break;
            end
            else
              FCurrentRec.Code := FIterator.AsString;
         end; // 'Code'
      1: if SameText(FIterator.AsString, 'Regional') then
            FCurrentRec.RegType := TRegistryType.rtRegional
         else
            FCurrentRec.RegType := TRegistryType.rtFederal; // 'RegistryType'
      2: FCurrentRec.RiskCategory := FIterator.AsInteger; // 'RiskCategory'
      3: FCurrentRec.RegDate := TimeStampToDateTime(FIterator.AsString);
        // 'Timestamp'
      4: continue; // 'WasSigned'
      5: FCurrentRec.Category := StrIndex(FIterator.AsString, cCategoryStr) + 1;
        // 'Category'
    end;
  end;
  FIterator.Return;
end;

constructor TNVOSParser.Create;
begin
  inherited;
  FObjects := TObjectList<TNVOSObject>.Create;
  FStatistic := TNVOSStatistic.Create;
end;

procedure TNVOSParser.CreateObject;
var
  I: integer;
begin
  FObjects.Add(TNVOSObject.Create);
  with FObjects.Last do
  begin
    Name := FCurrentRec.Name;
    Organization := FCurrentRec.Organization;
    FRegistrationDate := FCurrentRec.OrgRegDate;
    with Props do
    begin
      Code := FCurrentRec.Code;
      RegType := FCurrentRec.RegType;
      Category := FCurrentRec.Category;
      RegDate := FCurrentRec.RegDate;
      RiskCategory := FCurrentRec.RiskCategory;
    end;
    Air.ObjectCount := FCurrentRec.AirObjects;
    Air.TotalAnnualValue := FCurrentRec.AirTotalAnnual;
    for I := Low(FCurrentRec.AirFacts) to High(FCurrentRec.AirFacts) do
    begin
      Air.Facts.Add(TNVOSAirFact.Create);
      with Air.Facts.Last do
      begin
        Code := FCurrentRec.AirFacts[I].Code;
        Name := FCurrentRec.AirFacts[I].Name;
        AnnualValue := FCurrentRec.AirFacts[I].Annual;
        Power := FCurrentRec.AirFacts[I].Power;
      end;
    end;
  end;
  FCurrentRec.Clear;
  FStatistic.Add(FObjects.Last);
  if Assigned(FOnGetTotal) then
    FOnGetTotal(self, FObjects.Count, FTotal);
end;

destructor TNVOSParser.Destroy;
begin
  FreeAndNil(FStatistic);
  FreeAndNil(FObjects);
  inherited;
end;

function TNVOSParser.GetObject(const ACode: string): TNVOSObject;
var
  AObj: TNVOSObject;
begin
  AObj := nil;
  for AObj in FObjects do
    if AObj.Props.Code = ACode then
      Exit(AObj);
end;

procedure TNVOSParser.Parse(const AOKTMO: byte = 0);
var
  IsFalse: boolean;
begin
  FOktmo := AOKTMO;
  FTotal := 0;
  FMostPowerfulObjectValue := 0;
  FStatistic.Clear;
  FTextReader := nil;
  FReader := nil;
  FIterator := nil;
  FObjects.Clear;
  FTextReader := TStreamReader.Create(FFileName, TEncoding.UTF8, True);
  FReader := TJsonTextReader.Create(FTextReader);
  FIterator := TJSONIterator.Create(FReader);
  try
    // äâèãàåìñÿ ïî ìàññèâó îáúåêòîâ
    while FIterator.Next() do
    begin
      if FIterator.Recurse then
      begin
        IsFalse := False;
        // íàõîäèìñÿ âíóòðè çàïèñè îáúåêòà
        while FIterator.Next do
        begin
          if IsFalse then
          begin
            FCurrentRec.Clear;
            break;
          end;
          if FIterator.&Type = TJsonToken.StartObject then
          begin
            case StrIndex(FIterator.Key, cNestedObjects) of
              0: ParseOrganization; // 'Organization'
              1: IsFalse := ParseRecord; // 'Record'
              2: ParseAirFacts; // 'Facts'
              3: break; // 'MeasureTools'
            end;
          end
          else if FIterator.Key = 'Name' then
            FCurrentRec.Name := FIterator.AsString;
        end;
        FIterator.Return;
      end;
      if not IsFalse then
        CreateObject;
      FIterator.Return;
    end;
  finally
    FreeAndNil(FIterator);
    FreeAndNil(FReader);
    FreeAndNil(FTextReader);
  end;
end;

procedure TNVOSParser.ParseAirFacts;
var
  AirFactRec: TAirFactRec;
begin
  FIterator.Recurse;
  FIterator.Next('Air');
  FIterator.Recurse;

  while FIterator.Next do
  begin
    case StrIndex(FIterator.Key, cAirFactsPairs) of
      0:
        FCurrentRec.AirObjects := FIterator.AsInteger; // 'ObjectCount'
      1:
        begin
          FIterator.Recurse;
          while FIterator.Next() do
          begin
            FIterator.Recurse;
            with AirFactRec do
              while FIterator.Next do
              // ïðîõîäèì ïî îáúåêòó â ìàññèâå Air.Facts[]
              begin
                // ('AnnualValue','Code','Name','Power');
                case StrIndex(FIterator.Key, cAirFactsArrayPairs) of
                  0:
                    Annual := FIterator.AsDouble;
                  1:
                    Code := StrToInt(FIterator.AsString);
                  2:
                    Name := FIterator.AsString;
                  3:
                    Power := FIterator.AsDouble;
                end;
              end;
            FCurrentRec.AirFacts := FCurrentRec.AirFacts + [AirFactRec];
            FIterator.Return;
          end;
          FIterator.Return;
        end; // 'Facts'
      2:
        begin
          FCurrentRec.AirTotalAnnual := FIterator.AsDouble;

          if FCurrentRec.AirTotalAnnual > FMostPowerfulObjectValue then
          begin
            FMostPowerfulObjectValue := FCurrentRec.AirTotalAnnual;
            if Assigned(FOnGetMostPowerful) then
              FOnGetMostPowerful(self, FCurrentRec.Name, FCurrentRec.Code,
                FCurrentRec.AirObjects, FCurrentRec.AirTotalAnnual);
          end;

          FTotal := FTotal + FIterator.AsDouble;
        end;
    end;
  end;

  FIterator.Return;
  FIterator.Next();
  FIterator.Return;
end;

procedure TNVOSParser.ParseOrganization;
begin
  FIterator.Recurse;
  while FIterator.Next do
  begin
    case StrIndex(FIterator.Key, cOrganizationPairs) of
      0:
        FCurrentRec.Organization := FIterator.AsString;
      1:
        FCurrentRec.OrgRegDate := TimeStampToDateTime(FIterator.AsString);
    end;
  end;
  FIterator.Return;
end;

{ TNVOSAir }

constructor TNVOSAir.Create;
begin
  inherited;
  FFacts := TObjectList<TNVOSAirFact>.Create;
end;

destructor TNVOSAir.Destroy;
begin
  FreeAndNil(FFacts);
  inherited;
end;

{ TNVOSObject }

constructor TNVOSObject.Create;
begin
  inherited;
  FAir := TNVOSAir.Create;
  FProps := TNVOSProps.Create;
end;

destructor TNVOSObject.Destroy;
begin
  FreeAndNil(FProps);
  FreeAndNil(FAir);
  inherited;
end;

{ TNVOSParser.TCurrentRec }

procedure TNVOSParser.TCurrentRec.Clear;
begin
  Name := EmptyStr;
  Organization := EmptyStr;
  OrgRegDate := 0;
  Code := EmptyStr;
  Category := 0;
  RegDate := 0;
  RiskCategory := 0;
  AirObjects := 0;
  AirTotalAnnual := 0;
  Finalize(AirFacts);
end;

{ TNVOSStatistic }

procedure TNVOSStatistic.Add(AObject: TNVOSObject);
var
  AAirFact: TNVOSAirFact;
begin
  case AObject.Props.RegType of
    rtRegional:
      begin
        case AObject.Props.Category of
          1:
            inc(FRegional.I);
          2:
            inc(FRegional.II);
          3:
            inc(FRegional.III);
          4:
            inc(FRegional.IV);
        end;
      end;
    rtFederal:
      begin
        case AObject.Props.Category of
          1:
            inc(FFederal.I);
          2:
            inc(FFederal.II);
          3:
            inc(FFederal.III);
          4:
            inc(FFederal.IV);
        end;
      end;
  end;
  for AAirFact in AObject.Air.Facts do
    AddFact(AAirFact);
end;

procedure TNVOSStatistic.AddFact(AirFact: TNVOSAirFact);

  function FindFact(ACode: integer): TNVOSAirFact;
  var
    AFact: TNVOSAirFact;
  begin
    Result := nil;
    for AFact in FAirFacts do
      if AFact.Code = ACode then
        Exit(AFact)
  end;

var
  TmpFact: TNVOSAirFact;
begin
  TmpFact := FindFact(AirFact.Code);
  if not Assigned(TmpFact) then
  begin
    FAirFacts.Add(TNVOSAirFact.Create);
    TmpFact := FAirFacts.Last;
  end;
  TmpFact.AnnualValue := TmpFact.AnnualValue + AirFact.AnnualValue;
  TmpFact.Power := TmpFact.Power + AirFact.Power;
end;

procedure TNVOSStatistic.Clear;
begin
  FAirFacts.Clear;

end;

constructor TNVOSStatistic.Create;
begin
  FAirFacts := TObjectList<TNVOSAirFact>.Create;
end;

destructor TNVOSStatistic.Destroy;
begin
  FreeAndNil(FAirFacts);
  inherited;
end;

{ TNVOSStatistic.TCategories }

procedure TNVOSStatistic.TCategories.Clear;
begin
  I := 0;
  II := 0;
  III := 0;
  IV := 0;
end;

function TNVOSStatistic.TCategories.Total: integer;
begin
  Result := I + II + III + IV;
end;

end.