init

.gitattributes

@@ -0,0 +1,6 @@
+*	text=auto
+*.pas	eol=crlf
+*.dfm	eol=crlf
+*.dpr	eol=crlf
+*.groupproj	eol=crlf
+

.gitignore

@@ -0,0 +1,61 @@
+*.o
+*.lo
+*.la
+*.al
+.libs
+*.so
+*.so.[0-9]*
+*.a
+*.pyc
+*.pyo
+__pycache__
+*.rej
+*~ 
+.*.swp
+.DS_Store
+[Tt]humbs.db
+__history
+__recovery
+*.res
+*.local
+*.identcache
+*.stat
+*.toc
+*.log
+*.synctex.gz
+*.aux
+*_minted*
+*.dcu
+*.bpl
+TMSWeb
+Debug
+Win32
+Win64
+TMSWebIntermediate
+.vscode
+*.map
+*.apk
+*.dll
+*.exe
+*.bpi
+*.dcp
+*.dcu
+*.dres
+*.rsm
+*.tds
+*.lib
+*.cfg
+*.hpp
+*Resource.rc
+*.tvsconfig
+*.dsk
+*.stat
+*.zip
+*.7z
+*.arj
+*.tar
+*.tar.gz
+.git
+.svn
+*.user
+bin/

src/UFrmMain.dfm

@@ -0,0 +1,53 @@
+object MainForm: TMainForm
+  Left = 0
+  Top = 0
+  BorderStyle = bsSizeToolWin
+  Caption = 'XData Web Services'
+  ClientHeight = 405
+  ClientWidth = 697
+  Color = clBtnFace
+  Font.Charset = DEFAULT_CHARSET
+  Font.Color = clWindowText
+  Font.Height = -16
+  Font.Name = 'Tahoma'
+  Font.Style = []
+  OnCreate = FormCreate
+  DesignSize = (
+    697
+    405)
+  TextHeight = 19
+  object txtLog: TMemo
+    Left = 8
+    Top = 64
+    Width = 681
+    Height = 333
+    Anchors = [akLeft, akTop, akRight, akBottom]
+    Font.Charset = ANSI_CHARSET
+    Font.Color = clWindowText
+    Font.Height = -16
+    Font.Name = 'Consolas'
+    Font.Style = []
+    ParentFont = False
+    ReadOnly = True
+    TabOrder = 0
+  end
+  object btStart: TButton
+    Left = 8
+    Top = 8
+    Width = 105
+    Height = 50
+    Caption = 'Start'
+    TabOrder = 1
+    OnClick = btStartClick
+  end
+  object btStop: TButton
+    Left = 583
+    Top = 8
+    Width = 106
+    Height = 50
+    Anchors = [akTop, akRight]
+    Caption = 'Stop'
+    TabOrder = 2
+    OnClick = btStopClick
+  end
+end

src/UFrmMain.pas

@@ -0,0 +1,89 @@
+unit UFrmMain;
+
+interface
+
+uses
+  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
+  System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs,
+  Vcl.StdCtrls, UServerContainer;
+
+type
+  TMainForm = class(TForm)
+    txtLog: TMemo;
+    btStart: TButton;
+    btStop: TButton;
+    procedure btStartClick(ASender: TObject);
+    procedure btStopClick(ASender: TObject);
+    procedure FormCreate(ASender: TObject);
+  strict private
+    procedure UpdateGUI;
+
+  public
+    procedure Log( AText: String; ATimeStamp: Boolean = true );
+
+  end;
+
+var
+  MainForm: TMainForm;
+
+implementation
+
+{$R *.dfm}
+
+uses
+  System.DateUtils
+  ;
+
+resourcestring
+  SServerStopped = 'Server stopped';
+  SServerStartedAt = 'Server started at ';
+
+{ TMainForm }
+
+procedure TMainForm.btStartClick(ASender: TObject);
+begin
+  TServerContainer.Instance.Start;
+  UpdateGUI;
+end;
+
+procedure TMainForm.btStopClick(ASender: TObject);
+begin
+  TServerContainer.Instance.Stop;
+  UpdateGUI;
+end;
+
+procedure TMainForm.FormCreate(ASender: TObject);
+begin
+  UpdateGUI;
+end;
+
+procedure TMainForm.Log(AText: String; ATimeStamp: Boolean);
+var
+  LLine: String;
+
+begin
+  if ATimeStamp then begin
+    LLine := DateTimeToStr( TDateTime.Now ) + ': ';
+  end;
+
+  LLine := LLine + AText;
+
+  txtLog.Lines.Append(LLine);
+end;
+
+procedure TMainForm.UpdateGUI;
+const
+  cHttp = 'http://+';
+  cHttpLocalhost = 'http://localhost';
+begin
+  btStart.Enabled := not TServerContainer.Instance.Active;
+  btStop.Enabled := not btStart.Enabled;
+  if TServerContainer.Instance.Active then
+    Log(SServerStartedAt + StringReplace(
+      TServerContainer.Instance.BaseUrl,
+      cHttp, cHttpLocalhost, [rfIgnoreCase]))
+  else
+    Log(SServerStopped);
+end;
+
+end.

src/UServerContainer.dfm

@@ -0,0 +1,30 @@
+object ServerContainer: TServerContainer
+  Height = 210
+  Width = 431
+  object Dispatcher: TSparkleHttpSysDispatcher
+    Left = 72
+    Top = 16
+  end
+  object Server: TXDataServer
+    BaseUrl = 'http://+:80/'
+    Dispatcher = Dispatcher
+    EntitySetPermissions = <>
+    SwaggerOptions.Enabled = True
+    SwaggerUIOptions.Enabled = True
+    SwaggerUIOptions.ShowFilter = True
+    SwaggerUIOptions.DisplayOperationId = True
+    SwaggerUIOptions.TryItOutEnabled = True
+    Left = 216
+    Top = 16
+    object MiddlewareCors: TSparkleCorsMiddleware
+    end
+  end
+  object Manager: TFDManager
+    FormatOptions.AssignedValues = [fvMapRules]
+    FormatOptions.OwnMapRules = True
+    FormatOptions.MapRules = <>
+    Active = True
+    Left = 216
+    Top = 96
+  end
+end

src/UServerContainer.pas

@@ -0,0 +1,114 @@
+unit UServerContainer;
+
+interface
+
+uses
+  System.SysUtils, System.Classes, Sparkle.HttpServer.Module,
+  Sparkle.HttpServer.Context, Sparkle.Comp.Server,
+  Sparkle.Comp.HttpSysDispatcher, Aurelius.Drivers.Interfaces,
+  Aurelius.Comp.Connection, XData.Comp.ConnectionPool, XData.Server.Module,
+  XData.Comp.Server, FireDAC.Stan.Intf, FireDAC.Stan.Option, FireDAC.Stan.Error,
+  FireDAC.UI.Intf, FireDAC.Phys.Intf, FireDAC.Stan.Def, FireDAC.Stan.Pool,
+  FireDAC.Stan.Async, FireDAC.Phys, FireDAC.Phys.MySQL, FireDAC.Phys.MySQLDef,
+  FireDAC.VCLUI.Wait, Data.DB, FireDAC.Comp.Client, FireDAC.DApt,
+  Sparkle.Comp.CorsMiddleware;
+
+type
+  TServerContainer = class(TDataModule)
+    Dispatcher: TSparkleHttpSysDispatcher;
+    Server: TXDataServer;
+    Manager: TFDManager;
+    MiddlewareCors: TSparkleCorsMiddleware;
+
+  strict private
+    class var FInstance: TServerContainer;
+
+  private
+    function GetActive: Boolean;
+    function GetBaseUrl: String;
+
+
+  public
+    function GetConnection: TFDConnection;
+
+    class function Instance: TServerContainer;
+    class destructor Destroy;
+
+    procedure Start;
+    procedure Stop;
+
+    property Active: Boolean read GetActive;
+    property BaseUrl: String read GetBaseUrl;
+
+  public
+  end;
+
+
+
+implementation
+
+{%CLASSGROUP 'Vcl.Controls.TControl'}
+
+{$R *.dfm}
+
+const
+  CONDEF = 'sqlite_pool';
+
+class destructor TServerContainer.Destroy;
+begin
+  FInstance.Free;
+
+  inherited;
+end;
+
+function TServerContainer.GetActive: Boolean;
+begin
+  Result := Dispatcher.Active;
+end;
+
+function TServerContainer.GetBaseUrl: String;
+begin
+  Result := Server.BaseUrl;
+end;
+
+function TServerContainer.GetConnection: TFDConnection;
+begin
+  if not Manager.IsConnectionDef(CONDEF) then
+  begin
+    var LParams := TStringList.Create;
+    try
+      LParams.Add('Database=stock.db');
+      LParams.Add('Pooling=True');
+
+      Manager.AddConnectionDef(CONDEF, 'SQLite', LParams, False );
+    finally
+      LParams.Free;
+    end;
+  end;
+
+  Result := TFDConnection.Create(nil);
+  Result.ConnectionDefName := CONDEF;
+end;
+
+class function TServerContainer.Instance: TServerContainer;
+begin
+  if not Assigned( FInstance ) then
+  begin
+    FInstance := TServerContainer.Create(nil);
+  end;
+
+  Result := FInstance;
+end;
+
+
+procedure TServerContainer.Start;
+begin
+  Dispatcher.Active := True;
+end;
+
+procedure TServerContainer.Stop;
+begin
+  Dispatcher.Active := False;
+end;
+
+end.

stockservice.http.dpr

@@ -0,0 +1,12 @@
+program stockservice.http;
+
+uses
+  Vcl.Forms;
+
+{$R *.res}
+
+begin
+  Application.Initialize;
+  Application.MainFormOnTaskbar := True;
+  Application.Run;
+end.