You are not logged in.
OK, but where is an information how to declare the list of attachments (array or dynarray or collection)?
What's is the best method of receiving files using SOA method, for example:
type
IInteractions = interface(IInvokable)
['{75775F98-DCD5-455A-A0EE-06E25FF24683}']
function SendEMail(const Subject, Plain, ToList: string; Attachments: ????) : TResponse;
end;attachment should be a two fields structure like:
TAttachment = record
Name: RAWUtf8;
Value: RawByteString;
end;Should I declare Attachments: ???? as Attachments: array of TAttachment or create a TCollection inherited class or ....?
I've added fake field to record
type
TCounters = record
MemoryUsage: Integer;
ThreadsCount: integer;
fake: string;
end;and it worked.
Strange behavior.
---------------------------
Debugger Exception Notification
---------------------------
Project RestProtocol.exe raised exception class EInterfaceFactoryException with message 'TInterfaceFactoryRTTI.Create: TCounters record too small in IServerMonitor.PerformanceCounters method Items parameter'.
---------------------------
Break Continue Help
---------------------------
type
TCounters = record
MemoryUsage: Integer;
ThreadsCount: integer;
end;
IServerMonitor = interface(IInvokable)
['{592BF05B-ACA3-434B-8675-B2B498E7DD2D}']
function PerformanceCounters(out Items: TCounters): TResponse;
end;
implementation
initialization
TInterfaceFactory.RegisterInterfaces([TypeInfo(IServerMonitor)]);
end.Whats am I doing wrong?
OK, thank you. I asked about events performance in other forum thread, can you look at my questions?
What is the preferred solution for multiple event triggering engine from server to client. For example:
type
TSubscribe = class(TInterfacedObject, ISubscribe)
protected
WorkingHoursListeners: array of IWorkingHoursChanged;
ConfigurationChangeListeners: array of IConfigurationChanged;
procedure WorkingHoursChange(const callback: IWorkingHoursChanged);
procedure ConfigurationChange(const callback: IConfigurationChanged);
procedure CallbackReleased(const callback: IInvokable; const interfaceName: RawUTF8);
public
procedure RaiseWorkingHoursChange(const QueueID: Integer; const HourFrom, HourTo: TDateTime);
procedure RaiseConfigurationChange(const Key, Value: string);
end;or create separate class for each event like:
type
TWorkingHours = class(TInterfacedObject, IWorkingHours)
protected
Listeners: array of IWorkingHoursChanged;
procedure WorkingHoursChange(const callback: IWorkingHoursChanged);
public
procedure RaiseChange(const QueueID: Integer; const HourFrom, HourTo: TDateTime);
end;and the same for ConfigurationChange. I have to implement about 100 different callbacks.
Let's say we have a 2000 callback listeners working on different network segments - some of them uses slow connections such as mobile 3G.
So in this situation:
procedure TChatService.BlaBla(const pseudo,msg: string);
var i: integer;
begin
for i := high(fConnected) downto 0 do
try
fConnected[i].NotifyBlaBla(pseudo,msg);
except
InterfaceArrayDelete(fConnected,i);
end;
end;1. the loop speed will depend on client network speed and 2.freeze the main thread if I execute BlaBla from timer placed on Main Form. 3.The last client from fConnected array will wait very long time waiting for all previous notifications of that queue. 4.The solution is for example the thread pool for "notifictions worker" so it allows asynchronous notifications.
AB, can you answer for all 4 questions? Maybe NotifyBlaBla is already async?
So, for business application in desktop client-server architecture with callbacks feature (bidirectional communication) and the same for web client-server preferred solution is using websockets. In that right?
Is this possible to implement bidirectional communication like websockets using Named Pipes or callbacks available onky in websocket with useBidirSocket parameter.
Thats right: https://www.dropbox.com/s/qyv1yxe1l00qi … e.txt?dl=0
Are you sure that storing source code samples in external services such as dropbox is a good solution? Those samples won't be available in the future if I remove dropbox file, so my solution won't be available for anyone. Why we can't put the good solutions in the forum, you don't provide such smart helpful code solutions in documentation so that forum is one of the best source sharing service IMHO.
I'm getting AV in line
aClassType := GetClassParent(aClassType); -> access violation
in: function JSONObjectFromClass(aClassType: TClass; out aParser: PJSONCustomParser): TJSONObject;
my code:
IQueues = interface(IInvokable)
['{9857C187-68A2-4F22-823C-75B75F28B45A}']
function GetQueues(out response: TQueuesCollection): TResponse;
function WorkingHours(const MediaType: RawUTF8; out response: TQueuesWorkingHours): TResponse;
end;
TQueuesCollection = class(TInterfacedCollection)
protected
class function GetClass: TCollectionItemClass; override;
end;
Usage:
connector.ServiceDefine(IQueues, sicSingle).ResultAsJSONObjectWithoutResult := True;
var obj: IQueues;
var list: TQueuesCollection;
connector.Services.Resolve(IQueues, obj);
obj.GetQueues(list); -> access violation
Web request /queues.getqueues works fine.
Can someone help me how to accomplish the following task. I would like to create the procedure that help me register and retrieve an interface.
procedure TServerAccess.Resolve(intf: IInvokable; out Obj);
begin
connector.ServiceDefine(intf, sicSingle);--> [dcc32 Error] uServiceBase.pas(90): E2250 There is no overloaded version of 'ServiceDefine' that can be called with these arguments
connector.Services.Resolve(intf, obj); -> [dcc32 Error] uServiceBase.pas(91): E2250 There is no overloaded version of 'Resolve' that can be called with these arguments
end;
Thank you AB, this is what I needed.
type
IExtraInfo = interface
['{97B05BCF-D2E7-4BE3-B56B-BD43552F411B}']
procedure SetConnectionString(const value: string);
end;
ITest = interface(IInvokable)
['{20CF8A1A-95AC-446A-ABEF-9379E7DFA47B}']
procedure Test;
end;
TTest = class(TInterfacedObject, ITest, IExtraInfo)
private
connectionString: string;
procedure Test;
procedure SetConnectionString(const value: string);
end;
...
procedure TForm3.Button1Click(Sender: TObject);
begin
var Server := TSQLRestServerFullMemory.CreateWithOwnModel([], false, 'api');
Server.CreateMissingTables;
Server.OnServiceCreateInstance := Instance;
end;
procedure TForm3.Instance(Sender: TServiceFactoryServer;
Instance: TInterfacedObject);
begin
var intf: IExtraInfo;
if Supports(Instance,IExtraInfo, intf) then
intf.SetConnectionString('Server=myServerName\myInstanceName;Database=myDataBase;User Id=myUsername;Password=myPassword;');
end;Yeah, you're right.
c := Client.ServiceDefine(ITest,sicSingle);
c.ResultAsJSONObjectWithoutResult := True;
No way, my customer does not have information about database connection ![]()
I'm hosting the SOA interfaces through the http and named pipes.
Server := TSQLRestServerFullMemory.CreateWithOwnModel([], false, 'api');
Server.CreateMissingTables;
with Server.ServiceDefine(TTest,[ITest]) do
begin
ResultAsJSONObjectWithoutResult := True;
end;
Server.ExportServerNamedPipe('Test');
HttpServer := TSQLHttpServer.Create('2080',[Server],'+',{$IFDEF DEBUG}useHttpSocket{$ELSE}HTTP_DEFAULT_MODE{$ENDIF}, 32, secNone, 'api');http requests works fine, but the named pipes raises an error when I defined ResultAsJSONObjectWithoutResult := True;
error: Project Project3.exe raised exception class EInterfaceFactoryException with message 'TInterfacedObjectFakeClient.FakeCall(ITest.Test) failed: 'Invalid returned JSON content: expects {result:...}, got {}''.
Can you show sample code how to implement it using TInterfacedObjectRest ?
1.
type
IQueues = interface(IInvokable)
['{9857C187-68A2-4F22-823C-75B75F28B45A}']
function GetQueues(out response: TQueuesCollection): TResponse;
end;
2.
type
TQueues = class(TInterfacedObject, IQueues)
private
connectionString: string;
public
constructor Create; override;
function GetQueues(out response: TQueuesCollection): TResponse; -> here will be "select * from queues"
end;
How to pass for example ConnectionString to the created object, something like:
with Server.ServiceDefine(TQueues,[IQueues]) do
begin
onCreate:= myOnCreate;
end;
1.
type
IQueues = interface(IInvokable)
['{9857C187-68A2-4F22-823C-75B75F28B45A}']
function GetQueues(out response: TQueuesCollection): TResponse;
end;
2.
with Server.ServiceDefine(TQueues,[IQueues]) do
begin
SetOptions([], [optExecInMainThread]).ByPassAuthentication := true;
end;
3. put button1 in the same application where the interface is started -> TWinHTTP.Get('http://localhost:2080/api/Queues.WorkingHours'); -> application freezes until http request timeouts (why timeouts?)
When I use used component from indy: the idHttp.Get ( ) everything works fine or when I change the interface execution to own thread (removed optExecInMainThread)
Any ideas?
You are forgetting we have bpl
I have a standard ERP, and for the few customers with non standard needs we make modules (packages) that plug in the system, using all standard stuff, and adding or overriding any functionalityI'm starting with mORMot, so I'm just making some packages with the sources, wich works fine
Drawback: when you build a new version, you need to rebuild the customer packages as well
@Javierus, we have the similar solution since a years (I mean extra features in libraries), but we use DLL instead of BPL. We use that feature in both - client application and server. To be honest, the client application without plugins is extremely thin, allows to log-in and log-out, the plugins makes it a huge application with features depends on customer needs or the features bought by customer.
So it is a problem of Delphi RTTI.
There are two TPersistentWithCustomCreate classes, one in the dll and one in the main exeBut I don't understand
1. why the classes are mixed
2. why you need to use the mORMot client/server feature between a dll and an exe
Ad2. I've created the TSQLRestServerFullMemory in my Server Core. There are a lot of basic methods for most of my customers. But I have a few customers who needs the special features such as /root/Stupid.StupidMethod. I will never add such sh*t to the server core so I decided to create the dll libraries which extends my TSQLRestServerFullMemory by custom methods.
--------
MyCustomer123.dpr
begin
TInterfaceFactory.RegisterInterfaces([TypeInfo(IStupid)]);
RestServer := (SharedFunctions as ISharedFunctions).RestServer;
RestServer.ServiceDefine(TStupidIntegration, [IStupid], sicShared);
end;
I can confirm that moving mormot*.pas/Syncommons.pas to the new package (bpl) and building both exe and dll with that package solved the problem. Now the TPersistentWithCustomCreate class is identified as:
end else begin
ItemCreate := cicTPersistentWithCustomCreate;
exit;
Thanks.
No, that virtual keyword is not a problem, I just forget to put it in sample above.
Look how the mOROmot classified the class inherited from TPersistentWithCustomCreate
if C<>nil then
continue else begin
ItemCreate := cicTObject;
exit;
end;
instead of
end else begin
ItemCreate := cicTPersistentWithCustomCreate;
exit;
I think that the virtual table for dll is other then exe so for example the "is" statement won't work if you won't check Build with runtime packages for dll+exe and use the package that contain the class you are testing by "is".
Let me answer myself.
The "out" class instance will be automatically created be internal mechanism, no need to manually instance the object.
That's pity that mormot is so poor documented, no information about TPersistentWithCustomCreate, no simple samples in documentation, use cases. Searching for this forum takes a long hours or days to find a solution every time I have to implement new feature or even data type such as TPersistentWithCustomCreate.
I have this successful proof of concept using "mORMot" services as DLL.
https://drive.google.com/open?id=0Bx7LP … lAwYmNjQWs
Maybe is helpful for you.
Your sample app does not work with TPersistentWithCustomCreate
TTest = class(TPersistentWithCustomCreate)
public
constructor Create;
end;
TDLLOneService = class(TInterfacedObject, IDLLOneService)
protected
function Test1(const aText: RawUTF8): RawUTF8;
procedure ABC(out x: TTest);
end;
the problem concerns invalid class recognition in exe, mOROmot does not recognize TPersistentWithCustomCreate
Probably the mORMot should be attached to new package (bpl) and build with that runtime packages in both - exe and dll.
How to deal with objects especially their livetime.
type
TIVRSettings = class
published
PROMPT: TPROMPT; //TInterfacedCollection
PHONE_NUMBER: TPHONE_NUMBER; //TInterfacedCollection
PARAMETER: TPARAMETER; //TInterfacedCollection
end;
IVRSettings = interface(IInvokable)
['{DFA6783D-7C30-4CC2-B9F3-9D73147F302B}']
function GetVRSettings(out IVRSettings: TIVRSettings): TResponse;
end;
TSirenIntegration = class(TInterfacedObject, IVRSettings)
private
function GetVRSettings(out IVRSettings: TIVRSettings): TResponse;
end;
procedure TSirenIntegration.GetVRSettings(out IVRSettings: TIVRSettings): TResponse;
begin
IVRSettings:= TIVRSettings.create -> how about free?
end
should I inherit TIVRSettings from any autofree class such as TInterfacedObject (and implement an interface).
I'm getting such message while compiling application that uses package (Link with runtime packages) containing the mORMot unit.
"W1032 Exported package threadvar 'mORMot.ServiceContext' cannot be used outside of this package"
How to set compiler to ignore that warning or there is possibility to fix that at motmot side?
The sample project 27 generates the swagger from template. Can I load the template from exe resources to prevent from storing mustache files on disk?
Damn, you are right, it solves compilation errors I'm usually searching for this forum, why I was looking for solution on google only ...
I'm getting an error "SynCommons.pas(5841): E1025 Unsupported language feature: 'TObject'" while trying to add unit mORMot.pas to uses in package. Delphi Sydney 10.4.
Steps:
1. File -> New -> Package
2. File -> New -> Unit
3. Add mORMot to uses
unit Unit3;
interface
uses
mORMot;
implementation
end.Checking project dependencies...
Compiling Package2.dproj (Debug, Win32)
[dcc32 Error] SynCommons.pas(5841): E1025 Unsupported language feature: 'Object'
[dcc32 Error] SynCommons.pas(6432): E1025 Unsupported language feature: 'Object'
[dcc32 Error] SynCommons.pas(7255): E1025 Unsupported language feature: 'Object'
[dcc32 Error] SynCommons.pas(10254): E1025 Unsupported language feature: 'Object'
I saw in the forum history that there is a swagger template for API documentation. How to implement that documentation API to the Server in the sample code below?
Server := TSQLRestServerFullMemory.CreateWithOwnModel([], false, 'api');
Server.CreateMissingTables;
with Server.ServiceDefine(TServerMonitor,[IServerMonitor]) do
begin
//dont add "result" node to response for example {"result":{"key":"value"}}
ResultAsJSONObjectWithoutResult := True;
SetOptions([], []).ByPassAuthentication := true;
end;
with Server.ServiceDefine(TInteractions,[IInteractions]) do
begin
ResultAsJSONObjectWithoutResult := True;
//all methods "[]" will be executed in main thread
SetOptions([], [optExecInMainThread]).ByPassAuthentication := true;
end;type
TAgentItem = class(TCollectionItem)
property Queues: TRawByteStringDynArray read FQueues write FQueues;
end;
IAgents = interface(IInvokable)
['{69D97B11-3143-471F-B380-F706A3B6F6CB}']
procedure GetLogged(out agentCollection: TAgentsCollection);
procedure Logout(const AgentID: integer);
end;
implementation
var
agent: TAgent;
qList: TRawByteStringDynArray;
begin
SetLength(qList, agent.QueueCount);
for var j := 0 to agent.QueueCount - 1 do
qList[j] := StringToUTF8(agent.Queue[j].Name);
Queues := qList;
end;the response for that query looks like that:
{"agentCollection":[{"ID":2,"Ident":"super01","Name":"super01 super01","Status":2,"UserStatusID":0,"PhoneRegistered":false,"IPAddress":"","Queues":["VGVzdA==","VFNfVGVtYXQx"]}]}
the Queue seems to be base64 encoded. What I'm doing wrong?
I've declared the interface:
type
TCounters = record
MemoryUsage: Integer;
QueueCount: integer;
end;
IServerMonitor = interface(IInvokable)
['{21F546FB-F20E-43B8-8644-E86288A23BB6}']
function MemoryUsage: integer;
function DBQueueCount: integer;
procedure Counters(out MemoryUsage: Integer; out QueueCount: integer);
function Counters2: TCounters;
procedure Counters3(out Items: TCounters);
end;
when I execute the Counters method: http://localhost:2080/api/servermonitor.counters I'm getting array {"result":[123,11]}. How to prepare the procedure to retrieve the parameters name without an array? Expected result: {"result": {"MemoryUsage":123,"DBQueueCount":11} } .
The rest of methods Counters2, Counters3 generates the array also: {"result":[{"MemoryUsage":444,"QueueCount":666}]}
Whole mORMot framework works with RawUTF8 which is an AnsiString containing UTF8 characters. How to deal with string conversion working with standard Delphi components based on string type. I'm getting nervous seeing hundreds of hints concerning string conversion, for example:
button1.Caption := DateTimeMSToString(Now)
W1057 Implicit string cast from 'RawUTF8' to 'string'
What is the best solution to get rid those hints?
Great! I'll be very grateful. Actually I'm encrypting the text with salt = line number to make the log lines harder to decrypt for all those who would like to find any similar actions. I mean, if you encrypt the following lines:
Log.txt
202-01-01 12:12:12 Ping
202-01-01 12:12:12 Ping
202-01-01 12:12:12 Ping
202-01-01 12:12:13 Ping -> time changethe log with encrypted lines above can look like that:
8f1befe8
8f1befe8
8f1befe8
e54993b2 -> time changeSo, someone can see that I'm doing the same operation in interval, this is an information that I want to hide from competitors. So I've added the salt = line number that generates:
8f1befe8
e54993b2
68eb0414
c8eb0112I know that this is a very simple method of salting but for novice hacker can be impulse to stop trying to reverse engineer my log or guess my internal processes.
Of course, adding the extra milliseconds to the date and encrypting entire line implicate that encrypted text won't be the same for each line.
If you just implement an encrypted logs mechanism I would handle salting myself.
Does the SynLog allow to encrypt the text written to the log file + log viewer that read that logs? I don't want to allow competitors to analyze my app logs to prevent from stealing my algorithm/ideas or see my app errors. I tried to find the "crypt" word in the SynLog.pas file but unsuccessful.
Konsul41, your question does not concern exact mORMot but general working with libraries. This is too complicated to give a precise answer, we need to understand entire application structure and your expectations. Usually you can pass any data through exported stcall methods (dll)
ps. (polish)
Kolego, pisz po angielsku: "BPL ładowany poprzez".
Some logs from app:
[17:37:16][INFO] [RESTProtocol] Request from 127.0.0.1, command: /api/queryparameters
[17:37:16][INFO] [RESTProtocol] Retrieving query parameters. Query:select top 10000 * from calls where cl_id > :no
[17:37:16][INFO] [RESTProtocol] Retrieving complete
------------- Uncached query -----------
[17:37:36][INFO] [RESTProtocol] Request from 127.0.0.1, command: /api/querydata
[17:37:36][INFO] [RESTProtocol] Query from 127.0.0.1: select top 10000 * from calls where cl_id > :no. Parameters: [{"Name":"no","DataType":"ftInteger","Direction":"pdInput","Size":4,"Value":1}]
[17:37:36][INFO] [RESTProtocol] Query not found in cache, executing...
[17:37:37][INFO] [RESTProtocol] Query executed in 1011 ms. Recordcount: 10000
------------- Cached query -----------
[17:37:58][INFO] [RESTProtocol] Request from 127.0.0.1, command: /api/querydata
[17:37:58][INFO] [RESTProtocol] Query from 127.0.0.1: select top 10000 * from calls where cl_id > :no. Parameters: [{"Name":"no","DataType":"ftInteger","Direction":"pdInput","Size":4,"Value":1}]
[17:37:58][INFO] [RESTProtocol] Query found in cache. Recordcount: 10000The table [calls] contains about 25 columns, integers, date, strings. Log above show the caching sample, first query build the cache response for future use by other clients, and second query does not send request to the database, just send the previous cached data instead.
The GET method on this resource (/api/querydata) display helpful tools for managing cache:
https://localhost/api/querydata
command=clearcache - clear all cached queries
Sample: http://localhost/api/querydata?command=clearcache
command=cachestats - show statistics of cached queries
Sample: http://localhost/api/querydata?command=cachestats
For example the cache statistics link for test above looks like that:
Query:
select top 10000 * from calls where cl_id > :no
Parameters:
[{"Name":"no","DataType":"ftInteger","Direction":"pdInput","Size":4,"Value":1}]
Last Access:
2020-05-19 17:37:58
Payload size:
258701
The payload size is compressed json data - stream ready to be send to other clients.
I had similar needs but migrating from 3tier (with RemObjects) to 3tier (with mORMot). I implemented TSynRestDataset but using full mORMot features -not Indy, not OpenSSL, mORMot validators- (see https://synopse.info/forum/viewtopic.php?id=2712), we make small adaptations in out client applications (5, 10, 15 years) and all works fine. The mORMot framework greatness is infinite.
Yeah, but my SQL Queries on the client side contains millions of lines using MS SQL specified syntax keywords with declaring variables, creating ms sql temporary memory tables etc:) We are using it in reports, statistics, exec query as dynamic string (sp_executesql) dynamically changed sql texts etc.
We built completely different solutions I think.
Nice, i'm in the same situation and have a huge business application developed with firebird and UIB components.
Needs :
Use the app over vpn network whitch is a nigthmare because firebird protocol is to much slower
You won't have such problems, because the server makes queries to database not a client, the multiple connections are always open and the data are compressed
Have a possibility of changing the RDBMS to meet some customers obligations like MS SQL or POSTGRESQL
It is not so simple to migrate from one database to another, and this does not refers to my solution but sql syntax different for each database server. For example the MS SQL uses cursors for loops, the firebird <for select into>, if you use simple queries such as <select * from users where id >:id, my solution should meet your needs
Problems :
The app is about 10 years development and we can't refactor it quickly to adopt mormot and enjoy its many advantages
The same situation
- 15 years
DB layer is hardly coded with a lot of SQL queries.
@radexpol
Can your solution resolve some points of my needs ?
Yes, but extra code is required if you use IbTable, IbEvents. Some modifications on the server side also must be done, because my solution is based on ado* components not Ibx* and you will have to replace all Ib* to Rest*
Regards,
I have an application with similar requirements and I have often thought about doing this, for a quick and less painful migration.
Very good to know that you managed to make this migration successfully. This is encouraging.
Did you implemented a DataSet with the same properties as TADOQuery / Table, or Extended these classes?
Look at the code from my post. You'll see the RestDataset properties.
My app consists of two parts: client and server (Contact Center App), both client and server have a DB connection, client loads the customer data, displays the tickets, history of calls etc. and allows to administrate the system.
I'm using MS SQL.
Due to my customer requirements to prevent from connecting to DB from client apps I've created the framework that allows to migrate from Ado* components to Rest* compatible equivalent. My company project is very huge and replacing it's logic with classic rest methods is not possible in short time so I decided to create the workaround for fast cutting connection from client app to database, all queries are forwarded through the server. How it works:
All queries, commands and stored procedures are executed through the rest server
I tried to create the mechanism that is compatible with ADO* so you can write the same sql queries, use the same query parameters as you did with Ado*. The migration process is also very fast, usually you have to rename Ado* to Rest* in pas and dfm files.
Connection is secure
For client-server communication I use the Indy* components with SSL
Solution is partially mORMot based
I used the mORMot json implementation for fast processing
Connection pool
The connection pool of x number of concurrent connections has been implemented for concurrent queries
Query responses are cached (optional)
For every query coming from client the Rest Server creates the cache for future use by other clients. RestServer extracts the tables used in the query, parameters, and commandtext and saves that data in the memory with the response payload (compressed). If any data in the table of this query changes - the cache items bounded to this table are deleted. How can I know that the data in DB changed?
The RestServer creates the trigger on each table (on startup), OnDelete, OnUpdate, OnInsert , when the data changes that information goes to the table CACHE:
TableName DateModified
----------------------------------
CARS 2020-02-02 12:45:55
OWNERS 2020-02-02 11:11:11
the internal thread monitors that table, if date changes all cached queries containing that table are removed.
The other thread removes all cached queries that has not been used by any client since xx minutes.
Data are compressed
The response dataset is compressed to save the bandwidth (http gzip)
Use cases, parts of code:
Query content:
{"commandtext":"select top 100000 cl_id as [id] , * from [calls] cl\r\njoin devices on dv_id = cl_dv_id\r\nwhere
cl_id>:cl","commandtimeout":30,"usecache":true,"parameters":[{"Name":"cl","DataType":"ftInteger","Direction":"pdInput","Size":-1,"Value":777}]}Server side:
type
TJsonString = RawUTF8;
TJsonList = variant;
TJsonObject = variant;
TRemoteCommand = (rcClearCache, rcCacheStats);
TCacheItem = class(TPersistent)
private
fTables: TStringList;
fParameters: TJSONList;
FCommandText: string;
FJsonResponse: TJsonString;
FLastAccess: TDateTime;
FRecordCount: integer;
function GetJsonResponse: TJsonString;
public
property RecordCount: integer read FRecordCount write FRecordCount;
property CommandText: string read FCommandText write FCommandText;
property Parameters: TJSONList read FParameters write FParameters;
property Tables: TStringList read FTables;
property JsonResponse: TJsonString read GetJsonResponse write FJsonResponse;
property LastAccess: TDateTime read FLastAccess;
constructor Create;
destructor Destroy; override;
end;
TQueryCache = class
private
items: TObjectList;
criticalSection: TMultiReadExclusiveWriteSynchronizer;
function GetCacheItem(index: Integer): TCacheItem;
public
procedure RemoveTableCache(const ATableName: string);
function FindCacheItem(const ACommandText: string; AJsonParameters: TJSONList): TCacheItem;
procedure Add(const ACommandText: string; var AJsonParameters: TJSONObject; QeuryTables: TStrings; const ARecordCount: Integer; const AJsonResponse: string);
function Count: integer;
property CacheItems[index: Integer]: TCacheItem read GetCacheItem;
procedure GarbageCleanup;
function Cleanup: integer;
constructor Create;
destructor Destroy; override;
procedure ReadLock;
procedure ReadUnlock;
end;
TCacheWorker = class(TThread)
private
dsCache: TAdoDataset;
cache: TQueryCache;
connection: TAdoConnection;
tableList: TStringList;
procedure ProcessTable(const ATableName: string; const AChangeDate: TDateTime);
procedure SetConnectionString(const Value: string);
function GetConnectionString: string;
protected
procedure Execute; override;
public
property ConnectionString: string read GetConnectionString write SetConnectionString;
constructor Create(ACache: TQueryCache); reintroduce; overload;
destructor Destroy; override;
end;Client code:
TRestConnection = class(TComponent)
private
FClients: TList;
FDataSets: TList;
FRestAddress: string;
FCommandResource: string;
FQueryResource: string;
FStoredProcedureResource: string;
fParametersResource: string;
FSSL: boolean;
function DefaultRestAddress: Boolean;
function DefaultCommandResource: Boolean;
function DefaultQueryResource: Boolean;
function DefaultStoredProcedureResource: Boolean;
function DefaultParametersResource: Boolean;
function DefaultSSL: Boolean;
procedure ClearRefs;
function GetDataSetCount: Integer;
function GetDataSet(Index: Integer): TDataSet;
published
property RestAddress: string read FRestAddress write FRestAddress stored DefaultRestAddress;
property QueryResource: string read FQueryResource write FQueryResource stored DefaultQueryResource;
property CommandResource: string read FCommandResource write FCommandResource stored DefaultCommandResource;
property ParametersResource: string read FParametersResource write FParametersResource stored DefaultParametersResource;
property StoredProcedureResource: string read FStoredProcedureResource write FStoredProcedureResource stored DefaultStoredProcedureResource;
property SSL: boolean read FSSL write FSSL stored DefaultSSL;
end;
TRestDataset = class(TkbmCustomMemTable)
private
vJson: TJsonObject;
httpRequest: TIdHTTP;
SSLHandler: TIdSSLIOHandlerSocketOpenSSL;
CompressorZlib: TIdCompressorZlib;
FConnection: TRestConnection;
FCommandText: String;
FParameters: TParameters;
FCommandTimeout: integer;
FParamCheck: Boolean;
FUseCache: Boolean;
FTables: TStringList;
FAfterOpen: TDataSetNotifyEvent;
function GetParameters: TParameters;
procedure SetParameters(const Value: TParameters);
procedure Connected(Sender: TObject);
procedure SetConnection(const Value: TRestConnection);
protected
CommandType: TCommandType;
procedure SetCommandText(const Value: String);
function GetCommandText: String;
procedure InternalInitFieldDefs; override;
procedure DoBeforeOpen; override;
procedure DoAfterOpen; override;
procedure DoBeforePost; override;
procedure DoBeforeDelete; override;
function PSGetKeyFields: string; override;
procedure AssignCommandText(const Value: WideString; Loading: Boolean = False);
function ComponentLoading: Boolean;
procedure InternalRefreshParameters;
procedure DoAfterScroll; override;
procedure DoBeforeScroll; override;
procedure InternalRefresh; override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property Active;
property BeforeOpen;
property BeforeDelete;
property AfterDelete;
property BeforeScroll;
property AfterScroll;
property OnCalcFields;
property AfterInsert;
property BeforeEdit;
property AfterEdit;
property BeforePost;
property AfterPost;
property AfterOpen: TDataSetNotifyEvent read FAfterOpen write FAfterOpen;
property Connection: TRestConnection read FConnection write SetConnection;
property CommandText: String read GetCommandText write SetCommandText;
property Parameters: TParameters read GetParameters write SetParameters;
property CommandTimeout: Integer read FCommandTimeout write FCommandTimeout default 30;
property ParamCheck: Boolean read FParamCheck write FParamCheck default True;
property UseCache: Boolean read FUseCache write FUseCache default True;
end;
TRestCommand = class(TComponent)
private
FCommandText: String;
FConnection: TRestConnection;
httpRequest: TIdHTTP;
SSLHandler: TIdSSLIOHandlerSocketOpenSSL;
FParameters: TParameters;
FParamCheck: Boolean;
FCommandTimeout: Integer;
function GetParameters: TParameters;
procedure SetCommandText(const Value: String);
procedure SetParameters(const Value: TParameters);
procedure SetConnection(const Value: TRestConnection);
procedure Connected(Sender: TObject);
protected
CommandType: TCommandType;
procedure AssignCommandText(const Value: WideString; Loading: Boolean = False);
function ComponentLoading: Boolean;
procedure InternalRefreshParameters;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Execute; overload;
published
property Connection: TRestConnection read FConnection write SetConnection;
property CommandText: String read FCommandText write SetCommandText;
property Parameters: TParameters read GetParameters write SetParameters;
property CommandTimeout: Integer read FCommandTimeout write FCommandTimeout default 0;
property ParamCheck: Boolean read FParamCheck write FParamCheck default True;
end;
TRestStoredProc = class(TRestDataset)
public
constructor Create(AOwner: TComponent); override;
procedure ExecProc;
published
property ProcedureName: String read GetCommandText write SetCommandText;
end;Finally I was able to meet the customer requirements. Solution is very fast and quite pleasant in use and maybe useful for someone, so the question is if that solution seems to be useful for anyone except me, so I could create the github repo and extract that mechanism from my project to create the clean one. Unfortunately I cannot fully support this idea because I have a lot of tasks at job.
OK,
I've added FreeAndNil(DocVariantType) to the finalization because exceptions on Delphi closing was extremely annoying.
Create the package that contains:
requires
designide,
adortl,
rtl;
contains
SynCommons in '..\..\Components\mORMot\SynCommons.pas';
every time I'm closing Delphi an exception occurs.
I tried to find out the line of code that could raise an error and found a leak in initialization part:
DocVariantType := TDocVariant(SynRegisterCustomVariantType(TDocVariant));
I suppose that we should free up that object in finalization?
Could you please stop this discussion concerning support for Delphi 7? There is a lot of Delphi 7 users (so am I) and I'm really grateful that AB still supporting that compiler and does not abandon D7 support. I understand that you are throwing your 5 years old Samsung TV to the bin because of end of smart tv support. My Delphi7 works fine, and I have no important argument to move to any newer versions of it. FYI: two months ago I bought 5 RIO Licences with 3 yrs support and I'm almost sure that I will not have time to move to it this year as I tried 3 yrs ago.
End of discussion?
Hehe, ok.
I convinced my team that we must definitely upgrade to the mORMot 2.0, so I replaced a tons of uses units with the 2.0 ones. Have to revert all those changes, I hope they won't kill me now ![]()
No delphi 7 support ![]()
How to implement the decompression of zip file to a directory? The SynZip.pas with their:
zip := TZipRead.Create(zipFile);
try
zip.UnZipAll(filesRootPath);
finally
zip.Free;
end;
is missing.
It looks that Delphi 7 does not fully supports the new units format mormot.core.base: "mormot.core.base is not a valid identifier".
Package -> Add Unit
In my projects I used very often the VariantSaveJSON function. When I moved to mormot 2.0 I see that you removed that function. Can you restore it?
function VariantSaveJSON(const Value: variant; Escape: TTextWriterKind=twJSONEscape): RawUTF8; overload; -> missing
procedure VariantSaveJSON(const Value: variant; Escape: TTextWriterKind;var result: RawUTF8); overload;
Edit: VariantToDateTime also has been removed