mORMot Open Source

  TMeasurements = array of TMeasurement;

  TMeasurementJob = class(TSynPersistent)
  private
    fMeasurements: TMeasurements;
  protected
    procedure SetMeasurements(const aValue: TMeasurements);
  published
    property Measurements: TMeasurements read fMeasurements write SetMeasurements;
  end;

initialization
  TJSONSerializer.RegisterClassForJSON([TMeasurementJob, TMeasurement]);
  TJSONSerializer.RegisterObjArrayForJSON([TypeInfo(TMeasurements), TMeasurement]);

// client side
procedure SendDataToServer;
var
  Measurements: TMeasurements;
  aMeasurement: TMeasurement;
begin
  aJob := TMeasurementJob.Create;
  try
    for I := 0 to 10 do
    begin
      aMeasurement := TMeasurement.Create;
      ...
      ObjArrayAdd(Measurements, aMeasurement);
    end;
    
    aJob.Measurements := Measurements;
    
    // send data to the server
    fJobService.SaveMeasurementJob(aJob);

  finally
    ObjArrayClear(Measurements);
    aJob.Free;
  end;  
end;

function TSQLRest.RetrieveListObjArray(var ObjArray; Table: TSQLRecordClass;
  const FormatSQLWhere: RawUTF8; const BoundsSQLWhere: array of const;
  const aCustomFieldsCSV: RawUTF8): boolean;
var T: TSQLTable;
begin
  result := false;
  if (self=nil) or (Table=nil) then
    exit;
  T := MultiFieldValues(Table,aCustomFieldsCSV,FormatSQLWhere,BoundsSQLWhere);
  if T<>nil then
  try
    result := T.ToObjArray(result,Table); <------- HERE access violation
  finally
    T.Free;
  end;
end;


function TSQLTable.ToObjArray(var ObjArray; RecordType: TSQLRecordClass=nil): boolean;
var R: TSQLRecord;
    Row: PPUtf8Char;
    i: integer;
    arr: array of TSQLRecord absolute ObjArray;
begin
  result := false;
  ObjArrayClear(ObjArray); <------- HERE access violation
  if self=nil then
    exit;
  if RecordType=nil then begin
    RecordType := QueryRecordType;
    if RecordType=nil then
      exit;
  end;
  result := true;
  if fRowCount=0 then
    exit;
  R := RecordType.Create;
  try
    R.FillPrepare(self);
    SetLength(arr,fRowCount);        // faster than manual Add()
    Row := @fResults[FieldCount];   // Row^ points to first row of data
    for i := 0 to fRowCount-1 do begin
      arr[i] := RecordType.Create;
      R.fFill.Fill(pointer(Row),arr[i]);
      Inc(Row,FieldCount); // next data row
    end;
  finally
    R.Free;
  end;
end;


procedure ObjArrayClear(var aObjArray);
var i: integer;
    a: TObjectDynArray absolute aObjArray;
begin
  if a<>nil then begin
    for i := 0 to length(a)-1 do <------- HERE access violation
      a[i].Free;
    a := nil;
  end;
end;

http://server:1234/root/messartservice/SelectByManufacturer?aManufacturer=qwerty

function TDDDRepositoryRestQuery.ORMSelectOne(ORMWhereClauseFmt: PUTF8Char;
   const Bounds: array of const; ForcedBadRequest: boolean): TCQRSResult;
begin
  CqrsBeginMethod(qaSelect,result);
  if ForcedBadRequest then
    CqrsSetResult(cqrsBadRequest) else
    CqrsSetResultSuccessIf(Factory.Rest.Retrieve(ORMWhereClauseFmt,[],Bounds,
      fCurrentORMInstance),cqrsNotFound);
end;

function TDDDRepositoryRestQuery.ORMSelectOne(ORMWhereClauseFmt: PUTF8Char; const Bounds: array of const; ForcedBadRequest: boolean): TCQRSResult;
begin
  CqrsBeginMethod(qaSelect,result);
  if ForcedBadRequest then
    CqrsSetResult(cqrsBadRequest) else
    CqrsSetResultSuccessIf(Factory.Rest.Retrieve(ORMWhereClauseFmt,[],Bounds,
      fCurrentORMInstance),cqrsNotFound);
end;

procedure InitHTTPService;
begin
  Model := CreateModel;
  uPhoDataLayer.InitializePhoModel(Model, DatabaseConnectionProperties);

  ServerDB := TSQLRestServerDB.Create(Model, ChangeFileExt(ExeVersion.ProgramFileName, '.db3'), False);
  ServerDB.CreateMissingTables;
  ServerDB.ServiceRegister(TPhoMessartCommand, [TypeInfo(IPhoMessartCommand)], sicShared);
  ServerDB.ServiceContainer.InjectResolver([TPhoMessartCommandFactory.Create(ServerDB)], True);

  ServerHTTP := TSQLHttpServer.Create('7979', [ServerDB], '+', useHttpApiRegisteringURI);
  ServerHTTP.AccessControlAllowOrigin := '*'; // allow cross-site AJAX queries
end;

// constructor TPhoMessartCommandFactory looks like
constructor TPhoMessartCommandFactory.Create(ARest: TSQLRest; AOwner: TDDDRepositoryRestManager = nil);
begin
  inherited Create(IPhoMessartCommand, TPhoMessartCommand, TMessart, aRest, TPhoMessart, aOwner);
  AddFilterOrValidate(['*'], TSynFilterTrim.Create);
  AddFilterOrValidate(['Name'], TSynValidateNonVoidText.Create);
end;

var
  Model: TSQLModel;
  Client: TSQLHttpClient;
  MessartCommand: IPhoMessartCommand;
begin
  Model := TSQLModel.Create([]);
  Client := TSQLHttpClient.Create('localhost','7979', lModel);

  Client.ServiceDefine([IPhoMessartCommand], sicShared);
  Client.Services.Resolve(IPhoMessartCommand, MessartCommand);

  if not Assigned(MessartCommand) then
    raise Exception.Create('Can''t get PhoMessartCommand')
  else
    MessartCommand.SelectByName('somemessart');
end;

function TDDDRepositoryRestCommand.ORMAdd(aAggregate: TObject): TCQRSResult;
begin
  if CqrsBeginMethod(qaCommandDirect,result) then begin   
    // Factory is nil
    Factory.AggregateToTable(aAggregate,0,fCurrentORMInstance);
    ORMPrepareForCommit(soInsert,aAggregate);
  end;
end;

var
  PhoMessartCommandFactory: TPhoMessartCommandFactory;
begin
  FPhoRepository := TPhoDBRepository.Create;

  Model := TSQLModel.Create([TPhoMessartSQLRecord], ROOT_NAME);

  VirtualTableExternalRegister(Model, TPhoMessartSQLRecord, FPhoRepository.MDBConnectionProperties, 'messart');
  Model.Props[TPhoMessartSQLRecord].ExternalDB.MapField('ID', 'IdMessart');

  ServerDB := TSQLRestServerDB.Create(Model, ChangeFileExt(ExeVersion.ProgramFileName, '.db3'), False);
  ServerDB.CreateMissingTables;
  ServerDB.ServiceDefine(TPhoMessartCommand, [IPhoMessartCommand], sicShared);

  ServerHTTP := TSQLHttpServer.Create('7979', [ServerDB], '+', useHttpApiRegisteringURI);
  ServerHTTP.AccessControlAllowOrigin := '*'; // allow cross-site AJAX queries
end;

var
  cmd: IPhoMessartCommand;
  MA: TPhoMessart;
  macaption: RawUTF8;
  I: Integer;
begin
    ServerDB.Services.Resolve(IPhoMessartCommand, cmd);
    if Assigned(cmd) then
    begin
      MA := TPhoMessart.Create;
      try
        for I := 1 to 10 do begin
          UInt32ToUtf8(I, macaption);
          MA.Name := 'messart #'+macaption;
          if (cmd.Add(MA) <> cqrsSuccess) then
              raise Exception.CreateFmt('Invalid data: %s',[cmd.GetLastErrorInfo]);
        end;
         //here nothing is actually written to the database
        if (cmd.Commit <> cqrsSuccess) then
            raise Exception.CreateFmt('Commit error: %s',[cmd.GetLastErrorInfo]);
         // here everything has been written to the database
      finally
        MA.Free;
      end;
    end;
end;

// unit  mORMotDDD 

procedure TDDDRepositoryRestFactory.AggregateToTable(aAggregate: TObject; aID: TID; aDest: TSQLRecord);
var i: integer;
begin
  if fPropsMapping.MappingVersion<>fPropsMappingVersion then
    ComputeMapping;
  if aDest=nil then
    raise EDDDRepository.CreateUTF8(self,'%.AggregateToTable(%,%,%=nil)',
      [self,aAggregate,aID,fTable]);
  aDest.ClearProperties;
  aDest.IDValue := aID;
  if aAggregate<>nil then
    for i := 0 to high(fAggregateProp) do
      AggregatePropToTable(aAggregate,fAggregateProp[i],aDest,fAggregateToTable[i]);
end;

type
  TPhoMessartObjArray = type TObjectDynArray;

  IPhoMessartQuery = interface(ICQRSQuery)
  ['{87BDB69C-485D-429C-A6AE-8E2751FFCFFB}']
    function SelectByName(const AName: String): TCQRSResult;
    function Get(out AAggregate: TPhoMessart): TCQRSResult;
    function GetAll(out AAggregates: TPhoMessartObjArray): TCQRSResult;
    function GetNext(out AAggregate: TPhoMessart): TCQRSResult;
    function GetCount: Integer;
  end;

  IPhoMessartCommand = interface(IPhoMessartQuery)
  ['{23BE1585-5ED9-4596-A507-A264A2FEE8F6}']
    function Add(const AAggregate: TPhoMessart): TCQRSResult;
    function Update(const AUpdatedAggregate: TPhoMessart): TCQRSResult;
    function Delete: TCQRSResult;
    function DeleteAll: TCQRSResult;
    function Commit: TCQRSResult;
    function Rollback: TCQRSResult;
  end;

implementation

initialization
  TJSONSerializer.RegisterObjArrayForJSON(TypeInfo(TPhoMessartObjArray), TPhoMessart);
  TInterfaceFactory.RegisterInterfaces([TypeInfo(IPhoMessartQuery), TypeInfo(IPhoMessartCommand)]);

 initialization
   TInterfaceFactory.RegisterInterfaces([TypeInfo(IPhoMessartQuery), TypeInfo(IPhoMessartCommand)]);