Json Serializer und GUID

[backdraft]

Hallo zusammen,

ich nutze mittlerweile den Delphi Json Serialzter in vielen Projekten.
Jetzt bin ich das erste mal an eine GUID geraten, und da funktioniert er scheinbar nicht.

Konvertiere ich ein GUID nach JSon und wieder zurück ist der hintere Teil abgeschnitten.
Mache ich was falsch, oder ist das ein Bug?

Code:

  var lText := TStringList.Create;
  try
    var lGuid := TGUID.NewGuid;
    lText.Add(lGuid.ToString);

    var lJson: string;
    var lSerializer := TJsonSerializer.Create;
    try
      lJson := lSerializer.Serialize(lGuid);
    finally
      FreeAndNil(lSerializer);
    end;

    lText.Add(lJson);

    var lNewGuid: TGUID;
    var lDeserializer := TJsonSerializer.Create;
    try
      lNewGuid := lDeserializer.Deserialize<TGUID>(lJson);
    finally
      FreeAndNil(lSerializer);
    end;

    lText.Add(lNewGuid.ToString);

    ShowMessage(lText.Text);
  finally
    FreeAndNil(lText);
  end;

Ergebnis:

Code:

{1BBCB1AA-1BF2-42F7-96E2-2A84ED6699BA}
{"D1":465351082,"D2":7154,"D3":17143}
{1BBCB1AA-1BF2-42F7-0000-000000000000}

Es scheint die Variable D4 zu fehlen von TGUID (array[0..7] of byte).
Weiss jemand ob man dem Parser das manuell beibringen kann?

Grüße
Oliver

[jaenicke]

Leider ist die Dokumentation recht dürftig...
Einen eigenen Converter bekommst du soweit ich mich erinnere so rein:

Delphi-Quellcode:

TJsonD4Converter = class(TJsonConverter)
...

  TGuid = record
    [JsonConverter(TJsonD4Converter)]
    D4: array[0..7] of Byte;

Allerdings brauchst du dann noch einen passenden Provider, da das über die Rtti mit dem Array nicht klappt soweit ich mich erinnere...

Ich habe leider aktuell keine Zeit um nachzuschauen.

Vielleicht bekommst du das auch ohne Attribut (und damit einer Kopie der Recorddefinition) hin, aber das habe ich noch nicht versucht.

[Stevie]

Bekanntes Problem. Für das D4 Feld gibt es keine typeinfo. Sollte irgendwo im QP schon reportet sein.

[TiGü]

Es liegt, wie jaenicke andeutet, an der Typ-Definition für D4.
Das array[0..7] of Byte bekommt die Rtti nicht als Typ aufgedröselt.
Vielleicht ein Bug, weil anscheinend die Rtti immer einen richtigen Alias-Namen braucht.
Beim Erstellen des notwendigen TRttiField für D4, wird der FFieldType nicht ordentlich aufgelöst.
Die PTypeInfo dafür müsste als TTypeKind.tkArray rauskommen.

Delphi-Quellcode:

constructor TRttiField.Create(APackage: TRttiPackage; AParent: TRttiObject;
  var P: PByte);
begin
  inherited Create(APackage, AParent, P);
  FFieldType := GetFieldType; // hier kommt nil zurück für statische Arrays.
  FOffset := GetOffset;
end;
...
function TRttiRecordField.GetFieldType: TRttiType;
begin
  Result := Pool.TypeOrNil(Handle^.Field.TypeRef); //TypeRef ist hier nil, daher kommt von TypeOrNil auch nichts zurück. Das passiert schon beim Erzeugen des Basis-Typs TRttiObject im constructor
end;

Darum ist in TJsonSerializerWriter.WriteProperty in Zeile 1361 AProperty.Contract := ResolveContract(AProperty.TypeInf); der Wert für AProperty.TypeInf nil und es kommt kein vernünftiger Contract: TJsonContract bei raus.

Du kannst dich zumindest dahingehend behelfen, indem du dir einen Hilftyp zusammen schusterst und später dann immer zwischen deinen GUID-Typ und den richtigen TGUID-Typ aus der RTL castest:

Konsolenbeispiel:

Delphi-Quellcode:

program Project6;

{$APPTYPE CONSOLE}
{$R *.res}

uses
    System.SysUtils,
    System.Classes,
    System.JSON,
    System.JSON.Serializers;

type
    // TMyGUID = TGUID;
    TMyArray = array [0 .. 7] of Byte;

    TMyGUID = record
    public
        D1: Cardinal;
        D2: Word;
        D3: Word;
        D4: TMyArray;
        class function NewGuid: TMyGUID; static;
        function ToString: string;
    end;

class function TMyGUID.NewGuid: TMyGUID;
var
    foo: TGUID;
begin
    foo := TGuid.NewGuid;
    Result.D1 := foo.D1;
    Result.D2 := foo.D2;
    Result.D3 := foo.D3;
    Result.D4 := TMyArray(foo.D4);
end;

function TMyGUID.ToString: string;
begin
    Result := TGuid(Self).Tostring;
end;

var
    lGuid, lNewGuid: TMyGUID;
    lText: TStringList;
    lJson: string;
    lSerializer, lDeserializer: TJsonSerializer;

begin
    try
        lText := TStringList.Create;
        try
            lGuid := TMyGUID.NewGuid;
            lText.Add(lGuid.ToString);

            lSerializer := TJsonSerializer.Create;
            try
                lJson := lSerializer.Serialize<TMyGUID>(lGuid);
            finally
                FreeAndNil(lSerializer);
            end;

            lText.Add(lJson);

            lDeserializer := TJsonSerializer.Create;
            try
                lNewGuid := lDeserializer.Deserialize<TMyGUID>(lJson);
            finally
                FreeAndNil(lSerializer);
            end;

            lText.Add(lNewGuid.ToString);

            Writeln(lText.Text);
        finally
            FreeAndNil(lText);
        end;
    except
        on E: Exception do
            Writeln(E.ClassName, ': ', E.Message);
    end;
    Readln;
end.

Über den Call Stack TJsonDefaultContractResolver.ResolveContract | TJsonDefaultContractResolver.CreateContract | TJsonDefaultContractResolver.CreateArrayContract wird eine Instanz von TJsonArrayContract erzeugt, mit der die Serialisierung arbeiten kann.

[Stevie]

Einfach nen Konverter für TGUID schreiben und am Serializer hinzufügen, fertig:

Delphi-Quellcode:

type
  TGUIDConverter = class(TJsonConverter)
  public
    function CanConvert(ATypeInfo: PTypeInfo): Boolean; override;
    function ReadJson(const AReader: TJsonReader; ATypeInf: PTypeInfo; const AExistingValue: TValue;
      const ASerializer: TJsonSerializer): TValue; override;
    procedure WriteJson(const AWriter: TJsonWriter; const AValue: TValue;
      const ASerializer: TJsonSerializer);override;
  end;

function TGUIDConverter.CanConvert(ATypeInfo: PTypeInfo): Boolean;
begin
  Result := ATypeInfo = System.TypeInfo(TGUID);
end;

function TGUIDConverter.ReadJson(const AReader: TJsonReader;
  ATypeInf: PTypeInfo; const AExistingValue: TValue;
  const ASerializer: TJsonSerializer): TValue;
begin
  Result := TValue.From(TGuid.Create(AReader.Value.AsString));
end;

procedure TGUIDConverter.WriteJson(const AWriter: TJsonWriter;
  const AValue: TValue; const ASerializer: TJsonSerializer);
begin
  AWriter.WriteValue(AValue.AsType<TGUID>);
end;

type
  TFooBar = class
    GUID: TGUID;
  end;
procedure Main;
begin
  var foobar := TFooBar.Create;
  foobar.GUID := TGUID.NewGuid;
  Writeln(foobar.GUID.ToString);

  var lSerializer := TJsonSerializer.Create;
  lSerializer.Converters.Add(TGUIDConverter.Create);

  var lJson := lSerializer.Serialize(foobar);

  Writeln(lJson);

  var newFooBar := lSerializer.Deserialize<TFooBar>(lJson);
  Writeln(newFooBar.GUID.ToString);
end;

[TiGü]

Leider kein :huld: Smiley!


@backdraft: Aber dann den eigenen Konverter noch freigeben, dass fehlt in Stevies Beispiel.

[backdraft]

Ja vielen Dank.
Klappt perfekt.
Auf die Idee, dass ein einfach eine Converterproperty gibt bin ich nicht gekommen.
Ich dachte man kann es irgendwie über der Variable definieren mit [].
Läuft bestens.