如何在 Delphi 中解析JSON？

nom7f22z  于 2022-11-04  发布在  其他
关注(0)|答案(3)|浏览(198)

我有一个如下的JSON：

{
"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
}

在 Delphi 中，我试图解析它，但无法访问值 包含在“价格”中。
我写了这样的代码：

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;

读取值的正确方法是什么 包含在“价格”中？

delphi

3条答案

按热度按时间
qacovj5a

qacovj5a1#

下面是一个解析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;

注意，您的JSON无效，正确的定义为：

{
    "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
}
赞(0）分享  回复(0）举报  2022-11-04
8aqjt8rx

8aqjt8rx2#

可以使用 Delphi 的JSON library，JSON库中有JsonToObject class function，可以直接将字符串转换为Object（对象结构）
请参见：https://docwiki.embarcadero.com/Libraries/Sydney/en/REST.Json.TJson.JsonToObject
您可以使用Web手动创建类结构：https://jsontodelphi.com/
创建的JSON的类结构如下所示：

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;

现在，parse元素的代码更加简单了，你只需要像这样的代码就可以访问结构的不同属性：

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;
  //...
赞(0）分享  回复(0）举报  2022-11-04
cedebl8k

cedebl8k3#

试试这个，我为TFDMemtable做了一些助手。使用简单，不需要每次你有其他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.
赞(0）分享  回复(0）举报  2022-11-04
我来回答

相关问题

    查看更多

    热门标签

    更多
    JavaquerypythonNode开发语言requestUtil数据库Table后端算法LoggerMessageElementParser

    最新问答

    更多
    • 蜀ICP备13028337号-1 大数据知识库 https://www.saoniuhuo.com © All rights reserved
    • 本站内容来源互联网,如果侵犯您的权益请联系我们删除, 联系方式：448109455@qq.com