RestServer Antwort Json ohne "[" Klammern

[Sir Rufo]

Nunja, grundsätzlich ist das ja kein Problem (ja ein bisserl Tipparbeit mit den Klassen) wenn man es sich schon mal vorab gemütlich macht.

Delphi-Quellcode:

unit Unit1;

interface

uses
  System.Generics.Collections,
  System.SysUtils,
  REST.Json.Types;

type { internal data object }
  TFooData = class
  private
    FNumber: Integer;
  public
    property Number: Integer read FNumber write FNumber;
  end;

type { api objects }
  TFooWriteJson = class
  private
    [ JsonName( 'number_write' ) ]
    FNumber: string;
  public
    property Number: string read FNumber write FNumber;
  end;

  TFooReadJson = class
  private
    [ JsonName( 'number_read' ) ]
    FNumber: Integer;
  public
    property Number: Integer read FNumber write FNumber;
  end;

type
  TJsonSerializer = class abstract
  private type
    TConverter = record
      ClassType: TClass;
      Convert: TFunc<TObject, TObject>;
    end;
  private
    FConverterMap: TDictionary<TClass, TConverter>;
    FReverterMap : TDictionary<TClass, TConverter>;
  protected
    procedure RegisterConverter<TSource: class; TResult: class>( Converter: TFunc<TSource, TResult> );
    procedure RegisterConverterReverter<TSource: class; TResult: class, constructor>( Converter: TFunc<TSource, TResult>; Reverter: TFunc<TResult, TSource> );
    procedure RegisterReverter<TSource: class; TResult: class, constructor>( Converter: TFunc<TResult, TSource> );
  public
    constructor Create; virtual;
    destructor Destroy; override;

    function Serialize<T: class>( AObject: T ): string;
    function Deserialize<T: class>( const JsonStr: string ): T;
  end;

type
  TConcreteSerializer = class( TJsonSerializer )
  public
    constructor Create; virtual;
  end;

implementation

uses
  REST.Json,
  System.Json;

{ TJsonSerializer }

constructor TJsonSerializer.Create;
begin
  inherited;
  FConverterMap := TDictionary<TClass, TConverter>.Create;
  FReverterMap  := TDictionary<TClass, TConverter>.Create;
end;

function TJsonSerializer.Deserialize<T>( const JsonStr: string ): T;
var
  lConverter: TConverter;
  lJson     : TJsonObject;
  lSerObj   : TObject;
begin
  if not FReverterMap.TryGetValue( T, lConverter )
  then
    raise Exception.Create( 'Fehlermeldung' );

  lJson := TJsonObject.ParseJSONValue( JsonStr ) as TJsonObject;
  try
    lSerObj := lConverter.ClassType.Create;
    try
      TJson.JsonToObject( lSerObj, lJson );

      Result := lConverter.Convert( lSerObj ) as T;

    finally
      lSerObj.Free;
    end;
  finally
    lJson.Free;
  end;
end;

destructor TJsonSerializer.Destroy;
begin
  FConverterMap.Free;
  FReverterMap.Free;
  inherited;
end;

procedure TJsonSerializer.RegisterConverter<TSource, TResult>( Converter: TFunc<TSource, TResult> );
var
  lConverter: TConverter;
begin
  lConverter.ClassType := TResult;
  lConverter.Convert   :=
    function( Source: TObject ): TObject
    begin
      Result := Converter( Source as TSource );
    end;
  FConverterMap.Add( TSource, lConverter );
end;

procedure TJsonSerializer.RegisterConverterReverter<TSource, TResult>( Converter: TFunc<TSource, TResult>; Reverter: TFunc<TResult, TSource> );
begin
  RegisterConverter<TSource, TResult>( Converter );
  RegisterReverter<TSource, TResult>( Reverter );
end;

procedure TJsonSerializer.RegisterReverter<TSource, TResult>( Converter: TFunc<TResult, TSource> );
var
  lConverter: TConverter;
begin
  lConverter.ClassType := TResult;
  lConverter.Convert   :=
    function( Source: TObject ): TObject
    begin
      Result := Converter( Source as TResult );
    end;
  FReverterMap.Add( TSource, lConverter );
end;

function TJsonSerializer.Serialize<T>( AObject: T ): string;
var
  lConverter: TConverter;
  lSerObj   : TObject;
begin
  if not FConverterMap.TryGetValue( AObject.ClassType, lConverter )
  then
    raise Exception.Create( 'Fehlermeldung' );

  lSerObj := lConverter.Convert( AObject );
  try
    Result := TJson.ObjectToJsonString( lSerObj );
  finally
    lSerObj.Free;
  end;
end;

{ TConcreteSerializer }

constructor TConcreteSerializer.Create;
begin
  inherited;

  RegisterConverter<TFooData, TFooWriteJson>(
    function( s: TFooData ): TFooWriteJson
    begin
      Result := TFooWriteJson.Create;
      Result.Number := IntToStr( s.Number );
    end );

  RegisterReverter<TFooData, TFooReadJson>(
    function( s: TFooReadJson ): TFooData
    begin
      Result := TFooData.Create;
      Result.Number := s.Number;
    end );
end;

end.

Dann geht das nachher alles wie von selber

Delphi-Quellcode:

procedure Test;
var
  lSer : TJsonSerializer;
  lfoo : TFooData;
  lData: string;
begin
  lSer := TConcreteSerializer.Create;
  try

    lfoo := TFooData.Create;
    try
      lfoo.Number := 42;
      lData       := lSer.Serialize( lfoo );
    finally
      lfoo.Free;
    end;

    WriteLn( lData ); // {"number_write":"42"}

    lData := '{"number_read":42}';

    lfoo := lSer.Deserialize<TFooData>( lData );
    try
      WriteLn( lfoo.Number );
    finally
      lfoo.Free;
    end;

  finally
    lSer.Free;
  end;
end;

[ScharfeMietze]

https://www.youtube.com/watch?v=DdW8zssbQ0g
In diesem Vido wird beschrieben das auf einem Rest Server
function EchoJson: TJSONObject; TJSONObject als Result dienen kann.
Es wird mittels Result := TJSONObject.create erzeugt allerdings findet sich logischerweise nirgends ein .free.

Meine Frage an die Profis ist nun ob ich das so auch gefahrlos in jeder function so verwenden kann.
Ich erinnere mich an TStringlisten als result, die dann Leaks erzeugt haben.

Grüße
SM

[Sir Rufo]

Natürlich erzeugt das ein MemLeak, wenn du das nicht entsprechend behandlest und beim Aufruf der Funktion auch die LifeTime-Management-Verantwortung für das Ergebnis übernimmst.

Ist exakt das Gleiche wie bei

Delphi-Quellcode:

function BuildObject : TObject;
begin
  Result := TObject.Create;
end;

var
  lObj: TObject;
begin
  TObject.Create; // <= MemLeak
  BuildObject(); // <= MemLeak;

  // keine MemLeaks mit

  lObj := TObject.Create;
  try
    // ...
  finally
    lObj.Free;
  end;

  lObj := BuildObject();
  try
    // ...
  finally
    lObj.Free;
  end;
end;

Es gibt noch einen kleinen Unterschied:

Wenn beim Erzeugen der Instanz ein Problem auftritt, dann soll man auch dafür sorgen, dass die Instanz aufgeräumt wird (so wie das auch der constructor macht);

Delphi-Quellcode:

function BuildObject: TObject;
begin
  Result := TObject.Create; // <= Bei einer Excpetion gibt es keine Instanz
  try
    // hier noch beim Result-Object weitere Eigenschaften setzen
    // hier könnte es zu einer Exception kommen
  except
    Result.Free; // <= bei einer Exception, wird die Instanz verworfen
    raise; // <= und die Exception wieder ausgelöst
  end;
end;

[ScharfeMietze]

Perfect!! Danke für die Antwort. Das sind immer diese Fehlerteufel wenn man es nicht beachtet und dann das Wundern losgeht.

Gruß
SM

[ScharfeMietze]

Dann könnte die function so aussehen

Delphi-Quellcode:

function TServerMethods1.updateHddCrawler(Key: string; aJSONObject: TJSONObject): TJSONObject;
var
  LJSONObject: TJSONObject;
  s: string;
begin
Result := TJSONObject.Create;
  try
   if KeyValidation(Key) then frmHddCrawler.AnalyzeJson(aJSONObject,Result)
   else Result.AddPair('error', 'invalid key') ;
  except
   Result.Free;
   raise;
  end;
end;

Einwände?

[Sir Rufo]

Was die Erzeugung der Result-Instanz angeht -> Nein.

Der Rest sieht seltsam aus

[ScharfeMietze]

Jap! Zum Testen an sich nutze ich gerne Formen. Vor allem in der Planung. Dann kann ich mir auch mal per button Inhalte ausgeben lassen, oder auch mal eine kleine Testroutine einpflegen.
Oder meintest du was anderes?