mORMot Open Source

program GlobalCodeServer;

uses
  Vcl.Forms,
  Main in 'Main.pas' {FormMain},
  Services in 'Services.pas';

{$R *.res}

begin
  Application.Initialize;
  Application.MainFormOnTaskbar := True;
  Application.CreateForm(TFormMain, FormMain);
  Application.Run;
end.

unit Services;

interface

uses mORMot, Syncommons, SynOleDB, SynDB;

type
  IVeCode = interface(IInvokable)
    ['{DE580C16-54F4-4C82-860C-D60BE6374F29}']
    function GenCodes(aSetCode: RAWUTF8; aSvcCode: RAWUTF8): RAWUTF8;
  end;

  IPaCode = interface(IInvokable)
    ['{ED56F71A-37A3-4A3A-BB2B-827A6D03A390}']
    function GenCodes(aSetCode: RAWUTF8; aSvcCode: RAWUTF8): RAWUTF8;
  end;

  TVeCode = Class(TInterfacedObject, IVeCode)
  public
    function GenCodes(aSetCode: RAWUTF8; aSvcCode: RAWUTF8): RAWUTF8;
  End;

  TPaCode = Class(TInterfacedObject, IPaCode)
  public
    function GenCodes(aSetCode: RAWUTF8; aSvcCode: RAWUTF8): RAWUTF8;
  End;

var
  VeProp, PaProp: TOleDbMssqlConnectionProperties;

implementation

{ TVeUniCode }

function TVeCode.GenCodes(aSetCode, aSvcCode: RAWUTF8): RAWUTF8;
var
  _Data: Variant;
  aQuery: TSQLDBStatement;
begin

  // _Data := _Json(VeProp.Execute('select ?+? As Adata', [aSetCode, aSvcCode]).FetchAllAsJSON(true));
  aQuery := VeProp.NewThreadSafeStatement;
  aQuery.Execute('select ?+? As Adata', true, [aSetCode, aSvcCode]);
  _Data := _Json(aQuery.FetchAllAsJSON(true));
  aQuery.Free;
  Result := _Data._(0).Adata;
end;

{ TPaUniCode }

function TPaCode.GenCodes(aSetCode, aSvcCode: RAWUTF8): RAWUTF8;
var
  _Data: Variant;
  aQuery: TSQLDBStatement;
begin
  // _Data := _Json(PaProp.Execute('select ?+? As Adata', [aSetCode, aSvcCode]).FetchAllAsJSON(true));
  aQuery := PaProp.NewThreadSafeStatement;
  aQuery.Execute('select ?+? As Adata', true, [aSetCode, aSvcCode]);
  _Data := _Json(aQuery.FetchAllAsJSON(true));
  aQuery.Free;
  Result := _Data._(0).Adata;
end;

end.

unit Main;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, mORMot, mORMotSqlite3, mORMotHttpServer, SynOleDB, SynSqlite3Static;

type
  TFormMain = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
    VeModel, PaModel: TSQLModel;
    VeRest, PaRest: TSQLRestServerDB;
    VeHttp, PaHttp: TSQLHttpServer;
  public
    { Public declarations }
  end;

var
  FormMain: TFormMain;

implementation

{$R *.dfm}

uses Services;

procedure TFormMain.FormCreate(Sender: TObject);
begin
  VeProp := TOleDBMssqlConnectionProperties.Create('127.0.0.1,1433', 'DB8', 'Sa', '1');
  PaProp := TOleDBMssqlConnectionProperties.Create('127.0.0.1,1433', 'DB8', 'Sa', '1');

  VeModel := TSQLModel.Create([], 'Ve');
  PaModel := TSQLModel.Create([], 'Pa');

  VeRest := TSQLRestServerDB.Create(VeModel, ':memory:');
  PaRest := TSQLRestServerDB.Create(PaModel, ':memory:');

  VeRest.ServiceRegister(TVeCode, [TypeInfo(IVeCode)], sicClientDriven);
  PaRest.ServiceRegister(TPaCode, [TypeInfo(IPaCode)], sicClientDriven);

  VeHttp := TSQLHttpServer.Create('888', [VeRest], '+');
  PaHttp := TSQLHttpServer.Create('999', [PaRest], '+');

  VeHttp.AccessControlAllowOrigin := '*';
  PaHttp.AccessControlAllowOrigin := '*';
end;

procedure TFormMain.FormDestroy(Sender: TObject);
begin
  VeHttp.Free;
  PaHttp.Free;
  VeRest.Free;
  PaRest.Free;
  VeModel.Free;
  PaModel.Free;
  VeProp.Free;
  PaProp.Free;
end;

end.

program GlobalCodeTestCase;

{$APPTYPE CONSOLE}
{$R *.res}

uses
  System.SysUtils,
  Services in 'Services.pas', SynTests, mORMotHttpClient, mORMot;

type

  TTestClient = class(TSynTestCase)
  published
    procedure Test1;
  end;

  TTestSuit = class(TSynTestsLogged)
  published
    procedure MyTestSuit;
  end;

  { TTestSuit }

procedure TTestSuit.MyTestSuit;
begin
  AddCase([TTestClient]);
end;

{ TTestClient }

procedure TTestClient.Test1;
var
  VeModel, PaModel: TSQLModel;
  VeClient, PaClient: TSQLHttpClient;
  VeCode: IVeCode;
  Pacode: IPaCode;
  i: integer;
begin
  VeModel := TSQLModel.Create([], 'Ve');
  VeClient := TSQLHttpClient.Create('127.0.0.1', '888', VeModel);
  VeClient.ServiceRegister(TypeInfo(IVeCode), sicClientDriven);
  VeClient.ServerTimestampSynchronize;
  VeCode := VeClient.Service<IVeCode>;

  PaModel := TSQLModel.Create([], 'Pa');
  PaClient := TSQLHttpClient.Create('127.0.0.1', '999', PaModel);
  PaClient.ServiceRegister(TypeInfo(IPaCode), sicClientDriven);
  PaClient.ServerTimestampSynchronize;
  Pacode := PaClient.Service<IPaCode>;

  for i := 1 to 10000 do
  begin
    Check(VeCode.GenCodes('A', 'B') = 'AB');
    Check(Pacode.GenCodes('C', 'D') = 'CD');
  end;

  VeCode := nil;
  VeClient.Free;
  VeModel.Free;

  Pacode := nil;
  PaClient.Free;
  PaModel.Free;
end;

begin
  with TTestSuit.Create do
    try
      Run;
      readln;
    finally
      Free;
    end;

end.