9

I have a JSON like this:

{
"Content": [{
    "Identifier": "AABBCC",
    "Description": "test terfdfg",
    "GenericProductIdentifier": "AABBCC",
    "ProductFamilyDescription": "sampling",
    "LifeCycleStatus": "ACTIVE",
    "Price": {
        "Value": 1.00,
        "Quantity": 1000
    },
    "LeadTimeWeeks": "16",
    "FullBoxQty": 200,
}],
"TotalElements": 1,
"TotalPages": 1,
"NumberOfElements": 1,
"First": true,
"Size": 1,
"Number": 0
}

In Delphi 10.4, I'm trying to parse it, but I can't access the values ​​contained in 'Price'.

I wrote code like this:

var
  vContent: TJSONArray;
  vJson: TJSONObject;
  vContentRow: TJSONObject;
  i,j : Integer;
begin
  Memo2.Lines.Clear;

  if Memo1.Text = '' then
    exit;

  vJson := TJSONObject(TJSONObject.ParseJSONValue(TEncoding.ASCII.GetBytes(Memo1.Text),0));
  try
    vContent := TJSONArray(vJson.Get('Content').JsonValue);

    for i := 0 to Pred(vContent.Count) do
    begin
      vContentRow := TJSONObject(vContent.Items[i]);
      for j := 0 to Pred(vContentRow.Count) do
      begin
        Memo2.Lines.Add('  '+ vContentRow.Get(j).JsonString.Value+' : '+ vContentRow.Get(j).JsonValue.Value);
      end;
    end;

    Memo2.Lines.Add(vContent.Value);
  finally

  end;
end;

What is the correct way to read the values ​​contained in 'Price'?

2
  • 1
    Btw, you do not need TEncoding.ASCII.GetBytes( in your code. May simply pass Memo1.Text in ParseJSONValue( Commented Jun 9, 2022 at 14:37
  • OP, if any of these answers worked for you, please accept one (tick the green check mark). That would be very helpful for others who read this question. Thanks Commented Dec 22, 2022 at 12:50

3 Answers 3

9

Here is a sample code to parse your JSON:

uses
  System.IOUtils, System.JSON, System.Generics.Collections;

procedure TForm1.Button1Click(Sender: TObject);

  procedure GetPrices(const S: string);
  var
    V: TJsonValue;
    O, E, P: TJsonObject;
    A: TJsonArray;
  begin
    V := TJSONObject.ParseJSONValue(S);
    if not Assigned(V) then
      raise Exception.Create('Invalid JSON');
    try
      O := V as TJSONObject;
      A := O.GetValue<TJsonArray>('Content');
      for var I := 0 to A.Count - 1 do
      begin
        E := A.Items[I] as TJsonObject; // Element
        P := E.GetValue<TJsonObject>('Price');
        ShowMessage('Value: ' + P.GetValue<string>('Value') + '  ' + 'Quantity: ' +  P.GetValue<string>('Quantity'));
      end;
    finally
      V.Free;
    end;
  end;

var
  S: string;
begin
  S := TFile.ReadAllText('d:\json.txt'); // Retrieve it using some webservice
  GetPrices(S);
end;

Note, your JSON is invalid, the corect definition is:

{
    "Content": [{
        "Identifier": "AABBCC",
        "Description": "test terfdfg",
        "GenericProductIdentifier": "AABBCC",
        "ProductFamilyDescription": "sampling",
        "LifeCycleStatus": "ACTIVE",
        "Price": {
            "Value": 1.00,
            "Quantity": 1000
        },
        "LeadTimeWeeks": "16",
        "FullBoxQty": 200
    }],
    "TotalElements": 1,
    "TotalPages": 1,
    "NumberOfElements": 1,
    "First": true,
    "Size": 1,
    "Number": 0
}
Sign up to request clarification or add additional context in comments.

3 Comments

I have correct the json... Thank you very much
Just a small nitpick - ParseJSONValue() returns a TJSONValue. If the JSON cannot be parsed, a nil pointer is returned, which you are accounting for. But, if the JSON is OK but doesn't start with an Object, the cast to TJSONObject will fail and raise an exception, which are you not handling, and so the TJSONValue would be leaked. I would suggest moving the cast inside the try..finally, eg: V := TJSONObject.ParseJSONValue(S); if not Assigned(V) then raise ...; try O := V as TJSONObject; ... finally V.Free; end;
Thanks Remy, about exception i was aware, in case if a non object is passed, but not on mem leak.. adjusted the code
2

You can use the JSON library of Delphi. The JSON library has the JsonToObject class function that can convert directly the string to an Object (Object structure)

See this: https://docwiki.embarcadero.com/Libraries/Sydney/en/REST.Json.TJson.JsonToObject

You can create the classes structure manually o using the web: https://jsontodelphi.com/

The classes structure for your JSON created is this:

type
  TPrice = class;

  TPrice = class
  private
    FQuantity: Integer;
    FValue: Double;
  published
    property Quantity: Integer read FQuantity write FQuantity;
    property Value: Double read FValue write FValue;
  end;
  
  TContent = class
  private
    FDescription: string;
    FFullBoxQty: Integer;
    FGenericProductIdentifier: string;
    FIdentifier: string;
    FLeadTimeWeeks: string;
    FLifeCycleStatus: string;
    FPrice: TPrice;
    FProductFamilyDescription: string;
  published
    property Description: string read FDescription write FDescription;
    property FullBoxQty: Integer read FFullBoxQty write FFullBoxQty;
    property GenericProductIdentifier: string read FGenericProductIdentifier write FGenericProductIdentifier;
    property Identifier: string read FIdentifier write FIdentifier;
    property LeadTimeWeeks: string read FLeadTimeWeeks write FLeadTimeWeeks;
    property LifeCycleStatus: string read FLifeCycleStatus write FLifeCycleStatus;
    property Price: TPrice read FPrice;
    property ProductFamilyDescription: string read FProductFamilyDescription write FProductFamilyDescription;
  public
    constructor Create;
    destructor Destroy; override;
  end;
  
  TRoot = class(TJsonDTO)
  private
    [JSONName('Content'), JSONMarshalled(False)]
    FContentArray: TArray<TContent>;
    [GenericListReflect]
    FContent: TObjectList<TContent>;
    FFirst: Boolean;
    FNumber: Integer;
    FNumberOfElements: Integer;
    FSize: Integer;
    FTotalElements: Integer;
    FTotalPages: Integer;
    function GetContent: TObjectList<TContent>;
  protected
    function GetAsJson: string; override;
  published
    property Content: TObjectList<TContent> read GetContent;
    property First: Boolean read FFirst write FFirst;
    property Number: Integer read FNumber write FNumber;
    property NumberOfElements: Integer read FNumberOfElements write FNumberOfElements;
    property Size: Integer read FSize write FSize;
    property TotalElements: Integer read FTotalElements write FTotalElements;
    property TotalPages: Integer read FTotalPages write FTotalPages;
  public
    destructor Destroy; override;
  end;

Now, the code for parse elements is more simple. You only need a code like this to access different properties of your structure:

var
  Root: TRoot;
begin
  root := TJSON.JsonToObject<TRoot>(Memo1.Lines.Text);
  lblid.Caption := 'TotalElements: ' + Root.TotalElements.ToString;
  lblvalue.Caption := 'TotalPages: ' + Root.TotalPages.ToString;
  lblcount.Caption := 'Identifier: ' + Root.Content[0].Identifier;
  lblfirstonclick.Caption := 'Description: ' + Root.Content[0].Description;
  lbllastonclick.Caption := 'Price/Quantity:' + Root.Content[0].Price.Quantity.ToString;
  //...

1 Comment

It seems TJsonDTO is not a Delphi bundled class. Indeed JsonToObject works, just for simple things you have to define/manage a lot of classes/code, even for uneeded properties/structures in json. Usually I preffer to work directly with TJsonObject's.
0

Try this, i make some helper for TFDMemtable. Simple to uses, no need parsing everytime you have other JSON.

const 
  JSONString = 
  '{
"Content": [{
    "Identifier": "AABBCC",
    "Description": "test terfdfg",
    "GenericProductIdentifier": "AABBCC",
    "ProductFamilyDescription": "sampling",
    "LifeCycleStatus": "ACTIVE",
    "Price": {
        "Value": 1.00,
        "Quantity": 1000
    },
    "LeadTimeWeeks": "16",
    "FullBoxQty": 200,
}],
"TotalElements": 1,
"TotalPages": 1,
"NumberOfElements": 1,
"First": true,
"Size": 1,
"Number": 0
}';

begin
  if not Memtable.FillDataFromString(JSONString) then begin
    ShowMessages(Memtable.FieldByName('messages').AsString);
  end else begin
    Memtable.FillDataFromString(Memtable.FieldByName('Content').AsString);
    ShowMessages(Memtable.FieldByName('Price').AsString);
  end;
end;

====

unit BFA.Helper.MemTable;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.Memo.Types,
  System.Rtti, FMX.Grid.Style, FMX.Grid, FMX.ScrollBox, FMX.Memo, FMX.Edit,
  FMX.Controls.Presentation, FMX.StdCtrls, FireDAC.Stan.Intf,
  FireDAC.Stan.Option, FireDAC.Stan.Param, FireDAC.Stan.Error, FireDAC.DatS,
  FireDAC.Phys.Intf, FireDAC.DApt.Intf, System.Net.URLClient,
  System.Net.HttpClient, System.Net.HttpClientComponent, Data.DB,
  FireDAC.Comp.DataSet, FireDAC.Comp.Client, System.JSON, System.Net.Mime;

type
  TFDMemTableHelper = class helper for TFDMemTable
    procedure FillError(FMessage, FError : String);
    function FillDataFromString(FJSON : String) : Boolean; //ctrl + shift + C
  end;

implementation

{ TFDMemTableHelper }

function TFDMemTableHelper.FillDataFromString(FJSON: String): Boolean;  //bug memoryleak fix at checking is Object / array soon
const
  FArr = 0;
  FObj = 1;
  FEls = 2;

  function isCheck(FString : String) : Integer; begin
    Result := FEls;
    var FCheck := TJSONObject.ParseJSONValue(FJSON);
    if FCheck is TJSONObject then
      Result := FObj
    else if FCheck is TJSONArray then
      Result := FArr;

    FCheck.DisposeOf;
  end;

var
  JObjectData : TJSONObject;
  JArrayJSON : TJSONArray;
  JSONCheck : TJSONValue;
begin
  var FResult := isCheck(FJSON);
  try
    Self.Active := False;
    Self.Close;
    Self.FieldDefs.Clear;

    if FResult = FObj then begin
      JObjectData := TJSONObject.ParseJSONValue(FJSON) as TJSONObject;
    end else if FResult = FArr then begin
      JArrayJSON := TJSONObject.ParseJSONValue(FJSON) as TJSONArray;
      JObjectData := TJSONObject(JArrayJSON.Get(0));
    end else begin
      Self.FillError('FAILED PARSING JSON', 'THIS IS NOT JSON');
      Result := False;
      Exit;
    end;

    for var i := 0 to JObjectData.Size - 1 do begin
      Self.FieldDefs.Add(
        StringReplace(JObjectData.Get(i).JsonString.ToString, '"', '', [rfReplaceAll, rfIgnoreCase]),
        ftString,
        100000,
        False
      );
    end;

    Self.CreateDataSet;
    Self.Active := True;
    Self.Open;

    try
      if FResult = FArr then begin
        for var i := 0 to JArrayJSON.Size - 1 do begin
          JObjectData := TJSONObject(JArrayJSON.Get(i));
          Self.Append;
          for var ii := 0 to JObjectData.Size - 1 do begin
            JSONCheck := TJSONObject.ParseJSONValue(JObjectData.GetValue(Self.FieldDefs[ii].Name).ToJSON);

            if JSONCheck is TJSONObject then
              Self.Fields[ii].AsString := JObjectData.GetValue(Self.FieldDefs[ii].Name).ToJSON
            else if JSONCheck is TJSONArray then
              Self.Fields[ii].AsString := JObjectData.GetValue(Self.FieldDefs[ii].Name).ToJSON
            else
              Self.Fields[ii].AsString := JObjectData.Values[Self.FieldDefs[ii].Name].Value;

            JSONCheck.DisposeOf;
          end;
          Self.Post;
        end;
      end else begin
        Self.Append;
        for var ii := 0 to JObjectData.Size - 1 do begin
          JSONCheck := TJSONObject.ParseJSONValue(JObjectData.GetValue(Self.FieldDefs[ii].Name).ToJSON);

          if JSONCheck is TJSONObject then
            Self.Fields[ii].AsString := JObjectData.GetValue(Self.FieldDefs[ii].Name).ToJSON
          else if JSONCheck is TJSONArray then
            Self.Fields[ii].AsString := JObjectData.GetValue(Self.FieldDefs[ii].Name).ToJSON
          else
            Self.Fields[ii].AsString := JObjectData.Values[Self.FieldDefs[ii].Name].Value;

          JSONCheck.DisposeOf;
        end;
        Self.Post;
      end;

      Result := True;
    except
      on E : Exception do begin
        Result := False;
        Self.FillError('Error Parsing JSON', E.Message);
      end;
    end;
  finally
    if FResult = FObj then
      JObjectData.DisposeOf;

    if FResult = FArr then
      JArrayJSON.DisposeOf;

    Self.First;
  end;
end;

procedure TFDMemTableHelper.FillError(FMessage, FError : String);
begin
  Self.Active := False;
  Self.Close;
  Self.FieldDefs.Clear;

  Self.FieldDefs.Add('status', ftString, 200, False);
  Self.FieldDefs.Add('messages', ftString, 200, False);
  Self.FieldDefs.Add('data', ftString, 200, False);

  Self.CreateDataSet;
  Self.Active := True;
  Self.Open;

  Self.Append;
  Self.Fields[0].AsString := FError;
  Self.Fields[1].AsString := FMessage;
  Self.Post;
end;

end.

Comments

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.