You are not logged in.
Pages: 1
The Error is still there ... here a Patch for this
@@ -17867,7 +17867,7 @@
'"': begin
result := From;
PropValue := GetJSONField(From,From,@wasString,@EndOfObject);
- if (PropValue=nil) or (From=nil) or not wasString then
+ if (PropValue=nil) {or (From=nil)} or not wasString then
exit;
Str.Add(UTF8ToString(PropValue));
case EndOfObject of
There is a little bug when using TStrings (e.g. TStringList) in a TSQLRecord
The last entry in the StringList-Data will not restore in the Record:
// SQLite3Commons.pas
function JSONToObject(var ObjectInstance; From: PUTF8Char; var Valid: boolean): PUTF8Char;
...
oStrings: begin
...
'"': begin
result := From;
PropValue := GetJSONField(From,From,@wasString,@EndOfObject);
// After getting the last PropValue From is NIL
// unfortunately this causes an exit, and PropValue will not get into the StringList!
if (PropValue=nil) or (From=nil) or not wasString then
exit;
Str.Add(UTF8ToString(PropValue));
case EndOfObject of
']': break;
',': continue;
else exit;
hmmm, except of the memory leaks, cause the pic Instance will never be freed
The InternalState Property is only filled with data in TSQLRestClientURI.Retrieve
All other Methods declared in TSQLRest did not fill the Property - but they can fill
I just made the changes to TSQLRest.Retrieve(const SQLWhere: RawUTF8; Value: TSQLRecord)
function TSQLRest.Retrieve(const SQLWhere: RawUTF8; Value: TSQLRecord): boolean;
var T: TSQLTable;
begin
if (self=nil) or (Value=nil) then
T := nil else
T := InternalListJSON(Value.RecordClass,Value.RecordProps.
SQLFromSelectWhere('*',SQLWhere+' LIMIT 1'));
if T=nil then
result := false else
try
if T.RowCount>=1 then begin
Value.FillFrom(T,1); // fetch data from first result row
Value.fInternalState := T.InternalState; // the missing row in here
result := true;
end else
result := false;
finally
T.Free;
end;
end;
It's very useful to check the InternalState of the Record against the ServerInternalState, to decide if there are possible changes on the Server.
EDIT
This Method is the only one which did not fill the InternalState of the Record
thanx a lot
As documented in the code
procedure SetInt64Prop(Instance: TObject; PropInfo: PPropInfo; const Value: Int64);
// AB: use the getter field address if no setter (no write attribute) exists
and with this
procedure TSQLRecord.ComputeFieldsBeforeWrite(aRest: TSQLRest; aOccasion: TSQLEvent);
var F: integer;
begin
if (self<>nil) and (aRest<>nil) then
with RecordProps do begin
if HasModTimeFields then
for F := 0 to high(FieldType) do
if FieldType[f]=sftModTime then
SetInt64Prop(Self,Fields[F],aRest.ServerTimeStamp);
if HasCreateTimeField and (aOccasion=seAdd) then
for F := 0 to high(FieldType) do
if FieldType[f]=sftCreateTime then
SetInt64Prop(Self,Fields[F],aRest.ServerTimeStamp);
end;
end;
i would expect that this prop should have been updated by sending back to server:
TSQLMyRec = class( TSQLRecord )
private
fModTime : TModTime;
published
property ModTime : TModTime read fModTime;
end;
but the value will still be 0
Thank u 4 the fix ... well done
Here a small sample project
unit View.Main;
interface
uses
Windows, Messages, SysUtils, Variants, Classes,
Graphics, Controls, Forms, Dialogs, StdCtrls,
SynCommons, SQLite3Commons;
type
TMyItem = class( TCollectionItem )
private
fData : string;
published
property Data : string read fData write fData;
end;
TSQLTest = class( TSQLRecord )
private
fMyColl : TCollection;
public
constructor Create; override;
destructor Destroy; override;
published
property MyColl : TCollection read fMyColl;
end;
TForm1 = class( TForm )
Button1 : TButton;
procedure Button1Click( Sender : TObject );
private
public
end;
var
Form1 : TForm1;
implementation
{$R *.dfm}
{ TSQLTest }
constructor TSQLTest.Create;
begin
inherited;
fMyColl := TCollection.Create( TMyItem );
end;
destructor TSQLTest.Destroy;
begin
fMyColl.Free;
inherited;
end;
procedure TForm1.Button1Click( Sender : TObject );
var
RecSource, RecDest : TSQLTest;
begin
RecDest := TSQLTest.Create;
try
RecSource := TSQLTest.Create;
try
with TMyItem( RecSource.MyColl.Add ) do
begin
Data := 'Have a nice day';
end;
ShowMessage( IntToStr( RecSource.MyColl.Count ) ); // <- Shows 1
RecDest.FillFrom( RecSource );
finally
RecSource.Free;
end;
ShowMessage( IntToStr( RecDest.MyColl.Count ) ); // <- Access Violation!!
finally
RecDest.Free;
end;
end;
end.
TSQLBranch is just a example of what I want
Besides, I want a few more fields in TSQLAuthUser class, like LastName, FirstName, Birthdate, etc...
I can (surely) use a dynamic array of record with these fields. But then lost OOP-flexibility. Can you give me an example of TSQLRestServer.Create() constructor modification? Only a few lines of code that I understand the direction.
Why do u want to blow up the TSQLAuthUser?
This class is for authentication and not saying "Happy Birthday" to the user.
Why not use an extra TSQLRecord (e.g. TSQLExtendUser )
TSQLExtendUser = class( TSQLRecord )
published
property AuthUser : TSQLAuthUser;
property FirstName : SynUnicode;
property LastName : SynUnicode;
property Birthday : TDateTime;
// ... and whatever u like
end;
ok, i've located the problem for both cases in SQLite3Commons.pas
function TSQLRestClientURI.Retrieve(aID: integer; Value: TSQLRecord;
ForUpdate: boolean=false): boolean;
var Table: TSQLRecordClass;
Resp: RawUTF8;
begin
result := false;
if (self=nil) or (aID<=0) or (Value=nil) then
exit;
Table := Value.RecordClass;
// try to get the lock from the local Model
if ForUpdate and not Model.Lock(Table,aID) then
exit; // error marking as locked by the client
// try to get the lock from the Server
with URIGet(Table,aID,Resp,ForUpdate) do
if Lo=200 then begin
// we successfully get the lock from Server
Value.FillFrom(Resp);
Value.fInternalState := Hi;
if ForceBlobTransfert then
result := RetrieveBlobFields(Value) else
result := true;
end;
end;
But what happened if we didn't get a successful lock from the server?
The record in the Model is still marked as locked.
Because of this, we
a) will never get a lock on this record
b) can Unlock a record, even we didn't receive the lock at any time from Server
The solution for this is really simple:
function TSQLRestClientURI.Retrieve(aID: integer; Value: TSQLRecord;
ForUpdate: boolean=false): boolean;
var Table: TSQLRecordClass;
Resp: RawUTF8;
begin
result := false;
if (self=nil) or (aID<=0) or (Value=nil) then
exit;
Table := Value.RecordClass;
if ForUpdate and not Model.Lock(Table,aID) then
exit; // error marking as locked by the client
with URIGet(Table,aID,Resp,ForUpdate) do
if Lo=200 then begin
Value.FillFrom(Resp);
Value.fInternalState := Hi;
if ForceBlobTransfert then
result := RetrieveBlobFields(Value) else
result := true;
end
else
// if we didn't get the lock from the server, we have to unlock the record in the Model :o)
Model.UnLock(Table,aID);
end;
There is IMHO a caching problem with the Locks.
This code works perfect on several clients:
// Lock Record
if not MyClient.Retrieve( DataID, DataRec, True ) then
begin
ShowMessage( 'No Lock' );
Exit;
end;
try
// Performing some actions with DataRec
MyClient.Update( DataRec );
finally
// UnLock Record
MyClient.UnLock( DataRec );
end;
but if a client A tries to get the lock while another client B has already the lock, this client A won't get the lock, even if the lock is released by client B.
It took a small amount of time to get the lock from the server, but after client A didn't get the lock the next Retrieve on that ID is received without this little delay.
Thats why I think it is a caching problem.
Next thing on Locking is:
var
Locked : Boolean;
// Lock Record
Locked := MyClient.Retrieve( DataID, DataRec, True );
try
if Locked then
begin
// Performing some actions with DataRec
MyClient.Update( DataRec );
end;
finally
// UnLock Record
MyClient.UnLock( DataRec ); // UnLocks, even if we haven't got the Lock
end;
when client A gets no lock, because client B has the lock, then performing on client A then
MyClient.UnLock( DataRec )
will UnLock then record.
ok, i could handle this with the code above, but it is strange anyway
http.sys based HTTP server need to register the the URL - so it needs administrator rights.
See the documentation about this subject.
But the documentation also refers to the pure Delphi HTTP Server, which is used, when the http.sys based Server could not started (and this happens when starting without Admin rights).
And thats the main problem with XE2, this pure Delphi Server did not work
i find the solution.
i pass aHandeUserAuthentication = "false" when i create TSQLRestServerDB.
now i see the json data with browser.
Did u compile with XE2 and running NOT with admin rights?
No, also tested with XE2 Update2 ... u still need administrator rights to run the Http-Server
But there is still a difference, when using VirtualTables
here my record
type
TSQLSomeDataReal = class( TSQLRecord )
private
fStrData : SynUnicode;
FStrDataColl : TSomeDataCollection;
public
constructor Create; override;
destructor Destroy; override;
published
property StrData : SynUnicode read fStrData write fStrData;
property StrDataColl : TSomeDataCollection read FStrDataColl;
end;
TSQLSomeDataVirtual = class( TSQLRecordVirtualTableAutoID )
private
fStrData : SynUnicode;
FStrDataColl : TSomeDataCollection;
public
constructor Create; override;
destructor Destroy; override;
published
property StrData : SynUnicode read fStrData write fStrData;
property StrDataColl : TSomeDataCollection read FStrDataColl;
end;
and the creation of the client (and the database)
begin
Model := TSQLModel.Create( [TSQLSomeDataReal, TSQLSomeDataVirtual] );
Model.VirtualTableRegister( TSQLSomeDataVirtual, TSQLVirtualTableJSON );
fClient := TSQLRestClientDB.Create( Model, nil, TSQLDatabase.Create( ChangeFileExt( ParamStr( 0 ), '.db' ) ),
TSQLRestServerDB );
( fClient as TSQLRestClientDB ).Server.CreateMissingTables( 0 );
( fClient as TSQLRestClientDB ).Server.CreateSQLIndex( TSQLSomeDataReal, 'StrData', True );
end;
but there will be no UNIQUE INDEX in the database
without the VirtualTable
begin
Model := TSQLModel.Create( [TSQLSomeDataReal] );
fClient := TSQLRestClientDB.Create( Model, nil, TSQLDatabase.Create( ChangeFileExt( ParamStr( 0 ), '.db' ) ),
TSQLRestServerDB );
( fClient as TSQLRestClientDB ).Server.CreateMissingTables( 0 );
( fClient as TSQLRestClientDB ).Server.CreateSQLIndex( TSQLSomeDataReal, 'StrData', True );
end;
the UNIQUE INDEX works as expected
upps ... you are totally right
after building a test case, everything works fine ...
The record MUST be a TSQLRecord descendant.
it is ... not really TSQLRecord, but TSQLRecordVirtual, cause otherwise I can't register this as a virtual table
TMyData1Temp = class( TSQLRecordVirtual )
published
property MyCollection : TCollection read GetMyCollection;
end;
...
MyModel.VirtualTableRegister( TMyData1Temp, TSQLVirtualTableJSON );
so if i had to use a TSQLRecord descendant, how do I register as a virtual table?
While checking out the TSQLVirtualTable i got some strange behavior with them
At first i have a virtual table:
MyModel.VirtualTableRegister( TSQLMyData1Temp, TSQLVirtualTableJSON );
Sending and retrieving data works fine ... but there is some data missing.
The Record contains a collection and the collection data is missing in the file ... where has it gone?
Switching the table into a normal TSQLRecord everything is fine - also the collection data exists in the sqlite file.
Yes, now it works
:o)
I just take the Sample1 to point out the strange behavior
A little bit more complex Record ;o)
TSQLSampleRecord = class(TSQLRecord)
private
...
published
property Time: TDateTime read fTime write fTime;
property Name: RawUTF8 read fName write fName;
property Question: RawUTF8 read fQuestion write fQuestion;
property Data1: RawUTF8 read FData1 write FData1;
property Data2: RawUTF8 read FData2 write FData2;
property Data3: RawUTF8 read FData3 write FData3;
end;
and the modified Method in Sample1:
{$DEFINE TESTFILL}
procedure TForm1.FindButtonClick(Sender: TObject);
var Rec: TSQLSampleRecord;
begin
{$IFDEF TESTFILL}
Rec := TSQLSampleRecord.CreateAndFillPrepare(Database,'Name="%"',[StringToUTF8(NameEdit.Text)],'Name,Question');
try
// Rec.ClearProperties; // makes no difference
if not Rec.FillOne then
{$ELSE}
Rec := TSQLSampleRecord.Create(Database,'Name="%"',[StringToUTF8(NameEdit.Text)]);
try
if Rec.ID = 0 then
{$ENDIF}
QuestionMemo.Text := 'Not found' else
QuestionMemo.Text := UTF8ToString(Rec.Question) + '/' +UTF8ToString(Rec.Data1) + '/' +UTF8ToString(Rec.Data3) + '/' +UTF8ToString(Rec.Data3);
finally
Rec.Free;
end;
end;
Running the App in normal way I enter as name 'myname' and as message 'mymessage' and send the message
I type again the name and "Find previous message"
The Result is as expected
mymessage///
ok, that was easy, now we try this with CreateAndFillPrepare
Following the same steps as above will lead us to the following result:
myname/myname/myname/myname
It seems, that the JSONTable is a little bit to busy (and also confused) in filling the field values
The normal way to retrieve some records is this, which is quite clear and handsome
if MyRecord.FillPrepare( MyClient, 'IntData=?', [], [1] ) then
while MyRecord.FillOne do
begin
// do something very important
end;
But if we get no result from FillPrepare we will get an Exception from FillOne
// Fill with definitive no Rows just for testing
if MyRecord.FillPrepare( MyClient, '1=0', [], [] ) then // is true because the statement is correct
while MyRecord.FillOne do // <-- here we get an exception
begin
// do something very important
end;
Is this behavior a feature?
The fix is really simple to do
function TSQLRecord.FillOne: boolean;
begin
if (self=nil) or (fFill=nil) or (fFill.Table=nil) or
(fFill.Table.RowCount=0) or // <-- also check if FillTable is emtpy
(cardinal(fFill.FillCurrentRow)>cardinal(fFill.Table.RowCount)) then
result := false else begin
FillRow(fFill.FillCurrentRow);
inc(fFill.FillCurrentRow);
result := true;
end;
end;
The API-Server works fine but not the Delphi-THttpServer.
With Delphi XE no problems, just with XE2 (32bit)
Seems that the Server is responding, but it delivers no JSON-Results
Thanx
I found a small bug in that method.
After executing SetUser with no User and Password (could be used as a Logout) all Session-Values are cleared except the SessionUser-Prop.
So after that, the SessionUser-Prop is still assigned, but no User is logged in.
function TSQLRestClientURI.SetUser(const aUserName, aPassword: RawUTF8): boolean;
var aNonce, aClientNonce, aSessionKey: RawUTF8;
i: integer;
U: TSQLAuthUser;
begin
result := false;
if self=nil then
exit;
fSessionID := 0;
fSessionIDHexa8 := '';
fSessionPrivateKey := 0;
if (self=nil) or (aUserName='') then
exit;
FreeAndNil(fSessionUser); // <-- Seems to be a little bit too late, should be freed earlier
U := TSQLAuthUser.Create;
try
...
a possible fix is to free the SessionUser before the possible exit
...
fSessionPrivateKey := 0;
FreeAndNil(fSessionUser); // <-- now, we can exit if needed with no risk
if (self=nil) or (aUserName='') then
exit;
// FreeAndNil(fSessionUser); // <-- Seems to be a little bit too late, should be freed earlier
U := TSQLAuthUser.Create;
try
...
Pages: 1