You are not logged in.
Pages: 1
Hi!
I plan to update my project from M1 to M2. I try to start with a small test. But something went wrong. The code is not complex, but it does not work.
Declaration from unit DBInfo_Unit.pas:
...........
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;
Using In main unit:
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;
GetOne work fine. GetWhere's use gives an error even before entering the implementation. In Log:
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)
Am I doing something wrong or missing something?
Offline
Please follow the forum rules and don't post such big amount of code in the forum post itself.
IMHO there is not enough information to find out what is wrong in your code.
Some types are not defined.
Offline
I'm sorry. I didn't think the code in the post belonged to the HUGE category.
I prepared a project that I used to test/study mORMot2 where the named error is reproduced. I will be grateful if someone has the time and desire to check the code of the program and help me with the cause of the error.
Offline
Didn't specify... I'm using Delphi 12.1
Offline
Found the cause of the errors. mORMot does not know how to work with parameters in the methods of services of the "array of const" type.
Thank you all.
Offline
Yes of course. I have a Data field in my working project. Its structure depends on the context of the object. I use TDocVariant with it.
The my error in the test project rather refers to the categorys of copy/past and misty eyes.
Offline
Pages: 1