mORMot Open Source

type

  lsscAuth = (sscAuthNOTRequired, sscAuthRequired);

  TRestNewUser = class(TRestNewUser_session);

  TRestClientInfo = class
    Name: string;
    PreferredLanguage: string;
    sscAPITargetVersion: Double;
    sscLogin: string;
    sscPassword: string;
  end;

  TRestResult<T> = class
    MethodResult: T;
    Code: integer;
    Description: string;
    Comment: string;
  public
    procedure InitResult();
    procedure SetResult(pResCode: integer; pComment: string = ''); overload;
    procedure SetResult(Result: rResult); overload;
    function Success(): boolean;
    function GetDescription(OtherResCode: integer = -1): string;
    function GetReport(): string;
    constructor Create(MethodResult: T; RestClientInfo: TRestClientInfo; MethodName: string; SessionContext: TServerSessionContext); overload;
    constructor Create(MethodResult: T; RestClientInfo: TRestClientInfo; MethodName: string; SessionContext: TServerSessionContext;
      var UserAuthData: rRestUserAuthData); overload;
    destructor Destroy(); override;
  end;

  TGetAPIInfoResult = class
    APIVersion: Double;
    APINode: string;
    MethodsInfo: array of string;
    constructor Create;
    destructor Destroy; override;
  end;

  TRestMethodAttribute = class(TCustomAttribute)
    APIMinSupportedVersion: Double;
    sscAuth: lsscAuth;
  public
    constructor Create(MinSupportedVersion: Double; sscAuth: lsscAuth);
  end;

{$METHODINFO ON}

  TNode1 = class(TDataModule)
  private
    Settings: TSSCSettings;
    LeaveSessionAlive: boolean;
    SessionID: string;
    SessionContext: TServerSessionContext;
    class function GetMethodInfo(MethodName: string): TRestMethodAttribute;
    class function GetMethodsMinSupportedAPIVersions(): TStringList;
  published
    constructor Create(Settings: TSSCSettings); reintroduce;
    destructor Destroy(); override;
  public

    sscApiLogin: string;

    [TRestMethodAttribute(1.1, sscAuthNOTRequired)]
    function CreateSession(RestClientInfo: TRestClientInfo): TRestResult<string>;

    [TRestMethodAttribute(1.1, sscAuthNOTRequired)]
    function DestroySession(RestClientInfo: TRestClientInfo): TRestResult<string>;

    [TRestMethodAttribute(1.1, sscAuthNOTRequired)]
    function GetSessionID(RestClientInfo: TRestClientInfo): TRestResult<string>;

    [TRestMethodAttribute(1.1, sscAuthNOTRequired)]
    function GetAPIInfo(RestClientInfo: TRestClientInfo): TRestResult<TGetAPIInfoResult>;

    [TRestMethodAttribute(1.1, sscAuthNOTRequired)]
    function EchoString(RestClientInfo: TRestClientInfo; Value: string): TRestResult<string>;

    [TRestMethodAttribute(1.1, sscAuthNOTRequired)]
    function CheckUserExists(RestClientInfo: TRestClientInfo; UserID: string): TRestResult<boolean>;

    [TRestMethodAttribute(1.1, sscAuthNOTRequired)]
    function GetUserAuthorizationToken(RestClientInfo: TRestClientInfo; UserID: string): TRestResult<string>;

    [TRestMethodAttribute(1.1, sscAuthNOTRequired)]
    function RegisterNewUser(RestClientInfo: TRestClientInfo; NewUserData: TRestNewUser): TRestResult<string>;

    [TRestMethodAttribute(1.2, sscAuthRequired)]
    function SetRequestStatus(RestClientInfo: TRestClientInfo; RequestNumber, RequestStatusID: string; HTMLMessage: string = ''): TRestResult<string>;

    [TRestMethodAttribute(1.2, sscAuthRequired)]
    function AddRequestMessage(RestClientInfo: TRestClientInfo; RequestNumber, HTMLMessage: string; HiddenFromUser: boolean): TRestResult<string>;

  end;

{$METHODINFO OFF}

// Returns API info
function TNode1.GetAPIInfo(RestClientInfo: TRestClientInfo): TRestResult<TGetAPIInfoResult>;
const
  MethodName = 'GetAPIInfo';
var
  SL: TStringList;
  i: integer;
begin
  // Here i initialize result type as common TRestResult class with field "MethodResult" as TGetAPIInfoResult.
  Result := TRestResult<TGetAPIInfoResult>.Create(TGetAPIInfoResult.Create, RestClientInfo, MethodName, SessionContext);
  try
    if Result.Success() then
      begin
        // Method body
        Result.MethodResult.APIVersion := const_APIVersion;
        Result.MethodResult.APINode := Self.ClassName;
        SL := GetMethodsMinSupportedAPIVersions();
        SetLength(Result.MethodResult.MethodsInfo, SL.Count);
        for i := 0 to SL.Count - 1 do
          Result.MethodResult.MethodsInfo[i] := SL.Strings[i];
        SL.Free;
      end;
  finally
    // Save log
    SessionContext.restADCAddToExecutionHistory(MethodName, RestClientInfo.Name, sscApiLogin, RestClientInfo.sscLogin, RestClientInfo.sscAPITargetVersion,
      Result.Code);
  end;
end;

{
   "_parameters":[
      {
         "type":"NodeOne.TRestClientInfo",
         "id":1,
         "fields":{
            "Name":"Имя моего приложения",
            "PreferredLanguage":"Russian",
            "sscAPITargetVersion":"1.2",
            "sscLogin":"",
            "sscPassword":""
         }
      }
   ]
}

{
   "result":[
      {
         "type":"NodeOne.TRestResult<NodeOne.TGetAPIInfoResult>",
         "id":1,
         "fields":{
            "MethodResult":{
               "type":"NodeOne.TGetAPIInfoResult",
               "id":2,
               "fields":{
                  "APIVersion":1.2,
                  "APINode":"TNode1 ",
                  "MethodsInfo":[
                     "GetAPIInfo=1,1",
                     "EchoString=1,1"
                  ]
               }
            },
            "Code":0,
            "Description":"No errors.",
            "Comment":""
         }
      }
   ]
}

unit UnitSQLConnection;

interface

uses
  SynLog,              // logging features
  mORMot,              // RESTful server & ORM
  SynSQLite3,
  mORMotSQLite3,       // SQLite3 engine as ORM core
  SynSQLite3Static,    // staticaly linked SQLite3 engine
  mORMotDB,            // ORM using external DB
  SynDB,               // external DB core
  SynDBODBC,           // external DB access via ODBC
  UnitSQLDataModel;    // data model unit

var
  DataBase: TSQLRestServerDB;

implementation

var
  aProps: TSQLDBConnectionProperties;

procedure ConnectToDataBase();
begin
  // set logging abilities
  SQLite3Log.Family.Level := LOG_VERBOSE;
  // SQLite3Log.Family.EchoToConsole := LOG_VERBOSE;
  SQLite3Log.Family.PerThreadLog := ptIdentifiedInOnFile;
  // ODBC driver
  aProps := TODBCConnectionProperties.Create('', 'Driver={ODBC Driver 11 for SQL Server}; Server=127.0.0.1; Database=test_mORMot_ORM; Uid=IISUSR; Pwd=password_here; MARS_Connection=Yes;', '', '');
  // get the shared data model
  Model := CreateTabbleModel();
  // use MSSQL database for all tables
  VirtualTableExternalRegisterAll(Model, aProps);
  // create the main mORMot server
  DataBase := TSQLRestServerDB.Create(Model, ':memory:', false); // authentication=false
  // optionally execute all MSSQL requests in a single thread
  DataBase.AcquireExecutionMode[execORMGet] := amBackgroundORMSharedThread;
  DataBase.AcquireExecutionMode[execORMWrite] := amBackgroundORMSharedThread;
  // create tables or fields if missing
  DataBase.CreateMissingTables();
end;

procedure PrepareForShutdown();
begin
  aProps.Free;
  Model.Free;
  DataBase.Free;
end;

initialization

ConnectToDataBase();

finalization

PrepareForShutdown();

end.

unit UnitSQLDataModel;

interface

uses
  System.SysUtils,
  SynCommons,
  mORMot;

type
  TSQLUsers = class(TSQLRecord)
  private
    fName: RawUTF8;
    fSurname: RawUTF8;
    //fLastName: RawUTF8;
  published
    property Name: RawUTF8 read fName write fName;
    property Surname: RawUTF8 read fSurname write fSurname;
    //property LastName: RawUTF8 read fLastName write fLastName;
  end;

var
  Model: TSQLModel;

  function CreateTabbleModel: TSQLModel;

implementation

function CreateTabbleModel: TSQLModel;
begin
  result := TSQLModel.Create([TSQLUsers]);
end;

end.

procedure TForm1.FillUserList();
var
  Users: TSQLUsers;
begin
  ListBoxUsers.Clear;
  EditUserName.Clear;
  EditUserSurname.Clear;
  Users := TSQLUsers.CreateAndFillPrepare(Database, '');
  ListBoxUsers.Items.BeginUpdate;
  while Users.FillOne() do
    ListBoxUsers.Items.Add(UTF8ToString(Users.Name) + '=' + IntToStr(Users.ID));
  ListBoxUsers.Items.EndUpdate;
end;

procedure TForm1.AddUser();
var
  User: TSQLUsers;
begin
  User := TSQLUsers.Create();
  User.Name := StringToUTF8(EditUserName.Text);
  User.Surname := StringToUTF8(EditUserSurname.Text);
  Database.Add(User, True);
end;

procedure TForm1.ButtonUserAddClick(Sender: TObject);
var
  i: integer;
begin
  for i := 1 to 10000 do
    AddUser();
  FillUserList();
end;