Nadpisywanie elementów listy (Delphi 10.4)

0

Potrzebuję sparsować JSON'a.
W tym celu utworzyłem sobie własną klasę TMJson która przetwarza JSON'a i tworzy listę obiektów typu TMJsonItem.
Jedno property z JSON'a to jeden obiekt na liście.

unit MyJson;

interface

uses sysutils, strutils, dialogs, system.json.Readers, json, system.json.Types, generics.Collections, system.Classes;

type
  TMJsonItem = class
  public
    tokenType: TJsonToken;
    propertyName: string;
    strValue: string;
    strPath: string;
    function asString: string;
    procedure AfterConstruction; override;
  end;

type
  TMJson = class
  private
    Ftext: string;
    procedure setText(const Value: string);
  public
    items: Tobjectlist<TMJsonItem>;
    function asString: string;
    property text: string read Ftext write setText;
    procedure AfterConstruction; override;
    procedure BeforeDestruction; override;
  end;

implementation

{ TMJson }

procedure TMJson.AfterConstruction;
begin
  inherited;
  items := Tobjectlist<TMJsonItem>.Create;
end;

function TMJson.asString: string;
var
  i: integer;
begin
  result := '';
  for i := 0 to self.items.Count - 1 do
    result := result + self.items[i].asString + #13;
end;

procedure TMJson.BeforeDestruction;
begin
  inherited;
  items.Free;
end;

procedure TMJson.setText(const Value: string);
var
  Sr: TStringReader;
  Reader: TJsonTextReader;
  lItem: TMJsonItem;
begin
  self.items.Clear;
  Ftext := Value;
  Sr := TStringReader.Create(Ftext);
  Reader := TJsonTextReader.Create(Sr);
  try
    while Reader.read do
    begin
      if Reader.tokenType = TJsonToken.propertyName then
      begin
        lItem := TMJsonItem.Create;
        lItem.propertyName := Reader.Value.ToString;
        if Reader.read then
        begin
          self.items.Add(lItem);
          lItem.tokenType := Reader.tokenType;
          lItem.strPath := Reader.Path;
          lItem.strValue := Reader.Value.ToString;
        end
        else
          lItem.Free;
      end;
    end;
  finally
    Reader.Free;
    Sr.Free;
  end;
end;

{ TMJsonItem }

procedure TMJsonItem.AfterConstruction;
begin
  inherited;
  self.propertyName := '';
  self.strPath := '';
  self.strValue := '';
end;

function TMJsonItem.asString: string;
begin
   result := 'Token type: '+inttostr(byte(self.tokenType)) + ' : {PropertyName: ' + self.propertyName + '} {strPath: ' + self.strPath + '} {strValue=' + self.strValue + '}';

end;

end.

Przykład użycia klasy:

const
  JsonTxt1 = //
    '{' + //
    '"numberOfElements":2291,' + //
    '"timestamp":"2023-09-23T08:19:14.511Z"' + //
    '}';
  JsonTxt2 = //
    '{' + //
    '"numberOfElementsX":2291,' + //
    '"timestamp":"2023-09-23T08:19:14.511Z"' + //
    '}';
  JsonTxt3 = //
    '{' + //
    '"numberOfElements":2291,' + //
    '"timestampXXXXXXXXXXXXXXXXX":"2023-09-23T08:19:14.511Z"' + //
    '}';

procedure TForm4.Button5Click(Sender: TObject);
var
  lJson: TMJson;
  tmpStr: string;
begin

  lJson := TMJson.create;
  tmpStr := 'JSON1 =============' + #13;
  lJson.Text := JsonTxt1;
  tmpStr := tmpStr + lJson.asString+#13;

  tmpStr := tmpStr + 'JSON2 =============' + #13;
  lJson.Text := JsonTxt2;
  tmpStr := tmpStr + lJson.asString + #13;

  tmpStr := tmpStr + 'JSON3 =============' + #13;
  lJson.Text := JsonTxt3;
  tmpStr := tmpStr + lJson.asString + #13;

  self.Memo1.Lines.Text := tmpStr;
  lJson.Free;
end;

Treść memo (rezultat działania programu)

JSON1 =============
Token type: 7 : {PropertyName: numberOfElements} {strPath: timestamplements} {strValue=2291}       <= zamiast  
                                                                                                          {strPath:numberOfElements}
                                                                                                      jest
                                                                                                          {strPath:timestamplements}
Token type: 9 : {PropertyName: timestamp} {strPath: timestamp} {strValue=2023-09-23T08:19:14.511Z}

JSON2 =============
Token type: 7 : {PropertyName: numberOfElementsX} {strPath: numberOfElementsX} {strValue=2291}
Token type: 9 : {PropertyName: timestamp} {strPath: timestamp} {strValue=2023-09-23T08:19:14.511Z}

JSON3 =============
Token type: 7 : {PropertyName: numberOfElements} {strPath: numberOfElements} {strValue=2291}
Token type: 9 : {PropertyName: timestampXXXXXXXXXXXXXXXXX} {strPath: timestampXXXXXXXXXXXXXXXXX} {strValue=2023-09-23T08:19:14.511Z}

Niby działa, ale dzieją się dziwne rzeczy.
Drugi i trzeci JSON jest przetwarzany prawidłowo
W pierwszym, treść pola strPath pierwszego elementu listy zostaje nadpisana treścią pola strPath drugiego elementu listy.
Może jestem ślepy i nie widzę jakiegoś elementarnego błędu :)

0

Spakowany projekt
4p.zip

0

a nie możęsz skorzystać z tego?
https://docwiki.embarcadero.com/Libraries/Alexandria/en/System.JSON

0

@kAzek: : Dzięki za sprawdzenie. Dodatkowo sprawdziłem w D10.2 i jest OK. Czyli w D10.4 jest jakiś bug.
Zamiast listy obiektów Tobjectlist próbowałem użyć tablicy obiektów. Efekt ten sam, czyli błąd.
I co najdziwniejsze, zauważyłem że błąd pojawia się (i to nie zawsze) tylko wtedy kiedy nazwa pierwszego obiektu ma dokładnie 16 znaków, np. numberOfElements. Przy innej długości nazwy obiektu program działa prawidłowo

1

To postaw na tym Reader.Path brak pointa i debuguj (F7 aby wejśc do tej metody) .
W Delphi 11 wygląda ona tak:

function TJsonFiler.GetPath(AFromDepth: Integer): string;
var
  I: Integer;
begin
  if FCurrentPosition.ContainerType = TJsonContainerType.None then
    Result := ''
  else
  begin
    if AFromDepth < 0 then
      AFromDepth := 0;

    FPathBuilder.Length := 0;
    for I := AFromDepth to FStack.Count - 1 do
      FStack[I].WriteTo(FPathBuilder);

    if InsideContainer and (AFromDepth <= FStack.Count) then
      FCurrentPosition.WriteTo(FPathBuilder);

    Result := FPathBuilder.ToString(False);
  end;
end;

Tylko ostatnia instrukcja warunkowa na tym powinna sie wykonać poprzednie ani pętla nie.

0

@kAzek:
Tak wygląda pod D10.4. Kod jest identyczny. Trzeba by głębiej szukać

function TJsonFiler.GetPath(AFromDepth: Integer): string;
var
  I: Integer;
begin
  if FCurrentPosition.ContainerType = TJsonContainerType.None then
    Result := ''
  else
  begin
    if AFromDepth < 0 then
      AFromDepth := 0;

    FPathBuilder.Length := 0;
    for I := AFromDepth to FStack.Count - 1 do
      FStack[I].WriteTo(FPathBuilder);

    if InsideContainer and (AFromDepth <= FStack.Count) then
      FCurrentPosition.WriteTo(FPathBuilder);

    Result := FPathBuilder.ToString(False);
  end;
end;
2

Jest błąd z typem UnicodeString (string) - chyba jest to związane z RSP-20365: https://docwiki.embarcadero.com/RADStudio/Alexandria/en/List_of_publicly_reported_bugs_fixed_in_10.4.1. Jeżeli zdefiniujesz:

TMJsonItem = class
  public
    ...
    strPath: WideString; //lub AnsiString lub wymusisz długość zmiennej, np.: String[100]
    ...
  end;

lub (bez zmiany typu) przy odczycie rzutujesz jako WideString:

lItem.strPath := WideString(Reader.Path);

to będzie ok.

Sprawdzane w 10.4 Community.

0

@Paweł Dmitruk:

Jest błąd z typem UnicodeString (string) - chyba jest to związane z RSP-20365: https://docwiki.embarcadero.com/RADStudio/Alexandria/en/List_of_publicly_reported_bugs_fixed_in_10.4.1. >

przejrzałem serwis Embarcadero z raportami błędów..
Myślę że mój problem bardziej pasuje do tego:
TJSONObject.ToJSON outputs unicode as ascii and not (JSON) escapes: RSP-29121

0
grzegorz_so napisał(a):

TJSONObject.ToJSON outputs unicode as ascii and not (JSON) escapes: RSP-29121

Ale nigdzie nie korzystasz z funkcji ToJSON.

Zarejestruj się i dołącz do największej społeczności programistów w Polsce.

Otrzymaj wsparcie, dziel się wiedzą i rozwijaj swoje umiejętności z najlepszymi.

Utwórz konto