mORMot Open Source

  :TRecB.:1 = record
    v1: Integer;
    v2: Integer;
  end;

  TRecB = record
    a1: array of :TRecB.:1;
    a2: array of Integer;
    v1: Integer;
  end;

function Variant2TRecB(const Value: variant): TRecB;
begin
  if VariantType(Value.a1)=jvArray then
    for var i := 0 to integer(Value.a1.length)-1 do
      result.a1.Add(Variant2TRecA(Value.a1[i]));
  if VariantType(Value.a2)=jvArray then
    for var i := 0 to integer(Value.a2.length)-1 do
      result.a2.Add(Variant2Integer(Value.a2[i]));
  result.v1 := Value.v1;
end;

type
  Ta=record
    ...
  end;
  Tb=record
    arr:array of Ta;
    ...
  end;

{"time":"2014-08-17 22:14:04","year":2014,"mORMotVersion":"1.18","root":"root","orm":[{"tableName":"Customer","className":"TSQLCustomer","fields":[{"typeName":"ptRawUTF8","typeDelphi":"RawUTF8","typePascal":"string","typeCS":"string","typeJava":"String","index":1,"name":"Name","sql":2,"sqlName":"sftUTF8Text","typeKind":0,"typeKindName":"sftUnspecified","attr":0,"comma":","},{"typeName":"ptInteger","typeDelphi":"integer","typePascal":"integer","typeCS":"integer","typeJava":"int","index":2,"name":"Age","sql":5,"sqlName":"sftInteger","typeKind":0,"typeKindName":"sftUnspecified","attr":0}],"isInMormotPas":null,"comma":","},{"tableName":"AuthUser","className":"TSQLAuthUser","fields":[{"typeName":"ptRawUTF8","typeDelphi":"RawUTF8","typePascal":"string","typeCS":"string","typeJava":"String","index":1,"name":"LogonName","sql":2,"sqlName":"sftUTF8Text","typeKind":0,"typeKindName":"sftUnspecified","attr":1,"unique":true,"width":20,"comma":","},{"typeName":"ptRawUTF8","typeDelphi":"RawUTF8","typePascal":"string","typeCS":"string","typeJava":"String","index":2,"name":"DisplayName","sql":2,"sqlName":"sftUTF8Text","typeKind":0,"typeKindName":"sftUnspecified","attr":0,"width":50,"comma":","},{"typeName":"ptRawUTF8","typeDelphi":"RawUTF8","typePascal":"string","typeCS":"string","typeJava":"String","index":3,"name":"PasswordHashHexa","sql":2,"sqlName":"sftUTF8Text","typeKind":0,"typeKindName":"sftUnspecified","attr":0,"width":64,"comma":","},{"typeName":"ptCardinal","typeDelphi":"cardinal","typePascal":"cardinal","typeCS":"uint","typeJava":"long","index":4,"name":"GroupRights","sql":6,"sqlName":"sftID","typeKind":0,"typeKindName":"sftUnspecified","attr":0,"comma":","},{"typeName":"ptRawByteString","typeDelphi":"TSQLRawBlob","typePascal":"TSQLRawBlob","typeCS":"byte[]","typeJava":"byte[]","isBlob":true,"toVariant":"BlobToVariant","fromVariant":"VariantToBlob","index":5,"name":"Data","sql":15,"sqlName":"sftBlob","typeKind":3,"typeKindName":"sftBlob","attr":0}],"isInMormotPas":true,"comma":","},{"tableName":"AuthGroup","className":"TSQLAuthGroup","fields":[{"typeName":"ptRawUTF8","typeDelphi":"RawUTF8","typePascal":"string","typeCS":"string","typeJava":"String","index":1,"name":"Ident","sql":2,"sqlName":"sftUTF8Text","typeKind":0,"typeKindName":"sftUnspecified","attr":1,"unique":true,"width":50,"comma":","},{"typeName":"ptInteger","typeDelphi":"integer","typePascal":"integer","typeCS":"integer","typeJava":"int","index":2,"name":"SessionTimeout","sql":5,"sqlName":"sftInteger","typeKind":0,"typeKindName":"sftUnspecified","attr":0,"comma":","},{"typeName":"ptRawUTF8","typeDelphi":"RawUTF8","typePascal":"string","typeCS":"string","typeJava":"String","index":3,"name":"AccessRights","sql":2,"sqlName":"sftUTF8Text","typeKind":0,"typeKindName":"sftUnspecified","attr":0,"width":1600}],"isInMormotPas":true,"comma":null}],"soa":null,"authClass":"TSQLRestServerAuthenticationDefault","uri":"root/wrapper/context","host":"localhost:888","port":888}

/// remote access to a mORMot server using SmartMobileStudio
// - retrieved from http://localhost:888/root/wrapper/SmartMobileStudio/mORMotClient.pas.txt
// at 2014-08-17 22:02:42 using "SmartMobileStudio.pas.mustache" template
unit mORMotClient;

{
  WARNING:
    This unit has been generated by a mORMot 1.18 server.
    Any manual modification of this file may be lost after regeneration.

  Synopse mORMot framework. Copyright (C) 2014 Arnaud Bouchez
    Synopse Informatique - http://synopse.info

  This unit is released under a MPL/GPL/LGPL tri-license,
  and therefore may be freely included in any application.

  This unit would work on Smart Mobile Studio 2.1 and later.
}

interface

uses
  SmartCL.System,
  System.Types,
  SynCrossPlatformSpecific,
  SynCrossPlatformREST;


type
  /// map "Customer" table
  TSQLCustomer = class(TSQLRecord)
  protected
    fName: string; 
    fAge: integer; 
    // those overriden methods will emulate the needed RTTI
    class function ComputeRTTI: TRTTIPropInfos; override;
    procedure SetProperty(FieldIndex: integer; const Value: variant); override;
    function GetProperty(FieldIndex: integer): variant; override;
  public
    property Name: string read fName write fName;
    property Age: integer read fAge write fAge;
  end;
  

const
  /// the server port, corresponding to http://localhost:888
  SERVER_PORT = 888;


/// return the database Model corresponding to this server
function GetModel: TSQLModel;

/// create a TSQLRestClientHTTP instance and connect to the server
// - it will use by default port 888
// - secure connection will be established via TSQLRestServerAuthenticationDefault
// with the supplied credentials
// - request will be asynchronous, and trigger onSuccess or onError event
procedure GetClient(const aServerAddress, aUserName,aPassword: string;
  onSuccess, onError: TSQLRestEvent; aServerPort: integer=SERVER_PORT);


implementation


{ TSQLCustomer }

class function TSQLCustomer.ComputeRTTI: TRTTIPropInfos;
begin
  result := TRTTIPropInfos.Create(
    ['Name','Age',],
    [sftUnspecified,sftUnspecified,]);
end;

procedure TSQLCustomer.SetProperty(FieldIndex: integer; const Value: variant);
begin
  case FieldIndex of
  0: fID := Value;
  1: fName := Value;
  2: fAge := Value;
  end;
end;

function TSQLCustomer.GetProperty(FieldIndex: integer): variant;
begin
  case FieldIndex of
  0: result := fID;
  1: result := fName;
  2: result := fAge;
  end;
end;


function GetModel: TSQLModel;
begin
  result := TSQLModel.Create([TSQLCustomer,TSQLAuthUser,TSQLAuthGroup],'root');
end;

procedure GetClient(const aServerAddress, aUserName,aPassword: string;
  onSuccess, onError: TSQLRestEvent; aServerPort: integer);
begin
  var client := TSQLRestClientHTTP.Create(aServerAddress,aServerPort,GetModel,true);
  client.Connect(
  lambda
    try
      if client.ServerTimeStamp=0 then begin
        if Assigned(onError) then
          onError(client);
        exit;
      end;
      if not client.SetUser(TSQLRestServerAuthenticationDefault,aUserName,aPassword) then begin
        if Assigned(onError) then
          onError(client);
        exit;
      end;
      if Assigned(onSuccess) then
        onSuccess(client);
    except
      if Assigned(onError) then
        onError(client);
    end;
  end,
  onError);
end;


end.

procedure TForm1.W3Button1Click(Sender: TObject);
var
  Client : TSQLRestClientURI;
  customer : TSQLCustomer;
  s : String;
begin
  GetClient('127.0.0.1','User','synopse',
    lambda (aClient: TSQLRestClientURI)
      Client := aClient;
      customer := TSQLCustomer.CreateAndFillPrepare(Client,'','',[]);
      while customer.FillOne do
      begin
        s := customer.Name + ' ' + IntToStr(customer.Age);
        ShowMessage(s);
      end;
    end,
    lambda
      ShowMessage('Impossible to connect to the server!');
    end);
end;

program mORMotWrapGenTest;

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

uses
  System.SysUtils,
  Classes,
  SynCommons,
  mORMot,
  mORMotWrappers,
  mORMotHttpClient,
  mORMotHttpServer,
  mORMotSQLite3,
  SynSQLite3Static;

type
  TAddress = packed record
    Street, Zip, City : RawUTF8;
  end;

  TSex = (male, female);

  TPerson = packed record
    Name, Phone : RawUTF8;
    Sex : TSex;
  end;
  TContacts = array of TPerson;

  TOrderPosition = class(TCollectionItem)
  private
    fDate: TDateTime;
    fDescription: RawUTF8;
    fVolume: double;
  published
    property Date: TDateTime read fDate write fDate;
    property Description: RawUTF8 read fDescription write fDescription;
    property Volume: double read fVolume write fVolume;
  end;

  TOrdersCollection = class(TInterfacedCollection)
  private
    function GetCollItem(Index: Integer): TOrderPosition;
  protected
    class function GetClass: TCollectionItemClass; override;
  public
    function Add: TOrderPosition;
    property Item[index: Integer]: TOrderPosition
      read GetCollItem; default;
  end;

  TSQLCustomer = class(TSQLRecord)
  private
    fName: RawUTF8;
    fAddress: TAddress;
    fContacts: TContacts;
    fOrders: TOrdersCollection;
  public
    constructor Create; override;
    destructor Destroy; override;
  published
    property Name : RawUTF8 read fName write fName;
    property Address : TAddress read fAddress write fAddress;
    property Contacts : TContacts read fContacts write fContacts;
    property Orders : TOrdersCollection read fOrders write fOrders;
  end;

  ICustomerMgmt = interface (IInvokable)
    ['{9FE0D344-4488-4460-81D7-C89F8D29EC4A}']
    procedure MoveCustomerToNewAddress(CustomerID : integer;
      const NewAddress: TAddress);
    procedure AddContactToCustomer(CustomerID : integer;
      const NewContact: TPerson);
  end;

  IOrderMgmt = interface (IInvokable)
    ['{BF335418-61B4-4657-AA84-314FEE6BB342}']
    function CreateOrderForCustomer(WithCustomerID : integer) : integer;
  end;

  TCustomerMgmt = class(TInterfacedObject, ICustomerMgmt)
  public
    procedure MoveCustomerToNewAddress(CustomerID : integer;
      const NewAddress: TAddress);
    procedure AddContactToCustomer(CustomerID : integer;
      const NewContact: TPerson);
  end;

  TOrderMgmt = class(TInterfacedObject, IOrderMgmt)
  public
    function CreateOrderForCustomer(WithCustomerID : integer) : integer;
  end;

var
  FModel: TSQLModel;
  FServer: TSQLRestServer;
  FHTTPServer: TSQLHttpServer;

{ TOrderMgmt }

function TOrderMgmt.CreateOrderForCustomer(WithCustomerID: integer): integer;
begin
  Result := WithCustomerID; // just to return something - it's only a test
end;

{ TCustomerMgmt }

procedure TCustomerMgmt.AddContactToCustomer(CustomerID: integer;
  const NewContact: TPerson);
begin
  // Read Customer, Add NewContact to Contacts, Save Customer
end;

procedure TCustomerMgmt.MoveCustomerToNewAddress(CustomerID: integer;
  const NewAddress: TAddress);
begin
  // Read Customer, assign new Address, Save Customer
end;

{ TOrdersCollection }

function TOrdersCollection.Add: TOrderPosition;
begin
  result := inherited Add as TOrderPosition;
end;

class function TOrdersCollection.GetClass: TCollectionItemClass;
begin
  result := TOrderPosition;
end;

function TOrdersCollection.GetCollItem(Index: Integer): TOrderPosition;
begin
  result := Items[index] as TOrderPosition;
end;

{ TSQLCustomer }

constructor TSQLCustomer.Create;
begin
  inherited;
  fOrders := TOrdersCollection.Create;
end;

destructor TSQLCustomer.Destroy;
begin
  fOrders.Free;
  inherited;
end;

begin
  fModel := TSQLModel.Create([TSQLCustomer]);
  fServer := TSQLRestServerDB.Create(fModel, ChangeFileExt(paramstr(0), '.db3'),True);
  fServer.CreateMissingTables;
  AddToServerWrapperMethod(fServer,
    ['..\..\..\CrossPlatform\templates', '..\..\..\..\CrossPlatform\templates']);
  fServer.ServiceRegister(TCustomerMgmt,[TypeInfo(ICustomerMgmt)],sicSingle);
  fServer.ServiceRegister(TOrderMgmt,[TypeInfo(IOrderMgmt)],sicSingle);
  fHTTPServer := TSQLHttpServer.Create('888',[fServer],'+',useHttpApiRegisteringURI);
  fHTTPServer.AccessControlAllowOrigin := '*';
  WriteLn ('Server is running. Hit any key to exit.');
  ReadLn;
end.

...
type // define some enumeration types, used below
  Boolean = (False, True);
  Boolean = (False, True);
  Boolean = (False, True);
...

unit Unit1;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.StdCtrls,
  FMX.Edit;

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    Button1: TButton;
    Label1: TLabel;
    procedure Button1Click(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.fmx}

uses
  SynCrossPlatformCrypto,
  SynCrossPlatformJSON,
  SynCrossPlatformREST,
  SynCrossPlatformSpecific;

// didn't want to change the sample unit, so pasted the definition here
// for testing purpose that should do it

type
  TSQLSampleRecord = class(TSQLRecord)
  private
    fQuestion: RawUTF8;
    fName: RawUTF8;
    fTime: TModTime;
  published
    property Time: TModTime read fTime write fTime;
    property Name: RawUTF8 read fName write fName;
    property Question: RawUTF8 read fQuestion write fQuestion;
  end;

procedure TForm1.Button1Click(Sender: TObject);
var
  database : TSQLRest;
  model : TSQLModel;
  rec : TSQLSampleRecord;
begin
  model := TSQLModel.Create([TSQLSampleRecord]);
  database := TSQLRestClientHTTP.Create(Edit1.Text,8080,model);
  TSQLRestClientHTTP(database).SetUser(TSQLRestAuthenticationDefault, 'User','synopse');
  rec := TSQLSampleRecord.Create (database,1);
  Label1.Text := rec.Name;
  FreeAndNil(rec);
  FreeAndNil(database);
  FreeAndNil(model);
end;

end.

[DCC Fataler Fehler] SynCrossPlatformJSON.pas(63): F1026 Datei nicht gefunden: 'C:\src\MobileMormotTest\Contnrs.dcu'

uses
  SysUtils,
  Classes,
  System.Generics.Collections,
  Variants,
  TypInfo;

type
  TObjectList = TObjectList<TObject>;
  TStringDynArray = array of string;
  TVariantDynArray = array of variant;

Abh‰ngigkeiten des Projekts werden ¸berpr¸ft...
Compilieren von Project1.dproj (Debug, iOSSimulator)
dcc Befehlszeile f¸r "Project1.dpr"
  c:\xe6\embarcadero\studio\14.0\bin\dccios32.exe -$O- -$W+ --no-config -M -Q -TX. -[... deleted some pathnames here ...]  -NBC:\Users\Public\Documents\Embarcadero\Studio\14.0\Dcp\iOSSimulator -NO.\iOSSimulator\Debug   Project1.dpr   
[DCC Hinweis] SynCrossPlatform.inc(64): H2586 Alte '$IFEND'-Direktive gefunden. ƒndern Sie diese Direktive in '$ENDIF', oder aktivieren Sie $LEGACYIFEND
[DCC Hinweis] SynCrossPlatform.inc(67): H2586 Alte '$IFEND'-Direktive gefunden. ƒndern Sie diese Direktive in '$ENDIF', oder aktivieren Sie $LEGACYIFEND
[DCC Hinweis] SynCrossPlatform.inc(70): H2586 Alte '$IFEND'-Direktive gefunden. ƒndern Sie diese Direktive in '$ENDIF', oder aktivieren Sie $LEGACYIFEND
[DCC Hinweis] SynCrossPlatform.inc(74): H2586 Alte '$IFEND'-Direktive gefunden. ƒndern Sie diese Direktive in '$ENDIF', oder aktivieren Sie $LEGACYIFEND
[DCC Fehler] SynCrossPlatformJSON.pas(692): E2003 Undeklarierter Bezeichner: 'WideString'
[DCC Fehler] SynCrossPlatformJSON.pas(1152): E2089 Ung¸ltige Typumwandlung
[DCC Fehler] SynCrossPlatformJSON.pas(1157): E2089 Ung¸ltige Typumwandlung
[DCC Fehler] SynCrossPlatformJSON.pas(1169): E2089 Ung¸ltige Typumwandlung
[DCC Fehler] SynCrossPlatformJSON.pas(1189): E2003 Undeklarierter Bezeichner: 'GetWideStrProp'
[DCC Fehler] SynCrossPlatformJSON.pas(1192): E2003 Undeklarierter Bezeichner: 'GetUnicodeStrProp'
[DCC Fehler] SynCrossPlatformJSON.pas(1231): E2003 Undeklarierter Bezeichner: 'SetWideStrProp'
[DCC Fehler] SynCrossPlatformJSON.pas(1236): E2003 Undeklarierter Bezeichner: 'SetUnicodeStrProp'
[DCC Warnung] SynCrossPlatformJSON.pas(1350): W1000 Symbol 'TList' ist veraltet
[DCC Warnung] SynCrossPlatformJSON.pas(1351): W1000 Symbol 'TList' ist veraltet
[DCC Warnung] SynCrossPlatformJSON.pas(1351): W1000 Symbol 'Count' ist veraltet
[DCC Warnung] SynCrossPlatformJSON.pas(1354): W1000 Symbol 'TList' ist veraltet
[DCC Warnung] SynCrossPlatformJSON.pas(1354): W1000 Symbol 'Count' ist veraltet
[DCC Warnung] SynCrossPlatformJSON.pas(1355): W1000 Symbol 'TList' ist veraltet
[DCC Warnung] SynCrossPlatformJSON.pas(1355): W1000 Symbol 'List' ist veraltet
[DCC Fehler] SynCrossPlatformJSON.pas(1392): E2089 Ung¸ltige Typumwandlung
[DCC Fehler] SynCrossPlatformJSON.pas(1413): E2003 Undeklarierter Bezeichner: 'ShortString'
[DCC Fataler Fehler] Unit1.pas(31): F2063 Verwendete Unit 'SynCrossPlatformJSON.pas' kann nicht compiliert werden
Misslungen
Verstrichene Zeit: 00:00:00.4