mirror of
https://gitlab.com/freepascal.org/fpc/pas2js.git
synced 2025-04-27 22:04:39 +02:00
715 lines
19 KiB
ObjectPascal
715 lines
19 KiB
ObjectPascal
{
|
|
This file is part of the Free Pascal run time library.
|
|
Copyright (c) 2019 by Michael Van Canneyt, member of the
|
|
Free Pascal development team
|
|
|
|
Simple SQLDBRESTBridge JSON dataset component and connection.
|
|
|
|
See the file COPYING.FPC, included in this distribution,
|
|
for details about the copyright.
|
|
|
|
This program is distributed in the hope that it will be useful,
|
|
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
|
|
|
|
**********************************************************************}
|
|
unit sqldbrestdataset;
|
|
|
|
{$mode objfpc}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, SysUtils, JS, web, db, JSONDataset, restconnection;
|
|
|
|
Type
|
|
|
|
{ TSQLDBRestConnection }
|
|
|
|
TSQLDBRestConnection = Class(TRestConnection)
|
|
private
|
|
FConnectionsResourceName: String;
|
|
FCustomViewResourceName: String;
|
|
FDataProperty: String;
|
|
FmetaDataProperty: String;
|
|
FMetaDataResourceName: String;
|
|
FonGetResources: TNotifyEvent;
|
|
FPassword: String;
|
|
FResourceList: TStrings;
|
|
FUserName: String;
|
|
procedure DoResources(Sender: TObject);
|
|
function DoStoreDataProp: Boolean;
|
|
function DoStoreMetadata: Boolean;
|
|
function DoStoreMetadataProp: Boolean;
|
|
Protected
|
|
Procedure SetupRequest(aXHR : TJSXMLHttpRequest); override;
|
|
Function GetUpdateBaseURL(aRequest: TRecordUpdateDescriptor): String; override;
|
|
Function GetReadBaseURL(aRequest: TDataRequest): String; Override;
|
|
Public
|
|
Constructor create(aOwner : TComponent); override;
|
|
Destructor Destroy; override;
|
|
Procedure GetResources(OnResult : TNotifyEvent = Nil);
|
|
Property ResourceList : TStrings Read FResourceList;
|
|
Published
|
|
Property OnGetResources : TNotifyEvent Read FonGetResources Write FOnGetResources;
|
|
Property metaDataProperty : String read FmetaDataProperty Write FmetaDataProperty Stored DoStoreMetadataProp;
|
|
Property DataProperty : String read FDataProperty Write FDataProperty Stored DoStoreDataProp;
|
|
Property MetaDataResourceName : String Read FMetaDataResourceName Write FMetaDataResourceName Stored DoStoreMetadata;
|
|
Property UserName : String Read FUserName Write FUserName;
|
|
Property Password : String Read FPassword Write FPassword;
|
|
Property ConnectionsResourceName : String Read FConnectionsResourceName Write FConnectionsResourceName;
|
|
Property CustomViewResourceName : String Read FCustomViewResourceName Write FCustomViewResourceName;
|
|
// Published from TRESTCOnnection
|
|
Property BaseURL;
|
|
Property PageParam;
|
|
Property OnGetURL;
|
|
Property OnUpdateURL;
|
|
end;
|
|
|
|
{ TSQLDBRestDataset }
|
|
|
|
{ TQueryParam }
|
|
|
|
TQueryParam = class(TParam)
|
|
private
|
|
FEnabled: Boolean;
|
|
Public
|
|
Procedure Assign(Source : TPersistent); override;
|
|
function AsQuery : String;
|
|
Published
|
|
Property Enabled : Boolean Read FEnabled Write FEnabled;
|
|
end;
|
|
|
|
{ TQueryParams }
|
|
|
|
TQueryParams = Class(TParams)
|
|
private
|
|
function GetP(aIndex : Integer): TQueryParam;
|
|
procedure SetP(aIndex : Integer; AValue: TQueryParam);
|
|
Public
|
|
function AddParam(aName : string; aEnabled : Boolean = False) : TQueryParam; overload;
|
|
Property Params[aIndex : Integer] : TQueryParam Read GetP Write SetP; default;
|
|
end;
|
|
|
|
TGetQueryParamsEvent = Procedure (Sender : TDataset; IsReadURL : Boolean; var QueryString : String) of object;
|
|
|
|
TSQLDBRestDataset = Class(TJSONDataset)
|
|
private
|
|
FAutoApplyUpdates: Boolean;
|
|
FConnection: TSQLDBRestConnection;
|
|
FDatabaseConnection: String;
|
|
FOnGetQueryParams: TGetQueryParamsEvent;
|
|
FParams: TQueryParams;
|
|
FResourceID: String;
|
|
FResourceName: String;
|
|
FSQL: TStrings;
|
|
function CleanSQL: String;
|
|
function CustomViewResourceName: String;
|
|
procedure DoSQLChange(Sender: TObject);
|
|
procedure SetConnection(AValue: TSQLDBRestConnection);
|
|
procedure SetParams(AValue: TQueryParams);
|
|
procedure SetResourceID(AValue: String);
|
|
procedure SetResourceName(AValue: String);
|
|
procedure SetSQL(AValue: TStrings);
|
|
Protected
|
|
Procedure DoAfterPost; override;
|
|
Procedure DoAfterDelete; override;
|
|
function MyURL(isRead : Boolean): String; virtual;
|
|
Function CreateQueryParams : TQueryParams; virtual;
|
|
function GetURLQueryParams(IsRead : Boolean): string; virtual;
|
|
function DataPacketReceived(ARequest: TDataRequest): Boolean; override;
|
|
function GetStringFieldLength(F: TJSObject; AName: String; AIndex: Integer): integer;virtual;
|
|
function StringToFieldType(S: String): TFieldType; virtual;
|
|
Function DoGetDataProxy: TDataProxy; override;
|
|
Procedure MetaDataToFieldDefs; override;
|
|
Public
|
|
Constructor Create(aOwner : TComponent); override;
|
|
Destructor Destroy; override;
|
|
Class Function DefaultBlobDataToBytes(aValue : JSValue) : TBytes; override;
|
|
Class Function DefaultBytesToBlobData(aValue : TBytes) : JSValue; override;
|
|
Function ParamByName(const aName : String) : TQueryParam;
|
|
Published
|
|
// Connection to use to get data
|
|
Property Connection: TSQLDBRestConnection Read FConnection Write SetConnection;
|
|
// The resource to get/post/put/delete
|
|
Property ResourceName : String Read FResourceName Write SetResourceName;
|
|
// When set, the CustomView resource (as set in CustomViewResourceName) is used. Use with care!
|
|
Property SQL : TStrings Read FSQL Write SetSQL;
|
|
// Database connection to use for the resource. Will be appended to URL.
|
|
property DatabaseConnection : String Read FDatabaseConnection Write FDatabaseConnection;
|
|
// Parameters to send (use for filtering)
|
|
Property Params : TQueryParams Read FParams Write SetParams;
|
|
{
|
|
If you want to get a single resource, set the ID of the resource here.
|
|
This is equivalent to setting a parameter ID to the specified value.
|
|
}
|
|
Property ResourceID : String Read FResourceID Write SetResourceID;
|
|
// Get additional parameters with this event.
|
|
Property OnGetQueryParams : TGetQueryParamsEvent Read FOnGetQueryParams Write FOnGetQueryParams;
|
|
// Always immediatly call ApplyUpdates after post and delete.
|
|
Property AutoApplyUpdates : Boolean Read FAutoApplyUpdates Write FAutoApplyUpdates;
|
|
end;
|
|
|
|
implementation
|
|
|
|
uses DateUtils;
|
|
|
|
Type
|
|
|
|
{ TServiceRequest }
|
|
|
|
TServiceRequest = Class(TObject)
|
|
Private
|
|
FOnMyDone,
|
|
FOnDone : TNotifyEvent;
|
|
FXHR: TJSXMLHttpRequest;
|
|
function GetResult: String;
|
|
function GetResultJSON: TJSObject;
|
|
function GetStatusCode: Integer;
|
|
function onLoad(Event{%H-}: TEventListenerEvent): boolean;
|
|
Public
|
|
Constructor Create(Const aMethod,aURL,aUserName,aPassword : String; aOnDone1 : TNotifyEvent; aOnDone2 : TNotifyEvent = Nil);
|
|
Procedure Execute;
|
|
Property RequestResult : String read GetResult;
|
|
Property ResultJSON : TJSObject read GetResultJSON;
|
|
Property OnDone : TNotifyEvent Read FOnDone;
|
|
Property StatusCode : Integer Read GetStatusCode;
|
|
end;
|
|
|
|
{ TQueryParam }
|
|
|
|
procedure TQueryParam.Assign(Source: TPersistent);
|
|
|
|
Var
|
|
P : TQueryParam absolute Source;
|
|
|
|
begin
|
|
if Source is TQueryParam then
|
|
begin
|
|
FEnabled:=P.Enabled;
|
|
end;
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
function TQueryParam.AsQuery: String;
|
|
|
|
var
|
|
B : TBytes;
|
|
I : Integer;
|
|
|
|
begin
|
|
Result:='';
|
|
if Not Enabled then
|
|
exit;
|
|
Case DataType of
|
|
ftInteger : Result:=IntToStr(AsInteger);
|
|
ftAutoInc,
|
|
ftLargeInt : Result:=IntToStr(AsLargeInt);
|
|
ftBoolean : Result:=IntToStr(Ord(AsBoolean));
|
|
ftFloat : Str(asFloat,Result);
|
|
ftDate : Result:=DateToISO8601(asDateTime);
|
|
ftTime : Result:=DateToISO8601(asDateTime);
|
|
ftDateTime : Result:=DateToISO8601(asDateTime);
|
|
ftBlob :
|
|
begin
|
|
B:=AsBlob;
|
|
Result:='';
|
|
For I:=0 to Length(B)-1 do
|
|
Result:=TJSString(Result).Concat(TJSString.fromCharCode(B[I]));
|
|
end;
|
|
ftMemo : Result:=AsMemo;
|
|
else
|
|
Result:=AsString
|
|
end;
|
|
Result:=Name+'='+Result;
|
|
end;
|
|
|
|
{ TQueryParams }
|
|
|
|
function TQueryParams.GetP(aIndex : Integer): TQueryParam;
|
|
begin
|
|
Result:=Items[aIndex] as TQueryParam
|
|
end;
|
|
|
|
procedure TQueryParams.SetP(aIndex : Integer; AValue: TQueryParam);
|
|
begin
|
|
Items[aIndex]:=aValue;
|
|
end;
|
|
|
|
function TQueryParams.AddParam(aName: string; aEnabled: Boolean): TQueryParam;
|
|
begin
|
|
Result:=add As TQueryParam;
|
|
Result.Name:=aName;
|
|
Result.Enabled:=aEnabled;
|
|
end;
|
|
|
|
{ TServiceRequest }
|
|
|
|
constructor TServiceRequest.Create(const aMethod,aURL, aUserName, aPassword: String; aOnDone1 : TNotifyEvent; aOnDone2 : TNotifyEvent = Nil);
|
|
begin
|
|
FOnMyDone:=aOnDone1;
|
|
FOnDone:=aOnDone2;
|
|
FXHR:=TJSXMLHttpRequest.New;
|
|
FXHR.AddEventListener('load',@onLoad);
|
|
FXHR.open(aMethod,aURL,true);
|
|
(* else
|
|
begin
|
|
// FXHR.withCredentials := true;
|
|
FXHR.open(aMethod,aURL,true,aUserName,aPassword);
|
|
end;*)
|
|
FXHR.setRequestHeader('Content-Type', 'application/json');
|
|
FXHR.setRequestHeader('Authorization', 'Basic '+window.btoa(aUserName+':'+aPassword));
|
|
end;
|
|
|
|
procedure TServiceRequest.Execute;
|
|
begin
|
|
FXHR.send;
|
|
end;
|
|
|
|
function TServiceRequest.GetResult: String;
|
|
begin
|
|
Result:=FXHR.responseText;
|
|
end;
|
|
|
|
function TServiceRequest.GetResultJSON: TJSObject;
|
|
begin
|
|
if SameText(FXHR.getResponseHeader('Content-Type'),'application/json') then
|
|
Result:=TJSJSON.parseObject(RequestResult)
|
|
else
|
|
Result:=nil;
|
|
end;
|
|
|
|
function TServiceRequest.GetStatusCode: Integer;
|
|
begin
|
|
Result:=FXHR.Status;
|
|
end;
|
|
|
|
function TServiceRequest.onLoad(Event: TEventListenerEvent): boolean;
|
|
begin
|
|
if Assigned(FOnMyDone) then
|
|
FOnMyDone(Self);
|
|
Result:=False;
|
|
end;
|
|
|
|
|
|
|
|
|
|
{ TSQLDBRestConnection }
|
|
|
|
function TSQLDBRestConnection.DoStoreMetadata: Boolean;
|
|
begin
|
|
Result:=(FMetadataResourceName<>'metadata');
|
|
end;
|
|
|
|
function TSQLDBRestConnection.DoStoreMetadataProp: Boolean;
|
|
begin
|
|
Result:=(FMetaDataProperty<>'metaData');
|
|
end;
|
|
|
|
procedure TSQLDBRestConnection.SetupRequest(aXHR: TJSXMLHttpRequest);
|
|
begin
|
|
aXHR.setRequestHeader('Content-Type', 'application/json');
|
|
aXHR.setRequestHeader('Accept', 'application/json');
|
|
if (UserName<>'') then
|
|
aXHR.setRequestHeader('Authorization', 'Basic '+window.btoa(UserName+':'+Password));
|
|
// Will call the OnSetupHTTPRequest handler
|
|
inherited SetupRequest(aXHR);
|
|
end;
|
|
|
|
function TSQLDBRestConnection.GetUpdateBaseURL(aRequest: TRecordUpdateDescriptor): String;
|
|
|
|
Var
|
|
DS : TSQLDBRestDataset;
|
|
begin
|
|
Result:=inherited GetUpdateBaseURL(aRequest);
|
|
DS:=TSQLDBRestDataset(aRequest.Dataset);
|
|
Result:=IncludeTrailingPathDelimiter(Result)+DS.MyURL(False);
|
|
end;
|
|
|
|
function TSQLDBRestConnection.GetReadBaseURL(aRequest: TDataRequest): String;
|
|
|
|
Var
|
|
DS : TSQLDBRestDataset;
|
|
|
|
begin
|
|
Result:=inherited GetReadBaseURL(aRequest);
|
|
DS:=TSQLDBRestDataset(aRequest.Dataset);
|
|
Result:=IncludeTrailingPathDelimiter(Result)+DS.MyURL(True);
|
|
end;
|
|
|
|
procedure TSQLDBRestConnection.DoResources(Sender: TObject);
|
|
|
|
Var
|
|
R : TServiceRequest absolute Sender;
|
|
J,Res : TJSObject;
|
|
A : TJSArray;
|
|
i : Integer;
|
|
|
|
begin
|
|
FResourceList.Clear;
|
|
if (R.StatusCode=200) then
|
|
begin
|
|
J:=R.ResultJSON;
|
|
if J=Nil then
|
|
exit;
|
|
A:=TJSArray(J.Properties['data']);
|
|
For I:=0 to A.Length-1 do
|
|
begin
|
|
Res:=TJSObject(A[i]);
|
|
FResourceList.Add(String(Res.Properties['name']));
|
|
end;
|
|
end;
|
|
If Assigned(R.OnDone) then
|
|
R.OnDone(Self);
|
|
If Assigned(OnGetResources) then
|
|
OnGetResources(Self);
|
|
end;
|
|
|
|
function TSQLDBRestConnection.DoStoreDataProp: Boolean;
|
|
begin
|
|
Result:=(FDataProperty<>'data');
|
|
end;
|
|
|
|
constructor TSQLDBRestConnection.create(aOwner: TComponent);
|
|
begin
|
|
inherited create(aOwner);
|
|
FResourceList:=TStringList.Create;
|
|
FMetaDataResourceName:='metadata';
|
|
FmetaDataProperty:='metaData';
|
|
FDataProperty:='data';
|
|
TStringList(FResourceList).Sorted:=true;
|
|
end;
|
|
|
|
destructor TSQLDBRestConnection.Destroy;
|
|
begin
|
|
FreeAndNil(FResourceList);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TSQLDBRestConnection.GetResources(OnResult: TNotifyEvent);
|
|
|
|
Var
|
|
aURL : String;
|
|
R : TServiceRequest;
|
|
|
|
begin
|
|
aURL:=IncludeTrailingPathDelimiter(BaseURL)+MetaDataResourceName+'?fmt=json';
|
|
R:=TServiceRequest.Create('GET',aURL,Self.UserName,Self.Password,@DoResources,OnResult);
|
|
R.Execute;
|
|
end;
|
|
|
|
{ TSQLDBRestDataset }
|
|
|
|
procedure TSQLDBRestDataset.SetConnection(AValue: TSQLDBRestConnection);
|
|
begin
|
|
if FConnection=AValue then Exit;
|
|
if Assigned(FConnection) then
|
|
FConnection.RemoveFreeNotification(Self);
|
|
FConnection:=AValue;
|
|
if Assigned(FConnection) then
|
|
FConnection.FreeNotification(Self);
|
|
end;
|
|
|
|
procedure TSQLDBRestDataset.SetParams(AValue: TQueryParams);
|
|
begin
|
|
if FParams=AValue then Exit;
|
|
FParams.Assign(AValue);
|
|
end;
|
|
|
|
procedure TSQLDBRestDataset.SetResourceID(AValue: String);
|
|
begin
|
|
if FResourceID=AValue then Exit;
|
|
CheckInactive;
|
|
FResourceID:=AValue;
|
|
end;
|
|
|
|
function TSQLDBRestDataset.GetURLQueryParams(IsRead :Boolean) : string;
|
|
|
|
Procedure AddToResult(aQuery : string);
|
|
|
|
begin
|
|
if aQuery='' then
|
|
exit;
|
|
If Result<>'' then
|
|
Result:=Result+'&';
|
|
Result:=Result+aQuery;
|
|
end;
|
|
|
|
Var
|
|
I : Integer;
|
|
|
|
begin
|
|
Result:='';
|
|
if IsRead then
|
|
begin
|
|
if SameText(ResourceName,CustomViewResourceName) then
|
|
AddToResult('SQL='+EncodeURIComponent(CleanSQL));
|
|
For I:=0 to Params.Count-1 do
|
|
AddToResult(Params[I].AsQuery);
|
|
end;
|
|
if Assigned(FOnGetQueryParams) then
|
|
FOnGetQueryParams(Self,IsRead,Result);
|
|
end;
|
|
|
|
function TSQLDBRestDataset.MyURL(isRead: Boolean): String;
|
|
|
|
Var
|
|
Qry : String;
|
|
|
|
begin
|
|
Result:=DatabaseConnection;
|
|
if (Result<>'') and (Result[Length(Result)]<>'/') then
|
|
Result:=Result+'/';
|
|
Result:=Result+ResourceName;
|
|
if IsRead and (ResourceID<>'') then
|
|
Result:=Result+'/'+EncodeURIComponent(ResourceID);
|
|
Qry:=GetURLQueryParams(IsRead);
|
|
if Qry<>'' then
|
|
Result:=Result+'?'+Qry;
|
|
end;
|
|
|
|
procedure TSQLDBRestDataset.DoSQLChange(Sender: TObject);
|
|
begin
|
|
if Trim(FSQL.Text)<>'' then
|
|
FResourceName:=CustomViewResourceName;
|
|
end;
|
|
|
|
procedure TSQLDBRestDataset.SetResourceName(AValue: String);
|
|
begin
|
|
if FResourceName=AValue then Exit;
|
|
CheckInactive;
|
|
if Not SameText(aValue,CustomViewResourceName) then
|
|
FSQL.Clear;
|
|
FResourceName:=AValue;
|
|
end;
|
|
|
|
function TSQLDBRestDataset.CustomViewResourceName : String;
|
|
|
|
begin
|
|
if Assigned(Connection) then
|
|
Result:=Connection.CustomViewResourceName
|
|
else
|
|
Result:='customView';
|
|
end;
|
|
|
|
function TSQLDBRestDataset.CleanSQL: String;
|
|
|
|
begin
|
|
Result:=StringReplace(SQL.Text,#13#10,' ',[rfReplaceAll]);
|
|
Result:=StringReplace(Result,#10,' ',[rfReplaceAll]);
|
|
Result:=StringReplace(Result,#10,' ',[rfReplaceAll]);
|
|
end;
|
|
|
|
procedure TSQLDBRestDataset.SetSQL(AValue: TStrings);
|
|
begin
|
|
if FSQL=AValue then Exit;
|
|
FSQL.Assign(AValue);
|
|
end;
|
|
|
|
procedure TSQLDBRestDataset.DoAfterPost;
|
|
begin
|
|
inherited DoAfterPost;
|
|
if AutoApplyUpdates then
|
|
ApplyUpdates;
|
|
end;
|
|
|
|
procedure TSQLDBRestDataset.DoAfterDelete;
|
|
begin
|
|
inherited DoAfterDelete;
|
|
if AutoApplyUpdates then
|
|
ApplyUpdates;
|
|
end;
|
|
|
|
function TSQLDBRestDataset.CreateQueryParams: TQueryParams;
|
|
begin
|
|
Result:=TQueryParams.Create(Self,TQueryParam);
|
|
end;
|
|
|
|
|
|
|
|
class function TSQLDBRestDataset.DefaultBlobDataToBytes(aValue: JSValue): TBytes;
|
|
begin
|
|
Result:=BytesOf(Window.atob(String(aValue)));
|
|
end;
|
|
|
|
class function TSQLDBRestDataset.DefaultBytesToBlobData(aValue: TBytes
|
|
): JSValue;
|
|
begin
|
|
Result:=Window.Btoa(StringOf(aValue));
|
|
end;
|
|
|
|
function TSQLDBRestDataset.ParamByName(const aName: String): TQueryParam;
|
|
begin
|
|
Result:=TQueryParam(Params.ParamByName(aName));
|
|
end;
|
|
|
|
function TSQLDBRestDataset.DoGetDataProxy: TDataProxy;
|
|
begin
|
|
Result:=Connection.DataProxy;
|
|
end;
|
|
|
|
function TSQLDBRestDataset.StringToFieldType(S: String): TFieldType;
|
|
|
|
begin
|
|
if (s='int') then
|
|
Result:=ftInteger
|
|
else if (s='bigint') then
|
|
Result:=ftLargeInt
|
|
else if (s='float') then
|
|
Result:=ftFloat
|
|
else if (s='bool') then
|
|
Result:=ftBoolean
|
|
else if (s='date') then
|
|
Result:=ftDate
|
|
else if (s='datetime') then
|
|
Result:=ftDateTime
|
|
else if (s='time') then
|
|
Result:=ftTime
|
|
else if (s='blob') then
|
|
Result:=ftBlob
|
|
else if (s='string') then
|
|
Result:=ftString
|
|
else
|
|
if MapUnknownToStringType then
|
|
Result:=ftString
|
|
else
|
|
Raise EJSONDataset.CreateFmt('Unknown JSON data type : %s',[s]);
|
|
end;
|
|
|
|
function TSQLDBRestDataset.GetStringFieldLength(F: TJSObject; AName: String;
|
|
AIndex: Integer): integer;
|
|
|
|
Var
|
|
I,L : Integer;
|
|
D : JSValue;
|
|
|
|
begin
|
|
Result:=0;
|
|
D:=F.Properties['maxLen'];
|
|
if Not jsIsNan(toNumber(D)) then
|
|
begin
|
|
Result:=Trunc(toNumber(D));
|
|
if (Result<0) then
|
|
Raise EJSONDataset.CreateFmt('Invalid maximum length specifier for field %s',[AName])
|
|
else if Result=0 then // memofield
|
|
Result:=1000000
|
|
end
|
|
else
|
|
begin
|
|
For I:=0 to Rows.Length-1 do
|
|
begin
|
|
D:=FieldMapper.GetJSONDataForField(Aname,AIndex,Rows[i]);
|
|
if isString(D) then
|
|
begin
|
|
l:=Length(String(D));
|
|
if L>Result then
|
|
Result:=L;
|
|
end;
|
|
end;
|
|
end;
|
|
if (Result=0) then
|
|
Result:=20;
|
|
end;
|
|
|
|
procedure TSQLDBRestDataset.MetaDataToFieldDefs;
|
|
Var
|
|
A : TJSArray;
|
|
F : TJSObject;
|
|
I,FS : Integer;
|
|
N: String;
|
|
ft: TFieldType;
|
|
D : JSValue;
|
|
|
|
begin
|
|
FieldDefs.Clear;
|
|
D:=Metadata.Properties['fields'];
|
|
if Not IsArray(D) then
|
|
Raise EJSONDataset.Create('Invalid metadata object');
|
|
A:=TJSArray(D);
|
|
For I:=0 to A.Length-1 do
|
|
begin
|
|
If Not isObject(A[i]) then
|
|
Raise EJSONDataset.CreateFmt('Field definition %d in metadata is not an object',[i]);
|
|
F:=TJSObject(A[i]);
|
|
D:=F.Properties['name'];
|
|
If Not isString(D) then
|
|
Raise EJSONDataset.CreateFmt('Field definition %d in has no or invalid name property',[i]);
|
|
N:=String(D);
|
|
D:=F.Properties['type'];
|
|
If IsNull(D) or isUndefined(D) then
|
|
ft:=ftstring
|
|
else If Not isString(D) then
|
|
begin
|
|
Raise EJSONDataset.CreateFmt('Field definition %d in has invalid type property',[i])
|
|
end
|
|
else
|
|
begin
|
|
ft:=StringToFieldType(String(D));
|
|
end;
|
|
if (ft=ftString) then
|
|
fs:=GetStringFieldLength(F,N,I)
|
|
else
|
|
fs:=0;
|
|
FieldDefs.Add(N,ft,fs);
|
|
end;
|
|
end;
|
|
|
|
constructor TSQLDBRestDataset.Create(aOwner: TComponent);
|
|
begin
|
|
inherited Create(aOwner);
|
|
FSQL:=TStringList.Create;
|
|
TStringList(FSQL).OnChange:=@DoSQLChange;
|
|
FParams:=CreateQueryParams;
|
|
BlobFormat:=bfBase64;
|
|
end;
|
|
|
|
destructor TSQLDBRestDataset.Destroy;
|
|
begin
|
|
FreeAndNil(FSQL);
|
|
FreeAndnil(FParams);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TSQLDBRestDataset.DataPacketReceived(ARequest: TDataRequest): Boolean;
|
|
|
|
Var
|
|
O : TJSObject;
|
|
A : TJSArray;
|
|
smetadata,sroot : String;
|
|
begin
|
|
Result:=False;
|
|
If isNull(aRequest.Data) then
|
|
exit;
|
|
If isString(aRequest.Data) then
|
|
O:=TJSOBject(TJSJSON.Parse(String(aRequest.Data)))
|
|
else if isObject(aRequest.Data) then
|
|
O:=TJSOBject(aRequest.Data)
|
|
else
|
|
DatabaseError('Cannot handle data packet');
|
|
sRoot:=Connection.DataProperty;
|
|
sMetaData:=Connection.metaDataProperty;
|
|
if (sroot='') then
|
|
sroot:='data';
|
|
if (smetadata='') then
|
|
smetadata:='metaData';
|
|
{ if (IDField='') then
|
|
idField:='id';}
|
|
if O.hasOwnProperty(sMetaData) and isObject(o[sMetaData]) then
|
|
begin
|
|
if not Active then // Load fields from metadata
|
|
metaData:=TJSObject(o[SMetaData]);
|
|
{ if metaData.hasOwnProperty('idField') and isString(metaData['idField']) then
|
|
IDField:=string(metaData['idField']);}
|
|
end;
|
|
if O.hasOwnProperty(sRoot) and isArray(o[sRoot]) then
|
|
begin
|
|
A:=TJSArray(o[sRoot]);
|
|
Result:=A.Length>0;
|
|
AddToRows(A);
|
|
end;
|
|
end;
|
|
|
|
|
|
end.
|
|
|