source upload

contrib/mORMot/SQLite3/Samples/14 - Interface based services/Project14Client.dpr

@@ -0,0 +1,28 @@
+program Project14Client;
+
+{$ifdef Linux}
+  {$ifdef FPC_CROSSCOMPILING}
+    {$linklib libc_nonshared.a}
+  {$endif}
+{$endif}
+
+{$I Synopse.inc}
+
+uses
+  {$I SynDprUses.inc} // use FastMM4 on older Delphi, or set FPC threads
+  Forms,
+  {$ifdef FPC}
+  Interfaces,
+  {$endif}
+  Project14ClientMain in 'Project14ClientMain.pas' {Form1},
+  Project14Interface in 'Project14Interface.pas';
+
+{$ifndef FPC}
+{$R *.res}
+{$endif}
+
+begin
+  Application.Initialize;
+  Application.CreateForm(TForm1, Form1);
+  Application.Run;
+end.

contrib/mORMot/SQLite3/Samples/14 - Interface based services/Project14Client.lpi

@@ -0,0 +1,83 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="10"/>
+    <PathDelim Value="\"/>
+    <General>
+      <SessionStorage Value="InProjectDir"/>
+      <MainUnit Value="0"/>
+      <Title Value="Project14Client"/>
+      <ResourceType Value="res"/>
+      <UseXPManifest Value="True"/>
+    </General>
+    <BuildModes Count="1">
+      <Item1 Name="Default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+    </PublishOptions>
+    <RunParams>
+      <local>
+        <FormatVersion Value="1"/>
+      </local>
+    </RunParams>
+    <RequiredPackages Count="1">
+      <Item1>
+        <PackageName Value="LCL"/>
+      </Item1>
+    </RequiredPackages>
+    <Units Count="3">
+      <Unit0>
+        <Filename Value="Project14Client.dpr"/>
+        <IsPartOfProject Value="True"/>
+      </Unit0>
+      <Unit1>
+        <Filename Value="Project14ClientMain.pas"/>
+        <IsPartOfProject Value="True"/>
+        <ComponentName Value="Form1"/>
+        <HasResources Value="True"/>
+        <ResourceBaseClass Value="Form"/>
+      </Unit1>
+      <Unit2>
+        <Filename Value="Project14Interface.pas"/>
+        <IsPartOfProject Value="True"/>
+      </Unit2>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <PathDelim Value="\"/>
+    <Target>
+      <Filename Value="Project14Client"/>
+    </Target>
+    <SearchPaths>
+      <IncludeFiles Value="D:\DEV\lib\SQLite3\;D:\DEV\lib\;$(ProjOutDir)"/>
+      <OtherUnitFiles Value="D:\DEV\lib\SQLite3\;D:\DEV\lib\"/>
+      <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+    <CodeGeneration>
+      <TargetCPU Value="x86_64"/>
+      <TargetOS Value="linux"/>
+    </CodeGeneration>
+    <Linking>
+      <Options>
+        <Win32>
+          <GraphicApplication Value="True"/>
+        </Win32>
+      </Options>
+    </Linking>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions Count="3">
+      <Item1>
+        <Name Value="EAbort"/>
+      </Item1>
+      <Item2>
+        <Name Value="ECodetoolError"/>
+      </Item2>
+      <Item3>
+        <Name Value="EFOpenError"/>
+      </Item3>
+    </Exceptions>
+  </Debugging>
+</CONFIG>

contrib/mORMot/SQLite3/Samples/14 - Interface based services/Project14ClientMain.dfm

@@ -0,0 +1,83 @@
+object Form1: TForm1
+  Left = 334
+  Top = 330
+  Caption = 'Form1'
+  ClientHeight = 242
+  ClientWidth = 306
+  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
+  object ComboProtocol: TComboBox
+    Left = 80
+    Top = 16
+    Width = 153
+    Height = 24
+    Style = csDropDownList
+    TabOrder = 4
+    OnChange = ComboProtocolChange
+    Items.Strings = (
+      'HTTP / TCP-IP'
+      'Named Pipe'
+      'Weak HTTP / TCP-IP')
+  end
+end

contrib/mORMot/SQLite3/Samples/14 - Interface based services/Project14ClientMain.pas

@@ -0,0 +1,109 @@
+unit Project14ClientMain;
+
+{
+
+ By definition, you need the proper server to run:
+ - Project14Server.dpr for Named Pipes
+ - Project14ServerHttp.dpr for HTTP
+ - Project14ServerHttpWeak.dpr for HTTP/weak
+
+}
+
+interface
+
+uses
+  {$IFDEF WINDOWS}  Windows, Messages, {$ENDIF}
+  SysUtils, Variants, Classes, Graphics, Controls, Forms,
+  Dialogs, StdCtrls,
+  SynCommons, mORMot, mORMotHttpClient,
+  Project14Interface;
+
+type
+  TForm1 = class(TForm)
+    edtA: TEdit;
+    edtB: TEdit;
+    lblA: TLabel;
+    lblB: TLabel;
+    btnCall: TButton;
+    btnCancel: TButton;
+    lblResult: TLabel;
+    ComboProtocol: TComboBox;
+    procedure btnCancelClick(Sender: TObject);
+    procedure btnCallClick(Sender: TObject);
+    procedure FormDestroy(Sender: TObject);
+    procedure ComboProtocolChange(Sender: TObject);
+  private
+    { Private declarations }
+  public
+    { Public declarations }
+    Model: TSQLModel;
+    Client: TSQLRestClientURI;
+  end;
+
+var
+  Form1: TForm1;
+
+implementation
+
+{$R *.dfm}
+
+{$ifndef FPC}
+  {$R vista.RES} // includes Win10 manifest - use .RES for linux cross-compilation
+{$endif}
+
+procedure TForm1.btnCancelClick(Sender: TObject);
+begin
+  Close;
+end;
+
+procedure TForm1.btnCallClick(Sender: TObject);
+var a,b: integer;
+    err: integer;
+    I: ICalculator;
+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([],ROOT_NAME);
+    case ComboProtocol.ItemIndex of
+    0,2: Client := TSQLHttpClient.Create('localhost', PORT_NAME,Model);
+    {$IFDEF WINDOWS}
+    1: Client := TSQLRestClientURINamedPipe.Create(Model,APPLICATION_NAME);
+    {$ENDIF}
+    else exit;
+    end;
+    if not Client.ServerTimeStampSynchronize then begin
+      ShowMessage(UTF8ToString(Client.LastErrorMessage));
+      exit;
+    end;
+    case ComboProtocol.ItemIndex of
+    2:   TSQLRestServerAuthenticationNone.ClientSetUser(Client,'User','');
+    else Client.SetUser('User','synopse');
+    end;
+    Client.ServiceDefine([ICalculator],sicShared);
+  end;
+  if Client.Services['Calculator'].Get(I) then
+    lblResult.Caption := IntToStr(I.Add(a,b));
+end;
+
+procedure TForm1.FormDestroy(Sender: TObject);
+begin
+  Client.Free;
+  Model.Free;
+end;
+
+procedure TForm1.ComboProtocolChange(Sender: TObject);
+begin
+  FreeAndNil(Client);
+end;
+
+end.

contrib/mORMot/SQLite3/Samples/14 - Interface based services/Project14Interface.pas

@@ -0,0 +1,25 @@
+/// some common definitions shared by both client and server side
+unit Project14Interface;
+
+interface
+
+type
+  ICalculator = interface(IInvokable)
+    ['{9A60C8ED-CEB2-4E09-87D4-4A16F496E5FE}']
+    function Add(n1,n2: integer): integer;
+  end;
+
+const
+  ROOT_NAME = 'root';
+  PORT_NAME = '8888';
+  APPLICATION_NAME = 'RestService';
+
+implementation
+
+uses
+  mORMot;
+
+initialization
+  // so that we could use directly ICalculator instead of TypeInfo(ICalculator)
+  TInterfaceFactory.RegisterInterfaces([TypeInfo(ICalculator)]);
+end.

contrib/mORMot/SQLite3/Samples/14 - Interface based services/Project14Server.dpr

@@ -0,0 +1,47 @@
+program Project14Server;
+
+{$APPTYPE CONSOLE}
+
+uses
+  {$I SynDprUses.inc} // use FastMM4 on older Delphi, or set FPC threads
+  SysUtils,
+  SynCommons, SynLog, mORMot,
+  mORMotSQLite3, SynSQLite3Static,
+  Project14Interface;
+
+type
+  TServiceCalculator = class(TInterfacedObject, ICalculator)
+  public
+    function Add(n1,n2: integer): integer;
+  end;
+
+function TServiceCalculator.Add(n1, n2: integer): integer;
+begin
+  result := n1+n2;
+end;
+
+var
+  aModel: TSQLModel;
+begin
+  with TSQLLog.Family do begin
+    Level := LOG_VERBOSE;
+    EchoToConsole := LOG_VERBOSE; // log all events to the console
+  end;
+  aModel := TSQLModel.Create([],ROOT_NAME);
+  try
+    with TSQLRestServerDB.Create(aModel,ChangeFileExt(ExeVersion.ProgramFileName,'.db'),true) do
+    try
+      CreateMissingTables; // we need AuthGroup and AuthUser tables
+      ServiceDefine(TServiceCalculator,[ICalculator],sicShared);
+      if ExportServerNamedPipe(APPLICATION_NAME) 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.

contrib/mORMot/SQLite3/Samples/14 - Interface based services/Project14ServerExternal.dpr

@@ -0,0 +1,60 @@
+program Project14ServerExternal;
+
+{ this sample will create the main SQLite3 DB as in-memory, but will define all
+  tables as external, in the same .db file than Project14Server
+  -> just to demonstrate VirtualTableExternalRegisterAll() function and
+  reproduce the https://synopse.info/forum/viewtopic.php?id=1008 issue }
+
+{$APPTYPE CONSOLE}
+
+uses
+  {$I SynDprUses.inc} // use FastMM4 on older Delphi, or set FPC threads
+  SysUtils,
+  mORMot,
+  mORMotSQLite3,
+  SynCommons, SynLog,
+  SynDB,
+  SynDBSQLite3, SynSQLite3, SynSQLite3Static,
+  mORMotDB,
+  Project14Interface;
+
+type
+  TServiceCalculator = class(TInterfacedObject, ICalculator)
+  public
+    function Add(n1,n2: integer): integer;
+  end;
+
+function TServiceCalculator.Add(n1, n2: integer): integer;
+begin
+  result := n1+n2;
+end;
+
+var
+  aModel: TSQLModel;
+  aProps: TSQLDBSQLite3ConnectionProperties;
+begin
+  aProps := TSQLDBSQLite3ConnectionProperties.Create(
+    StringToUtf8(ChangeFileExt(ExeVersion.ProgramFileName,'.db')),'','','');
+  try
+    aModel := TSQLModel.Create([TSQLAuthGroup,TSQLAuthUser],ROOT_NAME);
+    VirtualTableExternalRegisterAll(aModel,aProps);
+    try
+      with TSQLRestServerDB.Create(aModel,SQLITE_MEMORY_DATABASE_NAME,true) do
+      try
+        CreateMissingTables; // we need AuthGroup and AuthUser tables
+        ServiceDefine(TServiceCalculator,[ICalculator],sicShared);
+        if ExportServerNamedPipe(APPLICATION_NAME) 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;
+  finally
+    aProps.Free;
+  end;
+end.

contrib/mORMot/SQLite3/Samples/14 - Interface based services/Project14ServerHttp.dpr

@@ -0,0 +1,71 @@
+/// this server will use TSQLRestServerFullMemory over HTTP
+program Project14ServerHttp;
+
+{$APPTYPE CONSOLE}
+
+{$ifdef Linux}
+  {$ifdef FPC_CROSSCOMPILING}
+    {$linklib libc_nonshared.a}
+  {$endif}
+{$endif}
+
+{$I Synopse.inc}
+
+uses
+  {$I SynDprUses.inc} // use FastMM4 on older Delphi, or set FPC threads
+  SysUtils,
+  Classes,
+  SynCommons,
+  SynLog,
+  mORMot,
+  mORMotHttpServer,
+  Project14Interface in 'Project14Interface.pas';
+
+type
+  TServiceCalculator = class(TInterfacedObject, ICalculator)
+  public
+    function Add(n1,n2: integer): integer;
+  end;
+
+function TServiceCalculator.Add(n1, n2: integer): integer;
+begin
+  result := n1+n2;
+end;
+
+
+var
+  aModel: TSQLModel;
+  aServer: TSQLRestServer;
+  aHTTPServer: TSQLHttpServer;
+begin
+  // define the log level
+  with TSQLLog.Family do begin
+    PerThreadLog := ptIdentifiedInOnFile;
+    Level := LOG_VERBOSE;
+    EchoToConsole := LOG_VERBOSE; // log all events to the console
+  end;
+  // create a Data Model
+  aModel := TSQLModel.Create([],ROOT_NAME);
+  try
+    // initialize a TObjectList-based database engine
+    aServer := TSQLRestServerFullMemory.Create(aModel,'test.json',false,true);
+    try
+      // register our ICalculator service on the server side
+      aServer.ServiceDefine(TServiceCalculator,[ICalculator],sicShared);
+      // launch the HTTP server
+      aHTTPServer := TSQLHttpServer.Create(PORT_NAME,[aServer],'+' {$ifndef ONLYUSEHTTPSOCKET},useHttpApiRegisteringURI{$endif});
+      try
+        aHTTPServer.AccessControlAllowOrigin := '*'; // for AJAX requests to work
+        writeln(#10'Background server is running.'#10);
+        writeln('Press [Enter] to close the server.'#10);
+        readln;
+      finally
+        aHTTPServer.Free;
+      end;
+    finally
+      aServer.Free;
+    end;
+  finally
+    aModel.Free;
+  end;
+end.

contrib/mORMot/SQLite3/Samples/14 - Interface based services/Project14ServerHttp.lpi

@@ -0,0 +1,79 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="10"/>
+    <PathDelim Value="\"/>
+    <General>
+      <Flags>
+        <UseDefaultCompilerOptions Value="True"/>
+      </Flags>
+      <SessionStorage Value="InProjectDir"/>
+      <MainUnit Value="0"/>
+      <Title Value="Project14ServerHttp"/>
+      <ResourceType Value="res"/>
+      <UseXPManifest Value="True"/>
+      <Icon Value="0"/>
+    </General>
+    <VersionInfo>
+      <StringTable ProductVersion=""/>
+    </VersionInfo>
+    <BuildModes Count="1">
+      <Item1 Name="Default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+    </PublishOptions>
+    <RunParams>
+      <local>
+        <FormatVersion Value="1"/>
+      </local>
+    </RunParams>
+    <RequiredPackages Count="1">
+      <Item1>
+        <PackageName Value="LCL"/>
+      </Item1>
+    </RequiredPackages>
+    <Units Count="1">
+      <Unit0>
+        <Filename Value="Project14ServerHttp.dpr"/>
+        <IsPartOfProject Value="True"/>
+      </Unit0>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <PathDelim Value="\"/>
+    <Target>
+      <Filename Value="Project14ServerHttp"/>
+    </Target>
+    <SearchPaths>
+      <IncludeFiles Value="D:\DEV\lib\SQLite3\;D:\DEV\lib\;$(ProjOutDir)"/>
+      <OtherUnitFiles Value="D:\DEV\lib\SQLite3\;D:\DEV\lib\"/>
+      <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+    <CodeGeneration>
+      <TargetCPU Value="x86_64"/>
+      <TargetOS Value="linux"/>
+    </CodeGeneration>
+    <Linking>
+      <Options>
+        <Win32>
+          <GraphicApplication Value="True"/>
+        </Win32>
+      </Options>
+    </Linking>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions Count="3">
+      <Item1>
+        <Name Value="EAbort"/>
+      </Item1>
+      <Item2>
+        <Name Value="ECodetoolError"/>
+      </Item2>
+      <Item3>
+        <Name Value="EFOpenError"/>
+      </Item3>
+    </Exceptions>
+  </Debugging>
+</CONFIG>

contrib/mORMot/SQLite3/Samples/14 - Interface based services/Project14ServerHttpWeak.dpr

@@ -0,0 +1,64 @@
+/// this server will use weak authentication with TSQLRestServerFullMemory over HTTP
+program Project14ServerHttpWeak;
+
+{$APPTYPE CONSOLE}
+
+uses
+  {$I SynDprUses.inc} // use FastMM4 on older Delphi, or set FPC threads
+  SysUtils,
+  Classes,
+  SynCommons,
+  SynLog,
+  mORMot,
+  mORMotSQLite3,
+  mORMotHttpServer,
+  Project14Interface;
+
+type
+  TServiceCalculator = class(TInterfacedObject, ICalculator)
+  public
+    function Add(n1,n2: integer): integer;
+  end;
+
+function TServiceCalculator.Add(n1, n2: integer): integer;
+begin
+  result := n1+n2;
+end;
+
+
+var
+  aModel: TSQLModel;
+  aServer: TSQLRestServer;
+  aHTTPServer: TSQLHttpServer;
+begin
+  // define the log level
+  with TSQLLog.Family do begin
+    Level := LOG_VERBOSE;
+    EchoToConsole := LOG_VERBOSE; // log all events to the console
+  end;
+  // create a Data Model (including TSQLAuthGroup,TSQLAuthUser here)
+  aModel := TSQLModel.Create([TSQLAuthGroup,TSQLAuthUser],ROOT_NAME);
+  try
+    // initialize a TObjectList-based database engine
+    aServer := TSQLRestServerFullMemory.Create(aModel,'test.json',false,false);
+    try
+      aServer.AuthenticationRegister(TSQLRestServerAuthenticationNone);
+      // register our ICalculator service on the server side
+      aServer.ServiceDefine(TServiceCalculator,[ICalculator],sicShared);
+      // launch the HTTP server
+      aHTTPServer := TSQLHttpServer.Create(PORT_NAME,[aServer],'+',useHttpApiRegisteringURI);
+      try
+        aHTTPServer.AccessControlAllowOrigin := '*'; // for AJAX requests to work
+        writeln(#10'Background server is running.'#10);
+        writeln('Press [Enter] to close the server.'#10);
+        readln;
+      finally
+        aHTTPServer.Free;
+      end;
+    finally
+      aServer.Free;
+    end;
+  finally
+    aModel.Free;
+  end;
+end.

contrib/mORMot/SQLite3/Samples/14 - Interface based services/Project14ServerInMemory.dpr

@@ -0,0 +1,46 @@
+/// this server will use TSQLRestServerFullMemory kind of in-memory server
+// - it will only by 200 KB big with LVCL :)
+program Project14ServerInMemory;
+
+{$APPTYPE CONSOLE}
+
+uses
+  {$I SynDprUses.inc} // use FastMM4 on older Delphi, or set FPC threads
+  SysUtils,
+  Classes,
+  SynCommons,
+  mORMot,
+  Project14Interface;
+
+type
+  TServiceCalculator = class(TInterfacedObject, ICalculator)
+  public
+    function Add(n1,n2: integer): integer;
+  end;
+
+function TServiceCalculator.Add(n1, n2: integer): integer;
+begin
+  result := n1+n2;
+end;
+
+
+var
+  aModel: TSQLModel;
+begin
+  aModel := TSQLModel.Create([],ROOT_NAME);
+  try
+    with TSQLRestServerFullMemory.Create(aModel,'test.json',false,true) do
+    try
+      ServiceDefine(TServiceCalculator,[ICalculator],sicShared);
+      if ExportServerNamedPipe(APPLICATION_NAME) 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.