Einzelnen Beitrag anzeigen

tobite

Registriert seit: 23. Feb 2015
2 Beiträge
 
#3

AW: TGUID-Wert innerhalb eines records in Json konvertieren (XE7)

  Alt 16. Jun 2015, 13:34
Hallo Chris,

hier die komplette Unit... einfach aus einer neuen Konsolen-dpr aufzurufen ohne spezielle weitere Projekteinstellungen:

Delphi-Quellcode:
>>>>>
unit TestDef;

interface

uses
  System.Rtti,
  System.JSON,
  System.SysUtils,
  REST.Json,
  REST.Json.Types,
  REST.JsonReflect;

type
  TGuidInterceptor = class (TJSONInterceptor)
  public
    function StringConverter (AData: TObject; AField: string): string; override;
    procedure StringReverter (AData: TObject; AField: string; AArg: string); override;
  end;

type
  {$METHODINFO ON}
  TRec = record
    [JSonReflect (ctString, rtString, TGuidInterceptor, nil, True)]
    FID: TGUID;
  end;

  TTest = class (TObject)
  public
    [JSonReflect (ctString, rtString, TGuidInterceptor, nil, False)]
    FID: TGUID;

// FRec: TRec;
  end;
  {$METHODINFO OFF}

procedure RunTest;

implementation

function TGuidInterceptor.StringConverter (AData: TObject; AField: string): string;
var
  Ctx: TRttiContext;
  GUID: TGUID;
begin
  GUID := Ctx.GetType (AData.ClassType).GetField (AField).GetValue (AData).AsType<TGUID>;
  Result := GUIDToString (GUID);
end;

procedure TGuidInterceptor.StringReverter (AData: TObject; AField: string; AArg: string);
var
  Ctx: TRttiContext;
  GUID: TGUID;
begin
  GUID := StringToGUID (AArg);
  Ctx.GetType (AData.ClassType).GetField (AField).SetValue (AData, TValue.From<TGUID> (GUID));
end;

procedure RunTest;
var
  TestObj: TTest;
  TestRev: TTest;
  S1, S2: string;
  LJSONValue: TJSONValue;
  LJSONObject: TJSONObject;
begin
  TestObj := TTest.Create;
  try
    TestObj.FID := TGUID.NewGuid;
// TestObj.FRec.FID := TestObj.FID;

    S1 := TJson.ObjectToJsonString (TestObj);

    LJSONValue := TJSONObject.ParseJSONValue (S1);
    Assert (Assigned (LJSONValue) and (LJSONValue is TJSONObject));
    if Assigned (LJSONValue) and (LJSONValue is TJSONObject) then begin
      LJSONObject := LJSONValue as TJSONObject;

      TestRev := TTest.Create;
      try
        TJson.JsonToObject (TestRev, LJSONObject);

        S2 := TJson.ObjectToJsonString (TestObj);
        Assert (S1.Equals (S2));
      finally
        TestRev.Free;
      end;
      end;
  finally
    TestObj.Free;
  end;
end;

end.
<<<<<
Zwei Zeilen, Feld FRec betreffend, sind auskommentiert. D. h. so wie o. a. läuft die Prozedur durch. Nimmt man die beiden Zeilen mit FRec rein, so kommt die RTTI-Exception. Das liegt daran, dass er für das TGUID-Feld im FRec nicht den Interceptor aufruft. Aber wie macht man's richtig?

Tobias

Geändert von mkinzler (17. Jun 2015 um 08:55 Uhr) Grund: Delphi-Tag eingefügt
  Mit Zitat antworten Zitat