source upload
This commit is contained in:
Razor12911
@@ -0,0 +1,267 @@
|
||||
unit PeopleServer;
|
||||
|
||||
interface
|
||||
|
||||
{$define TESTRECORD}
|
||||
|
||||
uses
|
||||
SynCommons,
|
||||
mORMot,
|
||||
mORMotHttpServer,
|
||||
mORMotWrappers,
|
||||
SynMustache,
|
||||
SysUtils;
|
||||
|
||||
type
|
||||
{$ifdef TESTRECORD}
|
||||
TRecordEnum = (reOne, reTwo, reLast);
|
||||
|
||||
TTestCustomJSONArraySimpleArray = packed record
|
||||
F: RawUTF8;
|
||||
G: array of RawUTF8;
|
||||
H: record
|
||||
H1: integer;
|
||||
H2: WideString;
|
||||
H3: record
|
||||
H3a: boolean;
|
||||
H3b: RawByteString;
|
||||
end;
|
||||
end;
|
||||
I: TDateTime;
|
||||
J: array of packed record
|
||||
J1: byte;
|
||||
J2: TGUID;
|
||||
J3: TRecordEnum;
|
||||
end;
|
||||
end;
|
||||
{$endif TESTRECORD}
|
||||
|
||||
{
|
||||
TRecB=packed record
|
||||
a1:array of packed record
|
||||
v1,v2:integer;
|
||||
end;
|
||||
a2:array of integer;
|
||||
v1:integer;
|
||||
end;
|
||||
}
|
||||
|
||||
TPeopleSexe = (sFemale, sMale);
|
||||
|
||||
TPeopleSexeDynArray = array of TPeopleSexe;
|
||||
|
||||
TSimpleRecord = packed record
|
||||
A,B: integer;
|
||||
C: RawUTF8;
|
||||
end;
|
||||
|
||||
TSimpleRecordDynArray = array of TSimpleRecord;
|
||||
|
||||
TSQLRecordPeople = class(TSQLRecord)
|
||||
protected
|
||||
fData: TSQLRawBlob;
|
||||
fFirstName: RawUTF8;
|
||||
fLastName: RawUTF8;
|
||||
fYearOfBirth: integer;
|
||||
fYearOfDeath: word;
|
||||
fAnother: TSQLRecordPeople;
|
||||
{$ifdef TESTRECORD}
|
||||
fSexe: TPeopleSexe;
|
||||
fSimple: TTestCustomJSONArraySimpleArray;
|
||||
public
|
||||
class procedure InternalRegisterCustomProperties(Props: TSQLRecordProperties); override;
|
||||
{$endif}
|
||||
published
|
||||
property FirstName: RawUTF8 read fFirstName write fFirstName;
|
||||
property LastName: RawUTF8 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 Another: TSQLRecordPeople read fAnother write fAnother;
|
||||
{$ifdef TESTRECORD}
|
||||
property Sexe: TPeopleSexe read fSexe write fSexe;
|
||||
public
|
||||
property Simple: TTestCustomJSONArraySimpleArray read fSimple;
|
||||
{$endif}
|
||||
end;
|
||||
|
||||
ICalculator = interface(IInvokable)
|
||||
['{9A60C8ED-CEB2-4E09-87D4-4A16F496E5FE}']
|
||||
function Add(n1,n2: integer): integer;
|
||||
procedure ToText(Value: Currency; const Curr: RawUTF8;
|
||||
var Sexe: TPeopleSexe; var Name: RawUTF8);
|
||||
{$ifdef TESTRECORD}
|
||||
function RecordToText(var Rec: TTestCustomJSONArraySimpleArray): string;
|
||||
{$endif}
|
||||
function GetPeople(id: TID; out People: TSQLRecordPeople;
|
||||
out Sexes: TPeopleSexeDynArray; var arr: TSimpleRecordDynArray): boolean;
|
||||
// var rec: TRecB): boolean;
|
||||
//function Test(toto: integer): TServiceCustomAnswer;
|
||||
end;
|
||||
|
||||
TCustomServer = class(TSQLRestServerFullMemory)
|
||||
published
|
||||
procedure DropTable(Ctxt: TSQLRestServerURIContext);
|
||||
end;
|
||||
|
||||
TPeopleServerAuthentication = (psaNone,psaWeak,psaDefault);
|
||||
|
||||
|
||||
procedure StartServer(auth: TPeopleServerAuthentication);
|
||||
|
||||
procedure StopServer;
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
{ TServiceCalculator }
|
||||
|
||||
type
|
||||
TServiceCalculator = class(TInterfacedObject, ICalculator)
|
||||
public
|
||||
function Add(n1,n2: integer): integer;
|
||||
procedure ToText(Value: Currency; const Curr: RawUTF8;
|
||||
var Sexe: TPeopleSexe; var Name: RawUTF8);
|
||||
{$ifdef TESTRECORD}
|
||||
function RecordToText(var Rec: TTestCustomJSONArraySimpleArray): string;
|
||||
{$endif}
|
||||
function GetPeople(id: TID; out People: TSQLRecordPeople;
|
||||
out Sexes: TPeopleSexeDynArray; var arr: TSimpleRecordDynArray): boolean;
|
||||
// var rec: TRecB): boolean;
|
||||
function Test(toto: integer): TServiceCustomAnswer;
|
||||
end;
|
||||
|
||||
function TServiceCalculator.Add(n1, n2: integer): integer;
|
||||
begin
|
||||
result := n1+n2;
|
||||
end;
|
||||
|
||||
procedure TServiceCalculator.ToText(Value: Currency; const Curr: RawUTF8;
|
||||
var Sexe: TPeopleSexe; var Name: RawUTF8);
|
||||
const SEX_TEXT: array[TPeopleSexe] of RawUTF8 = ('Miss','Mister');
|
||||
begin
|
||||
Name := FormatUTF8('% % for % %',[Curr,Value,SEX_TEXT[Sexe],Name]);
|
||||
Sexe := sFemale;
|
||||
end;
|
||||
|
||||
function TServiceCalculator.GetPeople(id: TID;
|
||||
out People: TSQLRecordPeople; out Sexes: TPeopleSexeDynArray;
|
||||
var arr: TSimpleRecordDynArray{; var rec: TRecB}): boolean;
|
||||
var n: integer;
|
||||
begin
|
||||
result := ServiceContext.Request.Server.Retrieve(id,People);
|
||||
n := length(arr);
|
||||
SetLength(arr,n+1);
|
||||
arr[n].A := id;
|
||||
arr[n].C := People.FirstName;
|
||||
end;
|
||||
|
||||
|
||||
{$ifdef TESTRECORD}
|
||||
|
||||
function TServiceCalculator.RecordToText(var Rec: TTestCustomJSONArraySimpleArray): string;
|
||||
var n: integer;
|
||||
begin
|
||||
result := UTF8ToString(RecordSaveJSON(Rec,TypeInfo(TTestCustomJSONArraySimpleArray)));
|
||||
Rec.F := Rec.F+'!';
|
||||
n := length(Rec.G);
|
||||
SetLength(Rec.G,n+1);
|
||||
Rec.G[n] := UInt32ToUtf8(n+1);
|
||||
inc(Rec.H.H1);
|
||||
if n=0 then
|
||||
exit; // first return J[] with nothing
|
||||
n := length(Rec.J);
|
||||
SetLength(Rec.J,n+1);
|
||||
Rec.J[n].J1 := n;
|
||||
Rec.J[n].J2.D2 := n;
|
||||
Rec.J[n].J3 := TRecordEnum(n mod (ord(high(TRecordEnum))+1));
|
||||
end;
|
||||
|
||||
{$endif}
|
||||
|
||||
{ TCustomServer }
|
||||
|
||||
procedure TCustomServer.DropTable(Ctxt: TSQLRestServerURIContext);
|
||||
begin
|
||||
if (Ctxt.Method=mGET) and (Ctxt.TableIndex>=0) then begin
|
||||
TSQLRestStorageInMemory(fStaticData[Ctxt.TableIndex]).DropValues;
|
||||
Ctxt.Success;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
var Model: TSQLModel;
|
||||
DB: TCustomServer;
|
||||
Server: TSQLHttpServer;
|
||||
|
||||
procedure StartServer(auth: TPeopleServerAuthentication);
|
||||
begin
|
||||
StopServer;
|
||||
//TSQLLog.Family.Level := LOG_VERBOSE;
|
||||
Model := TSQLModel.Create([TSQLAuthUser,TSQLAuthGroup,TSQLRecordPeople]);
|
||||
DB := TCustomServer.Create(Model);
|
||||
Server := TSQLHttpServer.Create('888',DB);
|
||||
Server.AccessControlAllowOrigin := '*';
|
||||
case auth of
|
||||
psaDefault:
|
||||
DB.AuthenticationRegister(TSQLRestServerAuthenticationDefault);
|
||||
psaWeak:
|
||||
DB.AuthenticationRegister(TSQLRestServerAuthenticationNone);
|
||||
end;
|
||||
if DB.TableRowCount(TSQLRecordPeople)=0 then
|
||||
// we expect at least one record
|
||||
if DB.AddSimple(TSQLRecordPeople,['First1','Last1',1801,1826,1{$ifdef TESTRECORD},0,''{$endif}])=0 then
|
||||
writeln('StartServer DB.Add(TSQLRecordPeople) Error');
|
||||
// in all cases, client will call DropTable method-based service
|
||||
AddToServerWrapperMethod(DB,['..\..\..\CrossPlatform\templates',
|
||||
'..\..\..\..\CrossPlatform\templates']);
|
||||
{$ifndef FPC}
|
||||
DB.ServiceRegister(TServiceCalculator,[TypeInfo(ICalculator)],sicShared);
|
||||
{$endif}
|
||||
end;
|
||||
|
||||
procedure StopServer;
|
||||
begin
|
||||
FreeAndNil(Server);
|
||||
FreeAndNil(DB);
|
||||
FreeAndNil(Model);
|
||||
end;
|
||||
|
||||
{$ifdef TESTRECORD}
|
||||
|
||||
{ TSQLRecordPeople }
|
||||
|
||||
const
|
||||
__TTestCustomJSONArraySimpleArray =
|
||||
'F RawUTF8 G array of RawUTF8 '+
|
||||
'H {H1 integer H2 WideString H3{H3a boolean H3b RawByteString}} I TDateTime '+
|
||||
'J [J1 byte J2 TGUID J3 TRecordEnum]';
|
||||
__TSimpleRecord = 'A,B:integer C: RawUTF8';
|
||||
__TRecB = 'a2:array of integer v1:integer';
|
||||
// __TRecB = 'a1 [v1,v2:integer] a2:array of integer v1:integer';
|
||||
|
||||
class procedure TSQLRecordPeople.InternalRegisterCustomProperties(
|
||||
Props: TSQLRecordProperties);
|
||||
begin
|
||||
Props.RegisterCustomPropertyFromRTTI(Self,TypeInfo(TTestCustomJSONArraySimpleArray),
|
||||
'Simple',@TSQLRecordPeople(nil).fSimple);
|
||||
end;
|
||||
|
||||
function TServiceCalculator.Test(toto: integer): TServiceCustomAnswer;
|
||||
begin
|
||||
result.Header := TEXT_CONTENT_TYPE_HEADER;
|
||||
result.Content := Int32ToUtf8(toto);
|
||||
result.Status := HTTP_SUCCESS;
|
||||
end;
|
||||
|
||||
initialization
|
||||
TTextWriter.RegisterCustomJSONSerializerFromTextSimpleType(TypeInfo(TRecordEnum));
|
||||
TTextWriter.RegisterCustomJSONSerializerFromText(
|
||||
TypeInfo(TTestCustomJSONArraySimpleArray),__TTestCustomJSONArraySimpleArray);
|
||||
TTextWriter.RegisterCustomJSONSerializerFromText(TypeInfo(TSimpleRecord),__TSimpleRecord);
|
||||
// TTextWriter.RegisterCustomJSONSerializerFromText(TypeInfo(TRecB),__TRecB);
|
||||
|
||||
|
||||
{$endif TESTRECORD}
|
||||
|
||||
end.
|
||||
Reference in New Issue
Block a user