source upload

contrib/mORMot/SQLite3/Samples/06 - Remote JSON REST Service/Project06Client.dpr

@@ -0,0 +1,19 @@
+program Project06Client;
+
+uses
+  {$I SynDprUses.inc} // use FastMM4 on older Delphi, or set FPC threads
+  Forms,
+  {$ifdef FPC}
+  Interfaces,
+  {$endif}
+  Project06ClientMain in 'Project06ClientMain.pas' {Form1};
+
+{$ifndef FPC}
+{$R *.res}
+{$endif FPC}
+
+begin
+  Application.Initialize;
+  Application.CreateForm(TForm1, Form1);
+  Application.Run;
+end.

contrib/mORMot/SQLite3/Samples/06 - Remote JSON REST Service/Project06ClientMain.dfm

@@ -0,0 +1,70 @@
+object Form1: TForm1
+  Left = 334
+  Top = 330
+  Width = 322
+  Height = 280
+  Caption = 'Form1'
+  Color = clBtnFace
+  Font.Charset = DEFAULT_CHARSET
+  Font.Color = clWindowText
+  Font.Height = -13
+  Font.Name = 'Tahoma'
+  Font.Style = []
+  OldCreateOrder = False
+  OnDestroy = FormDestroy
+  PixelsPerInch = 96
+  TextHeight = 16
+  object lblA: TLabel
+    Left = 56
+    Top = 50
+    Width = 17
+    Height = 16
+    Caption = 'A='
+  end
+  object lblB: TLabel
+    Left = 56
+    Top = 98
+    Width = 16
+    Height = 16
+    Caption = 'B='
+  end
+  object lblResult: TLabel
+    Left = 76
+    Top = 200
+    Width = 184
+    Height = 16
+    Caption = 'Enter numbers, then Call Server'
+  end
+  object edtA: TEdit
+    Left = 80
+    Top = 48
+    Width = 153
+    Height = 24
+    TabOrder = 0
+  end
+  object edtB: TEdit
+    Left = 80
+    Top = 96
+    Width = 153
+    Height = 24
+    TabOrder = 1
+  end
+  object btnCall: TButton
+    Left = 56
+    Top = 152
+    Width = 97
+    Height = 25
+    Caption = 'Call Server'
+    TabOrder = 2
+    OnClick = btnCallClick
+  end
+  object btnCancel: TButton
+    Left = 168
+    Top = 152
+    Width = 97
+    Height = 25
+    Caption = 'Quit'
+    TabOrder = 3
+    OnClick = btnCancelClick
+  end
+end

contrib/mORMot/SQLite3/Samples/06 - Remote JSON REST Service/Project06ClientMain.pas

@@ -0,0 +1,74 @@
+unit Project06ClientMain;
+
+interface
+
+uses
+  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
+  Dialogs, StdCtrls,
+  SynCommons, mORMot;
+
+type
+  TForm1 = class(TForm)
+    edtA: TEdit;
+    edtB: TEdit;
+    lblA: TLabel;
+    lblB: TLabel;
+    btnCall: TButton;
+    btnCancel: TButton;
+    lblResult: TLabel;
+    procedure btnCancelClick(Sender: TObject);
+    procedure btnCallClick(Sender: TObject);
+    procedure FormDestroy(Sender: TObject);
+  private
+    { Private declarations }
+  public
+    { Public declarations }
+    Model: TSQLModel;
+    Client: TSQLRestClientURINamedPipe;
+  end;
+
+var
+  Form1: TForm1;
+
+implementation
+
+{$R *.dfm}
+
+{$ifndef FPC}
+  {$R vista.RES} // includes Win10 manifest - use .RES for linux cross-compilation
+{$endif FPC}
+
+procedure TForm1.btnCancelClick(Sender: TObject);
+begin
+  Close;
+end;
+
+procedure TForm1.btnCallClick(Sender: TObject);
+var a,b: double;
+    err: integer;
+begin
+  val(edtA.Text,a,err);
+  if err<>0 then begin
+    edtA.SetFocus;
+    exit;
+  end;
+  val(edtB.Text,b,err);
+  if err<>0 then begin
+    edtB.SetFocus;
+    exit;
+  end;
+  if Client=nil then begin
+    if Model=nil then
+      Model := TSQLModel.Create([],'service');
+    Client := TSQLRestClientURINamedPipe.Create(Model,'RestService');
+  end;
+  lblResult.Caption := UTF8ToString(Client.CallBackGetResult('sum',['a',a,'b',b]));
+end;
+
+procedure TForm1.FormDestroy(Sender: TObject);
+begin
+  Client.Free;
+  Model.Free;
+end;
+
+end.

contrib/mORMot/SQLite3/Samples/06 - Remote JSON REST Service/Project06Server.dpr

@@ -0,0 +1,55 @@
+program Project06Server;
+
+{$APPTYPE CONSOLE}
+
+uses
+  {$I SynDprUses.inc} // use FastMM4 on older Delphi, or set FPC threads
+  SynCommons,
+  mORMot,
+  SysUtils;
+
+type
+  // TSQLRestServerFullMemory kind of server is light and enough for our purpose
+  TServiceServer = class(TSQLRestServerFullMemory)
+  published
+    procedure Sum(Ctxt: TSQLRestServerURIContext);
+  end;
+
+
+{ TServiceServer }
+
+procedure TServiceServer.Sum(Ctxt: TSQLRestServerURIContext);
+// begin // the following would be faster to write, a bit slower to execute:
+//   Ctxt.Results([Ctxt['a']+Ctxt['b']]);
+// end;
+var a,b: double;
+begin
+  if UrlDecodeNeedParameters(Ctxt.Parameters,'A,B') then begin
+    while Ctxt.Parameters<>nil do begin
+      UrlDecodeDouble(Ctxt.Parameters,'A=',a);
+      UrlDecodeDouble(Ctxt.Parameters,'B=',b,@Ctxt.Parameters);
+    end;
+    Ctxt.Results([a+b]);
+  end else
+    Ctxt.Error('Missing Parameter');
+end;
+
+var
+  aModel: TSQLModel;
+begin
+  aModel := TSQLModel.Create([],'service');
+  try
+    with TServiceServer.Create(aModel) do
+    try
+      if ExportServerNamedPipe('RestService') then
+        writeln('Background server is running.'#10) else
+        writeln('Error launching the server'#10);
+      write('Press [Enter] to close the server.');
+      readln;
+    finally
+      Free;
+    end;
+  finally
+    aModel.Free;
+  end;
+end.