mORMot Open Source

// 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;

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;

procedure SetInt64Prop(Instance: TObject; PropInfo: PPropInfo; const Value: Int64);
// AB: use the getter field address if no setter (no write attribute) exists

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;

TSQLMyRec = class( TSQLRecord )
private
  fModTime : TModTime;
published
  property ModTime : TModTime read fModTime;
end;

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.

MyModel.VirtualTableRegister( TSQLMyData1Temp, TSQLVirtualTableJSON );

  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;

{$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;

mymessage///

myname/myname/myname/myname

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
    ...  

  ...
  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
    ...