Skip to content
Permalink
Branch: master
Find file Copy path
Find file Copy path
Fetching contributors…
Cannot retrieve contributors at this time
436 lines (366 sloc) 14.6 KB
/// remote access to a mORMot server using SmartMobileStudio
// - retrieved from http://localhost:888/root/wrapper/SmartMobileStudio/mORMotClient.pas
// at 2014-12-10 21:44:23 using "SmartMobileStudio.pas.mustache" template
unit mORMotClient;
{
WARNING:
This unit has been generated by a mORMot 1.18.626 server.
Any manual modification of this file may be lost after regeneration.
Synopse mORMot framework. Copyright (C) 2014 Arnaud Bouchez
Synopse Informatique - https://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.1 and later.
}
interface
uses
SmartCL.System,
System.Types,
SynCrossPlatformSpecific,
SynCrossPlatformREST;
type // define some enumeration types, used below
TPeopleSexe = (sFemale, sMale);
TRecordEnum = (reOne, reTwo, reLast);
type // define some record types, used as properties below
TTestCustomJSONArraySimpleArray = record
F: String;
G: array of String;
H: record
H1: Integer;
H2: String;
H3: record
H3a: Boolean;
H3b: TSQLRawBlob;
end;
end;
I: TDateTime;
J: array of record
J1: Byte;
J2: TGUID;
J3: TRecordEnum;
end;
end;
TSimpleRecord = record
A: Integer;
B: Integer;
C: String;
end;
type // define some dynamic array types, used as properties below
TPeopleSexeDynArray = array of Byte;
TSimpleRecordDynArray = array of TSimpleRecord;
type
/// map "People" table
TSQLRecordPeople = class(TSQLRecord)
protected
fFirstName: String;
fLastName: String;
fData: TSQLRawBlob;
fYearOfBirth: Integer;
fYearOfDeath: Word;
fSexe: TPeopleSexe;
fSimple: TTestCustomJSONArraySimpleArray;
// 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 FirstName: String read fFirstName write fFirstName;
property LastName: String read fLastName write fLastName;
property Data: TSQLRawBlob read fData write fData;
property YearOfBirth: Integer read fYearOfBirth write fYearOfBirth;
property YearOfDeath: Word read fYearOfDeath write fYearOfDeath;
property Sexe: TPeopleSexe read fSexe write fSexe;
property Simple: TTestCustomJSONArraySimpleArray read fSimple write fSimple;
end;
/// service accessible via http://localhost:888/root/Calculator
// - this service will run in sicShared mode
// - synchronous and asynchronous methods are available, depending on use case
// - synchronous _*() methods will block the browser execution, so won't be
// appropriate for long process - on error, they may raise EServiceException
TServiceCalculator = class(TServiceClientAbstract)
public
/// will initialize an access to the remote service
constructor Create(aClient: TSQLRestClientURI); override;
procedure Add(n1: Integer; n2: Integer;
onSuccess: procedure(Result: Integer); onError: TSQLRestEvent);
function _Add(const n1: Integer; const n2: Integer): Integer;
procedure ToText(Value: Currency; Curr: String; Sexe: TPeopleSexe; Name: String;
onSuccess: procedure(Sexe: TPeopleSexe; Name: String); onError: TSQLRestEvent);
procedure _ToText(const Value: Currency; const Curr: RawUTF8; var Sexe: TPeopleSexe; var Name: RawUTF8);
procedure RecordToText(Rec: TTestCustomJSONArraySimpleArray;
onSuccess: procedure(Rec: TTestCustomJSONArraySimpleArray; Result: String); onError: TSQLRestEvent);
function _RecordToText(var Rec: TTestCustomJSONArraySimpleArray): String;
procedure GetPeople(id: TID; arr: TSimpleRecordDynArray;
onSuccess: procedure(People: TSQLRecordPeople; Sexes: TPeopleSexeDynArray; arr: TSimpleRecordDynArray; Result: Boolean); onError: TSQLRestEvent);
function _GetPeople(const id: TID; var People: TSQLRecordPeople; var Sexes: TPeopleSexeDynArray; var arr: TSimpleRecordDynArray): Boolean;
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);
// publish some low-level helpers for variant conversion
// - used internally: you should not need those functions in your end-user code
function Variant2TPeopleSexe(const _variant: variant): TPeopleSexe;
function Variant2TRecordEnum(const _variant: variant): TRecordEnum;
function Variant2TTestCustomJSONArraySimpleArray(const Value: variant): TTestCustomJSONArraySimpleArray;
function TTestCustomJSONArraySimpleArray2Variant(const Value: TTestCustomJSONArraySimpleArray): variant;
function Variant2TSimpleRecord(const Value: variant): TSimpleRecord;
function TSimpleRecord2Variant(const Value: TSimpleRecord): variant;
function Variant2TPeopleSexeDynArray(const _variant: variant): TPeopleSexeDynArray;
function TPeopleSexeDynArray2Variant(const _array: TPeopleSexeDynArray): variant;
function Variant2TSimpleRecordDynArray(const _variant: variant): TSimpleRecordDynArray;
function TSimpleRecordDynArray2Variant(const _array: TSimpleRecordDynArray): variant;
implementation
{ Some helpers for enumerates types }
{$HINTS OFF} // for begin asm return ... end; end below
// those functions will use the existing generated string array constant
// defined by the SMS compiler for each enumeration
function Variant2TPeopleSexe(const _variant: variant): TPeopleSexe;
begin
asm return @VariantToEnum(@_variant,@TPeopleSexe); end;
end;
function Variant2TRecordEnum(const _variant: variant): TRecordEnum;
begin
asm return @VariantToEnum(@_variant,@TRecordEnum); end;
end;
{$HINTS ON}
{ Some helpers for record types:
due to potential obfuscation of generated JavaScript, we can't assume
that the JSON used for transmission would match record fields naming }
function Variant2TTestCustomJSONArraySimpleArray(const Value: variant): TTestCustomJSONArraySimpleArray;
begin
result.F := Value.F;
if VariantType(Value.G)=jvArray then
for var i := 0 to integer(Value.G.length)-1 do
result.G.Add(String(Value.G[i]));
result.H.H1 := Value.H.H1;
result.H.H2 := Value.H.H2;
result.H.H3.H3a := Value.H.H3.H3a;
result.H.H3.H3b := VariantToBlob(Value.H.H3.H3b);
result.I := Iso8601ToDateTime(Value.I);
if VariantType(Value.J)=jvArray then begin
var tmp: TTestCustomJSONArraySimpleArray;
tmp.J.SetLength(1);
for var n := 0 to integer(Value.J.length)-1 do begin
var source := Value.J[n];
var dest := tmp.J[0];
dest.J1 := source.J1;
dest.J2 := VariantToGUID(source.J2);
dest.J3 := Variant2TRecordEnum(source.J3);
result.J.Add(dest);
end;
end;
end;
function TTestCustomJSONArraySimpleArray2Variant(const Value: TTestCustomJSONArraySimpleArray): variant;
begin
result := new JObject;
result.F := Value.F;
result.G := variant(Value.G);
result.H := new JObject;
result.H.H1 := Value.H.H1;
result.H.H2 := Value.H.H2;
result.H.H3 := new JObject;
result.H.H3.H3a := Value.H.H3.H3a;
result.H.H3.H3b := BlobToVariant(Value.H.H3.H3b);
result.I := DateTimeToIso8601(Value.I);
result.J := TVariant.CreateArray;
for var source in Value.J do begin
var dest: variant := new JObject;
dest.J1 := source.J1;
dest.J2 := GUIDToVariant(source.J2);
dest.J3 := ord(source.J3);
result.J.push(dest);
end;
end;
function Variant2TSimpleRecord(const Value: variant): TSimpleRecord;
begin
result.A := Value.A;
result.B := Value.B;
result.C := Value.C;
end;
function TSimpleRecord2Variant(const Value: TSimpleRecord): variant;
begin
result := new JObject;
result.A := Value.A;
result.B := Value.B;
result.C := Value.C;
end;
{ Some helpers for dynamic array types }
function Variant2TPeopleSexeDynArray(const _variant: variant): TPeopleSexeDynArray;
var tmp: Byte;
begin
if VariantType(_variant)=jvArray then
for var i := 0 to integer(_variant.Length)-1 do begin
tmp := (_variant[i]);
result.Add(tmp);
end;
end;
function TPeopleSexeDynArray2Variant(const _array: TPeopleSexeDynArray): variant;
var i: integer;
begin
result := TVariant.CreateArray;
for i := 0 to high(_array) do
result.push((_array[i]));
end;
function Variant2TSimpleRecordDynArray(const _variant: variant): TSimpleRecordDynArray;
var tmp: TSimpleRecord;
begin
if VariantType(_variant)=jvArray then
for var i := 0 to integer(_variant.Length)-1 do begin
tmp := Variant2TSimpleRecord(_variant[i]);
result.Add(tmp);
end;
end;
function TSimpleRecordDynArray2Variant(const _array: TSimpleRecordDynArray): variant;
var i: integer;
begin
result := TVariant.CreateArray;
for i := 0 to high(_array) do
result.push(TSimpleRecord2Variant(_array[i]));
end;
{ TSQLRecordPeople }
class function TSQLRecordPeople.ComputeRTTI: TRTTIPropInfos;
begin
result := TRTTIPropInfos.Create(
['FirstName','LastName','Data','YearOfBirth','YearOfDeath','Sexe','Simple'],
[sftUnspecified,sftUnspecified,sftBlob,sftUnspecified,sftUnspecified,sftUnspecified,sftRecord]);
end;
procedure TSQLRecordPeople.SetProperty(FieldIndex: integer; const Value: variant);
begin
case FieldIndex of
0: fID := Value;
1: fFirstName := Value;
2: fLastName := Value;
3: fData := VariantToBlob(Value);
4: fYearOfBirth := Value;
5: fYearOfDeath := Value;
6: fSexe := Variant2TPeopleSexe(Value);
7: fSimple := Variant2TTestCustomJSONArraySimpleArray(Value);
end;
end;
function TSQLRecordPeople.GetProperty(FieldIndex: integer): variant;
begin
case FieldIndex of
0: result := fID;
1: result := fFirstName;
2: result := fLastName;
3: result := BlobToVariant(fData);
4: result := fYearOfBirth;
5: result := fYearOfDeath;
6: result := ord(fSexe);
7: result := TTestCustomJSONArraySimpleArray2Variant(fSimple);
end;
end;
function GetModel: TSQLModel;
begin
result := TSQLModel.Create([TSQLAuthUser,TSQLAuthGroup,TSQLRecordPeople],'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;
{ TServiceCalculator }
constructor TServiceCalculator.Create(aClient: TSQLRestClientURI);
begin
fServiceName := 'Calculator';
fServiceURI := 'Calculator';
fInstanceImplementation := sicShared;
fContractExpected := '814F1362B19B2F4D';
inherited Create(aClient);
end;
procedure TServiceCalculator.Add(n1: Integer; n2: Integer;
onSuccess: procedure(Result: Integer); onError: TSQLRestEvent);
begin
fClient.CallRemoteServiceAsynch(self,'Add',1,
[n1,n2],
lambda (res: array of Variant)
onSuccess(res[0]);
end, onError);
end;
function TServiceCalculator._Add(const n1: Integer; const n2: Integer): Integer;
begin
var res := fClient.CallRemoteServiceSynch(self,'Add',1,
[n1,n2]);
Result := res[0];
end;
procedure TServiceCalculator.ToText(Value: Currency; Curr: String; Sexe: TPeopleSexe; Name: String;
onSuccess: procedure(Sexe: TPeopleSexe; Name: String); onError: TSQLRestEvent);
begin
fClient.CallRemoteServiceAsynch(self,'ToText',2,
[Value,Curr,ord(Sexe),Name],
lambda (res: array of Variant)
onSuccess(Variant2TPeopleSexe(res[0]),res[1]);
end, onError);
end;
procedure TServiceCalculator._ToText(const Value: Currency; const Curr: RawUTF8; var Sexe: TPeopleSexe; var Name: RawUTF8);
begin
var res := fClient.CallRemoteServiceSynch(self,'ToText',2,
[Value,Curr,ord(Sexe),Name]);
Sexe := Variant2TPeopleSexe(res[0]);
Name := res[1];
end;
procedure TServiceCalculator.RecordToText(Rec: TTestCustomJSONArraySimpleArray;
onSuccess: procedure(Rec: TTestCustomJSONArraySimpleArray; Result: String); onError: TSQLRestEvent);
begin
fClient.CallRemoteServiceAsynch(self,'RecordToText',2,
[TTestCustomJSONArraySimpleArray2Variant(Rec)],
lambda (res: array of Variant)
onSuccess(Variant2TTestCustomJSONArraySimpleArray(res[0]),res[1]);
end, onError);
end;
function TServiceCalculator._RecordToText(var Rec: TTestCustomJSONArraySimpleArray): String;
begin
var res := fClient.CallRemoteServiceSynch(self,'RecordToText',2,
[TTestCustomJSONArraySimpleArray2Variant(Rec)]);
Rec := Variant2TTestCustomJSONArraySimpleArray(res[0]);
Result := res[1];
end;
procedure TServiceCalculator.GetPeople(id: TID; arr: TSimpleRecordDynArray;
onSuccess: procedure(People: TSQLRecordPeople; Sexes: TPeopleSexeDynArray; arr: TSimpleRecordDynArray; Result: Boolean); onError: TSQLRestEvent);
begin
fClient.CallRemoteServiceAsynch(self,'GetPeople',4,
[id,TSimpleRecordDynArray2Variant(arr)],
lambda (res: array of Variant)
onSuccess(TSQLRecordPeople.CreateFromVariant(res[0]),Variant2TPeopleSexeDynArray(res[1]),Variant2TSimpleRecordDynArray(res[2]),res[3]);
end, onError);
end;
function TServiceCalculator._GetPeople(const id: TID; var People: TSQLRecordPeople; var Sexes: TPeopleSexeDynArray; var arr: TSimpleRecordDynArray): Boolean;
begin
var res := fClient.CallRemoteServiceSynch(self,'GetPeople',4,
[id,TSimpleRecordDynArray2Variant(arr)]);
People := TSQLRecordPeople.CreateFromVariant(res[0]);
Sexes := Variant2TPeopleSexeDynArray(res[1]);
arr := Variant2TSimpleRecordDynArray(res[2]);
Result := res[3];
end;
end.
You can’t perform that action at this time.