Posts by yurasek

yurasek · mORMot 1

Thank you for your help.
I fixed code, now it works.
In the example I have one more mistake - I have the wrong published section for TSQLServiceState.

yurasek · mORMot 1

I can not understand how the most simple to convert a lot of records SQLRecord to JSON, and then back again, but without the use of TSQLRestServerFullMemory?

I try so, but the first call SQLServiceState.FillOne returns False:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Mormot, StdCtrls, SynCommons;

type

  TSQLServiceState = class(TSQLRecord)
  private
    FState: Integer;
    FUpdated: Double;
  private
    property State: Integer read FState write FState;
    property Updated: Double read FUpdated write FUpdated;
  end;

  TForm1 = class(TForm)
    Memo1: TMemo;
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

const
  Raws = 5;

var
  Form1: TForm1;
  JSON: RawUTF8;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
  TextWriter: TTextWriter;
  i: Integer;
begin
  JSON:= '';
  Randomize;
  TextWriter:= TTextWriter.CreateOwnedStream;
  try
    for i:= 1 to Raws do
      TextWriter.AddJSONEscape(['Id', i, 'Updated', Now + Random(100), 'State', Random(100)]);
    JSON:= TextWriter.Text;
  finally
    TextWriter.Free
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  SQLServiceState: TSQLServiceState;
begin
  SQLServiceState:= TSQLServiceState.CreateAndFillPrepare(JSON);
  try
    while SQLServiceState.FillOne do //why False?
      begin
        Memo1.Lines.Add('Id : ' + IntToStr(SQLServiceState.ID));
        Memo1.Lines.Add('Updated : ' + DateTimeToStr(SQLServiceState.Updated));
        Memo1.Lines.Add('State : ' + IntToStr(SQLServiceState.State));
      end;
  finally
    SQLServiceState.Free;
  end;
end;

end.

yurasek · mORMot 1

In Delphi, there are some problems that occur at operations with non-integer numbers. Here's a simple example:

procedure CheckDoublePrecision;
var
  t1, t2: TDateTime;
  S: String;
begin
  t1:= EncodeDateTime(2014, 1, 8, 1, 0, 0, 0); //t1 = $40E455E155555555
  S:= DoubleToStr(t1); 
  DecimalSeparator:= '.';
  t2:= StrToFloat(S);//t2 = $40E455E15555555A
  if t1 <> t2 then
    ShowMessage('t1 <> t2');
end;

When the value DOUBLE_PRECISION = 15, then due to the nature of rounding produces a different value t1. As a solution you can increase the DOUBLE_PRECISION to 17, that would solve a number of problems:
- operations of converting a Double to a string and vice versa will occur without loss;
- Double values will be correctly stored in the database and retrieved from it.

A simple example to verify the correctness of rounding:

procedure CheckDoublePrecision2;
var
  t1, t2: TDateTime;
  i: Integer;
  S: String;
begin
  DecimalSeparator:= '.';
  t1:= EncodeDateTime(2014, 1, 8, 1, 0, 0, 0);
  for i:= 0 to 10000000 do
    begin
      S:= DoubleToStr(t1);
      t2:= StrToFloat(S);
      if t1 <> t2 then
        begin
          ShowMessage('Failed on ' + S);
          Exit;
        end;
      Inc(PInt64(@t1)^);
    end;
end;

Conceptual example of data distortion:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Mormot, mORMotSQLite3, SynSQLite3Static, DateUtils, StdCtrls;

type
  TSQLSampleRecord = class(TSQLRecord)
  private
    fValue: Double;
  published
    property Value: Double read fValue write fValue;
  end;

  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
var
  Sample: TSQLSampleRecord;
  DB: TSQLRestServerDB;
  t: Double;
begin
  t:= EncodeDateTime(2014, 1, 8, 1, 0, 0, 0);
  DB:= TSQLRestServerDB.Create(TSQLModel.Create([TSQLSampleRecord]),
    ExtractFilePath(Application.ExeName) + 'sample.db', True);
  try
    DB.Model.Owner:= DB;
    DB.CreateMissingTables(0);
    DB.Delete(TSQLSampleRecord, 1);
    Sample:= TSQLSampleRecord.Create;
    try
      Sample.ID:= 1;
      Sample.Value:= t;
      DB.Add(Sample, True, True);
      if DB.Retrieve(1, Sample) then
        begin
          //now in hex
          //t = $40E455E155555555
          //Sample.Value = $$40E455E15555555A
          if t <> Sample.Value then
            ShowMessage('t and Sample.Value are different!');
        end;
    finally
      Sample.Free;
    end;
  finally
    DB.Free;
  end;
end;

end.

yurasek · mORMot 1

ab wrote:

Do you want to have some events triggered at specific states, that's it?

Yes it is. Not enough events by which a client could see that sessions has timed out or lost connection.

yurasek · mORMot 1

What is the most optimal method can be used to monitor client-side session timeout or disconnection?

yurasek · mORMot 1

I'm using is not very good practice when in the back end in a separate thread is infinitely open and close a transaction with a certain interval, that allows to reach high-speed inserting.

yurasek · mORMot 1

When at least one user (local or remote) starts a transaction, then all the other record of any data will fail until the transaction is closed. In older versions of the framework transaction was common to all connections, how can enable this mechanism work?

P.S. Figured out yourself: it is necessary to use methods TSQLRestServerDB.DB.TransactionBegin() and TSQLRestServerDB.DB.Commit().

yurasek · mORMot 1

I created a small example that demonstrates the bug using the virtual tables. After pressing the Button1 in the back end is the following error:

Exception class ESQLite3Exception with message 'no such column: ID'

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Mormot, SynCommons, mORMotSQLite3, SynSQLite3Static,
  mORMotHttpServer, mORMotHttpClient;

type
  TSQLValue1 = class(TSQLRecord)
  private
    fValue1: Integer;
  published
    property Value1: Integer read fValue1 write fValue1;
  end;

  TSQLValue2 = class(TSQLRecord)
  private
    fValue2: Integer;
  published
    property Value2: Integer read fValue2 write fValue2;
  end;

  TSQLServer = class(TSQLRestServerDB)
  private
    FModel: TSQLModel;
    FServer: TSQLHttpServer;
  public
    constructor Create;
    destructor Destroy;
  end;

  TSQLClient = class(TSQLHttpClient)
  private
    FModel: TSQLModel;
  public
    constructor Create;
    destructor Destroy;
  end;

  TForm1 = class(TForm)
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  public
    Client: TSQLClient;
    Server: TSQLServer;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function CreateModel: TSQLModel;
begin
  Result:= TSQLModel.Create([TSQLAuthGroup, TSQLAuthUser, TSQLValue2, TSQLValue1]);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Server:= TSQLServer.Create;
  Client:= TSQLClient.Create;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  Client.Free;
  Server.Free;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  SQLValue1: TSQLValue1;
  SQLValue2: TSQLValue2;
begin
  SQLValue1:= TSQLValue1.CreateAndFillPrepare(Client, '');
  SQLValue1.Free;
  SQLValue2:= TSQLValue2.CreateAndFillPrepare(Client, '');
  SQLValue2.Free;
end;

constructor TSQLServer.Create;
begin
  FModel:= CreateModel;
  FModel.VirtualTableRegister(TSQLValue1, TSQLVirtualTableJSON);
  FModel.VirtualTableRegister(TSQLValue2, TSQLVirtualTableJSON);
  inherited Create(FModel, ChangeFileExt(ParamStr(0), '.db'), True);
  Self.CreateMissingTables(0);
  FServer:= TSQLHttpServer.Create('8080', Self);
end;

destructor TSQLServer.Destroy;
begin
  FServer.Free;
  inherited;
  FModel.Free;
end;

constructor TSQLClient.Create;
begin
  FModel:= CreateModel;
  inherited Create('127.0.0.1', '8080', FModel);
  Self.SetUser('Admin', 'synopse');
end;

destructor TSQLClient.Destroy;
begin
  inherited;
  FModel.Free;
end;

end.

The error appears here:

result ^. Prepare (DB.DB, SQL);

function TSQLRestServerDB.GetAndPrepareStatement(const SQL: RawUTF8): PSQLRequest;
var i, maxParam: integer;
    Types: TSQLParamTypeDynArray;
    Nulls: TSQLFieldBits;
    Values: TRawUTF8DynArray;
    GenericSQL: RawUTF8;
begin
  GenericSQL := ExtractInlineParameters(SQL,Types,Values,maxParam,Nulls);
  if maxParam=0 then begin
    // SQL code with no valid :(...): internal parameters
    if not (IdemPChar(pointer(SQL),'INSERT INTO ') and
            (PosEx(' DEFAULT VALUES;',SQL,13)=Length(SQL)-15)) then begin
      result := @fStaticStatement;
      result^.Prepare(DB.DB,SQL);
      DB.Log.Log(sllSQL,'% is no prepared statement',SQL,self);
      exit;
    end;
  end;
  DB.Log.Log(sllSQL,'% prepared as % with % param',[SQL,GenericSQL,maxParam],self);
  result := fStatementCache.Prepare(GenericSQL);
  // bind parameters
  assert(sqlite3.bind_parameter_count(result^.Request)=maxParam);
  for i := 0 to maxParam-1 do
  if i in Nulls then
    result^.BindNull(i) else
    case Types[i] of
      sptDateTime, // date/time are stored as ISO-8601 TEXT in SQLite3
      sptText:    result^.Bind(i+1,Values[i]);
      sptBlob:    result^.Bind(i+1,pointer(Values[i]),length(Values[i]));
      sptInteger: result^.Bind(i+1,GetInt64(pointer(Values[i])));
      sptFloat:   result^.Bind(i+1,GetExtended(pointer(Values[i])));
    end;
end;

yurasek · mORMot 1

ab, mpv, you are absolutely right. I wanted to save by using the field ID, but as I understand it better and more correct to add a new field. Thank you.

yurasek · mORMot 1

It seems to me, TSQLRestClient is lacking such method as

function TSQLRestClient.Update(Value: TSQLRecord; ID: integer): boolean; override;

Sometimes it is necessary to update the ID for the record, and this method would be useful.

yurasek · mORMot 1

I found a small error when working with TDateTime in the implementation of the method TInterfacedObjectFake.FakeCall (unit SQLite3Commons)

Current version

function TInterfacedObjectFake.FakeCall(var aCall: TFakeCallStack): Int64;
{...}
begin
{...}
      if ValueDirection=smdResult then
      case ValueType of // ordinal/real result values to CPU/FPU registers
      smvBoolean..smvInt64: Move(V^,result,SizeInStorage);   // al/ax/eax/eax:edx
      smvDouble:   asm mov eax,V; fld  qword ptr [eax] end;  // in st(0)
      smvCurrency: asm mov eax,V; fild qword ptr [eax] end;  // in st(0)
      end;
    end;
  end;
end;

Corrected version

function TInterfacedObjectFake.FakeCall(var aCall: TFakeCallStack): Int64;
{...}
begin
{...}
      if ValueDirection=smdResult then
      case ValueType of // ordinal/real result values to CPU/FPU registers
      smvBoolean..smvInt64: Move(V^,result,SizeInStorage);   // al/ax/eax/eax:edx
      smvDouble, smvDateTime: asm mov eax,V; fld  qword ptr [eax] end;  // in st(0)
      smvCurrency: asm mov eax,V; fild qword ptr [eax] end;  // in st(0)
      end;
    end;
  end;
end;

yurasek · mORMot 1

The problem is this: if you use a table with a unique field, then after trying to add a record with an existing value of adding a new record with a nonexistent value is always an error. Re-add the same record is successful.
Example of incorrect behavior of add a record:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, SQLite3Commons, SQLite3;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

  TSQLTest = class(TSQLRecord)
  private
    fTest: Integer;
  published
    property Test: Integer read fTest write fTest stored False;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
  SQLModel: TSQLModel;
  SQLServer: TSQLRestServerDB;
  SQLTest: TSQLTest;
begin
  SQLModel:= TSQLModel.Create([TSQLTest]);
  SQLServer:= TSQLRestServerDB.Create(SQLModel, ChangeFileExt(ParamStr(0), '.db'));
  SQLServer.CreateMissingTables(0);
  SQLServer.EngineExecuteAll('DELETE FROM Test');
  SQLTest:= TSQLTest.Create;
  SQLTest.Test:= 1;
  SQLServer.Add(SQLTest, True);
  if SQLServer.Add(SQLTest, True) = 0 then
    ShowMessage('Error 1'); //correct behavior, because record with the same value exists
  SQLTest.Test:= 2;         //change the value in the record
  if SQLServer.Add(SQLTest, True) = 0 then
    ShowMessage('Error 2'); //why?
  if SQLServer.Add(SQLTest, True) = 0 then
    ShowMessage('Error 3'); //re-adding does not cause errors
  SQLTest.Free;
  SQLServer.Free;
  SQLModel.Free
end;

end.

yurasek · mORMot 1

ab
Now works fine. Thank you for your work.

yurasek · mORMot 1

I've studied the documentation on the use of built-in authentication, but it is very detailed implementation, but it lacks a simple example of use. In my example, the subject matter.

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, SQLite3Commons, SQLite3, SQLite3HttpServer, SQLite3HttpClient;

type
  TSQLSampleRecord = class(TSQLRecord)
  private
    fCount: Integer;
  published
    property Count: Integer read fCount write fCount;
  end;

  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    FClient: TSQLite3HttpClient;
    FServer: TSQLite3HttpServer;
    FModel: TSQLModel;
    FDB: TSQLRestServerDB;
  public
    function CreateSampleModel: TSQLModel;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{ TForm1 }

function TForm1.CreateSampleModel: TSQLModel;
begin
  Result:= TSQLModel.Create([TSQLAuthGroup, TSQLAuthUser, TSQLSampleRecord]);
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  Sample: TSQLSampleRecord;
  Table: TSQLTableJSON;
begin
  FModel:= CreateSampleModel;
  FDB:= TSQLRestServerDB.Create(FModel, ExtractFilePath(Application.ExeName) + 'sample.db', True);
  FDB.CreateMissingTables(0);
  FDB.EngineExecuteAll('DELETE FROM SampleRecord');
  FDB.EngineExecuteAll('UPDATE sqlite_sequence SET seq = 0 WHERE name = "SampleRecord"');
  Sample:= TSQLSampleRecord.Create;
  Sample.Count:= 1;
  FDB.Add(Sample, True);
  Sample.Count:= 2;
  FDB.Add(Sample, True);
  Sample.Count:= 3;
  FDB.Add(Sample, True);
  FServer:= TSQLite3HttpServer.Create('8080', FDB);
  FClient:= TSQLite3HttpClient.Create('localhost', '8080', FModel, False);
  FClient.KeepAliveMS:= 0;
  FClient.SetUser('Admin', 'synopse');
  if not FClient.Delete(TSQLSampleRecord, 3) then  //the result is always true, even if the record with this ID does not exist
    ShowMessage('Failed to Delete!');
  Sample.Count:= 4;
  if FClient.Add(Sample, True) = 0 then
    ShowMessage('Failed to Add!');
  Sample.ID:= 1;
  Sample.Count:= 5;
  if not FClient.Update(Sample) then
    ShowMessage('Failed to Update!');
  Table:= FClient.MultiFieldValues(TSQLSampleRecord, '');
  if Assigned(Table) then
    begin

      Table.Free;
    end
  else
    ShowMessage('Failed to Select!'); //why and how to make it work?
  Sample.Free;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  FClient.Free;   //EAccessViolation at address 00AFB31F. Write of address 018F0BAD.
  FServer.Free;
  FDB.Free;
  FModel.Free;
end;

end.

yurasek · mORMot 1

I can not understand with built-in authentication mechanisms. Using even the Admin user with rights by default, I can not get the table contents using the method MultiFieldValues, as well as get the value of a single record using the methods Retrieve and OneFieldValue. Why is this may be related, as the user Admin property AllowRemoteExecute = True? In addition, these methods as Update, Delete, Add operate properly, but after they call while trying to free copy of class TSQLite3HttpClient exception occurs in the method TSQLite3HttpClientWinGeneric.InternalRequest on function fWinAPI.Request.

yurasek · mORMot 1

Were you able to reproduce the situation with a simultaneous change in the database in two or more threads, when this error occurs?
Here is an example of the log when my program tries to add data to the wrong table (in my case, the data were to be added to the table Value but not Data:

2011-05-10 18:26:16 TSQLRestServerDB.EngineExecute: unknown error  INSERT INTO Data (Time,TId,Bus,Address,Counter,Value) VALUES (:(40673.7682443171288):,:(123427):,:(1):,:(10):,:(16):,:(531):);

Very often when you use the client part implemented by TSQLite3HttpClient function MultiFieldValues when selecting data sometimes does not return, which probably also related to mistakes in the implementation of thread-safe.

yurasek · mORMot 1

I'm using the latest version.
In my application into a database saved a lot of small records and without the use of a transaction can not do.
In the examples and documentation I have not found a way how to open the transaction for several tables, but as I understand the use of the following construction is completely correct:

FDB.TransactionBegin(TSQLSampleRecord1);
FDB.TransactionBegin(TSQLSampleRecord2);
FDB.TransactionBegin(TSQLSampleRecord3);
FDB.Commit;

As far as I understand the use of class methods TSQLRestServerDB thread-safe. So why can not I execute a transaction in a separate thread?

yurasek · mORMot 1

First of all, thank you so much for developing the framework. The latest versions of framework I was faced with some errors when developing multithreaded applications. For some unknown reason, when you add or change records in multithreaded applications, there are exceptions to the form

Project Server.exe raised exception class ESQLException with message 'table SampleRecord1 has no column named Count3.'

That is, when adding a record SampleRecord1 with field Count1 or a record SampleRecord3 with field Count3 there is a distortion of data, resulting in an error.
Here is an example of code that causes an error:

unit uServer;

interface

uses
  Windows, Messages, SysUtils, Classes, Controls, Forms,
  SQLite3Commons, SQLite3, StdCtrls, SyncObjs;

type
  TSQLSampleRecord1 = class(TSQLRecord)
  private
    fCount: Integer;
  published
    property Count1: Integer read fCount write fCount;
  end;

  TSQLSampleRecord2 = class(TSQLRecord)
  private
    fCount: Integer;
  published
    property Count2: Integer read fCount write fCount;
  end;

  TSQLSampleRecord3 = class(TSQLRecord)
  private
    fCount: Integer;
  published
    property Count3: Integer read fCount write fCount;
  end;

  TDBThread = class(TThread)
  private
    FDB: TSQLRestServerDB;
    FEvent: THandle;
  public
    constructor Create(DB: TSQLRestServerDB);
    destructor Destroy; override;
    procedure Execute; override;
  end;

  TSampleThread = class(TThread)
  private
    FSQLRecordClass: TSQLRecordClass;
    FDB: TSQLRestServerDB;
    FId: Cardinal;
    FCount: Integer;
  public
    constructor Create(DB: TSQLRestServerDB; SQLRecordClass: TSQLRecordClass);
    destructor Destroy; override;
    procedure Execute; override;
    procedure Info;
  end;

  TSampleForm = class(TForm)
    LogMemo: TMemo;
    StartButton: TButton;
    StopButton: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure StartButtonClick(Sender: TObject);
    procedure StopButtonClick(Sender: TObject);
  private
    function CreateSampleModel: TSQLModel;
  public
    Model: TSQLModel;
    DB: TSQLRestServerDB;
    SampleThread1: TSampleThread;
    SampleThread2: TSampleThread;
    SampleThread3: TSampleThread;
    DBThread: TDBThread;
  end;

var
  SampleForm: TSampleForm;
  CS: TCriticalSection;

implementation

{$R *.dfm}
{.$define CS}

function TSampleForm.CreateSampleModel: TSQLModel;
begin
  Result:= TSQLModel.Create([TSQLSampleRecord1, TSQLSampleRecord2, TSQLSampleRecord3]);
end;

constructor TDBThread.Create(DB: TSQLRestServerDB);
begin
  FDB:= DB;
  FEvent:= CreateEvent(nil, False, False, nil);
  inherited Create(False);
end;

procedure TDBThread.Execute;
begin
  inherited;
  {$ifdef CS}
  CS.Enter;
  {$endif CS}
  try
    FDB.TransactionBegin(TSQLSampleRecord1);
    FDB.TransactionBegin(TSQLSampleRecord2);
    FDB.TransactionBegin(TSQLSampleRecord3);
  finally
    {$ifdef CS}
    CS.Leave;
    {$endif CS}
  end;
  while not Terminated and (WaitForSingleObject(FEvent, 5000) <> WAIT_OBJECT_0) do
    begin
      {$ifdef CS}
      CS.Enter;
      {$endif CS}
      try
        FDB.Commit;
        FDB.TransactionBegin(TSQLSampleRecord1);
        FDB.TransactionBegin(TSQLSampleRecord2);
        FDB.TransactionBegin(TSQLSampleRecord3);
      finally
        {$ifdef CS}
        CS.Leave;
        {$endif CS}
      end;
    end;
  {$ifdef CS}
  CS.Enter;
  {$endif CS}
  try
    FDB.Commit;
  finally
    {$ifdef CS}
    CS.Leave;
    {$endif CS}
    CloseHandle(FEvent);
  end;
end;

destructor TDBThread.Destroy;
begin
  SetEvent(FEvent);
  WaitFor;
  inherited;
end;

procedure TSampleForm.FormCreate(Sender: TObject);
begin
  CS:= TCriticalSection.Create;
  Model:= CreateSampleModel;
  DB:= TSQLRestServerDB.Create(Model, ExtractFilePath(Application.ExeName) + 'sample.db');
  DB.CreateSQLIndex(TSQLSampleRecord1, ['Count1'], False);
  DB.CreateSQLIndex(TSQLSampleRecord2, ['Count2'], False);
  DB.CreateSQLIndex(TSQLSampleRecord3, ['Count3'], False);
  DB.CreateMissingTables(0);
end;

procedure TSampleForm.FormDestroy(Sender: TObject);
begin
  if StopButton.Enabled then
    StopButton.Click;
  DB.Free;
  Model.Free;
  CS.Free;
end;

procedure TSampleThread.Execute;
var
  Rec1: TSQLSampleRecord1;
  Rec2: TSQLSampleRecord2;
  Rec3: TSQLSampleRecord3;
begin
  FId:= GetCurrentThreadId;
  if FSQLRecordClass.ClassName = 'TSQLSampleRecord1' then
    begin
      Rec1:= TSQLSampleRecord1.Create;
      while not Terminated do
        begin
          Randomize;
          Rec1.Count1:= Random(2000);
          {$ifdef CS}
          CS.Enter;
          {$endif CS}
          try
            FDB.Add(Rec1, True);
          finally
            {$ifdef CS}
            CS.Leave;
            {$endif CS}
          end;
          Inc(FCount);
          if FCount mod 1000 = 0 then
            Synchronize(Info);
          Sleep(1);
        end;
      Rec1.Free;
    end
  else
    if FSQLRecordClass.ClassName = 'TSQLSampleRecord2' then
      begin
        Rec2:= TSQLSampleRecord2.Create;
        while not Terminated do
          begin
            Randomize;
            Rec2.Count2:= Random(2000);
            {$ifdef CS}
            CS.Enter;
            {$endif CS}
            try
              FDB.Add(Rec2, True);
            finally
              {$ifdef CS}
              CS.Leave;
              {$endif CS}
            end;
            Inc(FCount);
            if FCount mod 1000 = 0 then
              Synchronize(Info);
            Sleep(1);
          end;
        Rec2.Free;
      end
    else
      begin
        Rec3:= TSQLSampleRecord3.Create;
        while not Terminated do
          begin
            Randomize;
            Rec3.Count3:= Random(2000);
            {$ifdef CS}
            CS.Enter;
            {$endif CS}
            try
              FDB.Add(Rec3, True);
            finally
              {$ifdef CS}
              CS.Leave;
              {$endif CS}
            end;
            Inc(FCount);
            if FCount mod 1000 = 0 then
              Synchronize(Info);
            Sleep(1);
          end;
        Rec3.Free;
      end;
end;

constructor TSampleThread.Create(DB: TSQLRestServerDB; SQLRecordClass: TSQLRecordClass);
begin
  FSQLRecordClass:= SQLRecordClass;
  FCount:= 0;
  FDB:= DB;
  inherited Create(True);
end;

destructor TSampleThread.Destroy;
begin
  Terminate;
  WaitFor;  
  inherited;
end;

procedure TSampleThread.Info;
begin
  SampleForm.LogMemo.Lines.Add(FormatDateTime('hh:mm:ss.zzz', Now) + ' [thread ' + IntToStr(FId) + ']: ' + IntToStr(FCount));
end;

procedure TSampleForm.StartButtonClick(Sender: TObject);
begin
  StartButton.Enabled:= False;
  DBThread:= TDBThread.Create(DB);
  SampleThread1:= TSampleThread.Create(DB, TSQLSampleRecord1);
  SampleThread2:= TSampleThread.Create(DB, TSQLSampleRecord2);
  SampleThread3:= TSampleThread.Create(DB, TSQLSampleRecord3);
  SampleThread1.Resume;
  SampleThread2.Resume;
  SampleThread3.Resume;
  StopButton.Enabled:= True;
end;

procedure TSampleForm.StopButtonClick(Sender: TObject);
begin
  StopButton.Enabled:= False;
  SampleThread3.Free;
  SampleThread2.Free;
  SampleThread1.Free;
  DBThread.Free;
  StartButton.Enabled:= True;
end;

end.

mORMot Open Source

#1 Re: mORMot 1 » How to simply convert TSQLRecord > JSON > TSQLRecord? » 2014-12-27 23:01:33

#2 mORMot 1 » How to simply convert TSQLRecord > JSON > TSQLRecord? » 2014-12-27 13:54:52

#3 mORMot 1 » Double_Precision » 2014-01-08 09:08:24

#4 Re: mORMot 1 » Client monitoring session timeout or disconnection » 2013-10-17 19:56:06

#5 mORMot 1 » Client monitoring session timeout or disconnection » 2013-10-17 05:12:18

#6 Re: mORMot 1 » Shared transaction between user sessions » 2013-10-09 20:52:42

#7 mORMot 1 » Shared transaction between user sessions » 2013-10-09 20:24:26

#8 mORMot 1 » Strange behavior when using the virtual tables (no such column: ID) » 2013-05-18 07:49:37

#9 Re: mORMot 1 » Additional method of TSQLRestClient.Update » 2012-05-18 09:06:38

#10 mORMot 1 » Additional method of TSQLRestClient.Update » 2012-05-17 22:22:50

#11 mORMot 1 » Small error in TInterfacedObjectFake.FakeCall » 2012-05-17 15:48:08

#12 mORMot 1 » Strange behavior when adding a record » 2012-01-05 22:49:11

#13 Re: mORMot 1 » Framework authentication » 2011-10-18 07:27:17

#14 Re: mORMot 1 » Framework authentication » 2011-10-16 16:08:54

#15 mORMot 1 » Framework authentication » 2011-10-15 20:48:40

#16 Re: mORMot 1 » SQLite3 Framework and multi-threading » 2011-05-13 07:24:27

#17 Re: mORMot 1 » SQLite3 Framework and multi-threading » 2011-05-10 08:40:11

#18 mORMot 1 » SQLite3 Framework and multi-threading » 2011-05-09 22:59:55

Board footer