source upload

contrib/mORMot/SQLite3/Samples/20 - DTO interface based service/Project20Client.dpr

@@ -0,0 +1,21 @@
+program Project20Client;
+
+//   first line of uses clause must be   {$I SynDprUses.inc}
+uses
+  {$I SynDprUses.inc}
+  Forms,
+  {$ifdef FPC}
+  Interfaces,
+  {$endif}
+  Project20ClientMain in 'Project20ClientMain.pas' {Form1},
+  Project20Interface in 'Project20Interface.pas';
+
+{$ifndef FPC}
+{$R *.res}
+{$endif}
+
+begin
+  Application.Initialize;
+  Application.CreateForm(TForm1, Form1);
+  Application.Run;
+end.

contrib/mORMot/SQLite3/Samples/20 - DTO interface based service/Project20ClientMain.dfm

@@ -0,0 +1,111 @@
+object Form1: TForm1
+  Left = 334
+  Top = 330
+  Width = 703
+  Height = 525
+  Caption = 'Form1'
+  Color = clBtnFace
+  Font.Charset = DEFAULT_CHARSET
+  Font.Color = clWindowText
+  Font.Height = -13
+  Font.Name = 'Tahoma'
+  Font.Style = []
+  OldCreateOrder = False
+  OnDestroy = FormDestroy
+  DesignSize = (
+    687
+    487)
+  PixelsPerInch = 96
+  TextHeight = 16
+  object lblA: TLabel
+    Left = 72
+    Top = 50
+    Width = 21
+    Height = 16
+    Caption = 'ID='
+  end
+  object lbl1: TLabel
+    Left = 403
+    Top = 42
+    Width = 87
+    Height = 16
+    Alignment = taRightJustify
+    Caption = 'Numer of calls:'
+  end
+  object lblTiming: TLabel
+    Left = 392
+    Top = 80
+    Width = 281
+    Height = 33
+    Anchors = [akLeft, akTop, akRight]
+    AutoSize = False
+    Font.Charset = DEFAULT_CHARSET
+    Font.Color = clWindowText
+    Font.Height = -13
+    Font.Name = 'Tahoma'
+    Font.Style = [fsItalic]
+    ParentFont = False
+  end
+  object lbl2: TLabel
+    Left = 411
+    Top = 20
+    Width = 79
+    Height = 16
+    Alignment = taRightJustify
+    Caption = 'Server name:'
+  end
+  object edtID: TEdit
+    Left = 96
+    Top = 48
+    Width = 153
+    Height = 24
+    TabOrder = 0
+    Text = '1234'
+  end
+  object btnCall: TButton
+    Left = 96
+    Top = 80
+    Width = 97
+    Height = 25
+    Caption = 'Call Server'
+    TabOrder = 1
+    OnClick = btnCallClick
+  end
+  object btnCancel: TButton
+    Left = 256
+    Top = 80
+    Width = 97
+    Height = 25
+    Caption = 'Quit'
+    TabOrder = 2
+    OnClick = btnCancelClick
+  end
+  object mmoResult: TMemo
+    Left = 8
+    Top = 120
+    Width = 670
+    Height = 358
+    Anchors = [akLeft, akTop, akRight, akBottom]
+    Lines.Strings = (
+      '')
+    ScrollBars = ssVertical
+    TabOrder = 3
+    WordWrap = False
+  end
+  object edtNumberOfCalls: TEdit
+    Left = 496
+    Top = 40
+    Width = 121
+    Height = 24
+    TabOrder = 4
+    Text = '1'
+  end
+  object edtServerName: TEdit
+    Left = 496
+    Top = 16
+    Width = 121
+    Height = 24
+    TabOrder = 5
+    Text = 'localhost'
+  end
+end

contrib/mORMot/SQLite3/Samples/20 - DTO interface based service/Project20ClientMain.pas

@@ -0,0 +1,104 @@
+unit Project20ClientMain;
+
+interface
+
+uses
+  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
+  Dialogs, StdCtrls,
+  SynCommons, mORMot, mORMotHttpClient,
+  Project20Interface;
+
+type
+  TForm1 = class(TForm)
+    edtID: TEdit;
+    lblA: TLabel;
+    btnCall: TButton;
+    btnCancel: TButton;
+    mmoResult: TMemo;
+    edtNumberOfCalls: TEdit;
+    lbl1: TLabel;
+    lblTiming: TLabel;
+    edtServerName: TEdit;
+    lbl2: TLabel;
+    procedure btnCancelClick(Sender: TObject);
+    procedure btnCallClick(Sender: TObject);
+    procedure FormDestroy(Sender: TObject);
+  private
+    { Private declarations }
+  public
+    { Public declarations }
+    Model: TSQLModel;
+    Client: TSQLRestClientURI;
+  end;
+
+var
+  Form1: TForm1;
+
+implementation
+
+{$R *.dfm}
+
+{$ifndef FPC}
+  {$R vista.RES}
+{$endif}
+
+procedure TForm1.btnCancelClick(Sender: TObject);
+begin
+  Close;
+end;
+
+procedure TForm1.btnCallClick(Sender: TObject);
+var id, numcalls, err, n: integer;
+    Timer: TPrecisionTimer;
+    I: IAirportService;
+    Airport: TDTOAirportDefinition;
+begin
+  val(edtID.Text,id,err);
+  if err<>0 then begin
+    edtID.SetFocus;
+    exit;
+  end;
+  val(edtNumberOfCalls.Text,numcalls,err);
+  if (err<>0) or (numcalls<=0) then begin
+    edtNumberOfCalls.SetFocus;
+    exit;
+  end;
+  if Client=nil then
+  try
+    if Model=nil then
+      Model := TSQLModel.Create([],ROOT_NAME);
+    Client := TSQLHttpClient.Create(AnsiString(edtServerName.Text),'888',Model);
+    if not Client.ServerTimeStampSynchronize then begin
+      ShowMessage(UTF8ToString(Client.LastErrorMessage));
+      FreeAndNil(Client);
+      exit;
+    end;
+    Client.ServiceRegister([TypeInfo(IAirportService)],sicShared);
+  except
+    on Exception do begin
+      FreeAndNil(Client);
+      exit;
+    end;
+  end;
+  if not Client.Services['AirportService'].Get(I) then
+    exit;
+  Airport := TDTOAirportDefinition.Create;
+  try
+    Timer.Start;
+    for n := 1 to numcalls do
+      I.GetAirportDefinition(id,Airport);
+    lblTiming.Caption := Format('Total time: %s'#13'Average time: %s',
+      [Timer.Stop,Timer.ByCount(numcalls)]);
+    mmoResult.Text := UTF8ToString(ObjectToJSON(Airport,[woHumanReadable]));
+  finally
+    Airport.Free;
+  end;
+end;
+
+procedure TForm1.FormDestroy(Sender: TObject);
+begin
+  Client.Free;
+  Model.Free;
+end;
+
+end.

contrib/mORMot/SQLite3/Samples/20 - DTO interface based service/Project20Interface.pas

@@ -0,0 +1,137 @@
+/// some common definitions shared by both client and server side
+unit Project20Interface;
+
+interface
+
+uses
+  Classes,
+  SynCommons,
+  mORMot;
+
+type
+  TDTOAirport = class(TCollectionItem)
+  private
+    FDCS: RawUTF8;
+    FLocation: RawUTF8;
+    FBHS: RawUTF8;
+    FGate: TRawUTF8DynArray;
+    FTerminal: TRawUTF8DynArray;
+  published
+    property Location: RawUTF8 read FLocation write FLocation;
+    property Terminal: TRawUTF8DynArray read FTerminal write FTerminal;
+    property Gate: TRawUTF8DynArray read FGate write FGate;
+    property BHS: RawUTF8 read FBHS write FBHS;
+    property DCS: RawUTF8 read FDCS write FDCS;
+  end;
+
+  TDTOAirports = class(TInterfacedCollection)
+  private
+    function GetCollItem(aIndex: Integer): TDTOAirport;
+  protected
+    class function GetClass: TCollectionItemClass; override;
+  public
+    function Add: TDTOAirport;
+    property Item[aIndex: Integer]: TDTOAirport read GetCollItem; default;
+  end;
+  
+  TDTOAirline = class(TCollectionItem)
+  private
+    FSQ: RawUTF8;
+    FET: RawUTF8;
+    FQR: TRawUTF8DynArray;
+    FCX: TRawUTF8DynArray;
+  published
+    property CX: TRawUTF8DynArray read FCX write FCX;
+    property QR: TRawUTF8DynArray read FQR write FQR;
+    property ET: RawUTF8 read FET write FET;
+    property SQ: RawUTF8 read FSQ write FSQ;
+  end;
+
+  TDTOAirlines = class(TInterfacedCollection)
+  private
+    function GetCollItem(aIndex: Integer): TDTOAirline;
+  protected
+    class function GetClass: TCollectionItemClass; override;
+  public
+    function Add: TDTOAirline;
+    property Item[aIndex: Integer]: TDTOAirline read GetCollItem; default;
+  end;
+  
+  TDTOAirportDefinition = class(TPersistentWithCustomCreate)
+  private
+    fAirline: TDTOAirlines;
+    fAirport: TDTOAirports;
+    fGroundHandler: TRawUTF8DynArray;
+  public
+    constructor Create; override;
+    destructor Destroy; override;
+  published
+    property Airport: TDTOAirports read fAirport;
+    property Airline: TDTOAirlines read fAirline;
+    property GroundHandler: TRawUTF8DynArray read fGroundHandler write fGroundHandler;
+  end;
+
+  IAirportService = interface(IInvokable)
+    ['{4A613FCE-3B0D-4582-97C5-4244B06C2006}']
+    procedure GetAirportDefinition(const AirPortID: integer; out Definition: TDTOAirportDefinition);
+  end;
+
+const
+  ROOT_NAME = 'project20';
+  PORT_NAME = '888';
+
+implementation
+
+
+{ TDTOAirports }
+
+function TDTOAirports.Add: TDTOAirport;
+begin
+  result := TDTOAirport(inherited Add);
+end;
+
+class function TDTOAirports.GetClass: TCollectionItemClass;
+begin
+  result := TDTOAirport;
+end;
+
+function TDTOAirports.GetCollItem(aIndex: Integer): TDTOAirport;
+begin
+  result := TDTOAirport(GetItem(aIndex));
+end;
+
+
+{ TDTOAirlines }
+
+function TDTOAirlines.Add: TDTOAirline;
+begin
+  result := TDTOAirline(inherited Add);
+end;
+
+class function TDTOAirlines.GetClass: TCollectionItemClass;
+begin
+  result := TDTOAirline;
+end;
+
+function TDTOAirlines.GetCollItem(aIndex: Integer): TDTOAirline;
+begin
+  result := TDTOAirline(GetItem(aIndex));
+end;
+
+
+{ TDTOAirportDefinition }
+
+constructor TDTOAirportDefinition.Create;
+begin
+  fAirport := TDTOAirports.Create;
+  fAirline := TDTOAirlines.Create;
+end;
+
+destructor TDTOAirportDefinition.Destroy;
+begin
+  fAirline.Free;
+  fAirport.Free;
+  inherited;
+end;
+
+end.

contrib/mORMot/SQLite3/Samples/20 - DTO interface based service/Project20ServerInMemory.dpr

@@ -0,0 +1,79 @@
+/// this server will use TSQLRestServerFullMemory kind of in-memory server
+program Project20ServerInMemory;
+
+{$APPTYPE CONSOLE}
+
+//   first line of uses clause must be   {$I SynDprUses.inc}
+uses
+  {$I SynDprUses.inc}
+  SysUtils,
+  Classes,
+  SynCommons,
+  SynTable,
+  SynLog,
+  mORMot,
+  mORMotHttpServer,
+  Project20Interface;
+
+type
+  TAirportService = class(TInterfacedObject, IAirportService)
+  public
+    procedure GetAirportDefinition(const AirPortID: integer; out Definition: TDTOAirportDefinition);
+  end;
+
+
+{ TAirportService }
+
+procedure TAirportService.GetAirportDefinition(const AirPortID: integer;
+  out Definition: TDTOAirportDefinition);
+begin
+  // create an object from static data
+  // (real application may use database and complex code to retrieve the values)
+  with Definition.Airport.Add do begin
+    Location := 'LAX';
+    Terminal := TRawUTF8DynArrayFrom(['terminalA', 'terminalB', 'terminalC']);
+    Gate := TRawUTF8DynArrayFrom(['gate1', 'gate2', 'gate3', 'gate4', 'gate5']);
+    BHS := 'Siemens';
+    DCS := 'Altiea';
+  end;
+  with Definition.Airline.Add do begin
+    CX := TRawUTF8DynArrayFrom(['B777', 'B737', 'A380', 'A320']);
+    QR := TRawUTF8DynArrayFrom(['A319', 'A380', 'B787']);
+    ET := '380';
+    SQ := 'A320';
+  end;
+  Definition.GroundHandler := TRawUTF8DynArrayFrom(['Swissport','SATS','Wings','TollData']);
+end;
+
+var
+  aModel: TSQLModel;
+  aDB: TSQLRestServer;
+  aServer: TSQLHttpServer;
+begin
+  // set the logs level to only important events (reduce .log size)
+  TSQLLog.Family.Level := LOG_STACKTRACE+[sllInfo,sllServer];
+  // initialize the ORM data model
+  aModel := TSQLModel.Create([],ROOT_NAME);
+  try
+    // create a fast in-memory ORM server
+    aDB := TSQLRestServerFullMemory.Create(aModel,'test.json',false,false);
+    try
+      // register our TAirportServer implementation
+      aDB.ServiceRegister(TAirportService,[TypeInfo(IAirportService)],sicShared);
+      // launch the HTTP server
+      aServer := TSQLHttpServer.Create(PORT_NAME,[aDB],'+',useHttpApiRegisteringURI);
+      try
+        aServer.AccessControlAllowOrigin := '*'; // allow cross-site AJAX queries
+        writeln('Background server is running'#10);
+        write('Press [Enter] to close the server.');
+        ConsoleWaitForEnterKey;
+      finally
+        aServer.Free;
+      end;
+    finally
+      aDB.Free;
+    end;
+  finally
+    aModel.Free;
+  end;
+end.