You are not logged in.
Anyway, I will revert it because it seems to be unneeded and unsafe - premature optimization or over optimization.
Which is the root of all evil, said.
Are you sure that's what you wanted?
else if (StartPos = 0) and
(Len = L) and
(PStrCnt(PAnsiChar(pointer(fDataString)) - _STRCNT)^ = 1) then
FastAssignUtf8(Text, fDataString) // fast return the fDataString instance
else
The description says: "fast return the fDataString instance", but the second part of the sentence says: "and set src to Nil". After calling function FastAssignUtf8, "fDataString" is empty. The function should then better called: GetAsTextAndEmptyStreamIfLenIsSize().
With best regards
Thomas
Commit 7267 tested and it works. Thank you very much and have a nice weekend.
With best regards
Thomas
I don't see when fThreads[] could be = 0, unless the log file input is corrupted / was not generated by TSynLog.
If remote logging is used (TRestHttpsClient.CreateForRemoteLogging and LogView), this may be the case.
With best regards
Thomas
mORMot2, Commit 7264 (fedb2ee), Delphi 12, 32Bit
Unit mormot.core.log
Line 7756 should be changed. It should be checked that (fThreads[Index] > 0), otherwise the call to function GetBitPtr could run into nothing.
function TSynLogFileView.Select(aRow: integer): integer;
...
for i := 0 to Count - 1 do
begin
if fLevels[i] in fEvents then
begin
if (fThreads = nil)
or GetBitPtr(pointer(fThreadSelected), fThreads[i] - 1) then // <-- here
begin
With best regards
Thomas
mORMot2, Commit 7243 (ee6c774), Delphi 12, 32Bit
Unit mormot.core.log
Line 7550 should be changed. The search should not be started from "fCount" but from "fSelectedCount".
function TSynLogFileView.SearchPreviousText(const aPattern: RawUtf8; aRow: integer): PtrInt;
...
// search from end
// for result := fCount - 1 downto aRow + 1 do <= This line should be changed
for result := fSelectedCount - 1 downto aRow + 1 do
if LineContains(aPattern, fSelected[result]) then
exit;
With best regards
Thomas
This is not clear for me, but will my possible solution "map" on DB field to one vaiants property?
Do Mormot fw have such a example? ORM implementation widely found in examples, but this - not.
You can read this article in Delphi-Praxis forum. It can also be found in the examples. To query this field directly via SQL, it uses the SQLite syntax.
With best regards
Thomas
I'm currently refactoring our code to use mORMot version 2 and I can't find the function CurrentServiceContext (previously found on the mORMot.pas unit) to get the TServiceRunningContext.
Unit mormot.rest.server
ServiceRunningContext, or better use TInjectableObjectRest for Interface-based Services.
With best regards
Thomas
I think, I don't seem to know how to use THttpMultiPartStream and THttpClientSocket.Post function.
Please give me some advice.
Did you watch the stream before sending it? The following simple test looks ok to me:
var
mpStream: THttpMultiPartStream;
fileStream: THandleStream;
begin
mpStream := THttpMultiPartStream.Create;
try
mpStream.AddContent('Field01', '100', TEXT_CONTENT_TYPE);
mpStream.AddContent('Field02', '{"Name": "Thomas"}', JSON_CONTENT_TYPE);
mpStream.AddFileContent('Data', 'data.json', '{"Name": "Thomas","Nickname": "tbo"}', JSON_CONTENT_TYPE, 'binary');
mpStream.AddFile('Test', MakePath([Executable.ProgramFilePath, 'test.json']));
mpStream.AddFile('Image', MakePath([Executable.ProgramFilePath, 'image.png']));
fileStream := TFileStreamEx.Create(MakePath([Executable.ProgramFilePath, 'mpTest.dat']), fmCreate);
try
mpStream.Flush;
StreamCopyUntilEnd(mpStream, fileStream);
finally
fileStream.Free;
end;
finally
mpStream.Free;
end;
With best regards
Thomas
Do you have more clue?
Sorry Arnaud, I made a stupid copy-paste mistake. Everything is fine with mORMot. The nasty thing was, the Delphi debugger totally misled me. I shouldn't work until the middle of the night. The only good thing was that I got some new ideas from all the debugging. Sorry again for the false alarm.
With best regards
Thomas
mORMot2, Commit 6984, Delphi XE, 32Bit
If the returned object has empty string fields, an AV occurs. Fields with text content have no problems.
Error message:
An exception of class EAccessViolation with message "Access violation at address 00604E98" has occurred. Reading address 0EFFFFF8 occurred.
The call stack is:
mormot.core.data.TRawUtf8Interning.Unique(???,'',0)
mormot.core.json._JL_RawUtf8($2ACEADC {''},$12EC84)
mormot.core.json._JL_RttiCustomProps('q',$12EC84)
mormot.core.json._JL_RttiCustom('q',$12EC84)
mormot.core.json._JL_RttiObjectWithID('¬ê¬'#2#$12#$F'P',$12EC84)
mormot.core.interfaces.TInterfaceMethodArgument.SetFromJson(...)
JSON looks like this:
'{RowID:0,ActiveState:0,CreatedAt:0,ModifiedAt:0,RecVersion:0,Username:"",Password:""},false]'
Function FastAssignNew in TRawUtf8Interning.Unique() fails:
procedure TRawUtf8Interning.Unique(
...
if (aText = nil) or
(aTextLen <= 0) then
FastAssignNew(aResult)
With values: aText = '' and aTextLen = 0
With best regards
Thomas
Do you know if there's a sample project available which shows the rest server pool usage ...
Sorry no, I have already written about this, but can't find the thread (I post in several forums). Perhaps you will find some inspiration in this thread. Another reader may have links at hand. The easiest way is to start from an example and incorporate the various techniques described. The help is written very detailed.
With best regards
Thomas
But in this scenario all functions would be inside a monolithic server process. As in a normal rest server implementation I could have several endpoints/routes but I could not replace only one part/route while keeping the rest of the other modules unchanged. I would always need to deploy a complete new server binary.
No, you can specify server URI and port and set up several Rest clients as required.
Generally: How you organize your data is up to you. You can have one or more databases for all customers, or one or more databases for each customer. The interfaces only do your routing and the necessary administration. What happens in the background afterwards is up to you. Example: Access via a pool of servers would be:
function TCustomServiceObject.GetReportRestOrm: IRestOrm;
begin
with TAdminRestServer(Server) do
Result := RestServerPool.FindReportRestServer(GetReportRestServerID(ServiceRunningContext.Request.Session)).Orm;
end;
function TReportService.UpdateSource(const pmcRowID: TID; const pmcSource: RawBlob): Boolean;
var
orm: IRestOrm;
begin
orm := GetReportRestOrm;
if orm <> Nil then
Result := orm.UpdateBlob(TOrmReport, pmcRowID, 'Source', pmcSource)
else
Result := False;
end;
Here you fetch the corresponding RestServer via a SessionID. The data can come from wherever you want. It can also be another service, created by you or by an outside service provider.
PS: My examples are simple to get started, but can also be easily expanded.
With best regards
Thomas
Thanks vor your reply, but how can i handle this, when I have a Setup Like this:
Myservice1.exe
Myservice2.exe
Myservice3.exe
Guiapp.exe
If you want to run multiple HttpServers, I see no advantage in this, you can instantiate the clients as follows:
TRestHttpClient.Create(ServerURI, TOrmModel.Create([], ROOT_NAME_SERVER), ServerPort, {Https=} (ServerPort = 443));
For an introduction to the topic, you can read articles Introduction to method-based services and Introduction to Interface-based Services in Delphi-Praxis forum.
With best regards
Thomas
Do I need to publish each service on a separate port on my PC, and directly connect my App which wants to fetch data from different services to each Service:Port individually?
You can register several services for one RestServer and one root name:
function TXRestServer.InitializeServices: Boolean;
begin
Result := (ServiceDefine(TX1Service, [IX1], sicSingle) <> Nil);
Result := Result and (ServiceDefine(TX2Service, [IX2], sicClientDriven) <> Nil);
You can register several RestServers for one HttpServer and port:
FHttpServer := TRestHttpServer.Create(pmcPort, [FXRestServer, FYRestServer], '+' {DomainName}, useHttpSocket);
Depending on the root name for a RestServer, it could look like this (example: root for X-RestServer is "store" and for Y-RestServer is "admin"):
domain.com/store
domain.com/admin
With best regards
Thomas
My problem is that with 500 child objects in the list, the whole process lasts 10 seconds for deserialisation. Is there a way to speed it up?
Something else is wrong. In this article you will find some benchmark values for comparison. The time for 500 objects should only be a few milliseconds.
With best regards
Thomas
Valid is true but the object isnt populated with any data.
Only "published" properties are serialized. If you want to serialize other properties, you must register your own functions with TRttiJson.RegisterCustomSerializer().
With best regards
Thomas
Delphi 12 Athens, mORMot2 V2.2
Following test case:
type
TTestItem = record
Name1: String;
Name2: String;
end;
var
item: TTestItem;
begin
item.Name1 := 'A';
item.Name2 := 'B';
ShowMessage(Utf8ToString(RecordSaveJson(item, TypeInfo(TTestItem))));
All tests except for the last one are ok. This leads to an access violation:
Rtti.ByTypeInfo[TypeInfo(TTestItem)].Props.NameChange('Name1', ''); // Ok: {"Name2":"B"}
Rtti.ByTypeInfo[TypeInfo(TTestItem)].Props.NameChanges(['Name1'], ['']); // Ok: {"Name2":"B"}
Rtti.ByTypeInfo[TypeInfo(TTestItem)].Props.NameChanges(['Name1', 'Name2'], ['N1', 'N2']); // Ok: {"N1":"A","N2":"B"}
Rtti.ByTypeInfo[TypeInfo(TTestItem)].Props.NameChanges(['Name1', 'Name2'], ['N1', '']); // Ok: {"N1":"A"}
Rtti.ByTypeInfo[TypeInfo(TTestItem)].Props.NameChanges(['Name1', 'Name2'], ['', 'N2']); // Error: Access violation
With best regards
Thomas
I imagine the code should actually just modify the log filename, not the full path.
You are right. It should look like this:
procedure TServerLog.ComputeFileName;
begin
inherited ComputeFileName;
FFileName := MakePath([ExtractFilePath(FFileName), StringReplace(ExtractFileName(FFileName), ' ', '_', [rfReplaceAll])]);
end;
With best regards
Thomas
@Thomas: My problem with your demo is that I get this error:
First chance exception at $75ADF932. Exception class EOSException with message 'TFileStreamEx.Create(C:\Delphi\Components_Full\Database\mORMot2\ex\ThirdPartyDemos\tbo\04-HttpServer-InterfaceServices\bin\TestRestServer_20240102_175743.log) failed as ERROR_PATH_NOT_FOUND'. Process TestRestServer.exe (5340)
I have tested it with the following and it works for me without any problems:
Windows 10
Delphi 12 Athens
mORMot2 Version 2.2
Unfortunately, I can't help you.
With best regards
Thomas
Try to define your services BEFORE calling SetUser().
Are you sure? Then all my comments in source code since mORMot1 are wrong:
// IMPORTANT: First log in and then call ServiceDefine()!
if not FServerRestClient.SetUser(pmcAdminUsername, pmcAdminPassword, {HashedPassword=} False) then
Exit(scsErrLoginAdminUser); //=>
if not InitializeServices then
Exit(scsErrInitializeServices); //=>
end;
@RaelB: Have you already tried this example?
With best regards
Thomas
I have switched to the latest mORMot2 version. The following source code has worked so far. Two log files are now created. One for TSynLog and one for TVGServerLog.
type
TVGServerLog = class(TSynLog)
protected
procedure ComputeFileName; override;
end;
constructor TVGServerDaemon.Create;
begin
inherited Create(TVGServerSettings, ...
Settings.LogPath := TFileUtils.GetLogFileFolder(TVGServerSettings(Settings).ServerID);
Settings.SetLog(TVGServerLog);
Now TSynDaemon.AfterCreate must be overwritten. Name AfterCreate() does not really say what is being done. Perhaps a name like SetLogClassAfterCreate() would be more descriptive. If the LogClass has already been assigned in TSynDaemonSettings Create, it will be overwritten in AfterCreate(). Maybe check for Nil:
procedure TSynDaemon.AfterCreate;
begin
if RunFromSynTests then
fSettings.fLogClass := TSynLog // share the same TSynLog for all daemons
else if fSettings.LogClass = Nil then
fSettings.SetLog(TSynLog); // real world logging
end;
Best wishes and a Happy New Year 2024 to all.
With best regards
Thomas
Have any idea? Thank you.
I have created a simple unit for this:
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.UITypes, System.Classes,
mormot.core.base, mormot.core.text, mormot.core.rtti, mormot.core.log;
type
TRemoteLogging = class(TComponent)
strict private
FLogClass: TSynLogClass;
protected
const
DEFAULT_PORT = 8091;
public
destructor Destroy; override;
procedure Start(pmLogClass: TSynLogClass; const pmcUri: RawUtf8 = '127.0.0.1/LogService');
procedure Stop;
end;
implementation
uses
mormot.net.sock,
mormot.rest.http.client;
destructor TRemoteLogging.Destroy;
begin
Stop;
inherited Destroy;
end;
procedure TRemoteLogging.Start(pmLogClass: TSynLogClass; const pmcUri: RawUtf8);
var
uri: TUri;
begin
if pmLogClass <> Nil then
try
FLogClass := pmLogClass;
uri.From(pmcUri, Int32ToUtf8(DEFAULT_PORT));
TRestHttpsClient.CreateForRemoteLogging(uri.Server, pmLogClass, Utf8ToInteger(uri.Port), uri.Root);
except
on E: Exception do
pmLogClass.Add.Log(sllError, E);
end;
end;
procedure TRemoteLogging.Stop;
begin
if FLogClass <> Nil then
FLogClass.Family.EchoRemoteStop;
end;
It is used like this:
procedure TfrmMain.FormCreate(Sender: TObject);
begin
...
TRemoteLogging.Create(Self).Start(TSynLog);
With best regards
Thomas
If errmsg returns a Chinese string, the client displays it incorrectly, but if errmsg is of type string, the return is correct. I don't know why.
With this minimal information, I can only guess:
var s: String := Utf8ToString(errMsg);
With best regards
Thomas
Compile package mormot2 2.0.1: Exit code 1, Errors: 1, Hints: 2 ...
What could be wrong?
I think you are using a mORMot2 version that was created before May 2022. It would be better to update to the current one. That's all I can help with.
With best regards
Thomas
I am using this record to be able to copy data from one TOrmMyclass instance to an other by just copying the myclassdata record variable between them.
Why do you want to do it this way? Does not the following also meet your requirements:
type
TOrmItem = class(TOrm)
private
FField1: Integer;
FField2: Integer;
FField3: Integer;
published
property Field1: Integer
read FField1 write FField1;
property Field2: Integer
read FField2 write FField2;
property Field3: Integer
read FField3 write FField3;
end;
var
item1, item2: TOrmItem;
begin
item1 := TOrmItem.CreateWithID(High(Int64));
try
item1.Field1 := 1;
item1.Field2 := 2;
item1.Field3 := 3;
var json: RawJson := item1.GetJsonValues({Expand=} False, {WithID=} True, 'Field1,Field3');
item2 := TOrmItem.CreateWithID(1);
try
ShowMessage(item2.GetJsonValues(True, True, ALL_FIELDS));
item2.FillFrom(Pointer(json));
ShowMessage(item2.GetJsonValues(True, True, ALL_FIELDS));
finally
item2.Free;
end;
finally
item1.Free;
end;
The result is:
{"RowID":1,"Field1":0,"Field2":0,"Field3":0}
{"RowID":9223372036854775807,"Field1":1,"Field2":0,"Field3":3}
With best regards
Thomas
example-03:
in u_SharedTypes, the following line causes [dcc32 Error] u_SharedTypes.pas(75): E2034 Too many actual parameters
pmCheckedFileName^ := TPath.Combine(dirName, fileName, False)
Removing the ,false parameter will cause it to compile.
You are right, in Delphi 10.3 the definition still looks like this: "class function TPath.Combine(const Path1, Path2: string): string;".
With best regards
Thomas
The example-03 does not compile, ...
The example compiles for me without errors, warnings or hints. You do not specify which Delphi version you are using, nor which mORMot commit.
If the function name is expanded with a slash, the log shows following:
GET Files/GetAllFileNames/=400
mormot.rest.server.TRestServerRoutingRest { "errorCode":400, "errorText":"Invalid URI" }
The following is written in help:
function TServiceCalculator.Add(n1, n2: integer): integer;
will accept such requests:
- URL='root/Calculator.Add' and InBody='[ 1,2 ]'
- URL='root/Calculator.Add?+%5B+1%2C2+%5D' // decoded as ' [ 1,2 ]'
- URL='root/Calculator.Add?n1=1&n2=2' // in any order, even missing
If the help is correct, it is the expected result.
PS: If you put a breakpoint in function TRestServer.Uri() at position "node := fRouter.Lookup(ctxt);", you can trace it.
With best regards
Thomas
It was obvious that a TValuePUtf8Char.ToDouble method was missing.
I would lean towards the following:
type
TValuePUtf8Char = record
...
function ToFloat: TSynExtended; overload;
function ToFloat(const pmcDefaultValue: TSynExtended): TSynExtended; overload;
function TValuePUtf8Char.ToFloat: TSynExtended;
begin
Result := GetExtended(Text);
end;
function TValuePUtf8Char.ToFloat(const pmcDefaultValue: TSynExtended): TSynExtended;
var
err: Integer;
begin
Result := GetExtended(Text, err);
if err <> 0 then
Result := pmcDefaultValue;
end;
Then it can be written like this:
if pmvContext.ParseObject(['c', 'a', 'A'], @recValues) then
begin
rec.c := recValues[0].ToFloat;
rec.R1.a1 := recValues[1].ToFloat(-1);
rec.R1.a2 := recValues[2].ToFloat(NaN);
With best regards
Thomas
As you see that we split the JSON text to be a nested record, and would like to DynArrayLoadJson the JSON directly to the recs array.
This does not work automatically. Your definition must correspond to the JSON data format. But you can write and register your own serializer:
type
TTestRec = packed record
c: Double; // -> c
R1: record
a1: Double; // -> a
a2: Double; // -> A
end;
end;
PTestRec = ^TTestRec;
TTestRecArray = array of TTestRec;
TTestRecArrayFiler = class(TObject)
public
class procedure CustomReader(var pmvContext: TJsonParserContext; pmData: Pointer);
end;
class procedure TTestRecArrayFiler.CustomReader(var pmvContext: TJsonParserContext; pmData: Pointer);
var
rec: PTestRec absolute pmData;
recValues: array[0..2] of TValuePUtf8Char;
begin
if pmvContext.ParseObject(['c', 'a', 'A'], @recValues) then
begin
rec.c := GetExtended(recValues[0].Text);
rec.R1.a1 := GetExtended(recValues[1].Text);
rec.R1.a2 := GetExtended(recValues[2].Text);
end;
end;
const
JSON = '[{"c":"28403.81000000","a":"28420.61000000","A":"0.00351000"},{"c":"0.13690000","a":"0.13930000","A":"408.00000000"}]';
var
recs: TTestRecArray;
begin
if DynArrayLoadJson(recs, JSON, TypeInfo(TTestRecArray), Nil, True) then
begin
for var i: Integer := 0 to High(recs) do
ShowMessage(Format('c: %.5f, a: %.5f, A: %.5f', [recs[i].c, recs[i].R1.a1, recs[i].R1.a2]));
end;
initialization
TRttiJson.RegisterCustomSerializer(TypeInfo(TTestRec), TTestRecArrayFiler.CustomReader, Nil);
With best regards
Thomas
Tough the data titile "a" and "A" is Duplicated consider by pascal language, but our purpose is to parse the data to a pre-defined record, even the name is Duplicated in the Json text, that will not matter.
Try it this way:
type
TTestRec = packed record
c: Double;
a1: Double;
a2: Double;
end;
TTestRecArray = array of TTestRec;
const
JSON = '[{"c": "28403.81000000","a": "28420.61000000","A": "0.00351000"},{"c": "0.13690000","a": "0.13930000","A": "408.00000000"}]';
var
recs: TTestRecArray;
begin
if DynArrayLoadJson(recs, JSON, TypeInfo(TTestRecArray), Nil, True) then
ShowMessage(Format('a: %f, A: %f', [recs[1].a1, recs[1].a2]));
initialization
Rtti.ByTypeInfo[TypeInfo(TTestRec)].Props.NameChanges(['c', 'a1', 'a2'], ['c', 'a', 'A']);
With best regards
Thomas
The problem was finally in my code. The provided variable b content was the problem
Apologies for the trouble
Can you please describe exactly what you did wrong and how you solved it, so that other readers can find a solution here if they have the same problem. You can also learn from mistakes and you don't have to make them all yourself. I have no idea what exactly went wrong for you.
With best regards
Thomas
The description says: "It should work with Delphi 10.2 or later". In my articles I do not explicitly pay attention to compatibility with older Delphi versions. The example uses TWebBrowser and probably cannot be adapted to older Delphi versions. Or you install an open source WebBrowser component for your version.
With best regards
Thomas
Too many fields. You have to define MAX_SQLFIELDS_128.
With best regards
Thomas
mORMot2, Commit 6006 (0eae863), Unit mormot.core.data, Line 7675
Parameter "reformat" was forgotten to be passed.
procedure TDynArray.SaveToJson(out result: RawUtf8; EnumSetsAsText: boolean;
reformat: TTextWriterJsonFormat);
begin
SaveToJson(result, TEXTWRITEROPTIONS_ENUMASTEXT[EnumSetsAsText],
TEXTWRITEROBJECTOPTIONS_ENUMASTEXT[EnumSetsAsText], --> reformat);
end;
With best regards
Thomas
I would call the naming of parameters "forceSocket" and "forceNotSocket" unfortunate. Maybe I'm the only one who had to look twice until I understood the source code.
/// retrieve the content of a web page, using the HTTP/1.1 protocol and GET method
// - this method will use a low-level THttpClientSock socket for plain http URI,
// or TWinHttp/TCurlHttp for any https URI
function HttpGet(const aUri: RawUtf8; const inHeaders: RawUtf8;
outHeaders: PRawUtf8 = nil; forceNotSocket: boolean = false;
outStatus: PInteger = nil; timeout: integer = 0; forceSocket: boolean = false;
ignoreTlsCertError: boolean = false): RawByteString; overload;
With best regards
Thomas
When looking for the word "clipping" here on the forum I came across this topic from MtwStark.
I don't know if my hint is helpful. I haven't used SynPDF yet and only skimmed the thread, but when I hear the word "clipping" I immediately think of Angus Johnson Clipper2 library, which is also used with Image32. The older Clipper1 library can be found here.
With best regards
Thomas
Here is the translation of the article into English with Google Translator. The result is not perfect, but it is readable.
I used the server as an example for a new article with TMS WebCore. Unfortunately I didn't pay attention during the implementation and developed against an older version of mORMot2. I had no time for a revision for a year. The following changes were made that it works with the WebCore Miletus App example:
constructor TFileRestServer.Create(const pmcRootName: RawUtf8; const pmcDataFolder: TFileName);
begin
if not DirectoryExists(pmcDataFolder) then
raise Exception.Create('A data directory must be specified.');
CreateWithOwnModel([TAuthGroup, TFileAuthUser], {HandleUserAuthentication=} False, pmcRootName);
// Register the authentication methods selectively
{$IF DEFINED(AuthNone)}
AuthenticationRegister(TRestServerAuthenticationNone);
{$ELSE}
(AuthenticationRegister(TRestServerAuthenticationDefault) as TRestServerAuthenticationSignedUri).NoTimestampCoherencyCheck := True;
{$ENDIF}
...
constructor TTestServerMain.Create(const pmcCustomerConfigFileName: TFileName; const pmcDataFolder: TFileName);
begin
inherited Create;
FRestServer := TFileRestServer.Create(ROOT_NAME_FILE, pmcDataFolder);
FRestServer.NoAjaxJson := False; // Important that JavaScript can process the result
...
With best regards
Thomas
If your Wep-App has only a few pages, then mORMot MVC and JavaScript with a CSS Framework (Bootstrap, Bulma, TailwindCSS) is a good choice. If there are more, then TMS WebCore is worth a look. I've had a license for 3 years. Only use WebCore VSC, which works well for me.
With best regards
Thomas
i found the "hello" field value only display the first letter, this is why?
Please tell us the Delphi and mORMot version you are using.
Create a new project. Put a DBGrid and a Button on the Form. Add the following Units in the uses section.
uses
...
mormot.core.base,
mormot.core.data,
mormot.core.text,
mormot.core.unicode,
mormot.core.log,
mormot.core.os,
mormot.orm.base,
mormot.orm.core,
mormot.rest.sqlite3,
mormot.db.rad.ui.orm,
mormot.db.raw.sqlite3,
mormot.db.raw.sqlite3.static;
Paste the source code from my example. From the "begin" all in the OnClick event of the Button. Also add the Desc after the Name property when filling the database like in the source code below.
ormItem.Desc := 'Description ' + StringToUtf8(i.ToString);
If there are still problems, you can insert the following source code after assigning the DataSet and explicitly create the columns of the grid.
DBGrid.DataSource.DataSet.DisableControls;
try
var gridCol: TColumn;
gridCol := DBGrid.Columns.Add;
gridCol.FieldName := 'Name';
gridCol.Width := 50;
gridCol := DBGrid.Columns.Add;
gridCol.FieldName := 'Desc';
gridCol.Width := 200;
finally
DBGrid.DataSource.DataSet.EnableControls;
end;
With best regards
Thomas
You can play a bit with SQLTimeStampVariantType. Delphi just needs to know what you want:
var value: Variant := VarSQLTimeStampCreate(Now); // <- Variant of type SQLTimeStampVariantType
ShowMessage(TDateTime(value).ToString);
ShowMessage(DateTimeToStr(value.AsDateTime));
ShowMessage(Format('Date: %d.%d.%d', [Word(value.Day), Word(value.Month), Word(value.Year)]));
ShowMessage(Format('Time: %d:%d:%d', [Word(value.Hour), Word(value.Minute), Word(value.Second)]));
var dt: TDateTime := value;
ShowMessage(dt.ToString);
Or have a look in Unit Data.SqlTimSt at class TSQLTimeStampData and TSQLTimeStampVariantType.
With best regards
Thomas
There are something that can be done on mormot internal to dont need make this conversion by hand????
Take another look at my source code.
With best regards
Thomas
How we can resolve this?
For example, like this:
var
doc: TDocVariantData;
begin
doc.InitFast;
var value: Variant := VarSQLTimeStampCreate(Date);
ShowMessage(VarTypeAsText(VarType(value)));
doc.AddOrUpdateValue('MyInt', 10);
doc.AddOrUpdateValue('MyBoolean', True);
doc.AddOrUpdateValue('MyVariantDate', TDateTime(value));
ShowMessage(doc.ToJson);
With best regards
Thomas
What I should?
Write following and see what type the Variant is.
ShowMessage(VarTypeAsText(VarType(vValue)));
This works:
var
doc: TDocVariantData;
begin
doc.InitFast;
var vValue: Variant := Date;
doc.AddOrUpdateValue('MyInt', 10);
doc.AddOrUpdateValue('MyBoolean', True);
doc.AddOrUpdateValue('MyVariantDate', vValue);
ShowMessage(doc.ToJson);
And where is vParams used in source code?
With best regards
Thomas
But it did not work with dbgrid which DataSource.Dataset has data records, i guess whether the Client.MultiFieldValues result has some show question
Delphi 11.3
mORMot2, Commit 5750 (06ac0fe)
This example works for me:
type
TOrmItem = class(TOrm)
private
FName: RawUtf8;
FDesc: RawUtf8;
published
property Name: RawUtf8
read FName write FName;
property Desc: RawUtf8
read FDesc write FDesc;
end;
begin
var dbFileName: TFileName := MakePath([Executable.ProgramFilePath, 'ItemDB.db']);
var restServer: TRestServerDB := TRestServerDB.CreateWithOwnModel([TOrmItem], dbFileName, False);
try
restServer.DB.Synchronous := smNormal;
restServer.DB.LockingMode := lmExclusive;
restServer.Server.CreateMissingTables(0, [itoNoAutoCreateGroups, itoNoAutoCreateUsers]);
var ormItem: TOrmItem := TOrmItem.Create;
try
for var i: Integer := 0 to 99 do
begin
ormItem.Name := StringToUtf8(i.ToString);
restServer.Add(ormItem, True);
end;
finally
ormItem.Free;
end;
FreeAndNil(DBGrid.DataSource);
var ormTable: TOrmTable := restServer.MultiFieldValues(TOrmItem, 'Name, Desc');
if ormTable.RowCount > 0 then
begin
DBGrid.DataSource := TDataSource.Create(DBGrid);
DBGrid.DataSource.DataSet := TOrmTableDataSet.Create(DBGrid, ormTable);
end;
finally
restServer.Free;
end;
end;
initialization
var logFamily: TSynLogFamily := TSynLog.Family;
logFamily.Level := LOG_VERBOSE;
With best regards
Thomas
Delphi 11.3
mORMot2, Commit 5750 (06ac0fe)
Source code that worked all the time can no longer be executed. The problem starts with this line:
var restServer: TRestServerDB := TRestServerDB.CreateWithOwnModel([TOrmItem], dbFileName, False);
When trying to open the SQLite database, the following execution is thrown immediately when calling the Add function:
function TSqlDataBase.DBOpen: integer;
...
begin
log := fLog.Enter('DBOpen %', [fFileNameWithoutPath], self);
class function TSynLog.Enter(const TextFmt: RawUtf8; const TextArgs: array of const; aInstance: TObject): ISynLog;
...
begin
log := Add;
Execption text:
ThreadId=11820
ProcessId=6
ThreadName="Main"
ExceptionMessage="Access violation at address 004B6641. Read of address 00000020"
ExceptionName="EAccessViolation"
ExceptionDisplayName="$C0000005"
ExceptionAddress=004B6641
LineNumber=4755
It can be prevented, for example, with:
initialization
var logFamily: TSynLogFamily := TSynLog.Family;
logFamily.Level := LOG_VERBOSE;
This behavior is new. I have tested it on a few older examples.
With best regards
Thomas