mORMot Open Source

program Project1;

{$APPTYPE CONSOLE}

{$R *.res}

uses
  System.SysUtils, SynCommons, system.Classes, SynDB, SynTable, ZDbcIntfs, SynDBZeos, mORMot, mORMotDB, mORMotSQLite3,
  SynSQLite3Static, mORMotHttpServer, mORMotHttpClient;

type
  TSimpleRecord = class(TSQLRecord)
  private
    FChangeTime: TDateTime;
  published
    property ChangeTime: TDateTime read FChangeTime write FChangeTime;
  end;

var
  vCommandLine: TCommandLine;
  vMode: RawUTF8;

const
  cServerPort = '8080';
  cConnectStr = '{"Kind":"TSQLDBZEOSConnectionProperties","ServerName":"firebird://",' +
                '"DatabaseName":"d:\\Projects\\Tests\\REC_VERSION_TEST.FDB","User":"SYSDBA","Password":"HuYxjMYsqbe2"}'; //HuYxjMYsqbe2  = masterkey

procedure RunServer;
var
  vDBConnectionParams: TSQLDBZEOSConnectionProperties;
  vModel: TSQLModel;
  vRestServer: TSQLRestServerDB;
  vHttpServer: TSQLHttpServer;
  vSimpleRecord: TSimpleRecord;
begin
  Writeln('RunServer');
  TAutoFree.One(vDBConnectionParams, TSQLDBZEOSConnectionProperties.CreateFromJSON(cConnectStr) as TSQLDBZEOSConnectionProperties);
//  vDBConnectionParams.ZeosURL.Properties.Add('hard_commit=true');
  vModel := TSQLModel.Create([TSimpleRecord]);
  VirtualTableExternalRegisterAll(vModel, vDBConnectionParams, True);
  TAutoFree.One(vRestServer, TSQLRestServerDB.Create(vModel, ':memory:'));
  vRestServer.Model.Owner := vRestServer;
  vRestServer.AcquireExecutionMode[execORMGet] := amBackgroundORMSharedThread;
  vRestServer.AcquireExecutionMode[execORMWrite] := amBackgroundORMSharedThread;
  vRestServer.CreateMissingTables;
  if vRestServer.TableRowCount(TSimpleRecord) = 0 then
    begin
      TAutoFree.One(vSimpleRecord, TSimpleRecord.Create);
      vSimpleRecord.ChangeTime := Now;
      vRestServer.Add(vSimpleRecord, True);
    end;
  TAutoFree.One(vHttpServer, TSQLHttpServer.Create(cServerPort, [vRestServer], '+', useHttpApiRegisteringURI));
  vHttpServer.AccessControlAllowOrigin := '*';
  Writeln('Server is now running on http://localhost:' + cServerPort + '/root'#13#10#13#10+'Press [Enter] to quit');
  Readln;
end;

procedure RunClient;
var
  i: Integer;
  vModel: TSQLModel;
  vHttpClient: TSQLHttpClient;
  vSimpleRecord: TSimpleRecord;
begin
  Writeln('RunClient');
  vModel := TSQLModel.Create([TSimpleRecord]);
  TAutoFree.One(vHttpClient, TSQLHttpClient.Create('localhost', cServerPort, vModel));
  vHttpClient.Model.Owner := vHttpClient;
  TAutoFree.One(vSimpleRecord, TSimpleRecord.Create);
  vHttpClient.Retrieve(1, vSimpleRecord);
  i := 0;
  while true do
    begin
      inc(i);
      vSimpleRecord.FChangeTime := now;
      if vHttpClient.Update(vSimpleRecord) then
        Writeln('Udate #' + i.ToString);
      Sleep(100);
      if ConsoleKeyPressed(13) then break;
    end;
  Readln;
end;

begin
  TAutoFree.One(vCommandLine, TCommandLine.Create);
  vMode := vCommandLine.AsUTF8('mode', 'S', '');
  case vMode[1] of
    'S', 's': RunServer;
    'C', 'c': RunClient;
  end;
end.

....
Udate #96
Udate #97
Udate #98
Udate #99
Udate #100
Udate #101
Udate #102
Udate #103
Udate #104
Udate #105
Udate #106
Udate #107
Udate #108
Udate #109
Udate #110
Udate #111
Udate #112
Udate #113

PS>

$ gstat -u sysdba -p masterkey -r d:\Projects\Tests\REC_VERSION_TEST.FDB

Database "d:\Projects\Tests\REC_VERSION_TEST.FDB"
Database header page information:
        Flags                   0
        Checksum                12345
        Generation              120
        Page size               4096
        ODS version             11.2
        Oldest transaction      1
        Oldest active           1
        Oldest snapshot         1
        Next transaction        118
        Bumped transaction      1
        Sequence number         0
        Next attachment ID      1
        Implementation ID       16
        Shadow count            0
        Page buffers            0
        Next header page        0
        Database dialect        3
        Creation date           May 10, 2021 23:51:00
        Attributes              force write

    Variable header data:
        *END*


Database file sequence:
File d:\Projects\Tests\REC_VERSION_TEST.FDB is the only file

Analyzing database pages ...
SIMPLERECORD (128)
    Primary pointer page: 168, Index root page: 169
    Average record length: 17.00, total records: 1
    Average version length: 9.00, total versions: 113, max versions: 113
    Data pages: 1, data page slots: 1, average fill: 73%
    Fill distribution:
         0 - 19% = 0
        20 - 39% = 0
        40 - 59% = 0
        60 - 79% = 1
        80 - 99% = 0

    Index NDXSIMPLERECORDID (1)
        Depth: 1, leaf buckets: 1, nodes: 1
        Average data length: 9.00, total dup: 0, max dup: 0
        Fill distribution:
             0 - 19% = 1
            20 - 39% = 0
            40 - 59% = 0
            60 - 79% = 0
            80 - 99% = 0

    Index RDB$PRIMARY1 (0)
        Depth: 1, leaf buckets: 1, nodes: 1
        Average data length: 9.00, total dup: 0, max dup: 0
        Fill distribution:
             0 - 19% = 1
            20 - 39% = 0
            40 - 59% = 0
            60 - 79% = 0
            80 - 99% = 0

...
        Oldest transaction      1
        Oldest active           1
        Oldest snapshot         1
        Next transaction        118
...
SIMPLERECORD (128)
...
    Average version length: 9.00, total versions: 113, max versions: 113

  while true do
    begin
      inc(i);
      vBatch := TSQLRestBatch.Create(FRestServer, TSQLRecordSample, 5);
      try
        vSQLRecordSample.LastLogin := now;
        vBatch.Update(vSQLRecordSample);
        vBatch.Update(vSQLRecordSample);
        vBatch.Update(vSQLRecordSample);
        vBatch.Update(vSQLRecordSample);
        vBatch.Update(vSQLRecordSample);
        FRestServer.BatchSend(vBatch);
      finally
        vBatch.Free;
      end;
        Writeln('Udate #' + i.ToString);
      Sleep(300);
      if ConsoleKeyPressed(13) then break;
    end;