paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-05-31 02:12:35 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Add 2 client-side demo programs

Browse Source 
git-svn-id: trunk@60644 -
This commit is contained in:
michael 2019-03-10 10:31:38 +00:00
parent a0c7eac2b7
commit d8c8090d58
14 changed files with 2190 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
.gitattributes vendored
View File

@ -1697,6 +1697,19 @@ components/fpvectorial/wmfvectorialreader.pas svneol=native#text/plain
components/fpvectorial/wmfvectorialwriter.pas svneol=native#text/plain
components/fpweb/README.txt svneol=native#text/plain
components/fpweb/demo/README.txt svneol=native#text/plain
components/fpweb/demo/bufclient/bufclient.ico -text
components/fpweb/demo/bufclient/bufclient.lpi svneol=native#text/plain
components/fpweb/demo/bufclient/bufclient.lpr svneol=native#text/plain
components/fpweb/demo/bufclient/bufclient.res -text
components/fpweb/demo/bufclient/frmmain.lfm svneol=native#text/plain
components/fpweb/demo/bufclient/frmmain.pp svneol=native#text/plain
components/fpweb/demo/jsonclient/frmmain.lfm svneol=native#text/plain
components/fpweb/demo/jsonclient/frmmain.pp svneol=native#text/plain
components/fpweb/demo/jsonclient/jsonclient.ico -text
components/fpweb/demo/jsonclient/jsonclient.lpi svneol=native#text/plain
components/fpweb/demo/jsonclient/jsonclient.lpr svneol=native#text/plain
components/fpweb/demo/jsonclient/jsonclient.res -text
components/fpweb/demo/jsonclient/sqldbrestdataset.pp svneol=native#text/plain
components/fpweb/demo/restbridge/dmrestbridge.lfm svneol=native#text/plain
components/fpweb/demo/restbridge/dmrestbridge.pp svneol=native#text/plain
components/fpweb/demo/restbridge/restserver.lpi svneol=native#text/plain

BIN
components/fpweb/demo/bufclient/bufclient.ico Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 134 KiB

86
components/fpweb/demo/bufclient/bufclient.lpi Normal file
View File

@ -0,0 +1,86 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="11"/>
<General>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<Title Value="bufclient"/>
<Scaled Value="True"/>
<ResourceType Value="res"/>
<UseXPManifest Value="True"/>
<XPManifest>
<DpiAware Value="True"/>
</XPManifest>
<Icon Value="0"/>
</General>
<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>
<RequiredPackages Count="4">
<Item1>
<PackageName Value="SynEdit"/>
</Item1>
<Item2>
<PackageName Value="weblaz"/>
</Item2>
<Item3>
<PackageName Value="FCL"/>
</Item3>
<Item4>
<PackageName Value="LCL"/>
</Item4>
</RequiredPackages>
<Units Count="2">
<Unit0>
<Filename Value="bufclient.lpr"/>
<IsPartOfProject Value="True"/>
</Unit0>
<Unit1>
<Filename Value="frmmain.pp"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="MainForm"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
</Unit1>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<Target>
<Filename Value="bufclient"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Linking>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
</CompilerOptions>
<Debugging>
<Exceptions Count="3">
<Item1>
<Name Value="EAbort"/>
</Item1>
<Item2>
<Name Value="ECodetoolError"/>
</Item2>
<Item3>
<Name Value="EFOpenError"/>
</Item3>
</Exceptions>
</Debugging>
</CONFIG>

22
components/fpweb/demo/bufclient/bufclient.lpr Normal file
View File

@ -0,0 +1,22 @@
program bufclient;
{$mode objfpc}{$H+}
uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
Interfaces, // this includes the LCL widgetset
Forms, frmmain
{ you can add units after this };
{$R *.res}
begin
RequireDerivedFormResource:=True;
Application.Scaled:=True;
Application.Initialize;
Application.CreateForm(TMainForm, MainForm);
Application.Run;
end.

BIN
components/fpweb/demo/bufclient/bufclient.res Normal file
View File

Binary file not shown.

721
components/fpweb/demo/bufclient/frmmain.lfm Normal file
View File

@ -0,0 +1,721 @@
object MainForm: TMainForm
Left = 489
Height = 368
Top = 180
Width = 600
ActiveControl = PCData
Caption = 'SQLDB REST Bridge BufDataset client'
ClientHeight = 368
ClientWidth = 600
Constraints.MinWidth = 600
SessionProperties = 'EPasword.Text;EURL.Text;EUserName.Text;Height;Left;Top;Width'
LCLVersion = '2.1.0.0'
object GBServer: TGroupBox
Left = 0
Height = 96
Top = 0
Width = 600
Align = alTop
Caption = 'Server Connection'
ClientHeight = 78
ClientWidth = 598
TabOrder = 0
object EURL: TEdit
Left = 88
Height = 27
Top = 8
Width = 497
Anchors = [akTop, akLeft, akRight]
TabOrder = 0
Text = 'http://localhost:3000/'
TextHint = 'URL for SQLDB Rest bridge server'
end
object LEURL: TLabel
Left = 8
Height = 24
Top = 8
Width = 69
Alignment = taRightJustify
AutoSize = False
Caption = 'Base URL'
FocusControl = EURL
Layout = tlCenter
ParentColor = False
end
object LUserName: TLabel
Left = 0
Height = 27
Top = 40
Width = 77
Alignment = taRightJustify
AutoSize = False
Caption = 'Username'
FocusControl = EUserName
Layout = tlCenter
ParentColor = False
end
object EUserName: TEdit
Left = 88
Height = 27
Top = 40
Width = 120
TabOrder = 1
TextHint = 'User name'
end
object LPassword: TLabel
Left = 208
Height = 22
Top = 42
Width = 64
Alignment = taRightJustify
AutoSize = False
Caption = 'Password'
Layout = tlCenter
ParentColor = False
end
object EPassword: TEdit
Left = 288
Height = 27
Top = 40
Width = 136
EchoMode = emPassword
PasswordChar = '*'
TabOrder = 2
TextHint = 'Password'
end
object BGetresources: TButton
Left = 449
Height = 25
Top = 42
Width = 136
Anchors = [akTop, akRight]
Caption = 'Get Resource list'
OnClick = BGetresourcesClick
TabOrder = 3
end
end
object LBResources: TListBox
Left = 0
Height = 272
Top = 96
Width = 100
Align = alLeft
ItemHeight = 0
ScrollWidth = 98
TabOrder = 1
TopIndex = -1
end
object PResource: TPanel
Left = 100
Height = 272
Top = 96
Width = 500
Align = alClient
BevelOuter = bvNone
ClientHeight = 272
ClientWidth = 500
TabOrder = 2
object PData: TPanel
Left = 0
Height = 39
Top = 0
Width = 500
Align = alTop
BevelOuter = bvNone
ClientHeight = 39
ClientWidth = 500
TabOrder = 0
object NavResource: TDBNavigator
Left = 8
Height = 25
Top = 8
Width = 241
BevelOuter = bvNone
ChildSizing.EnlargeHorizontal = crsScaleChilds
ChildSizing.EnlargeVertical = crsScaleChilds
ChildSizing.ShrinkHorizontal = crsScaleChilds
ChildSizing.ShrinkVertical = crsScaleChilds
ChildSizing.Layout = cclLeftToRightThenTopToBottom
ChildSizing.ControlsPerLine = 100
ClientHeight = 25
ClientWidth = 241
DataSource = DSResource
Options = []
TabOrder = 0
end
object BFetchResource: TButton
Left = 355
Height = 25
Top = 8
Width = 131
Anchors = [akTop, akRight]
Caption = 'Get Resource data'
OnClick = BFetchResourceClick
TabOrder = 1
end
end
object PCData: TPageControl
Left = 0
Height = 233
Top = 39
Width = 500
ActivePage = TSRaw
Align = alClient
TabIndex = 1
TabOrder = 1
object TSGrid: TTabSheet
Caption = 'Grid view'
ClientHeight = 198
ClientWidth = 494
object GResource: TDBGrid
Left = 0
Height = 198
Top = 0
Width = 494
Align = alClient
Color = clWindow
Columns = <>
DataSource = DSResource
TabOrder = 0
end
end
object TSRaw: TTabSheet
Caption = 'Raw Data'
ClientHeight = 198
ClientWidth = 494
inline SERawData: TSynEdit
Left = 0
Height = 198
Top = 0
Width = 494
Align = alClient
Font.Height = 13
Font.Name = 'DejaVu Sans Mono'
Font.Pitch = fpFixed
Font.Quality = fqNonAntialiased
ParentColor = False
ParentFont = False
TabOrder = 0
Gutter.Width = 57
Gutter.MouseActions = <>
RightGutter.Width = 0
RightGutter.MouseActions = <>
Highlighter = SHXML
Keystrokes = <
item
Command = ecUp
ShortCut = 38
end
item
Command = ecSelUp
ShortCut = 8230
end
item
Command = ecScrollUp
ShortCut = 16422
end
item
Command = ecDown
ShortCut = 40
end
item
Command = ecSelDown
ShortCut = 8232
end
item
Command = ecScrollDown
ShortCut = 16424
end
item
Command = ecLeft
ShortCut = 37
end
item
Command = ecSelLeft
ShortCut = 8229
end
item
Command = ecWordLeft
ShortCut = 16421
end
item
Command = ecSelWordLeft
ShortCut = 24613
end
item
Command = ecRight
ShortCut = 39
end
item
Command = ecSelRight
ShortCut = 8231
end
item
Command = ecWordRight
ShortCut = 16423
end
item
Command = ecSelWordRight
ShortCut = 24615
end
item
Command = ecPageDown
ShortCut = 34
end
item
Command = ecSelPageDown
ShortCut = 8226
end
item
Command = ecPageBottom
ShortCut = 16418
end
item
Command = ecSelPageBottom
ShortCut = 24610
end
item
Command = ecPageUp
ShortCut = 33
end
item
Command = ecSelPageUp
ShortCut = 8225
end
item
Command = ecPageTop
ShortCut = 16417
end
item
Command = ecSelPageTop
ShortCut = 24609
end
item
Command = ecLineStart
ShortCut = 36
end
item
Command = ecSelLineStart
ShortCut = 8228
end
item
Command = ecEditorTop
ShortCut = 16420
end
item
Command = ecSelEditorTop
ShortCut = 24612
end
item
Command = ecLineEnd
ShortCut = 35
end
item
Command = ecSelLineEnd
ShortCut = 8227
end
item
Command = ecEditorBottom
ShortCut = 16419
end
item
Command = ecSelEditorBottom
ShortCut = 24611
end
item
Command = ecToggleMode
ShortCut = 45
end
item
Command = ecCopy
ShortCut = 16429
end
item
Command = ecPaste
ShortCut = 8237
end
item
Command = ecDeleteChar
ShortCut = 46
end
item
Command = ecCut
ShortCut = 8238
end
item
Command = ecDeleteLastChar
ShortCut = 8
end
item
Command = ecDeleteLastChar
ShortCut = 8200
end
item
Command = ecDeleteLastWord
ShortCut = 16392
end
item
Command = ecUndo
ShortCut = 32776
end
item
Command = ecRedo
ShortCut = 40968
end
item
Command = ecLineBreak
ShortCut = 13
end
item
Command = ecSelectAll
ShortCut = 16449
end
item
Command = ecCopy
ShortCut = 16451
end
item
Command = ecBlockIndent
ShortCut = 24649
end
item
Command = ecLineBreak
ShortCut = 16461
end
item
Command = ecInsertLine
ShortCut = 16462
end
item
Command = ecDeleteWord
ShortCut = 16468
end
item
Command = ecBlockUnindent
ShortCut = 24661
end
item
Command = ecPaste
ShortCut = 16470
end
item
Command = ecCut
ShortCut = 16472
end
item
Command = ecDeleteLine
ShortCut = 16473
end
item
Command = ecDeleteEOL
ShortCut = 24665
end
item
Command = ecUndo
ShortCut = 16474
end
item
Command = ecRedo
ShortCut = 24666
end
item
Command = ecGotoMarker0
ShortCut = 16432
end
item
Command = ecGotoMarker1
ShortCut = 16433
end
item
Command = ecGotoMarker2
ShortCut = 16434
end
item
Command = ecGotoMarker3
ShortCut = 16435
end
item
Command = ecGotoMarker4
ShortCut = 16436
end
item
Command = ecGotoMarker5
ShortCut = 16437
end
item
Command = ecGotoMarker6
ShortCut = 16438
end
item
Command = ecGotoMarker7
ShortCut = 16439
end
item
Command = ecGotoMarker8
ShortCut = 16440
end
item
Command = ecGotoMarker9
ShortCut = 16441
end
item
Command = ecSetMarker0
ShortCut = 24624
end
item
Command = ecSetMarker1
ShortCut = 24625
end
item
Command = ecSetMarker2
ShortCut = 24626
end
item
Command = ecSetMarker3
ShortCut = 24627
end
item
Command = ecSetMarker4
ShortCut = 24628
end
item
Command = ecSetMarker5
ShortCut = 24629
end
item
Command = ecSetMarker6
ShortCut = 24630
end
item
Command = ecSetMarker7
ShortCut = 24631
end
item
Command = ecSetMarker8
ShortCut = 24632
end
item
Command = ecSetMarker9
ShortCut = 24633
end
item
Command = EcFoldLevel1
ShortCut = 41009
end
item
Command = EcFoldLevel2
ShortCut = 41010
end
item
Command = EcFoldLevel3
ShortCut = 41011
end
item
Command = EcFoldLevel4
ShortCut = 41012
end
item
Command = EcFoldLevel5
ShortCut = 41013
end
item
Command = EcFoldLevel6
ShortCut = 41014
end
item
Command = EcFoldLevel7
ShortCut = 41015
end
item
Command = EcFoldLevel8
ShortCut = 41016
end
item
Command = EcFoldLevel9
ShortCut = 41017
end
item
Command = EcFoldLevel0
ShortCut = 41008
end
item
Command = EcFoldCurrent
ShortCut = 41005
end
item
Command = EcUnFoldCurrent
ShortCut = 41003
end
item
Command = EcToggleMarkupWord
ShortCut = 32845
end
item
Command = ecNormalSelect
ShortCut = 24654
end
item
Command = ecColumnSelect
ShortCut = 24643
end
item
Command = ecLineSelect
ShortCut = 24652
end
item
Command = ecTab
ShortCut = 9
end
item
Command = ecShiftTab
ShortCut = 8201
end
item
Command = ecMatchBracket
ShortCut = 24642
end
item
Command = ecColSelUp
ShortCut = 40998
end
item
Command = ecColSelDown
ShortCut = 41000
end
item
Command = ecColSelLeft
ShortCut = 40997
end
item
Command = ecColSelRight
ShortCut = 40999
end
item
Command = ecColSelPageDown
ShortCut = 40994
end
item
Command = ecColSelPageBottom
ShortCut = 57378
end
item
Command = ecColSelPageUp
ShortCut = 40993
end
item
Command = ecColSelPageTop
ShortCut = 57377
end
item
Command = ecColSelLineStart
ShortCut = 40996
end
item
Command = ecColSelLineEnd
ShortCut = 40995
end
item
Command = ecColSelEditorTop
ShortCut = 57380
end
item
Command = ecColSelEditorBottom
ShortCut = 57379
end>
MouseActions = <>
MouseTextActions = <>
MouseSelActions = <>
Lines.Strings = (
''
)
VisibleSpecialChars = [vscSpace, vscTabAtLast]
SelectedColor.BackPriority = 50
SelectedColor.ForePriority = 50
SelectedColor.FramePriority = 50
SelectedColor.BoldPriority = 50
SelectedColor.ItalicPriority = 50
SelectedColor.UnderlinePriority = 50
SelectedColor.StrikeOutPriority = 50
BracketHighlightStyle = sbhsBoth
BracketMatchColor.Background = clNone
BracketMatchColor.Foreground = clNone
BracketMatchColor.Style = [fsBold]
FoldedCodeColor.Background = clNone
FoldedCodeColor.Foreground = clGray
FoldedCodeColor.FrameColor = clGray
MouseLinkColor.Background = clNone
MouseLinkColor.Foreground = clBlue
LineHighlightColor.Background = clNone
LineHighlightColor.Foreground = clNone
inline SynLeftGutterPartList1: TSynGutterPartList
object SynGutterMarks1: TSynGutterMarks
Width = 24
MouseActions = <>
end
object SynGutterLineNumber1: TSynGutterLineNumber
Width = 17
MouseActions = <>
MarkupInfo.Background = clBtnFace
MarkupInfo.Foreground = clNone
DigitCount = 2
ShowOnlyLineNumbersMultiplesOf = 1
ZeroStart = False
LeadingZeros = False
end
object SynGutterChanges1: TSynGutterChanges
Width = 4
MouseActions = <>
ModifiedColor = 59900
SavedColor = clGreen
end
object SynGutterSeparator1: TSynGutterSeparator
Width = 2
MouseActions = <>
MarkupInfo.Background = clWhite
MarkupInfo.Foreground = clGray
end
object SynGutterCodeFolding1: TSynGutterCodeFolding
MouseActions = <>
MarkupInfo.Background = clNone
MarkupInfo.Foreground = clGray
MouseActionsExpanded = <>
MouseActionsCollapsed = <>
end
end
end
end
end
end
object DSResource: TDataSource
DataSet = BDSResource
left = 341
top = 207
end
object BDSResource: TBufDataset
FieldDefs = <>
left = 204
top = 207
end
object PSMain: TIniPropStorage
StoredValues = <>
OnSaveProperties = PSMainSaveProperties
OnRestoreProperties = PSMainRestoreProperties
left = 521
top = 113
end
object HTCResource: TFPHTTPClient
KeepConnection = False
IOTimeout = 0
HTTPversion = '1.1'
AllowRedirect = False
left = 389
top = 96
end
object SHXML: TSynXMLSyn
DefaultFilter = 'XML Document (*.xml,*.xsd,*.xsl,*.xslt,*.dtd)|*.xml;*.xsd;*.xsl;*.xslt;*.dtd'
Enabled = False
WantBracesParsed = False
left = 269
top = 189
end
end

184
components/fpweb/demo/bufclient/frmmain.pp Normal file
View File

@ -0,0 +1,184 @@
unit frmmain;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, db, BufDataset, fphttpclient, Forms, Controls, Graphics,
Dialogs, StdCtrls, ExtCtrls, DBCtrls, DBGrids, IniPropStorage, ComCtrls,
fpJSON, SynEdit, SynHighlighterXML, XMLDatapacketReader;
type
{ TMainForm }
TMainForm = class(TForm)
BGetresources: TButton;
BDSResource: TBufDataset;
BFetchResource: TButton;
DSResource: TDataSource;
GResource: TDBGrid;
HTCResource: TFPHTTPClient;
NavResource: TDBNavigator;
EURL: TEdit;
EUserName: TEdit;
EPassword: TEdit;
GBServer: TGroupBox;
PCData: TPageControl;
PSMain: TIniPropStorage;
LEURL: TLabel;
LUserName: TLabel;
LPassword: TLabel;
LBResources: TListBox;
PResource: TPanel;
PData: TPanel;
SERawData: TSynEdit;
SHXML: TSynXMLSyn;
TSGrid: TTabSheet;
TSRaw: TTabSheet;
procedure BFetchResourceClick(Sender: TObject);
procedure BGetresourcesClick(Sender: TObject);
procedure PSMainRestoreProperties(Sender: TObject);
procedure PSMainSaveProperties(Sender: TObject);
private
function ConfigConnection: String;
procedure DisplayResources(J: TJSONObject);
procedure GetResourceData;
procedure GetResources;
public
end;
var
MainForm: TMainForm;
implementation
uses strutils,httpprotocol, jsonparser, URIParser;
{$R *.lfm}
{ TMainForm }
Function TMainForm.ConfigConnection : String;
Var
P : String;
begin
HTCResource.UserName:=EUserName.Text;
HTCResource.Password:=EPassword.Text;
Result:=EURL.Text;
if (Result='') then
Raise Exception.Create('Need a URL to perform request');
P:=LowerCase(ParseUri(Result,False).Protocol);
if (P<>'http') and (P<>'https') then
Result:='http://'+Result;
Result:=IncludeHTTPPathDelimiter(Result);
end;
procedure TMainForm.DisplayResources(J : TJSONObject);
Var
A : TJSONArray;
I : Integer;
R : TJSONObject;
N : String;
begin
LBResources.Items.Clear;
A:=J.Get('data',TJSONArray(Nil));
if not assigned(A) then
exit;
For I:=0 to A.Count-1 do
begin
R:=A.Objects[i];
N:=R.Get('name','');
if N<>'' then
LBResources.Items.Add(N);
end;
end;
procedure TMainForm.GetResources;
Var
S : TMemoryStream;
URL : String;
D : TJSONData;
J : TJSONObject absolute D;
begin
URL:=ConfigConnection;
S:=TMemoryStream.Create;
try
HTCResource.Get(URL+'metadata/?fmt=json&humanreadable=0',S);
S.Position:=0;
D:=GetJSON(S);
if D is TJSONObject then
DisplayResources(J);
finally
S.Free;
end;
end;
procedure TMainForm.GetResourceData;
Var
S : TMemoryStream;
URL : String;
begin
URL:=ConfigConnection;
if LBResources.ItemIndex<>-1 then
URL:=URL+LBResources.Items[LBResources.ItemIndex];
S:=TMemoryStream.Create;
try
HTCResource.Get(URL+'?fmt=buf&humanreadable=1',S);
S.Position:=0;
SERawData.Lines.LoadFromStream(S);
S.Position:=0;
BDSResource.LoadFromStream(S,dfXML);
finally
S.Free;
end;
end;
procedure TMainForm.BGetresourcesClick(Sender: TObject);
begin
GetResources;
end;
procedure TMainForm.PSMainRestoreProperties(Sender: TObject);
Var
S: String;
begin
S:=PSMAin.ReadString('pwd','');
if (S<>'') then
EPassword.Text:=XorDecode('secret',S)
else
EPassword.Clear;
end;
procedure TMainForm.PSMainSaveProperties(Sender: TObject);
Var
S: String;
begin
S:=EPassword.Text;
If (S<>'') then
PSMAin.WriteString('pwd',XorEncode('secret',S));
end;
procedure TMainForm.BFetchResourceClick(Sender: TObject);
begin
GetResourceData;
end;
end.

708
components/fpweb/demo/jsonclient/frmmain.lfm Normal file
View File

@ -0,0 +1,708 @@
object MainForm: TMainForm
Left = 489
Height = 368
Top = 180
Width = 600
ActiveControl = PCData
Caption = 'SQLDB REST Bridge JSONDataset client'
ClientHeight = 368
ClientWidth = 600
Constraints.MinWidth = 600
OnCreate = FormCreate
SessionProperties = 'EPasword.Text;EURL.Text;EUserName.Text;Height;Left;Top;Width'
LCLVersion = '2.1.0.0'
object GBServer: TGroupBox
Left = 0
Height = 96
Top = 0
Width = 600
Align = alTop
Caption = 'Server Connection'
ClientHeight = 78
ClientWidth = 598
TabOrder = 0
object EURL: TEdit
Left = 88
Height = 27
Top = 8
Width = 497
Anchors = [akTop, akLeft, akRight]
TabOrder = 0
Text = 'http://localhost:3000/'
TextHint = 'URL for SQLDB Rest bridge server'
end
object LEURL: TLabel
Left = 8
Height = 24
Top = 8
Width = 69
Alignment = taRightJustify
AutoSize = False
Caption = 'Base URL'
FocusControl = EURL
Layout = tlCenter
ParentColor = False
end
object LUserName: TLabel
Left = 0
Height = 27
Top = 40
Width = 77
Alignment = taRightJustify
AutoSize = False
Caption = 'Username'
FocusControl = EUserName
Layout = tlCenter
ParentColor = False
end
object EUserName: TEdit
Left = 88
Height = 27
Top = 40
Width = 120
TabOrder = 1
TextHint = 'User name'
end
object LPassword: TLabel
Left = 208
Height = 22
Top = 42
Width = 64
Alignment = taRightJustify
AutoSize = False
Caption = 'Password'
Layout = tlCenter
ParentColor = False
end
object EPassword: TEdit
Left = 288
Height = 27
Top = 40
Width = 136
EchoMode = emPassword
PasswordChar = '*'
TabOrder = 2
TextHint = 'Password'
end
object BGetresources: TButton
Left = 449
Height = 25
Top = 42
Width = 136
Anchors = [akTop, akRight]
Caption = 'Get Resource list'
OnClick = BGetresourcesClick
TabOrder = 3
end
end
object LBResources: TListBox
Left = 0
Height = 272
Top = 96
Width = 100
Align = alLeft
ItemHeight = 0
ScrollWidth = 98
TabOrder = 1
TopIndex = -1
end
object PResource: TPanel
Left = 100
Height = 272
Top = 96
Width = 500
Align = alClient
BevelOuter = bvNone
ClientHeight = 272
ClientWidth = 500
TabOrder = 2
object PData: TPanel
Left = 0
Height = 39
Top = 0
Width = 500
Align = alTop
BevelOuter = bvNone
ClientHeight = 39
ClientWidth = 500
TabOrder = 0
object NavResource: TDBNavigator
Left = 8
Height = 25
Top = 8
Width = 241
BevelOuter = bvNone
ChildSizing.EnlargeHorizontal = crsScaleChilds
ChildSizing.EnlargeVertical = crsScaleChilds
ChildSizing.ShrinkHorizontal = crsScaleChilds
ChildSizing.ShrinkVertical = crsScaleChilds
ChildSizing.Layout = cclLeftToRightThenTopToBottom
ChildSizing.ControlsPerLine = 100
ClientHeight = 25
ClientWidth = 241
DataSource = DSResource
Options = []
TabOrder = 0
end
object BFetchResource: TButton
Left = 355
Height = 25
Top = 8
Width = 131
Anchors = [akTop, akRight]
Caption = 'Get Resource data'
OnClick = BFetchResourceClick
TabOrder = 1
end
end
object PCData: TPageControl
Left = 0
Height = 233
Top = 39
Width = 500
ActivePage = TSRaw
Align = alClient
TabIndex = 1
TabOrder = 1
object TSGrid: TTabSheet
Caption = 'Grid view'
ClientHeight = 198
ClientWidth = 494
object GResource: TDBGrid
Left = 0
Height = 198
Top = 0
Width = 494
Align = alClient
Color = clWindow
Columns = <>
DataSource = DSResource
TabOrder = 0
end
end
object TSRaw: TTabSheet
Caption = 'Raw Data'
ClientHeight = 198
ClientWidth = 494
inline SERawData: TSynEdit
Left = 0
Height = 198
Top = 0
Width = 494
Align = alClient
Font.Height = 13
Font.Name = 'DejaVu Sans Mono'
Font.Pitch = fpFixed
Font.Quality = fqNonAntialiased
ParentColor = False
ParentFont = False
TabOrder = 0
Gutter.Width = 57
Gutter.MouseActions = <>
RightGutter.Width = 0
RightGutter.MouseActions = <>
Keystrokes = <
item
Command = ecUp
ShortCut = 38
end
item
Command = ecSelUp
ShortCut = 8230
end
item
Command = ecScrollUp
ShortCut = 16422
end
item
Command = ecDown
ShortCut = 40
end
item
Command = ecSelDown
ShortCut = 8232
end
item
Command = ecScrollDown
ShortCut = 16424
end
item
Command = ecLeft
ShortCut = 37
end
item
Command = ecSelLeft
ShortCut = 8229
end
item
Command = ecWordLeft
ShortCut = 16421
end
item
Command = ecSelWordLeft
ShortCut = 24613
end
item
Command = ecRight
ShortCut = 39
end
item
Command = ecSelRight
ShortCut = 8231
end
item
Command = ecWordRight
ShortCut = 16423
end
item
Command = ecSelWordRight
ShortCut = 24615
end
item
Command = ecPageDown
ShortCut = 34
end
item
Command = ecSelPageDown
ShortCut = 8226
end
item
Command = ecPageBottom
ShortCut = 16418
end
item
Command = ecSelPageBottom
ShortCut = 24610
end
item
Command = ecPageUp
ShortCut = 33
end
item
Command = ecSelPageUp
ShortCut = 8225
end
item
Command = ecPageTop
ShortCut = 16417
end
item
Command = ecSelPageTop
ShortCut = 24609
end
item
Command = ecLineStart
ShortCut = 36
end
item
Command = ecSelLineStart
ShortCut = 8228
end
item
Command = ecEditorTop
ShortCut = 16420
end
item
Command = ecSelEditorTop
ShortCut = 24612
end
item
Command = ecLineEnd
ShortCut = 35
end
item
Command = ecSelLineEnd
ShortCut = 8227
end
item
Command = ecEditorBottom
ShortCut = 16419
end
item
Command = ecSelEditorBottom
ShortCut = 24611
end
item
Command = ecToggleMode
ShortCut = 45
end
item
Command = ecCopy
ShortCut = 16429
end
item
Command = ecPaste
ShortCut = 8237
end
item
Command = ecDeleteChar
ShortCut = 46
end
item
Command = ecCut
ShortCut = 8238
end
item
Command = ecDeleteLastChar
ShortCut = 8
end
item
Command = ecDeleteLastChar
ShortCut = 8200
end
item
Command = ecDeleteLastWord
ShortCut = 16392
end
item
Command = ecUndo
ShortCut = 32776
end
item
Command = ecRedo
ShortCut = 40968
end
item
Command = ecLineBreak
ShortCut = 13
end
item
Command = ecSelectAll
ShortCut = 16449
end
item
Command = ecCopy
ShortCut = 16451
end
item
Command = ecBlockIndent
ShortCut = 24649
end
item
Command = ecLineBreak
ShortCut = 16461
end
item
Command = ecInsertLine
ShortCut = 16462
end
item
Command = ecDeleteWord
ShortCut = 16468
end
item
Command = ecBlockUnindent
ShortCut = 24661
end
item
Command = ecPaste
ShortCut = 16470
end
item
Command = ecCut
ShortCut = 16472
end
item
Command = ecDeleteLine
ShortCut = 16473
end
item
Command = ecDeleteEOL
ShortCut = 24665
end
item
Command = ecUndo
ShortCut = 16474
end
item
Command = ecRedo
ShortCut = 24666
end
item
Command = ecGotoMarker0
ShortCut = 16432
end
item
Command = ecGotoMarker1
ShortCut = 16433
end
item
Command = ecGotoMarker2
ShortCut = 16434
end
item
Command = ecGotoMarker3
ShortCut = 16435
end
item
Command = ecGotoMarker4
ShortCut = 16436
end
item
Command = ecGotoMarker5
ShortCut = 16437
end
item
Command = ecGotoMarker6
ShortCut = 16438
end
item
Command = ecGotoMarker7
ShortCut = 16439
end
item
Command = ecGotoMarker8
ShortCut = 16440
end
item
Command = ecGotoMarker9
ShortCut = 16441
end
item
Command = ecSetMarker0
ShortCut = 24624
end
item
Command = ecSetMarker1
ShortCut = 24625
end
item
Command = ecSetMarker2
ShortCut = 24626
end
item
Command = ecSetMarker3
ShortCut = 24627
end
item
Command = ecSetMarker4
ShortCut = 24628
end
item
Command = ecSetMarker5
ShortCut = 24629
end
item
Command = ecSetMarker6
ShortCut = 24630
end
item
Command = ecSetMarker7
ShortCut = 24631
end
item
Command = ecSetMarker8
ShortCut = 24632
end
item
Command = ecSetMarker9
ShortCut = 24633
end
item
Command = EcFoldLevel1
ShortCut = 41009
end
item
Command = EcFoldLevel2
ShortCut = 41010
end
item
Command = EcFoldLevel3
ShortCut = 41011
end
item
Command = EcFoldLevel4
ShortCut = 41012
end
item
Command = EcFoldLevel5
ShortCut = 41013
end
item
Command = EcFoldLevel6
ShortCut = 41014
end
item
Command = EcFoldLevel7
ShortCut = 41015
end
item
Command = EcFoldLevel8
ShortCut = 41016
end
item
Command = EcFoldLevel9
ShortCut = 41017
end
item
Command = EcFoldLevel0
ShortCut = 41008
end
item
Command = EcFoldCurrent
ShortCut = 41005
end
item
Command = EcUnFoldCurrent
ShortCut = 41003
end
item
Command = EcToggleMarkupWord
ShortCut = 32845
end
item
Command = ecNormalSelect
ShortCut = 24654
end
item
Command = ecColumnSelect
ShortCut = 24643
end
item
Command = ecLineSelect
ShortCut = 24652
end
item
Command = ecTab
ShortCut = 9
end
item
Command = ecShiftTab
ShortCut = 8201
end
item
Command = ecMatchBracket
ShortCut = 24642
end
item
Command = ecColSelUp
ShortCut = 40998
end
item
Command = ecColSelDown
ShortCut = 41000
end
item
Command = ecColSelLeft
ShortCut = 40997
end
item
Command = ecColSelRight
ShortCut = 40999
end
item
Command = ecColSelPageDown
ShortCut = 40994
end
item
Command = ecColSelPageBottom
ShortCut = 57378
end
item
Command = ecColSelPageUp
ShortCut = 40993
end
item
Command = ecColSelPageTop
ShortCut = 57377
end
item
Command = ecColSelLineStart
ShortCut = 40996
end
item
Command = ecColSelLineEnd
ShortCut = 40995
end
item
Command = ecColSelEditorTop
ShortCut = 57380
end
item
Command = ecColSelEditorBottom
ShortCut = 57379
end>
MouseActions = <>
MouseTextActions = <>
MouseSelActions = <>
Lines.Strings = (
''
)
VisibleSpecialChars = [vscSpace, vscTabAtLast]
SelectedColor.BackPriority = 50
SelectedColor.ForePriority = 50
SelectedColor.FramePriority = 50
SelectedColor.BoldPriority = 50
SelectedColor.ItalicPriority = 50
SelectedColor.UnderlinePriority = 50
SelectedColor.StrikeOutPriority = 50
BracketHighlightStyle = sbhsBoth
BracketMatchColor.Background = clNone
BracketMatchColor.Foreground = clNone
BracketMatchColor.Style = [fsBold]
FoldedCodeColor.Background = clNone
FoldedCodeColor.Foreground = clGray
FoldedCodeColor.FrameColor = clGray
MouseLinkColor.Background = clNone
MouseLinkColor.Foreground = clBlue
LineHighlightColor.Background = clNone
LineHighlightColor.Foreground = clNone
inline SynLeftGutterPartList1: TSynGutterPartList
object SynGutterMarks1: TSynGutterMarks
Width = 24
MouseActions = <>
end
object SynGutterLineNumber1: TSynGutterLineNumber
Width = 17
MouseActions = <>
MarkupInfo.Background = clBtnFace
MarkupInfo.Foreground = clNone
DigitCount = 2
ShowOnlyLineNumbersMultiplesOf = 1
ZeroStart = False
LeadingZeros = False
end
object SynGutterChanges1: TSynGutterChanges
Width = 4
MouseActions = <>
ModifiedColor = 59900
SavedColor = clGreen
end
object SynGutterSeparator1: TSynGutterSeparator
Width = 2
MouseActions = <>
MarkupInfo.Background = clWhite
MarkupInfo.Foreground = clGray
end
object SynGutterCodeFolding1: TSynGutterCodeFolding
MouseActions = <>
MarkupInfo.Background = clNone
MarkupInfo.Foreground = clGray
MouseActionsExpanded = <>
MouseActionsCollapsed = <>
end
end
end
end
end
end
object DSResource: TDataSource
left = 341
top = 207
end
object PSMain: TIniPropStorage
StoredValues = <>
OnSaveProperties = PSMainSaveProperties
OnRestoreProperties = PSMainRestoreProperties
left = 521
top = 113
end
object HTCResource: TFPHTTPClient
KeepConnection = False
IOTimeout = 0
HTTPversion = '1.1'
AllowRedirect = False
left = 389
top = 96
end
end

191
components/fpweb/demo/jsonclient/frmmain.pp Normal file
View File

@ -0,0 +1,191 @@
unit frmmain;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, db, BufDataset, fphttpclient, Forms, Controls, Graphics,
Dialogs, StdCtrls, ExtCtrls, DBCtrls, DBGrids, IniPropStorage, ComCtrls,
fpJSON, SynEdit, SynHighlighterXML, fpjsondataset, sqldbrestdataset;
type
{ TMainForm }
TMainForm = class(TForm)
BGetresources: TButton;
BFetchResource: TButton;
DSResource: TDataSource;
GResource: TDBGrid;
HTCResource: TFPHTTPClient;
NavResource: TDBNavigator;
EURL: TEdit;
EUserName: TEdit;
EPassword: TEdit;
GBServer: TGroupBox;
PCData: TPageControl;
PSMain: TIniPropStorage;
LEURL: TLabel;
LUserName: TLabel;
LPassword: TLabel;
LBResources: TListBox;
PResource: TPanel;
PData: TPanel;
SERawData: TSynEdit;
TSGrid: TTabSheet;
TSRaw: TTabSheet;
procedure BFetchResourceClick(Sender: TObject);
procedure BGetresourcesClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure PSMainRestoreProperties(Sender: TObject);
procedure PSMainSaveProperties(Sender: TObject);
private
JSResource : TSQLDBRestDataset;
function ConfigConnection: String;
procedure DisplayResources(J: TJSONObject);
procedure GetResourceData;
procedure GetResources;
public
end;
var
MainForm: TMainForm;
implementation
uses strutils,httpprotocol, jsonparser, URIParser;
{$R *.lfm}
{ TMainForm }
Function TMainForm.ConfigConnection : String;
Var
P : String;
begin
HTCResource.UserName:=EUserName.Text;
HTCResource.Password:=EPassword.Text;
Result:=EURL.Text;
if (Result='') then
Raise Exception.Create('Need a URL to perform request');
P:=LowerCase(ParseUri(Result,False).Protocol);
if (P<>'http') and (P<>'https') then
Result:='http://'+Result;
Result:=IncludeHTTPPathDelimiter(Result);
end;
procedure TMainForm.DisplayResources(J : TJSONObject);
Var
A : TJSONArray;
I : Integer;
R : TJSONObject;
N : String;
begin
LBResources.Items.Clear;
A:=J.Get('data',TJSONArray(Nil));
if not assigned(A) then
exit;
For I:=0 to A.Count-1 do
begin
R:=A.Objects[i];
N:=R.Get('name','');
if N<>'' then
LBResources.Items.Add(N);
end;
end;
procedure TMainForm.GetResources;
Var
S : TMemoryStream;
URL : String;
D : TJSONData;
J : TJSONObject absolute D;
begin
URL:=ConfigConnection;
S:=TMemoryStream.Create;
try
HTCResource.Get(URL+'metadata/?fmt=json&humanreadable=0',S);
S.Position:=0;
D:=GetJSON(S);
if D is TJSONObject then
DisplayResources(J);
finally
S.Free;
end;
end;
procedure TMainForm.GetResourceData;
Var
S : TMemoryStream;
URL : String;
begin
URL:=ConfigConnection;
if LBResources.ItemIndex<>-1 then
URL:=URL+LBResources.Items[LBResources.ItemIndex];
S:=TMemoryStream.Create;
try
HTCResource.Get(URL+'?fmt=json&humanreadable=1',S);
S.Position:=0;
SERawData.Lines.LoadFromStream(S);
S.Position:=0;
JSResource.LoadFromStream(S);
JSResource.Open;
finally
S.Free;
end;
end;
procedure TMainForm.BGetresourcesClick(Sender: TObject);
begin
GetResources;
end;
procedure TMainForm.FormCreate(Sender: TObject);
begin
JSResource:=TSQLDBRestDataset.Create(Self);
DSResource.DataSet:=JSResource;
end;
procedure TMainForm.PSMainRestoreProperties(Sender: TObject);
Var
S: String;
begin
S:=PSMAin.ReadString('pwd','');
if (S<>'') then
EPassword.Text:=XorDecode('secret',S)
else
EPassword.Clear;
end;
procedure TMainForm.PSMainSaveProperties(Sender: TObject);
Var
S: String;
begin
S:=EPassword.Text;
If (S<>'') then
PSMAin.WriteString('pwd',XorEncode('secret',S));
end;
procedure TMainForm.BFetchResourceClick(Sender: TObject);
begin
GetResourceData;
end;
end.

BIN
components/fpweb/demo/jsonclient/jsonclient.ico Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 134 KiB

90
components/fpweb/demo/jsonclient/jsonclient.lpi Normal file
View File

@ -0,0 +1,90 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="11"/>
<General>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<Title Value="jsonclient"/>
<Scaled Value="True"/>
<ResourceType Value="res"/>
<UseXPManifest Value="True"/>
<XPManifest>
<DpiAware Value="True"/>
</XPManifest>
<Icon Value="0"/>
</General>
<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>
<RequiredPackages Count="4">
<Item1>
<PackageName Value="SynEdit"/>
</Item1>
<Item2>
<PackageName Value="weblaz"/>
</Item2>
<Item3>
<PackageName Value="FCL"/>
</Item3>
<Item4>
<PackageName Value="LCL"/>
</Item4>
</RequiredPackages>
<Units Count="3">
<Unit0>
<Filename Value="jsonclient.lpr"/>
<IsPartOfProject Value="True"/>
</Unit0>
<Unit1>
<Filename Value="frmmain.pp"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="MainForm"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
</Unit1>
<Unit2>
<Filename Value="sqldbrestdataset.pp"/>
<IsPartOfProject Value="True"/>
</Unit2>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<Target>
<Filename Value="jsonclient"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Linking>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
</CompilerOptions>
<Debugging>
<Exceptions Count="3">
<Item1>
<Name Value="EAbort"/>
</Item1>
<Item2>
<Name Value="ECodetoolError"/>
</Item2>
<Item3>
<Name Value="EFOpenError"/>
</Item3>
</Exceptions>
</Debugging>
</CONFIG>

22
components/fpweb/demo/jsonclient/jsonclient.lpr Normal file
View File

@ -0,0 +1,22 @@
program jsonclient;
{$mode objfpc}{$H+}
uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
Interfaces, // this includes the LCL widgetset
Forms, frmmain, sqldbrestdataset
{ you can add units after this };
{$R *.res}
begin
RequireDerivedFormResource:=True;
Application.Scaled:=True;
Application.Initialize;
Application.CreateForm(TMainForm, MainForm);
Application.Run;
end.

BIN
components/fpweb/demo/jsonclient/jsonclient.res Normal file
View File

Binary file not shown.

153
components/fpweb/demo/jsonclient/sqldbrestdataset.pp Normal file
View File

@ -0,0 +1,153 @@
unit sqldbrestdataset;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, db, fpjson, fpjsondataset;
Type
{ TSQLDBRestDataset }
TSQLDBRestDataset = Class(TBaseJSONDataset)
private
Protected
function GetStringFieldLength(F: TJSONObject; AName: String; AIndex: Integer): integer;virtual;
function StringToFieldType(S: String): TFieldType; virtual;
Function CreateFieldMapper: TJSONFieldMapper; override;
Procedure MetaDataToFieldDefs; override;
Public
procedure LoadFromStream(S: TStream);
end;
implementation
type
PRecInfo = ^TRecInfo;
TRecInfo = record
Index: Integer;
Bookmark: Longint;
BookmarkFlag: TBookmarkFlag;
end;
procedure TSQLDBRestDataset.LoadFromStream(S: TStream);
Var
D : TJSONData;
O : TJSONObject absolute D;
N : String;
I : Integer;
begin
D:=GetJSON(S);
try
if (D.JSONType<>jtObject) then
Raise EJSONDataset.Create('Not a valid JSON data packet');
N:='data';
// Check metadata
I:=O.IndexOfName('metaData');
if (I<>-1) then
begin
If (O.Items[i].JSONType<>jtObject) then
Raise EJSONDataset.Create('Invalid JSON metaData in data packet.');
Metadata:=O.Objects['metaData'];
O.Extract(I);
end;
// Check rows
I:=O.IndexOfName(N);
if (I=-1) then
Raise EJSONDataset.Create('Missing data in data packet');
if (O.Items[i].JSONType<>jtArray) then
Raise EJSONDataset.Create('Rows element must be an array');
Rows:=O.Items[i] as TJSONArray;
O.Extract(I);
OwnsData:=True;
finally
D.Free;
end;
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:=ftString // Buggy TJSONDataset in 3.0.4
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.CreateFieldMapper: TJSONFieldMapper;
begin
Result:=TJSONObjectFieldMapper.Create;
end;
function TSQLDBRestDataset.GetStringFieldLength(F: TJSONObject; AName: String;
AIndex: Integer): integer;
Var
I,L : Integer;
D : TJSONData;
begin
Result:=F.Get('maxLen',0);
if (Result=0) then
Result:=255;
end;
procedure TSQLDBRestDataset.MetaDataToFieldDefs;
Var
A : TJSONArray;
F : TJSONObject;
I,FS : Integer;
N,D: String;
ft: TFieldType;
begin
FieldDefs.Clear;
A:=Metadata.Get('fields',TJSONArray(Nil));
if A=Nil then
Raise EJSONDataset.Create('Invalid metadata object');
For I:=0 to A.Count-1 do
begin
F:=A.Objects[i];
N:=F.Get('name','');
If N='' then
Raise EJSONDataset.CreateFmt('Field definition %d in has no or invalid name property',[i]);
D:=F.Get('type','');
If (D='') then
ft:=ftstring
else
ft:=StringToFieldType(String(D));
if (ft=ftString) then
fs:=GetStringFieldLength(F,N,I)
else
fs:=0;
FieldDefs.Add(N,ft,fs);
end;
end;
end.