mirror of
https://gitlab.com/freepascal.org/fpc/pas2js.git
synced 2025-08-26 06:49:13 +02:00
* Merging revisions r356,r357,r358,r359,r365,r366,r373,r374,r376 from trunk:
------------------------------------------------------------------------
r356 | michael | 2019-03-07 09:46:06 +0100 (Thu, 07 Mar 2019) | 1 line
* Auto-detect JSON type
------------------------------------------------------------------------
r357 | michael | 2019-03-07 09:46:40 +0100 (Thu, 07 Mar 2019) | 1 line
* Allow descendents to configure data requests
------------------------------------------------------------------------
r358 | michael | 2019-03-07 09:51:16 +0100 (Thu, 07 Mar 2019) | 1 line
* SQLDBRestBridge components and first demo
------------------------------------------------------------------------
r359 | michael | 2019-03-07 09:55:15 +0100 (Thu, 07 Mar 2019) | 1 line
* Small fix in html, add missing closing tr tag
------------------------------------------------------------------------
r365 | michael | 2019-03-09 21:02:37 +0100 (Sat, 09 Mar 2019) | 1 line
* Add logout method
------------------------------------------------------------------------
r366 | michael | 2019-03-09 21:03:01 +0100 (Sat, 09 Mar 2019) | 1 line
* Fix detection of push state api
------------------------------------------------------------------------
r373 | michael | 2019-03-12 04:44:14 +0100 (Tue, 12 Mar 2019) | 1 line
* Let TBlobField descend of TField
------------------------------------------------------------------------
r374 | michael | 2019-03-12 09:11:52 +0100 (Tue, 12 Mar 2019) | 1 line
* TBlobField must bet TBinaryField descendent, but needs to allow size 0
------------------------------------------------------------------------
r376 | michael | 2019-03-12 19:24:17 +0100 (Tue, 12 Mar 2019) | 1 line
* Fixes for working with the JSONStreamer
------------------------------------------------------------------------
This commit is contained in:
michael
parent
bb16e3a85e
commit
8e46daef77
12
demo/restbridge/simple/README.txt
Normal file
12
demo/restbridge/simple/README.txt
Normal file
@ -0,0 +1,12 @@
|
|||||||
|
|
||||||
|
In order to run this demo, you must run one of the SQLDB REST bridge demos
|
||||||
|
as a server:
|
||||||
|
|
||||||
|
fpc/packages/fcl-web/example/restbridge
|
||||||
|
lazarus/components/fpweb/demo/restbridge/
|
||||||
|
lazarus/components/fpweb/demo/restmodule/
|
||||||
|
|
||||||
|
You need to know how it is configured (The port, base URL)
|
||||||
|
|
||||||
|
The servers are by default set up so the client requires authentication,
|
||||||
|
so unless that was disabled, you need to know what user the demo is using to authenticate requests !
|
||||||
81
demo/restbridge/simple/restbridge.html
Normal file
81
demo/restbridge/simple/restbridge.html
Normal file
@ -0,0 +1,81 @@
|
|||||||
|
<html>
|
||||||
|
<head>
|
||||||
|
<title>REST Bridge</title>
|
||||||
|
<meta charset="utf-8"/>
|
||||||
|
<link href="https://maxcdn.bootstrapcdn.com/bootstrap/4.0.0/css/bootstrap.min.css" rel="stylesheet">
|
||||||
|
<script src="https://code.jquery.com/jquery-3.2.1.slim.min.js" ></script>
|
||||||
|
<script src="https://cdnjs.cloudflare.com/ajax/libs/popper.js/1.12.9/umd/popper.min.js"> </script>
|
||||||
|
<script src="https://maxcdn.bootstrapcdn.com/bootstrap/4.0.0/js/bootstrap.min.js"></script>
|
||||||
|
<script type="application/javascript" src="restbridgeclient.js"></script>
|
||||||
|
</head>
|
||||||
|
<body>
|
||||||
|
<div class="container-fluid">
|
||||||
|
<div class="row">
|
||||||
|
<div class="col-md-12">
|
||||||
|
<div id="urlform" role="form" class="form-inline">
|
||||||
|
<div class="input-group col-md-6">
|
||||||
|
<label class="input-group-text" for="edtUrl">
|
||||||
|
Base URL
|
||||||
|
</label>
|
||||||
|
<input type="text" class="form-control" id="edtURL" value="http://localhost:8080/"/>
|
||||||
|
</div>
|
||||||
|
<div class="input-group col-md-2">
|
||||||
|
<label class="input-group-text" for="edtUserName">
|
||||||
|
UserName
|
||||||
|
</label>
|
||||||
|
<input type="text" class="form-control" id="edtUserName" value="Michael"/>
|
||||||
|
</div>
|
||||||
|
<div class="input-group col-md-2">
|
||||||
|
<label class="input-group-text" for="exampleInputPassword1">
|
||||||
|
Password
|
||||||
|
</label>
|
||||||
|
<input type="password" class="form-control" id="edtPassword" value="secret" />
|
||||||
|
</div>
|
||||||
|
<button id="btnResources" class="btn col-md-2">
|
||||||
|
Get Resource List
|
||||||
|
</button>
|
||||||
|
</div>
|
||||||
|
</div>
|
||||||
|
</div>
|
||||||
|
<div class="row">
|
||||||
|
<div class="col-md-12">
|
||||||
|
<form id="show" role="form" class="form-inline">
|
||||||
|
<div class="input-group col-md-3">
|
||||||
|
<label class="input-group-text " for="selResource">
|
||||||
|
Resource
|
||||||
|
</label>
|
||||||
|
<select class="custom-select col-md-auto" id="selResource" >
|
||||||
|
<option selected>Choose...</option>
|
||||||
|
<option value="1">One</option>
|
||||||
|
<option value="2">Two</option>
|
||||||
|
<option value="3">Three</option>
|
||||||
|
</select>
|
||||||
|
</div>
|
||||||
|
<div class="input-group col-md-7">
|
||||||
|
<label class="input-group-text " for="edtOptions">
|
||||||
|
Additional options:
|
||||||
|
</label>
|
||||||
|
<input type="text" class="form-control" id="edtOptions" />
|
||||||
|
</div>
|
||||||
|
<button id="btnFetch" type="submit" class="btn btn-primary col-md-2">
|
||||||
|
Get data
|
||||||
|
</button>
|
||||||
|
</form>
|
||||||
|
</div>
|
||||||
|
</div>
|
||||||
|
</div>
|
||||||
|
<div class="row">
|
||||||
|
<div class="col-md-12">
|
||||||
|
<table id="resulttable" class="table table-sm table-striped table-hover">
|
||||||
|
<thead id="datahead"></thead>
|
||||||
|
<tbody id="databody"></tbody>
|
||||||
|
</table>
|
||||||
|
</div>
|
||||||
|
</div>
|
||||||
|
<script type="application/javascript">
|
||||||
|
rtl.showUncaughtExceptions=true;
|
||||||
|
rtl.run();
|
||||||
|
</script>
|
||||||
|
</body>
|
||||||
|
</html>
|
||||||
|
|
||||||
85
demo/restbridge/simple/restbridgeclient.lpi
Normal file
85
demo/restbridge/simple/restbridgeclient.lpi
Normal file
@ -0,0 +1,85 @@
|
|||||||
|
<?xml version="1.0" encoding="UTF-8"?>
|
||||||
|
<CONFIG>
|
||||||
|
<ProjectOptions>
|
||||||
|
<Version Value="11"/>
|
||||||
|
<General>
|
||||||
|
<Flags>
|
||||||
|
<MainUnitHasCreateFormStatements Value="False"/>
|
||||||
|
<MainUnitHasTitleStatement Value="False"/>
|
||||||
|
<MainUnitHasScaledStatement Value="False"/>
|
||||||
|
<Runnable Value="False"/>
|
||||||
|
</Flags>
|
||||||
|
<SessionStorage Value="InProjectDir"/>
|
||||||
|
<MainUnit Value="0"/>
|
||||||
|
<Title Value="restbridgeclient"/>
|
||||||
|
<UseAppBundle Value="False"/>
|
||||||
|
<ResourceType Value="res"/>
|
||||||
|
</General>
|
||||||
|
<CustomData Count="1">
|
||||||
|
<Item0 Name="PasJSWebBrowserProject" Value="1"/>
|
||||||
|
</CustomData>
|
||||||
|
<BuildModes Count="1">
|
||||||
|
<Item1 Name="Default" Default="True"/>
|
||||||
|
</BuildModes>
|
||||||
|
<PublishOptions>
|
||||||
|
<Version Value="2"/>
|
||||||
|
<UseFileFilters Value="True"/>
|
||||||
|
</PublishOptions>
|
||||||
|
<RunParams>
|
||||||
|
<FormatVersion Value="2"/>
|
||||||
|
<Modes Count="0"/>
|
||||||
|
</RunParams>
|
||||||
|
<Units Count="2">
|
||||||
|
<Unit0>
|
||||||
|
<Filename Value="restbridgeclient.lpr"/>
|
||||||
|
<IsPartOfProject Value="True"/>
|
||||||
|
</Unit0>
|
||||||
|
<Unit1>
|
||||||
|
<Filename Value="restbridge.html"/>
|
||||||
|
<IsPartOfProject Value="True"/>
|
||||||
|
</Unit1>
|
||||||
|
</Units>
|
||||||
|
</ProjectOptions>
|
||||||
|
<CompilerOptions>
|
||||||
|
<Version Value="11"/>
|
||||||
|
<Target>
|
||||||
|
<Filename Value="restbridgeclient.js" ApplyConventions="False"/>
|
||||||
|
</Target>
|
||||||
|
<SearchPaths>
|
||||||
|
<IncludeFiles Value="$(ProjOutDir)"/>
|
||||||
|
<UnitOutputDirectory Value="js"/>
|
||||||
|
</SearchPaths>
|
||||||
|
<Parsing>
|
||||||
|
<SyntaxOptions>
|
||||||
|
<AllowLabel Value="False"/>
|
||||||
|
<UseAnsiStrings Value="False"/>
|
||||||
|
</SyntaxOptions>
|
||||||
|
</Parsing>
|
||||||
|
<CodeGeneration>
|
||||||
|
<TargetOS Value="browser"/>
|
||||||
|
</CodeGeneration>
|
||||||
|
<Linking>
|
||||||
|
<Debugging>
|
||||||
|
<GenerateDebugInfo Value="False"/>
|
||||||
|
<UseLineInfoUnit Value="False"/>
|
||||||
|
</Debugging>
|
||||||
|
</Linking>
|
||||||
|
<Other>
|
||||||
|
<CustomOptions Value="-Jeutf-8 -Jirtl.js -Jc"/>
|
||||||
|
<CompilerPath Value="$(pas2js)"/>
|
||||||
|
</Other>
|
||||||
|
</CompilerOptions>
|
||||||
|
<Debugging>
|
||||||
|
<Exceptions Count="3">
|
||||||
|
<Item1>
|
||||||
|
<Name Value="EAbort"/>
|
||||||
|
</Item1>
|
||||||
|
<Item2>
|
||||||
|
<Name Value="ECodetoolError"/>
|
||||||
|
</Item2>
|
||||||
|
<Item3>
|
||||||
|
<Name Value="EFOpenError"/>
|
||||||
|
</Item3>
|
||||||
|
</Exceptions>
|
||||||
|
</Debugging>
|
||||||
|
</CONFIG>
|
||||||
182
demo/restbridge/simple/restbridgeclient.lpr
Normal file
182
demo/restbridge/simple/restbridgeclient.lpr
Normal file
@ -0,0 +1,182 @@
|
|||||||
|
program restbridgeclient;
|
||||||
|
|
||||||
|
{$mode objfpc}
|
||||||
|
|
||||||
|
uses
|
||||||
|
JS, Classes, SysUtils, Web, db, jsondataset, sqldbrestdataset;
|
||||||
|
|
||||||
|
Type
|
||||||
|
|
||||||
|
{ TMainForm }
|
||||||
|
|
||||||
|
TMainForm = class(TComponent)
|
||||||
|
Private
|
||||||
|
FData: TSQLDBRestDataset;
|
||||||
|
FConn: TSQLDBRestConnection;
|
||||||
|
FBtnResources : TJSHTMLButtonElement;
|
||||||
|
FBtnData : TJSHTMLButtonElement;
|
||||||
|
FEdtURL : TJSHTMLInputElement;
|
||||||
|
FEdtUserName : TJSHTMLInputElement;
|
||||||
|
FEdtPassword : TJSHTMLInputElement;
|
||||||
|
FSelResource : TJSHTMLSelectElement;
|
||||||
|
FDataHead : TJSHTMLElement;
|
||||||
|
FDataBody : TJSHTMLElement;
|
||||||
|
function ConfigureConnection: Boolean;
|
||||||
|
function ConfigureDataset: Boolean;
|
||||||
|
procedure CreateDataHead(Dataset: TDataset);
|
||||||
|
function CreateDataRow(aRowNo: Integer; Dataset: TDataset): String;
|
||||||
|
procedure CreateDataTable(Dataset: TDataset);
|
||||||
|
procedure DoGetResources(Sender: TObject);
|
||||||
|
procedure DoOpen(DataSet: TDataSet);
|
||||||
|
function GetData(aEvent: TJSMouseEvent): boolean;
|
||||||
|
function GetElement(const aID: String): TJSHTMLElement;
|
||||||
|
function GetResources(aEvent: TJSMouseEvent): boolean;
|
||||||
|
Public
|
||||||
|
Constructor Create(aOwner : TComponent); override;
|
||||||
|
Procedure BindElements;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TMainForm }
|
||||||
|
|
||||||
|
Function TMainForm.ConfigureDataset : Boolean;
|
||||||
|
|
||||||
|
begin
|
||||||
|
FData.ResourceName:=FSelResource.value;
|
||||||
|
Result:=(FData.ResourceName<>'');
|
||||||
|
if not Result then
|
||||||
|
Window.Alert('Dataset not correctly configured');
|
||||||
|
end;
|
||||||
|
|
||||||
|
Function TMainForm.ConfigureConnection : Boolean;
|
||||||
|
|
||||||
|
begin
|
||||||
|
FConn.BaseURL:=FedtURL.value;
|
||||||
|
FConn.Password:=FEdtPassword.value;
|
||||||
|
FConn.UserName:=FEdtUserName.value;
|
||||||
|
Result:=FConn.BaseURL<>'';
|
||||||
|
if not Result then
|
||||||
|
Window.Alert('Connection not correctly configured');
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TMainForm.GetResources(aEvent: TJSMouseEvent): boolean;
|
||||||
|
begin
|
||||||
|
if ConfigureConnection then
|
||||||
|
FConn.GetResources
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TMainForm.DoGetResources(Sender: TObject);
|
||||||
|
|
||||||
|
Var
|
||||||
|
S : String;
|
||||||
|
I : Integer;
|
||||||
|
|
||||||
|
begin
|
||||||
|
S:='<option selected>Choose...</option>';
|
||||||
|
For I:=0 to FConn.ResourceList.Count-1 do
|
||||||
|
S:=S+sLineBreak+'<option>'+FConn.ResourceList[i]+'</option>';
|
||||||
|
FSelResource.innerHTML:=S;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TMainForm.CreateDataHead(Dataset : TDataset);
|
||||||
|
|
||||||
|
Var
|
||||||
|
sHTML : String;
|
||||||
|
I : integer;
|
||||||
|
|
||||||
|
begin
|
||||||
|
sHTML:='<tr>';
|
||||||
|
sHTML:=sHTML+'<th>#</th>';
|
||||||
|
For I:=0 to Dataset.FieldDefs.Count-1 do
|
||||||
|
sHTML:=sHTML+'<th>'+Dataset.FieldDefs[i].Name+'</th>'+sLineBreak;
|
||||||
|
sHTML:=sHTML+'</tr>';
|
||||||
|
FDataHead.innerHTML:=sHTML;
|
||||||
|
end;
|
||||||
|
|
||||||
|
Function TMainForm.CreateDataRow(aRowNo : Integer; Dataset : TDataset) : String;
|
||||||
|
|
||||||
|
Var
|
||||||
|
I : integer;
|
||||||
|
sHTML : String;
|
||||||
|
|
||||||
|
begin
|
||||||
|
// Prepend dataset name to id?
|
||||||
|
sHtml:=Format('<tr id="row-%d"><td>%d</td>',[DataSet.RecNo,aRowNo]);
|
||||||
|
For I:=0 to Dataset.Fields.Count-1 do
|
||||||
|
sHTML:=sHTML+'<td>'+Dataset.Fields[i].AsString+'</td>'+sLineBreak;
|
||||||
|
sHTML:=sHtml+'</tr>';
|
||||||
|
Result:=sHTML;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TMainForm.CreateDataTable(Dataset : TDataset);
|
||||||
|
|
||||||
|
Var
|
||||||
|
sHTML : String;
|
||||||
|
I : integer;
|
||||||
|
|
||||||
|
begin
|
||||||
|
sHTML:='';
|
||||||
|
I:=0;
|
||||||
|
while not Dataset.EOF do
|
||||||
|
begin
|
||||||
|
inc(i);
|
||||||
|
sHtml:=SHTML+CreateDataRow(i,Dataset);
|
||||||
|
Dataset.Next;
|
||||||
|
end;
|
||||||
|
FDataBody.innerHTML:=sHTML;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TMainForm.DoOpen(DataSet: TDataSet);
|
||||||
|
begin
|
||||||
|
CreateDataHead(Dataset);
|
||||||
|
CreateDataTable(Dataset);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TMainForm.GetData(aEvent: TJSMouseEvent): boolean;
|
||||||
|
begin
|
||||||
|
If not ConfigureConnection then
|
||||||
|
exit;
|
||||||
|
if not ConfigureDataset then
|
||||||
|
exit;
|
||||||
|
FData.Load([],Nil);
|
||||||
|
end;
|
||||||
|
|
||||||
|
constructor TMainForm.Create(aOwner: TComponent);
|
||||||
|
begin
|
||||||
|
inherited Create(aOwner);
|
||||||
|
// Ideally, this is done in an IDE
|
||||||
|
FConn:=TSQLDBRestConnection.Create(Self);
|
||||||
|
FCOnn.OnGetResources:=@DoGetResources;
|
||||||
|
FData:=TSQLDBRestDataset.Create(Self);
|
||||||
|
FData.AfterOpen:=@DoOpen;
|
||||||
|
FData.Connection:=FConn;
|
||||||
|
// This must always be done in code
|
||||||
|
BindElements;
|
||||||
|
end;
|
||||||
|
|
||||||
|
Function TMainForm.GetElement(Const aID : String): TJSHTMLElement;
|
||||||
|
|
||||||
|
begin
|
||||||
|
Result:=TJSHTMLElement(document.getElementById(aID));
|
||||||
|
if (Result=Nil) then
|
||||||
|
Console.Log('Could not find element '+aID);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TMainForm.BindElements;
|
||||||
|
begin
|
||||||
|
FBtnResources:=TJSHTMLButtonElement(getElement('btnResources'));
|
||||||
|
FBtnResources.OnClick:=@GetResources;
|
||||||
|
FBtnData:=TJSHTMLButtonElement(getElement('btnFetch'));
|
||||||
|
FBtnData.OnClick:=@GetData;
|
||||||
|
FSelResource:=TJSHTMLSelectElement(GetElement('selResource'));
|
||||||
|
FEdtURL:=TJSHTMLInputElement(getElement('edtURL'));
|
||||||
|
FEdtUserName:=TJSHTMLInputElement(getElement('edtUserName'));
|
||||||
|
FEdtPassword:=TJSHTMLInputElement(getElement('edtPassword'));
|
||||||
|
FDataHead:=getElement('datahead');
|
||||||
|
FDataBody:=getElement('databody');
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
begin
|
||||||
|
TMainForm.Create(Nil);
|
||||||
|
end.
|
||||||
@ -86,6 +86,9 @@ Type
|
|||||||
FChannel : TROHTTPClientChannel;
|
FChannel : TROHTTPClientChannel;
|
||||||
FOnLoginFailed: TDAFailedEvent;
|
FOnLoginFailed: TDAFailedEvent;
|
||||||
FOnLogin: TDALoginSuccessEvent;
|
FOnLogin: TDALoginSuccessEvent;
|
||||||
|
FOnLogout: TDASuccessEvent;
|
||||||
|
FOnLogoutailed: TDAFailedEvent;
|
||||||
|
FOnLogoutFailed: TDAFailedEvent;
|
||||||
FStreamerType: TDAStreamerType;
|
FStreamerType: TDAStreamerType;
|
||||||
FURL: String;
|
FURL: String;
|
||||||
procedure ClearConnection;
|
procedure ClearConnection;
|
||||||
@ -112,6 +115,7 @@ Type
|
|||||||
// Call this to login. This is an asynchronous call, check the result using OnLoginOK and OnLoginFailed calls.
|
// Call this to login. This is an asynchronous call, check the result using OnLoginOK and OnLoginFailed calls.
|
||||||
Procedure Login(aUserName, aPassword : String);
|
Procedure Login(aUserName, aPassword : String);
|
||||||
Procedure LoginEx(aLoginString : String);
|
Procedure LoginEx(aLoginString : String);
|
||||||
|
Procedure Logout;
|
||||||
// You can set this. If you didn't set this, and URL is filled, an instance will be created.
|
// You can set this. If you didn't set this, and URL is filled, an instance will be created.
|
||||||
Property DataService : TDADataAbstractService Read GetDataService Write FDataService;
|
Property DataService : TDADataAbstractService Read GetDataService Write FDataService;
|
||||||
// You can set this. If you didn't set this, and URL is filled, an instance will be created.
|
// You can set this. If you didn't set this, and URL is filled, an instance will be created.
|
||||||
@ -129,6 +133,10 @@ Type
|
|||||||
Property OnLogin : TDALoginSuccessEvent Read FOnLogin Write FOnLogin;
|
Property OnLogin : TDALoginSuccessEvent Read FOnLogin Write FOnLogin;
|
||||||
// Called when login call failed. When call was executed but user is wrong OnLogin is called !
|
// Called when login call failed. When call was executed but user is wrong OnLogin is called !
|
||||||
Property OnLoginCallFailed : TDAFailedEvent Read FOnLoginFailed Write FOnLoginFailed;
|
Property OnLoginCallFailed : TDAFailedEvent Read FOnLoginFailed Write FOnLoginFailed;
|
||||||
|
// Called when logout call is executed.
|
||||||
|
Property OnLogout : TDASuccessEvent Read FOnLogout Write FOnLogout;
|
||||||
|
// Called when logout call failed.
|
||||||
|
Property OnLogOutCallFailed : TDAFailedEvent Read FOnLogoutailed Write FOnLogoutFailed;
|
||||||
// Streamertype : format of the data package in the message.
|
// Streamertype : format of the data package in the message.
|
||||||
Property StreamerType : TDAStreamerType Read FStreamerType Write FStreamerType;
|
Property StreamerType : TDAStreamerType Read FStreamerType Write FStreamerType;
|
||||||
end;
|
end;
|
||||||
@ -203,7 +211,7 @@ begin
|
|||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function TDAConnection.DetectMessageType(Const aURL : String) : TDAMessageType;
|
function TDAConnection.DetectMessageType(const aURL: String): TDAMessageType;
|
||||||
|
|
||||||
Var
|
Var
|
||||||
S : String;
|
S : String;
|
||||||
@ -284,6 +292,11 @@ begin
|
|||||||
EnsureLoginService.LoginEx(aLoginString,FOnLogin,FOnLoginFailed);
|
EnsureLoginService.LoginEx(aLoginString,FOnLogin,FOnLoginFailed);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
procedure TDAConnection.Logout;
|
||||||
|
begin
|
||||||
|
EnsureLoginService.Logout(FOnLogout,FOnLogoutFailed);
|
||||||
|
end;
|
||||||
|
|
||||||
{ TDADataset }
|
{ TDADataset }
|
||||||
|
|
||||||
function TDADataset.DataTypeToFieldType(s : String) : TFieldType;
|
function TDADataset.DataTypeToFieldType(s : String) : TFieldType;
|
||||||
@ -346,6 +359,7 @@ procedure TDADataset.CreateFieldDefs(a: TJSArray);
|
|||||||
Var
|
Var
|
||||||
I : Integer;
|
I : Integer;
|
||||||
F : TDAField;
|
F : TDAField;
|
||||||
|
FO : TJSObject absolute F;
|
||||||
fn,dt : string;
|
fn,dt : string;
|
||||||
fs : Integer;
|
fs : Integer;
|
||||||
FT : TFieldType;
|
FT : TFieldType;
|
||||||
@ -357,9 +371,19 @@ begin
|
|||||||
begin
|
begin
|
||||||
F:=TDAField(A.Elements[i]);
|
F:=TDAField(A.Elements[i]);
|
||||||
fn:=F.Name;
|
fn:=F.Name;
|
||||||
fs:=F.Size;
|
// The JSON streamer does not create all properties :(
|
||||||
dt:=F.type_;
|
if FO.hasOwnProperty('size') then
|
||||||
req:=F.Required;
|
fs:=F.Size
|
||||||
|
else
|
||||||
|
fs:=0;
|
||||||
|
if FO.hasOwnProperty('type') then
|
||||||
|
dt:=F.type_
|
||||||
|
else
|
||||||
|
dt:='string';
|
||||||
|
if FO.hasOwnProperty('required') then
|
||||||
|
req:=F.Required
|
||||||
|
else
|
||||||
|
Req:=false;
|
||||||
Ft:=DataTypeToFieldType(dT);
|
Ft:=DataTypeToFieldType(dT);
|
||||||
if (ft=ftBlob) and (fs=0) then
|
if (ft=ftBlob) and (fs=0) then
|
||||||
fs:=1;
|
fs:=1;
|
||||||
@ -467,6 +491,8 @@ begin
|
|||||||
else
|
else
|
||||||
Msg:=Fail;
|
Msg:=Fail;
|
||||||
Success:=rrFail;
|
Success:=rrFail;
|
||||||
|
ErrorMsg:=Msg;
|
||||||
|
DoAfterRequest;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TDADataRequest.doSuccess(res: JSValue);
|
procedure TDADataRequest.doSuccess(res: JSValue);
|
||||||
@ -488,12 +514,13 @@ begin
|
|||||||
if (DADS.DAConnection.EnsureMessageType=mtJSON) then
|
if (DADS.DAConnection.EnsureMessageType=mtJSON) then
|
||||||
S:=TROUtil.Frombase64(S);
|
S:=TROUtil.Frombase64(S);
|
||||||
Case DADS.DAConnection.StreamerType of
|
Case DADS.DAConnection.StreamerType of
|
||||||
stJSON : DStr:=TDABIN2DataStreamer.new;
|
stJSON : DStr:=TDAJSONDataStreamer.new;
|
||||||
stBIN: DStr:=TDABIN2DataStreamer.new;
|
stBIN: DStr:=TDABIN2DataStreamer.new;
|
||||||
end;
|
end;
|
||||||
DStr.Stream:=S;
|
DStr.Stream:=S;
|
||||||
DStr.initializeRead;
|
DStr.initializeRead;
|
||||||
DT:=TDADataTable.New;
|
DT:=TDADataTable.New;
|
||||||
|
DT.name:=DADS.TableName;
|
||||||
DStr.ReadDataset(DT);
|
DStr.ReadDataset(DT);
|
||||||
Rows:=TJSArray.New;
|
Rows:=TJSArray.New;
|
||||||
for I:=0 to length(DT.rows)-1 do
|
for I:=0 to length(DT.rows)-1 do
|
||||||
|
|||||||
@ -670,6 +670,7 @@ type
|
|||||||
// Wrapper that calls SetFieldType
|
// Wrapper that calls SetFieldType
|
||||||
// procedure SetBlobType(AValue: TBlobType);
|
// procedure SetBlobType(AValue: TBlobType);
|
||||||
protected
|
protected
|
||||||
|
class procedure CheckTypeSize(AValue: Longint); override;
|
||||||
function GetBlobSize: Longint; virtual;
|
function GetBlobSize: Longint; virtual;
|
||||||
function GetIsNull: Boolean; override;
|
function GetIsNull: Boolean; override;
|
||||||
procedure GetText(var AText: string; ADisplayText{%H-}: Boolean); override;
|
procedure GetText(var AText: string; ADisplayText{%H-}: Boolean); override;
|
||||||
@ -7027,6 +7028,11 @@ end;
|
|||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
class procedure TBlobField.CheckTypeSize(AValue: Longint);
|
||||||
|
begin
|
||||||
|
If AValue<0 then
|
||||||
|
DatabaseErrorFmt(SInvalidFieldSize,[AValue]);
|
||||||
|
end;
|
||||||
|
|
||||||
function TBlobField.GetBlobSize: Longint;
|
function TBlobField.GetBlobSize: Longint;
|
||||||
|
|
||||||
|
|||||||
@ -1,3 +1,18 @@
|
|||||||
|
{
|
||||||
|
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 EXTJS JSON dataset component.
|
||||||
|
|
||||||
|
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 ExtJSDataset;
|
unit ExtJSDataset;
|
||||||
|
|
||||||
{$mode objfpc}
|
{$mode objfpc}
|
||||||
|
|||||||
@ -1,3 +1,18 @@
|
|||||||
|
{
|
||||||
|
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 JSON dataset component.
|
||||||
|
|
||||||
|
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.
|
||||||
|
|
||||||
|
**********************************************************************}
|
||||||
{$mode objfpc}
|
{$mode objfpc}
|
||||||
|
|
||||||
unit JSONDataset;
|
unit JSONDataset;
|
||||||
@ -332,7 +347,7 @@ type
|
|||||||
// Format JSON date to from DT for Field F
|
// Format JSON date to from DT for Field F
|
||||||
function FormatDateTimeField(DT : TDateTime; F: TField): String; virtual;
|
function FormatDateTimeField(DT : TDateTime; F: TField): String; virtual;
|
||||||
// Create fieldmapper. A descendent MUST implement this.
|
// Create fieldmapper. A descendent MUST implement this.
|
||||||
Function CreateFieldMapper : TJSONFieldMapper; virtual; abstract;
|
Function CreateFieldMapper : TJSONFieldMapper; virtual;
|
||||||
// If True, then the dataset will free MetaData and FRows when it is closed.
|
// If True, then the dataset will free MetaData and FRows when it is closed.
|
||||||
Property OwnsData : Boolean Read FownsData Write FOwnsData;
|
Property OwnsData : Boolean Read FownsData Write FOwnsData;
|
||||||
// set to true if unknown field types should be handled as string fields.
|
// set to true if unknown field types should be handled as string fields.
|
||||||
@ -1569,6 +1584,14 @@ begin
|
|||||||
Result:=FormatDateTime(ptrn,DT);
|
Result:=FormatDateTime(ptrn,DT);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
function TBaseJSONDataSet.CreateFieldMapper: TJSONFieldMapper;
|
||||||
|
begin
|
||||||
|
if FRowType=rtJSONArray then
|
||||||
|
Result:=TJSONArrayFieldMapper.Create
|
||||||
|
else
|
||||||
|
Result:=TJSONObjectFieldMapper.Create;
|
||||||
|
end;
|
||||||
|
|
||||||
function TBaseJSONDataSet.GetFieldData(Field: TField; Buffer: TDatarecord): JSValue;
|
function TBaseJSONDataSet.GetFieldData(Field: TField; Buffer: TDatarecord): JSValue;
|
||||||
|
|
||||||
var
|
var
|
||||||
|
|||||||
@ -1,3 +1,19 @@
|
|||||||
|
{
|
||||||
|
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 REST connection component for use with Datasets.
|
||||||
|
|
||||||
|
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 RestConnection;
|
unit RestConnection;
|
||||||
|
|
||||||
{$mode objfpc}
|
{$mode objfpc}
|
||||||
@ -22,9 +38,10 @@ Type
|
|||||||
FPageParam: String;
|
FPageParam: String;
|
||||||
function GetDataProxy: TDataProxy;
|
function GetDataProxy: TDataProxy;
|
||||||
Protected
|
Protected
|
||||||
Function GetUpdateBaseURL : String; virtual;
|
Procedure SetupRequest(aXHR : TJSXMLHttpRequest); virtual;
|
||||||
Function GetReadBaseURL : String; virtual;
|
Function GetUpdateBaseURL(aRequest: TRecordUpdateDescriptor) : String; virtual;
|
||||||
Function GetPageURL(aRequest : TDataRequest) : String;
|
Function GetReadBaseURL(aRequest: TDataRequest) : String; virtual;
|
||||||
|
Function GetPageURL(aRequest : TDataRequest) : String; virtual;
|
||||||
Function GetRecordUpdateURL(aRequest : TRecordUpdateDescriptor) : String;
|
Function GetRecordUpdateURL(aRequest : TRecordUpdateDescriptor) : String;
|
||||||
Public
|
Public
|
||||||
Function DoGetDataProxy : TDataProxy; virtual;
|
Function DoGetDataProxy : TDataProxy; virtual;
|
||||||
@ -129,12 +146,17 @@ begin
|
|||||||
Result:=FDataProxy;
|
Result:=FDataProxy;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function TRESTConnection.GetUpdateBaseURL: String;
|
procedure TRESTConnection.SetupRequest(aXHR: TJSXMLHttpRequest);
|
||||||
|
begin
|
||||||
|
// Do nothing
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TRESTConnection.GetUpdateBaseURL(aRequest: TRecordUpdateDescriptor): String;
|
||||||
begin
|
begin
|
||||||
Result:=BaseURL;
|
Result:=BaseURL;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function TRESTConnection.GetReadBaseURL: String;
|
function TRESTConnection.GetReadBaseURL(aRequest: TDataRequest): String;
|
||||||
begin
|
begin
|
||||||
Result:=BaseURL;
|
Result:=BaseURL;
|
||||||
end;
|
end;
|
||||||
@ -145,7 +167,7 @@ Var
|
|||||||
URL : String;
|
URL : String;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
URL:=GetReadBaseURL;
|
URL:=GetReadBaseURL(aRequest);
|
||||||
if (PageParam<>'') then
|
if (PageParam<>'') then
|
||||||
begin
|
begin
|
||||||
if Pos('?',URL)<>0 then
|
if Pos('?',URL)<>0 then
|
||||||
@ -168,7 +190,7 @@ Var
|
|||||||
begin
|
begin
|
||||||
KeyField:='';
|
KeyField:='';
|
||||||
Result:='';
|
Result:='';
|
||||||
Base:=GetUpdateBaseURL;
|
Base:=GetUpdateBaseURL(aRequest);
|
||||||
if aRequest.Status in [usModified,usDeleted] then
|
if aRequest.Status in [usModified,usDeleted] then
|
||||||
begin
|
begin
|
||||||
I:=aRequest.Dataset.Fields.Count-1;
|
I:=aRequest.Dataset.Fields.Count-1;
|
||||||
@ -286,6 +308,7 @@ begin
|
|||||||
else
|
else
|
||||||
begin
|
begin
|
||||||
R.FXHR.open('GET',URL,true);
|
R.FXHR.open('GET',URL,true);
|
||||||
|
Connection.SetupRequest(R.FXHR);
|
||||||
R.FXHR.send;
|
R.FXHR.send;
|
||||||
Result:=True;
|
Result:=True;
|
||||||
end;
|
end;
|
||||||
|
|||||||
416
packages/fcl-db/sqldbrestdataset.pp
Normal file
416
packages/fcl-db/sqldbrestdataset.pp
Normal file
@ -0,0 +1,416 @@
|
|||||||
|
{
|
||||||
|
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
|
||||||
|
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;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TSQLDBRestDataset }
|
||||||
|
|
||||||
|
TSQLDBRestDataset = Class(TJSONDataset)
|
||||||
|
private
|
||||||
|
FConnection: TSQLDBRestConnection;
|
||||||
|
FResourceName: String;
|
||||||
|
procedure SetConnection(AValue: TSQLDBRestConnection);
|
||||||
|
procedure SetResourceName(AValue: String);
|
||||||
|
Protected
|
||||||
|
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
|
||||||
|
Property Connection: TSQLDBRestConnection Read FConnection Write SetConnection;
|
||||||
|
Property ResourceName : String Read FResourceName Write SetResourceName;
|
||||||
|
end;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
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;
|
||||||
|
|
||||||
|
{ 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(GetResult)
|
||||||
|
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);
|
||||||
|
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
|
||||||
|
inherited SetupRequest(aXHR);
|
||||||
|
aXHR.setRequestHeader('Content-Type', 'application/json');
|
||||||
|
aXHR.setRequestHeader('Accept', 'application/json');
|
||||||
|
if (UserName<>'') then
|
||||||
|
aXHR.setRequestHeader('Authorization', 'Basic '+window.btoa(UserName+':'+Password));
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TSQLDBRestConnection.GetUpdateBaseURL(aRequest: TRecordUpdateDescriptor): String;
|
||||||
|
begin
|
||||||
|
Result:=inherited GetUpdateBaseURL(aRequest);
|
||||||
|
Result:=IncludeTrailingPathDelimiter(Result)+TSQLDBRestDataset(aRequest.Dataset).ResourceName;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TSQLDBRestConnection.GetReadBaseURL(aRequest: TDataRequest): String;
|
||||||
|
begin
|
||||||
|
Result:=inherited GetReadBaseURL(aRequest);
|
||||||
|
Result:=IncludeTrailingPathDelimiter(Result)+TSQLDBRestDataset(aRequest.Dataset).ResourceName;
|
||||||
|
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.SetResourceName(AValue: String);
|
||||||
|
begin
|
||||||
|
if FResourceName=AValue then Exit;
|
||||||
|
CheckInactive;
|
||||||
|
FResourceName:=AValue;
|
||||||
|
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])
|
||||||
|
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;
|
||||||
|
|
||||||
|
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.
|
||||||
|
|
||||||
@ -1251,7 +1251,8 @@ Var
|
|||||||
end;
|
end;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
if Result and isDefined(Window) and isDefined(Window.Navigator) then
|
Result:=False;
|
||||||
|
if isDefined(Window) and isDefined(Window.Navigator) then
|
||||||
begin
|
begin
|
||||||
ua:=Window.Navigator.userAgent;
|
ua:=Window.Navigator.userAgent;
|
||||||
Result:=Not (
|
Result:=Not (
|
||||||
@ -1261,9 +1262,9 @@ begin
|
|||||||
or IsB('Chrome')
|
or IsB('Chrome')
|
||||||
or isB('Windows Phone')
|
or isB('Windows Phone')
|
||||||
);
|
);
|
||||||
If Result then
|
|
||||||
Result:=isDefined(Window.history) and isDefined(Window.history);
|
|
||||||
end;
|
end;
|
||||||
|
If Result then
|
||||||
|
Result:=isDefined(Window.history) and isDefined(Window.history);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
{ ---------------------------------------------------------------------
|
{ ---------------------------------------------------------------------
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user