mORMot Open Source

  ...........  
  TDBInfo = class(TSynAutoCreateFields)
  private
    fDBID      : TDBID;
    fDBName    : TDBName;
    fDBFile    : TDBFile;
    fCreateDate: TTimeLog;
    fLastOpen  : TTimeLog;
    fData      : string;
    fArr       : TDocArray;
    fColl      : TCollTests;
  public
    function Documents: TDynArray;
    procedure FromORM(ormDBInfo: TOrmDBInfo);
  published
    property DBID      : TDBID read fDBID write fDBID;
    property DBName    : TDBName read fDBName write fDBName;
    property DBFile    : TDBFile read fDBFile write fDBFile;
    property CreateDate: TTimeLog read fCreateDate write fCreateDate;
    property LastOpen  : TTimeLog read fLastOpen write fLastOpen;
    property data      : string read fData write fData;
    property DocArray  : TDocArray read fArr write fArr;
    property Coll      : TCollTests read fColl;
  end;

  TDBInfoArray = array of TDBInfo;

  IDBInfoService = interface(IInvokable)
    ['{495A2BC3-E1EB-45BD-9ABB-B1F6B1395E74}']
    function Add(var aDBInfo: TDBInfo): TServiceResult;
    function GetOne(var aDBInfo: TDBInfo; FindBy: TFindBy): TServiceResult;
    function GetWhere(const aWhere: string; const BoundsWhere: array of const; var aDBInfoArr: TDBInfoArray; var Count: Integer): TServiceResult;
    function Update(const aDBInfo: TDBInfo): TServiceResult;
    function Delete(const aID: TID): TServiceResult;
    function TotalCount: Integer;
  end;

  /// ORM class corresponding to TDBInfo
  TOrmDBInfo = class(TOrm)
  protected
    fDBName    : string;
    fDBFile    : string; 
    fCreateDate: TTimeLog;
    fLastOpen  : TTimeLog;
    fData      : string; 
    fCollVar   : string;
    fDocArray  : string;
  public
    procedure FromObject(aDBInfo: TDBInfo; IncludeId: Boolean = True);
  published
    property DBName    : string read fDBName write fDBName { stored AS_UNIQUE };
    property DBFile    : string read fDBFile write fDBFile { stored AS_UNIQUE };
    property CreateDate: TTimeLog read fCreateDate write fCreateDate;
    property LastOpen  : TTimeLog read fLastOpen write fLastOpen;
    property data      : string read fData write fData;
    property DocArray  : string  read fDocArray write fDocArray;
    property Coll      : string read fCollVar write fCollVar;
  end;

  TOrmDBInfoArray = array of TOrmDBInfo;

  TDBInfoService = class(TInjectableObjectRest, IDBInfoService)
  public
    function Add(var aDBInfo: TDBInfo): TServiceResult;
    function GetOne(var aDBInfo: TDBInfo; FindBy: TFindBy): TServiceResult;
    function GetWhere(const aWhere: string; const BoundsWhere: array of const; var aDBInfoArr: TDBInfoArray;
      var Count: Integer): TServiceResult;
    function Update(const aDBInfo: TDBInfo): TServiceResult;
    function Delete(const aID: TID): TServiceResult;
    function TotalCount: Integer;
  end;

....................

function TDBInfoService.GetOne(var aDBInfo: TDBInfo; FindBy: TFindBy): TServiceResult;
var
  ormDBInfo: TOrmDBInfo;
begin
  case FindBy of
    fbID: ormDBInfo := TOrmDBInfo.Create(server.orm, 'ID=?', [aDBInfo.DBID]);
    fbName: ormDBInfo := TOrmDBInfo.Create(server.orm, 'DBName=?', [aDBInfo.DBName]);
    fbFile: ormDBInfo := TOrmDBInfo.Create(server.orm, 'DBFile=?', [aDBInfo.DBFile]);
    fbDateCreate: ormDBInfo := TOrmDBInfo.Create(server.orm, 'CreateDate=?', [aDBInfo.CreateDate]);
    fbDateLastOpen: ormDBInfo := TOrmDBInfo.Create(server.orm, 'LastOpen=?', [aDBInfo.LastOpen]);
    fbDataInfo: ormDBInfo := TOrmDBInfo.Create(server.orm, 'CreateDate=?', [aDBInfo.CreateDate]);
  else Exit(srBadRequest);
  end;

  try
    if ormDBInfo.ID = 0 then begin
      result := srNotFound;
    end else begin
      aDBInfo.FromORM(ormDBInfo);
      result := srSuccess;
    end;
  finally
    ormDBInfo.Free;
  end;
end;

function TDBInfoService.GetWhere(const aWhere: string; const BoundsWhere: array of const; var aDBInfoArr: TDBInfoArray;
  var Count: Integer): TServiceResult;
var
  Results  : TOrmDBInfoArray;
  ormDBInfo: TOrmDBInfo;
  aList    : IList<TOrmDBInfo>;
  DA       : TDynArray;
  Idx      : Integer;
begin

  //  ormDBInfo := TOrmDBInfo.CreateAndFillPrepare(server.orm, ToUTF8(aWhere), BoundsWhere);
  //  try
  //    DA := DynArray(TypeInfo(TDocArray), aDBInfoArr);
  //    while ormDBInfo.FillOne do begin
  //      Idx := DA.Add(TDBInfo.Create);
  //      aDBInfoArr[Idx].FromORM(ormDBInfo);
  //    end;
  //    Count := DA.Count;
  //    result := srSuccess;
  //  finally
  //    ormDBInfo.Free;
  //  end;

  //  if server.orm.RetrieveIList(TOrmDBInfo, aList, ToUTF8(aWhere), BoundsWhere) then begin
  //    Count := aList.Count;
  //    SetLength(aDBInfoArr, Count);
  //    for var I := 0 to Count - 1 do begin
  //      aDBInfoArr[I] := TDBInfo.Create;
  //      aDBInfoArr[I].FromORM(aList[I]);
  //    end;
  //    result := srSuccess;
  //  end else result := srBadRequest;

  if server.orm.RetrieveListObjArray(Results, TOrmDBInfo, ToUTF8(aWhere), BoundsWhere) then begin
    try
      Count := Length(Results);
      SetLength(aDBInfoArr, Count);
      for var I := 0 to Count - 1 do begin
        aDBInfoArr[I] := TDBInfo.Create;
        aDBInfoArr[I].FromORM(Results[I]);
      end;
      result := srSuccess;
    finally
      ObjArrayClear(Results);
    end;
  end
  else result := srBadRequest;
end;

    CoreModel := TOrmModel.Create([TOrmDBInfo, TAuthUser, TAuthGroup]);
    CoreDBClient := TRestClientDB.Create(CoreModel, nil,  '_TestDBInfo_M2.db3',  TSQLRestServerDB,  True,   ''  );

    // Server
    with CoreDBClient.server do begin
      db.Synchronous := smOff;
      db.LockingMode := lmExclusive;
      CreateMissingTables;
      AuthenticationRegister(TRestServerAuthenticationDefault);
      ServiceDefine(TDBInfoService, [IDBInfoService], sicShared  );
    end;

    // Client
    Check('CoreDBClient.SetUser', CoreDBClient.SetUser('Admin'  , 'synopse'));
    Check('CoreDBClient.ServiceDefine', CoreDBClient.ServiceDefine([IDBInfoService], sicShared ));

............

    Bool := aRest.Services.Resolve(IDBInfoService, cmd);
    if Bool then begin
       for i := 1 to MAX do begin
           DBInfo.DBName := 'Template' + I.Tostring;
           Check('GetOne DBName="' + DBInfo.DBName + '"', cmd.GetOne(DBInfo, fbName) = srSuccess);
       end;

       Check('GetWhere Name = Template_1*', cmd.GetWhere('DBName LIKE ?', ['Template_1%'], DBInfoArr, Count) = srSuccess);
    end;

20240614 15454602 EXCOS EAccessViolation (c0000005) [Main] at f19c4d mormot.core.rtti.pas IsObjectDefaultOrVoid (9423)  mormot.core.rtti.pas TRttiCustom.ValueIsVoid (8078) mormot.core.json.pas _JS_RttiCustom (5781) mormot.core.interfaces.pas TInterfaceMethodArgument.AddJson (2719) mormot.core.interfaces.pas TInterfacedObjectFake.FakeCallGetJsonFromStack (3442) mormot.soa.client.pas TInterfacedObjectFakeClient.FakeCallGetJsonFromStack (502) mormot.core.interfaces.pas TInterfacedObjectFake.FakeCallInternalProcess (3544) mormot.core.interfaces.pas TInterfacedObjectFakeRaw.FakeCall (3307)