mORMot Open Source

unit Project14Interface;

interface

type
  TTagList = packed record
    Base: widestring;
    L: array of packed record
     name: WideString;
     age: integer;
    end;
  end;


  ICalculator = interface(IInvokable)
    ['{9A60C8ED-CEB2-4E09-87D4-4A16F496E5FF}']
    function Add(n1,n2: integer): integer;
    function Sub(n1b,n2b: integer): integer;
    procedure list(tag:string;var tagList:TTaglist);
  end;

const
  ROOT_NAME = 'root';
  PORT_NAME = '888';
  APPLICATION_NAME = 'RestService';

implementation

end.

program Project14ServerHttp;

{$APPTYPE CONSOLE}

uses
  SysUtils,
  Classes,
  SynCommons,
  mORMot,
  mORMotHttpServer,
  mORMotWrappers,
  Project14Interface in 'Project14Interface.pas';

type

  TServiceCalculator = class(TInterfacedObject, ICalculator)
  public
    function Add(n1,n2: integer): integer;
    function Sub(n1b,n2b: integer): integer;
    procedure list(tag:string;var tagList:TTaglist);
  end;

function TServiceCalculator.Add(n1, n2: integer): integer;
begin
  result := n1+n2;
end;

function TServiceCalculator.Sub(n1b, n2b: integer): integer;
begin
  result := n1b-n2b;
end;

procedure TServiceCalculator.list(tag:string;var tagList:TTaglist);
begin
  //
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
  aModel := TSQLModel.Create([],ROOT_NAME);
  try
    // initialize a TObjectList-based database engine
    aServer := TSQLRestServerFullMemory.Create(aModel,'test.json',false,true);
    try
      // add the http://localhost:888/root/wrapper code generation web page
      AddToServerWrapperMethod(aServer,
        ['..\..\..\CrossPlatform\templates','..\..\..\..\CrossPlatform\templates']);


      // register our ICalculator service on the server side
      aServer.ServiceRegister(TServiceCalculator,[TypeInfo(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.

from mormot.pas:

{$ifndef NOVARIANTS}
function TInterfaceFactory.ContextFromMethods(aRegisteredTypes: TRawUTF8List): variant;
const VERB_DELPHI: array[boolean] of string[9] = ('procedure','function');
      NULL_OR_COMMA: array[boolean] of RawUTF8 = ('null','","');
var methods,arguments: TDocVariantData;
    m,a,r: integer;
    arg: variant;
begin
  methods.Init(JSON_OPTIONS[true]);
  for m := 0 to fMethodsCount-1 do
  with fMethods[m] do begin
    r := 0;
    arguments.Init(JSON_OPTIONS[true]);
    for a := 1 to high(args) do begin // ignore self as a=0
      arg := args[a].ContextFromArguments(aRegisteredTypes);
      if (args[a].ValueDirection in [smdConst,smdVar]) and (a<ArgsInLast) then begin
        arg.commaIn := '; ';
        arg.commaInSingle := ',';   // <---------------------------------------------------------------------------------------
      end;
      if (args[a].ValueDirection in [smdVar,smdOut]) and (a<ArgsOutNotResultLast) then
        arg.commaOut := '; ';
      if args[a].ValueDirection in [smdVar,smdOut,smdResult] then begin
        arg.indexOutResult := UInt32ToUtf8(r)+']';
        inc(r);
        if a<ArgsOutLast then
          arg.commaOutResult := '; ';
      end;
      arguments.AddItem(arg);
    end;
    methods.AddItem(_ObjFast(['methodName',URI,'verb',VERB_DELPHI[ArgsResultIndex>=0],
      'args',variant(arguments),'argsOutputCount',r]));
    arguments.Clear;
  end;
  result := variant(methods);
end;
{$endif}



arg.commaInSingle is Variant and ',' is a char.

  TSQLRecord = class(TPersistent)
  protected
    fID: int64;
    fInternalState: cardinal;

    fFill: TSQLTableJSON;
    {$ifdef ISSMS}
    class function GetRTTI: TRTTIPropInfos;
    /// you should override these methods
    class function ComputeRTTI: TRTTIPropInfos; virtual;
    procedure SetProperty(FieldIndex: integer; const Value: variant); virtual;
    function GetProperty(FieldIndex: integer): variant; virtual;
    {$endif}
  public
    /// this constructor initializes the record
    constructor Create; overload; virtual;
    /// this constructor loads a record from a REST instance from its ID
    constructor Create(aClient: TSQLRest; aID: integer;
      ForUpdate: boolean=false); overload;
    /// this constructor loads a record from a REST instance
    // - you can bind parameters by using ? in the SQLWhere clause
    // - FieldNames='' retrieve simple fields, '*' all fields, or as specified
    constructor Create(aClient: TSQLRest; const FieldNames, SQLWhere: string;
      const BoundsSQLWhere: array of const); overload;
    /// this constructor ask the server for a list of matching records
    // - you can bind parameters by using ? in the SQLWhere clause
    // - FieldNames='' retrieve simple fields, '*' all fields, or as specified
    // - then you can also loop through all rows with
    // ! while Rec.FillOne do
    // !   dosomethingwith(Rec);
    constructor CreateAndFillPrepare(aClient: TSQLRest; const FieldNames,
      SQLWhere: string; const BoundsSQLWhere: array of const);
    /// finalize the record memory
    destructor Destroy; override;
    /// fill the specified record from the supplied JSON
    function FromJSON(const aJSON: string): boolean;
    {$ifdef ISSMS}
    /// fill the specified record from Names/Values pairs
    function FromNamesValues(const Names: TStrArray; const Values: TVariantDynArray;
      ValuesStartIndex: integer): boolean;
    {$endif}
    /// fill all published properties of this object with the next available
    // row of data, as returned by CreateAndFillPrepare() constructor
    function FillOne: boolean;
    /// go to the first data row, as returned by CreateAndFillPrepare(),
    // then fill all published properties of this object
    // - you can use it e.g. as:
    // ! while Rec.FillOne do
    // !   dosomethingwith(Rec);
    // ! if Rec.FillRewind then
    // ! repeat
    // !   dosomeotherthingwith(Rec);
    // ! until not Rec.FillOne;
    function FillRewind: boolean;
    /// get the object properties as JSON
    // - FieldNames='' to retrieve simple fields, '*' all fields, or as specified
    function ToJSON(aModel: TSQLModel; aFieldNames: string=''): string;
    /// return the class type of this TSQLRecord
    function RecordClass: TSQLRecordClass;
      {$ifdef HASINLINE}inline;{$endif}
    /// contains the TSQLTableJSON instance after CreateAndFillPrepare()
    property FillTable: TSQLTableJSON read fFill;
    /// internal state counter of the mORMot server at last access time
    // - can be used to check if retrieved data may be out of date
    property InternalState: cardinal read fInternalState;
  published
    /// stores the record's primary key
    property ID: int64 read fID write fID;
  end;

'{Name:"{""$regex"": ""test.*"", $options: ""i""}"}'