mORMot Open Source

  private
    ModeloServicos   : TSQLModel;
    ServidorServicos : TSQLRestServerFullMemory;
    HTTPServer        : TSQLHttpServer;
...

procedure TobjMain.InicializarServicos;
var au : TSQLAuthUser;
begin
   ModeloServicos   := TSQLModel.Create([],_CONST_ROOT_NAME);
   ServidorServicos := TSQLRestServerFullMemory.Create(ModeloServicos,'test.json',false,true);
   ServidorServicos.ServiceDefine(TATWLicensingModule, [IATWLicModule], sicPerSession);

   HTTPServer := TSQLHttpServer.Create('8889',[ServidorServicos],'+',useBidirSocket);
   HTTPServer.WebSocketsEnable(ServidorServicos, _CONST_ENCRIPT).Settings.SetDefaults();
end;

type
  TTrainRequestAnswer = (etTRAnswerNone=0, etTRAnswerAccept=1, etTRAnswerReject=2);

  TSectionBlock = class(TPersistent)
  private
    FSBName: string;
    FId: LongInt;
    procedure SetId(const Value: LongInt);
    procedure SetSBName(const Value: string);
  published
    property Id : LongInt read FId write SetId;
    property SBName : string read FSBName write SetSBName;
  end;

  TTrain = class(TPersistent)
  private
    FLocomotive: string;
    FTail: string;
    FId: LongInt;
    FPrefix: string;
    procedure SetId(const Value: LongInt);
    procedure SetLocomotive(const Value: string);
    procedure SetPrefix(const Value: string);
    procedure SetTail(const Value: string);
  published
    property Id : LongInt read FId write SetId;
    property Prefix : string read FPrefix write SetPrefix;
    property Locomotive : string read FLocomotive write SetLocomotive;
    property Tail : string read FTail write SetTail;
  end;

  TTrainRequest = class(TPersistentWithCustomCreate)
  private
    FToSB: TSectionBlock;
    FTrain: TTrain;
    FDataHoraRequest: string;
    FTryAgainHour: Integer;
    FRequestAnswer: TTrainRequestAnswer;
    FFromSB: TSectionBlock;
    FIdStretch: LongInt;
    FOSNumber: LongInt;
    FRejectReason2: string;
    FTryAgainMinute: Integer;
    FRejectReason1: string;
    procedure SetDataHoraRequest(const Value: string);
    procedure SetFromSB(const Value: TSectionBlock);
    procedure SetIdStretch(const Value: LongInt);
    procedure SetOSNumber(const Value: LongInt);
    procedure SetRejectReason1(const Value: string);
    procedure SetRejectReason2(const Value: string);
    procedure SetRequestAnswer(const Value: TTrainRequestAnswer);
    procedure SetToSB(const Value: TSectionBlock);
    procedure SetTrain(const Value: TTrain);
    procedure SetTryAgainHour(const Value: Integer);
    procedure SetTryAgainMinute(const Value: Integer);
  public
    constructor Create; override;
    destructor Destroy(); override;
  published
    property Train : TTrain read FTrain write SetTrain;
    property FromSB : TSectionBlock read FFromSB write SetFromSB;
    property ToSB : TSectionBlock read FToSB write SetToSB;
    property RequestAnswer : TTrainRequestAnswer read FRequestAnswer write SetRequestAnswer;
    property OSNumber : LongInt read FOSNumber write SetOSNumber;
    property DataHoraRequest : string read FDataHoraRequest write SetDataHoraRequest;
    property RejectReason1 : string read FRejectReason1 write SetRejectReason1;
    property RejectReason2 : string read FRejectReason2 write SetRejectReason2;
    property TryAgainHour : Integer read FTryAgainHour write SetTryAgainHour;
    property TryAgainMinute : Integer read FTryAgainMinute write SetTryAgainMinute;
    property IdStretch : LongInt read FIdStretch write SetIdStretch;
  end;

......
{ TTrainRequest }
constructor TTrainRequest.Create;
begin
  inherited;
  FTrain  := TTrain.Create;
  FToSB   := TSectionBlock.Create;
  FFromSB := TSectionBlock.Create;
end;

destructor TTrainRequest.Destroy;
begin
  FTrain.Free;
  FToSB.Free;
  FFromSB.Free;
  inherited;
end;

....

procedure TForm3.BitBtn2Click(Sender: TObject);
var t_trainrequest : TTrainRequest;
    i              : integer;
    JSon           : RawUTF8;
    JsonPtr        : PUTF8Char;
    IsValidJson    : Boolean;
    objLista,
    objLista1      : TObjectList;
begin
    TSQLLog.Family.Level :=  LOG_VERBOSE;

    objLista := TObjectList.Create();
    for I := 0 to 10 do begin
      t_trainrequest := TTrainRequest.Create;

      t_trainrequest.Train.Id := i;
      t_trainrequest.Train.Prefix := 'A'+IntToStr(i);
      t_trainrequest.Train.Locomotive := IntToStr(i * 111);
      t_trainrequest.Train.Tail := 'CAUDA';

      t_trainrequest.FromSB.Id := i;
      t_trainrequest.FromSB.SBName := 'SB'+IntToStr(i);

      t_trainrequest.ToSB.Id := 0;
      t_trainrequest.ToSB.SBName := 'SB'+IntToStr(i*2);

      t_trainrequest.DataHoraRequest := FormatDateTime('dd/mm/yyyy hh:mm:ss:zzz ', NOW);

      t_trainrequest.IdStretch := 1;

      objLista.Add(t_trainrequest);
    end;
    TJSONSerializer.RegisterClassForJSON([TTrainRequest, TTrain, TSectionBlock]);
    JSon :=  ObjectToJson(objLista, [woStoreClassName, woHumanReadable]);

    JsonPtr := @Json[1];
    Memo1.Lines.Add( JsonPtr );

    FreeAndNil(objLista);
  //Parse1
  //objLista1 := TTrainRequestSet( JSONToNewObject(JsonPtr, IsValidJson, [j2oIgnoreUnknownProperty]) );

  //Parse2
    objLista1 := TObjectList.Create;
    JSONToObject(objLista1, JsonPtr, IsValidJson, TTrainRequest, [j2oIgnoreUnknownProperty]);

    if IsValidJson then begin

      if objLista1.Count > 0 then begin
        Memo1.Lines.Add( 'OBJ -TrainRequestCollection');
        for I := 0 to objLista1.Count -1 do begin
          Memo1.Lines.Add(
            'ID MSG: '         + TTrainRequest(objLista1[i]).Train.Prefix +
            ' - FromSB: '      + TTrainRequest(objLista1[i]).FromSB.SBName +
            ' - ToSB: '        + TTrainRequest(objLista1[i]).ToSB.SBName +
            ' - OSNumber: '    + IntToStr(TTrainRequest(objLista1.Items[i]).OSNumber)
            );

        end;
        Memo1.Lines.Add( '-----------------------------------------------');
      end;
      Memo1.Lines.Add( '-----------------------------------------------');
      Memo1.Lines.Add( 'JSon OK');
    end else begin
      Memo1.Lines.Add( 'JSon Invalid');
    end;
  Freeandnil(objLista1);
end;