Delphi/delphimvcframework
1
0
Fork 0
mirror of https://github.com/danieleteti/delphimvcframework.git synced 2024-11-15 07:45:54 +01:00
Code Issues Actions Packages Projects Releases Wiki Activity

Samples changed to use TMVCRESTClient

Browse Source
This commit is contained in:
João Antônio Duarte 2020-08-26 17:13:18 -03:00
parent 2b3051f194
commit 815547b852
31 changed files with 1464 additions and 917 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
samples/CustomAuth/MainClientFormU.dfm
View File

@ -86,7 +86,7 @@ object Form7: TForm7
Width = 161 Width = 161
Height = 147 Height = 147
Caption = 'Login/Logout' Caption = 'Login/Logout'
TabOrder = 0 TabOrder = 2
object Label1: TLabel object Label1: TLabel
Left = 16 Left = 16
Top = 20 Top = 20
@ -133,7 +133,7 @@ object Form7: TForm7
Width = 602 Width = 602
Height = 27 Height = 27
Align = alBottom Align = alBottom
TabOrder = 1 TabOrder = 6
end end
object Button1: TButton object Button1: TButton
Left = 311 Left = 311
@ -142,7 +142,7 @@ object Form7: TForm7
Height = 45 Height = 45
Anchors = [akLeft, akTop, akRight] Anchors = [akLeft, akTop, akRight]
Caption = 'Call Public Action (no login required)' Caption = 'Call Public Action (no login required)'
TabOrder = 2 TabOrder = 0
OnClick = Button1Click OnClick = Button1Click
end end
object Memo1: TMemo object Memo1: TMemo
@ -153,7 +153,7 @@ object Form7: TForm7
Anchors = [akLeft, akTop, akRight, akBottom] Anchors = [akLeft, akTop, akRight, akBottom]
Lines.Strings = ( Lines.Strings = (
'Memo1') 'Memo1')
TabOrder = 3 TabOrder = 5
end end
object Button2: TButton object Button2: TButton
Left = 311 Left = 311
@ -162,7 +162,7 @@ object Form7: TForm7
Height = 45 Height = 45
Anchors = [akLeft, akTop, akRight] Anchors = [akLeft, akTop, akRight]
Caption = 'Call action allowed only for "role1"' Caption = 'Call action allowed only for "role1"'
TabOrder = 4 TabOrder = 3
OnClick = Button2Click OnClick = Button2Click
end end
object Button3: TButton object Button3: TButton
@ -172,7 +172,7 @@ object Form7: TForm7
Height = 45 Height = 45
Anchors = [akLeft, akTop, akRight] Anchors = [akLeft, akTop, akRight]
Caption = 'Call action allowed only for "role2"' Caption = 'Call action allowed only for "role2"'
TabOrder = 5 TabOrder = 4
OnClick = Button3Click OnClick = Button3Click
end end
object ListBox1: TListBox object ListBox1: TListBox
@ -185,7 +185,7 @@ object Form7: TForm7
'user1:user1pass' 'user1:user1pass'
'user2:user2pass' 'user2:user2pass'
'admin:adminpass') 'admin:adminpass')
TabOrder = 6 TabOrder = 1
OnClick = ListBox1Click OnClick = ListBox1Click
end end
object ApplicationEvents1: TApplicationEvents object ApplicationEvents1: TApplicationEvents

50
samples/CustomAuth/MainClientFormU.pas
View File

@ -29,7 +29,7 @@ interface
uses uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.AppEvnts, MVCFramework.RESTClient, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.AppEvnts, MVCFramework.RESTClient,
Vcl.ExtCtrls; MVCFramework.RESTClient.Intf, Vcl.ExtCtrls;
type type
TForm7 = class(TForm) TForm7 = class(TForm)
@ -59,10 +59,11 @@ type
procedure Button3Click(Sender: TObject); procedure Button3Click(Sender: TObject);
procedure ListBox1Click(Sender: TObject); procedure ListBox1Click(Sender: TObject);
private private
FRESTClient: TRESTClient; FRESTClient: IMVCRESTClient;
FLogoutUrl: string; FLogoutUrl: string;
FLogoutMethod: string; FLogoutMethod: string;
procedure FillMemo(Response: IRESTResponse); FSessionId: string;
procedure FillMemo(Response: IMVCRESTResponse);
{ Private declarations } { Private declarations }
public public
{ Public declarations } { Public declarations }
@ -75,14 +76,14 @@ implementation
uses uses
System.JSON, System.JSON,
MVCFramework.SystemJSONUtils; MVCFramework.SystemJSONUtils, MVCFramework.Commons;
{$R *.dfm} {$R *.dfm}
procedure TForm7.ApplicationEvents1Idle(Sender: TObject; var Done: Boolean); procedure TForm7.ApplicationEvents1Idle(Sender: TObject; var Done: Boolean);
begin begin
if FRESTClient.SessionID.IsEmpty then if FSessionID.IsEmpty then
begin begin
btnLogInLogOut.Caption := 'LOGIN'; btnLogInLogOut.Caption := 'LOGIN';
Panel1.Caption := 'Not Logged'; Panel1.Caption := 'Not Logged';
@ -92,7 +93,7 @@ begin
else else
begin begin
btnLogInLogOut.Caption := 'LOGOUT'; btnLogInLogOut.Caption := 'LOGOUT';
Panel1.Caption := 'SessionID = ' + FRESTClient.SessionID; Panel1.Caption := 'SessionID = ' + FSessionID;
edtUsername.Enabled := False; edtUsername.Enabled := False;
edtPassword.Enabled := False; edtPassword.Enabled := False;
end; end;
@ -102,7 +103,7 @@ end;
procedure TForm7.btnLogInLogOutClick(Sender: TObject); procedure TForm7.btnLogInLogOutClick(Sender: TObject);
var var
lJObj: TJSONObject; lJObj: TJSONObject;
lRes: IRESTResponse; lRes: IMVCRESTResponse;
begin begin
if btnLogInLogOut.Caption = 'LOGIN' then if btnLogInLogOut.Caption = 'LOGIN' then
begin begin
@ -110,10 +111,10 @@ begin
try try
lJObj.AddPair('username', edtUsername.Text); lJObj.AddPair('username', edtUsername.Text);
lJObj.AddPair('password', edtPassword.Text); lJObj.AddPair('password', edtPassword.Text);
lRes := FRESTClient.doPOST('/system/users/logged', [], TSystemJSON.JSONValueToString(lJObj, False)); lRes := FRESTClient.Post('/system/users/logged', TSystemJSON.JSONValueToString(lJObj, False));
if lRes.HasError then if not lRes.Success then
begin begin
ShowMessage(lRes.Error.ExceptionMessage); ShowMessage(lRes.Content);
end; end;
FLogoutUrl := lRes.HeaderValue('X-LOGOUT-URL'); FLogoutUrl := lRes.HeaderValue('X-LOGOUT-URL');
FLogoutMethod := lRes.HeaderValue('X-LOGOUT-METHOD'); FLogoutMethod := lRes.HeaderValue('X-LOGOUT-METHOD');
@ -124,50 +125,53 @@ begin
else else
begin begin
Assert(FLogoutMethod = 'DELETE'); Assert(FLogoutMethod = 'DELETE');
lRes := FRESTClient.doDELETE(FLogoutUrl, []); lRes := FRESTClient.Delete(FLogoutUrl);
if lRes.HasError then if not lRes.Success then
begin begin
ShowMessage(lRes.Error.ExceptionMessage); ShowMessage(lRes.Content);
end; end;
end; end;
FSessionId := lRes.CookieByName(TMVCConstants.SESSION_TOKEN_NAME).Value;
if FSessionId.Contains('invalid') then
FSessionId := '';
end; end;
procedure TForm7.Button1Click(Sender: TObject); procedure TForm7.Button1Click(Sender: TObject);
var var
lRes: IRESTResponse; lRes: IMVCRESTResponse;
begin begin
lRes := FRESTClient.doGET('/private/public/action', []); lRes := FRESTClient.Get('/private/public/action');
FillMemo(lRes); FillMemo(lRes);
end; end;
procedure TForm7.Button2Click(Sender: TObject); procedure TForm7.Button2Click(Sender: TObject);
var var
lRes: IRESTResponse; lRes: IMVCRESTResponse;
begin begin
lRes := FRESTClient.doGET('/private/role1', []); lRes := FRESTClient.Get('/private/role1');
FillMemo(lRes); FillMemo(lRes);
end; end;
procedure TForm7.Button3Click(Sender: TObject); procedure TForm7.Button3Click(Sender: TObject);
var var
lRes: IRESTResponse; lRes: IMVCRESTResponse;
begin begin
lRes := FRESTClient.doGET('/private/role2', []); lRes := FRESTClient.Get('/private/role2');
FillMemo(lRes); FillMemo(lRes);
end; end;
procedure TForm7.FillMemo(Response: IRESTResponse); procedure TForm7.FillMemo(Response: IMVCRESTResponse);
begin begin
Memo1.Lines.Add( Memo1.Lines.Add(
Format('[%s] [%s] %s', Format('[%s] [%s] %s',
[TimeToStr(Time), [TimeToStr(Time),
Response.ResponseText, Response.StatusText,
Response.BodyAsString])); Response.Content]));
end; end;
procedure TForm7.FormCreate(Sender: TObject); procedure TForm7.FormCreate(Sender: TObject);
begin begin
FRESTClient := TRESTClient.Create('localhost', 8080); FRESTClient := TMVCRESTClient.New.BaseURL('localhost', 8080);
end; end;
procedure TForm7.ListBox1Click(Sender: TObject); procedure TForm7.ListBox1Click(Sender: TObject);

16
samples/CustomRoleAuth/MainClientFormU.dfm
View File

@ -88,7 +88,7 @@ object Form7: TForm7
Width = 161 Width = 161
Height = 147 Height = 147
Caption = 'Login/Logout' Caption = 'Login/Logout'
TabOrder = 0 TabOrder = 3
object Label1: TLabel object Label1: TLabel
Left = 16 Left = 16
Top = 20 Top = 20
@ -135,7 +135,7 @@ object Form7: TForm7
Width = 556 Width = 556
Height = 27 Height = 27
Align = alBottom Align = alBottom
TabOrder = 1 TabOrder = 10
end end
object Button1: TButton object Button1: TButton
Left = 311 Left = 311
@ -144,7 +144,7 @@ object Form7: TForm7
Height = 27 Height = 27
Anchors = [akLeft, akTop, akRight] Anchors = [akLeft, akTop, akRight]
Caption = 'Call Public Action (no login required)' Caption = 'Call Public Action (no login required)'
TabOrder = 2 TabOrder = 0
OnClick = Button1Click OnClick = Button1Click
end end
object Memo1: TMemo object Memo1: TMemo
@ -155,7 +155,7 @@ object Form7: TForm7
Anchors = [akLeft, akTop, akRight, akBottom] Anchors = [akLeft, akTop, akRight, akBottom]
Lines.Strings = ( Lines.Strings = (
'Memo1') 'Memo1')
TabOrder = 3 TabOrder = 9
end end
object Button2: TButton object Button2: TButton
Left = 311 Left = 311
@ -189,7 +189,7 @@ object Form7: TForm7
'user1_2:user1_2pass' 'user1_2:user1_2pass'
'user3:user3pass' 'user3:user3pass'
'admin:adminpass') 'admin:adminpass')
TabOrder = 6 TabOrder = 2
OnClick = ListBox1Click OnClick = ListBox1Click
end end
object Button4: TButton object Button4: TButton
@ -199,7 +199,7 @@ object Form7: TForm7
Height = 27 Height = 27
Anchors = [akLeft, akTop, akRight] Anchors = [akLeft, akTop, akRight]
Caption = 'Call action allowed only for "role1 and role2"' Caption = 'Call action allowed only for "role1 and role2"'
TabOrder = 7 TabOrder = 6
OnClick = Button4Click OnClick = Button4Click
end end
object Button5: TButton object Button5: TButton
@ -219,7 +219,7 @@ object Form7: TForm7
Height = 27 Height = 27
Anchors = [akLeft, akTop, akRight] Anchors = [akLeft, akTop, akRight]
Caption = 'Call Authenticated only' Caption = 'Call Authenticated only'
TabOrder = 9 TabOrder = 1
OnClick = Button6Click OnClick = Button6Click
end end
object Button7: TButton object Button7: TButton
@ -229,7 +229,7 @@ object Form7: TForm7
Height = 27 Height = 27
Anchors = [akLeft, akTop, akRight] Anchors = [akLeft, akTop, akRight]
Caption = 'Call action allowed only for "role1 or role2"' Caption = 'Call action allowed only for "role1 or role2"'
TabOrder = 10 TabOrder = 7
OnClick = Button7Click OnClick = Button7Click
end end
object ApplicationEvents1: TApplicationEvents object ApplicationEvents1: TApplicationEvents

64
samples/CustomRoleAuth/MainClientFormU.pas
View File

@ -32,7 +32,7 @@ uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
System.Classes, Vcl.Graphics, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.AppEvnts, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.AppEvnts,
MVCFramework.RESTClient, MVCFramework.RESTClient, MVCFramework.RESTClient.Intf,
Vcl.ExtCtrls; Vcl.ExtCtrls;
type type
@ -71,10 +71,11 @@ type
procedure Button6Click(Sender: TObject); procedure Button6Click(Sender: TObject);
procedure Button7Click(Sender: TObject); procedure Button7Click(Sender: TObject);
private private
FRESTClient: TRESTClient; FRESTClient: IMVCRESTClient;
FLogoutUrl: string; FLogoutUrl: string;
FLogoutMethod: string; FLogoutMethod: string;
procedure FillMemo(Response: IRESTResponse); FSessionId: string;
procedure FillMemo(Response: IMVCRESTResponse);
{ Private declarations } { Private declarations }
public public
{ Public declarations } { Public declarations }
@ -87,13 +88,13 @@ implementation
uses uses
System.JSON, System.JSON,
MVCFramework.SystemJSONUtils; MVCFramework.SystemJSONUtils, MVCFramework.Commons;
{$R *.dfm} {$R *.dfm}
procedure TForm7.ApplicationEvents1Idle(Sender: TObject; var Done: Boolean); procedure TForm7.ApplicationEvents1Idle(Sender: TObject; var Done: Boolean);
begin begin
if FRESTClient.SessionID.IsEmpty then if FSessionID.IsEmpty then
begin begin
btnLogInLogOut.Caption := 'LOGIN'; btnLogInLogOut.Caption := 'LOGIN';
Panel1.Caption := 'Not Logged'; Panel1.Caption := 'Not Logged';
@ -103,7 +104,7 @@ begin
else else
begin begin
btnLogInLogOut.Caption := 'LOGOUT'; btnLogInLogOut.Caption := 'LOGOUT';
Panel1.Caption := 'SessionID = ' + FRESTClient.SessionID; Panel1.Caption := 'SessionID = ' + FSessionID;
edtUsername.Enabled := False; edtUsername.Enabled := False;
edtPassword.Enabled := False; edtPassword.Enabled := False;
end; end;
@ -113,7 +114,7 @@ end;
procedure TForm7.btnLogInLogOutClick(Sender: TObject); procedure TForm7.btnLogInLogOutClick(Sender: TObject);
var var
lJObj: TJSONObject; lJObj: TJSONObject;
lRes: IRESTResponse; lRes: IMVCRESTResponse;
begin begin
if btnLogInLogOut.Caption = 'LOGIN' then if btnLogInLogOut.Caption = 'LOGIN' then
begin begin
@ -121,11 +122,11 @@ begin
try try
lJObj.AddPair('username', edtUsername.Text); lJObj.AddPair('username', edtUsername.Text);
lJObj.AddPair('password', edtPassword.Text); lJObj.AddPair('password', edtPassword.Text);
lRes := FRESTClient.doPOST('/system/users/logged', [], lRes := FRESTClient.Post('/system/users/logged',
TSystemJSON.JSONValueToString(lJObj, False)); TSystemJSON.JSONValueToString(lJObj, False));
if lRes.HasError then if not lRes.Success then
begin begin
ShowMessage(lRes.Error.ExceptionMessage); ShowMessage(lRes.Content);
end; end;
FLogoutUrl := lRes.HeaderValue('X-LOGOUT-URL'); FLogoutUrl := lRes.HeaderValue('X-LOGOUT-URL');
FLogoutMethod := lRes.HeaderValue('X-LOGOUT-METHOD'); FLogoutMethod := lRes.HeaderValue('X-LOGOUT-METHOD');
@ -136,79 +137,82 @@ begin
else else
begin begin
Assert(FLogoutMethod = 'DELETE'); Assert(FLogoutMethod = 'DELETE');
lRes := FRESTClient.doDELETE(FLogoutUrl, []); lRes := FRESTClient.Delete(FLogoutUrl);
if lRes.HasError then if not lRes.Success then
begin begin
ShowMessage(lRes.Error.ExceptionMessage); ShowMessage(lRes.Content);
end; end;
end; end;
FSessionId := lRes.CookieByName(TMVCConstants.SESSION_TOKEN_NAME).Value;
if FSessionId.Contains('invalid') then
FSessionId := '';
end; end;
procedure TForm7.Button1Click(Sender: TObject); procedure TForm7.Button1Click(Sender: TObject);
var var
lRes: IRESTResponse; lRes: IMVCRESTResponse;
begin begin
lRes := FRESTClient.doGET('/private/public/action', []); lRes := FRESTClient.Get('/private/public/action');
FillMemo(lRes); FillMemo(lRes);
end; end;
procedure TForm7.Button2Click(Sender: TObject); procedure TForm7.Button2Click(Sender: TObject);
var var
lRes: IRESTResponse; lRes: IMVCRESTResponse;
begin begin
lRes := FRESTClient.doGET('/private/role1', []); lRes := FRESTClient.Get('/private/role1');
FillMemo(lRes); FillMemo(lRes);
end; end;
procedure TForm7.Button3Click(Sender: TObject); procedure TForm7.Button3Click(Sender: TObject);
var var
lRes: IRESTResponse; lRes: IMVCRESTResponse;
begin begin
lRes := FRESTClient.doGET('/private/role2', []); lRes := FRESTClient.Get('/private/role2');
FillMemo(lRes); FillMemo(lRes);
end; end;
procedure TForm7.Button4Click(Sender: TObject); procedure TForm7.Button4Click(Sender: TObject);
var var
lRes: IRESTResponse; lRes: IMVCRESTResponse;
begin begin
lRes := FRESTClient.doGET('/private/role1and2', []); lRes := FRESTClient.Get('/private/role1and2');
FillMemo(lRes); FillMemo(lRes);
end; end;
procedure TForm7.Button5Click(Sender: TObject); procedure TForm7.Button5Click(Sender: TObject);
var var
lRes: IRESTResponse; lRes: IMVCRESTResponse;
begin begin
lRes := FRESTClient.doGET('/private/role/admin', []); lRes := FRESTClient.Get('/private/role/admin');
FillMemo(lRes); FillMemo(lRes);
end; end;
procedure TForm7.Button6Click(Sender: TObject); procedure TForm7.Button6Click(Sender: TObject);
var var
lRes: IRESTResponse; lRes: IMVCRESTResponse;
begin begin
lRes := FRESTClient.doGET('/private/authenticatedOnly', []); lRes := FRESTClient.Get('/private/authenticatedOnly');
FillMemo(lRes); FillMemo(lRes);
end; end;
procedure TForm7.Button7Click(Sender: TObject); procedure TForm7.Button7Click(Sender: TObject);
var var
lRes: IRESTResponse; lRes: IMVCRESTResponse;
begin begin
lRes := FRESTClient.doGET('/private/role1or2', []); lRes := FRESTClient.Get('/private/role1or2');
FillMemo(lRes); FillMemo(lRes);
end; end;
procedure TForm7.FillMemo(Response: IRESTResponse); procedure TForm7.FillMemo(Response: IMVCRESTResponse);
begin begin
Memo1.Lines.Add(Format('[%s] [%s] %s', [TimeToStr(Time), Memo1.Lines.Add(Format('[%s] [%s] %s', [TimeToStr(Time),
Response.ResponseText, Response.BodyAsString])); Response.StatusText, Response.Content]));
end; end;
procedure TForm7.FormCreate(Sender: TObject); procedure TForm7.FormCreate(Sender: TObject);
begin begin
FRESTClient := TRESTClient.Create('localhost', 8080); FRESTClient := TMVCRESTClient.New.BaseURL('localhost', 8080);
end; end;
procedure TForm7.ListBox1Click(Sender: TObject); procedure TForm7.ListBox1Click(Sender: TObject);

16
samples/articles_crud_vcl_client/MainFormU.dfm
View File

@ -11,7 +11,6 @@ object MainForm: TMainForm
Font.Name = 'Tahoma' Font.Name = 'Tahoma'
Font.Style = [] Font.Style = []
OldCreateOrder = False OldCreateOrder = False
OnClose = FormClose
OnCreate = FormCreate OnCreate = FormCreate
PixelsPerInch = 96 PixelsPerInch = 96
TextHeight = 13 TextHeight = 13
@ -30,8 +29,7 @@ object MainForm: TMainForm
Height = 40 Height = 40
DataSource = dsrcArticles DataSource = dsrcArticles
Align = alRight Align = alRight
TabOrder = 0 TabOrder = 3
ExplicitHeight = 31
end end
object btnOpen: TButton object btnOpen: TButton
AlignWithMargins = True AlignWithMargins = True
@ -41,9 +39,8 @@ object MainForm: TMainForm
Height = 40 Height = 40
Align = alLeft Align = alLeft
Caption = 'Open' Caption = 'Open'
TabOrder = 1 TabOrder = 0
OnClick = btnOpenClick OnClick = btnOpenClick
ExplicitHeight = 31
end end
object btnRefreshRecord: TButton object btnRefreshRecord: TButton
AlignWithMargins = True AlignWithMargins = True
@ -55,7 +52,6 @@ object MainForm: TMainForm
Caption = 'Refresh Record' Caption = 'Refresh Record'
TabOrder = 2 TabOrder = 2
OnClick = btnRefreshRecordClick OnClick = btnRefreshRecordClick
ExplicitHeight = 35
end end
object Button1: TButton object Button1: TButton
AlignWithMargins = True AlignWithMargins = True
@ -65,9 +61,8 @@ object MainForm: TMainForm
Height = 40 Height = 40
Align = alLeft Align = alLeft
Caption = 'Close' Caption = 'Close'
TabOrder = 3 TabOrder = 1
OnClick = btnCloseClick OnClick = btnCloseClick
ExplicitHeight = 31
end end
object Panel2: TPanel object Panel2: TPanel
Left = 1 Left = 1
@ -77,7 +72,6 @@ object MainForm: TMainForm
Align = alBottom Align = alBottom
BevelOuter = bvNone BevelOuter = bvNone
TabOrder = 4 TabOrder = 4
ExplicitTop = 48
object Label1: TLabel object Label1: TLabel
Left = 3 Left = 3
Top = 11 Top = 11
@ -90,7 +84,7 @@ object MainForm: TMainForm
Top = 30 Top = 30
Width = 156 Width = 156
Height = 21 Height = 21
TabOrder = 0 TabOrder = 1
end end
object btnFilter: TButton object btnFilter: TButton
Left = 165 Left = 165
@ -98,7 +92,7 @@ object MainForm: TMainForm
Width = 107 Width = 107
Height = 40 Height = 40
Caption = 'Filter' Caption = 'Filter'
TabOrder = 1 TabOrder = 0
OnClick = btnFilterClick OnClick = btnFilterClick
end end
end end

54
samples/articles_crud_vcl_client/MainFormU.pas
View File

@ -8,7 +8,7 @@ uses
FireDAC.Stan.Param, FireDAC.Stan.Error, FireDAC.DatS, FireDAC.Phys.Intf, FireDAC.Stan.Param, FireDAC.Stan.Error, FireDAC.DatS, FireDAC.Phys.Intf,
FireDAC.DApt.Intf, Data.DB, FireDAC.Comp.DataSet, FireDAC.Comp.Client, FireDAC.DApt.Intf, Data.DB, FireDAC.Comp.DataSet, FireDAC.Comp.Client,
Vcl.Grids, Vcl.DBGrids, Vcl.ExtCtrls, Vcl.StdCtrls, MVCFramework.RESTClient, Vcl.Grids, Vcl.DBGrids, Vcl.ExtCtrls, Vcl.StdCtrls, MVCFramework.RESTClient,
Vcl.DBCtrls; Vcl.DBCtrls, MVCFramework.RESTClient.Intf;
type type
TMainForm = class(TForm) TMainForm = class(TForm)
@ -31,7 +31,6 @@ type
procedure FormCreate(Sender: TObject); procedure FormCreate(Sender: TObject);
procedure dsArticlesBeforePost(DataSet: TDataSet); procedure dsArticlesBeforePost(DataSet: TDataSet);
procedure dsArticlesBeforeDelete(DataSet: TDataSet); procedure dsArticlesBeforeDelete(DataSet: TDataSet);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure dsArticlesBeforeRefresh(DataSet: TDataSet); procedure dsArticlesBeforeRefresh(DataSet: TDataSet);
procedure dsArticlesAfterOpen(DataSet: TDataSet); procedure dsArticlesAfterOpen(DataSet: TDataSet);
procedure btnOpenClick(Sender: TObject); procedure btnOpenClick(Sender: TObject);
@ -42,9 +41,9 @@ type
private private
fFilter: string; fFilter: string;
fLoading: Boolean; fLoading: Boolean;
fRESTClient: TRESTClient; fRESTClient: IMVCRESTClient;
{ Private declarations } { Private declarations }
procedure ShowError(const AResponse: IRESTResponse); procedure ShowError(const AResponse: IMVCRESTResponse);
procedure SetFilter(const Value: string); procedure SetFilter(const Value: string);
public public
property Filter: string read fFilter write SetFilter; property Filter: string read fFilter write SetFilter;
@ -87,19 +86,19 @@ end;
procedure TMainForm.dsArticlesAfterOpen(DataSet: TDataSet); procedure TMainForm.dsArticlesAfterOpen(DataSet: TDataSet);
var var
Res: IRESTResponse; Res: IMVCRESTResponse;
begin begin
if fFilter.IsEmpty then if fFilter.IsEmpty then
begin begin
// this a simple sychronous request... // this a simple sychronous request...
Res := fRESTClient.doGET('/articles', []); Res := fRESTClient.Get('/articles');
end end
else else
begin begin
Res := fRESTClient.doGET('/articles/searches', [], ['q'], [fFilter]); Res := fRESTClient.AddQueryStringParam('q', fFilter).Get('/articles/searches');
end; end;
if Res.HasError then if not Res.Success then
begin begin
ShowError(Res); ShowError(Res);
Exit; Exit;
@ -108,7 +107,7 @@ begin
DataSet.DisableControls; DataSet.DisableControls;
try try
fLoading := true; fLoading := true;
dsArticles.LoadJSONArrayFromJSONObjectProperty('data', Res.BodyAsString); dsArticles.LoadJSONArrayFromJSONObjectProperty('data', Res.Content);
fLoading := false; fLoading := false;
dsArticles.First; dsArticles.First;
finally finally
@ -118,11 +117,11 @@ end;
procedure TMainForm.dsArticlesBeforeDelete(DataSet: TDataSet); procedure TMainForm.dsArticlesBeforeDelete(DataSet: TDataSet);
var var
Res: IRESTResponse; Res: IMVCRESTResponse;
begin begin
if dsArticles.State = dsBrowse then if dsArticles.State = dsBrowse then
Res := fRESTClient.DataSetDelete('/articles', dsArticlesid.AsString); Res := fRESTClient.DataSetDelete('/articles', dsArticlesid.AsString);
if not(Res.ResponseCode in [200]) then if not(Res.StatusCode in [200]) then
begin begin
ShowError(Res); ShowError(Res);
Abort; Abort;
@ -131,15 +130,15 @@ end;
procedure TMainForm.dsArticlesBeforePost(DataSet: TDataSet); procedure TMainForm.dsArticlesBeforePost(DataSet: TDataSet);
var var
Res: IRESTResponse; Res: IMVCRESTResponse;
begin begin
if not fLoading then if not fLoading then
begin begin
if dsArticles.State = dsInsert then if dsArticles.State = dsInsert then
Res := fRESTClient.DataSetInsert('/articles', dsArticles) Res := fRESTClient.DataSetInsert('/articles', dsArticles)
else else
Res := fRESTClient.DataSetUpdate('/articles', dsArticles, dsArticlesid.AsString); Res := fRESTClient.DataSetUpdate('/articles', dsArticlesid.AsString, dsArticles);
if not(Res.ResponseCode in [200, 201]) then if not(Res.StatusCode in [200, 201]) then
begin begin
ShowError(Res); ShowError(Res);
Abort; Abort;
@ -159,22 +158,19 @@ end;
procedure TMainForm.dsArticlesBeforeRowRequest(DataSet: TFDDataSet); procedure TMainForm.dsArticlesBeforeRowRequest(DataSet: TFDDataSet);
var var
Res: IRESTResponse; Res: IMVCRESTResponse;
begin begin
Res := fRESTClient.doGET('/articles', [DataSet.FieldByName('id').AsString]); Res := fRESTClient
.AddPathParam('Id', DataSet.FieldByName('id').AsString)
.Get('/articles/($Id)');
fLoading := true; fLoading := true;
DataSet.LoadJSONObjectFromJSONObjectProperty('data', Res.BodyAsString); DataSet.LoadJSONObjectFromJSONObjectProperty('data', Res.Content);
fLoading := false; fLoading := false;
end; end;
procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
fRESTClient.Free;
end;
procedure TMainForm.FormCreate(Sender: TObject); procedure TMainForm.FormCreate(Sender: TObject);
begin begin
fRESTClient := MVCFramework.RESTClient.TRESTClient.Create('localhost', 8080); fRESTClient := TMVCRESTClient.New.BaseURL('localhost', 8080);
end; end;
procedure TMainForm.SetFilter(const Value: string); procedure TMainForm.SetFilter(const Value: string);
@ -183,17 +179,17 @@ begin
EditFilter.Text := Value; EditFilter.Text := Value;
end; end;
procedure TMainForm.ShowError(const AResponse: IRESTResponse); procedure TMainForm.ShowError(const AResponse: IMVCRESTResponse);
begin begin
if AResponse.HasError then if not AResponse.Success then
MessageDlg( MessageDlg(
AResponse.Error.HTTPError.ToString + ': ' + AResponse.Error.ExceptionMessage + sLineBreak + AResponse.StatusCode.ToString + ': ' + AResponse.StatusText + sLineBreak +
'[' + AResponse.Error.ExceptionClassname + ']', '[' + AResponse.Content + ']',
mtError, [mbOK], 0) mtError, [mbOK], 0)
else else
MessageDlg( MessageDlg(
AResponse.ResponseCode.ToString + ': ' + AResponse.ResponseText + sLineBreak + AResponse.StatusCode.ToString + ': ' + AResponse.StatusText + sLineBreak +
AResponse.BodyAsString, AResponse.Content,
mtError, [mbOK], 0); mtError, [mbOK], 0);
end; end;

10
samples/articles_crud_vcl_client_api_binder/MainFormU.dfm
View File

@ -30,7 +30,7 @@ object MainForm: TMainForm
Height = 40 Height = 40
DataSource = dsrcArticles DataSource = dsrcArticles
Align = alRight Align = alRight
TabOrder = 0 TabOrder = 3
end end
object btnOpen: TButton object btnOpen: TButton
AlignWithMargins = True AlignWithMargins = True
@ -40,7 +40,7 @@ object MainForm: TMainForm
Height = 40 Height = 40
Align = alLeft Align = alLeft
Caption = 'Open' Caption = 'Open'
TabOrder = 1 TabOrder = 0
OnClick = btnOpenClick OnClick = btnOpenClick
end end
object btnRefreshRecord: TButton object btnRefreshRecord: TButton
@ -62,7 +62,7 @@ object MainForm: TMainForm
Height = 40 Height = 40
Align = alLeft Align = alLeft
Caption = 'Close' Caption = 'Close'
TabOrder = 3 TabOrder = 1
OnClick = btnCloseClick OnClick = btnCloseClick
end end
object Panel2: TPanel object Panel2: TPanel
@ -85,7 +85,7 @@ object MainForm: TMainForm
Top = 30 Top = 30
Width = 156 Width = 156
Height = 21 Height = 21
TabOrder = 0 TabOrder = 1
end end
object btnFilter: TButton object btnFilter: TButton
Left = 165 Left = 165
@ -93,7 +93,7 @@ object MainForm: TMainForm
Width = 107 Width = 107
Height = 40 Height = 40
Caption = 'Filter' Caption = 'Filter'
TabOrder = 1 TabOrder = 0
OnClick = btnFilterClick OnClick = btnFilterClick
end end
end end

52
samples/articles_crud_vcl_client_api_binder/MainFormU.pas
View File

@ -7,7 +7,7 @@ uses
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, FireDAC.Stan.Intf, FireDAC.Stan.Option, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, FireDAC.Stan.Intf, FireDAC.Stan.Option,
FireDAC.Stan.Param, FireDAC.Stan.Error, FireDAC.DatS, FireDAC.Phys.Intf, FireDAC.Stan.Param, FireDAC.Stan.Error, FireDAC.DatS, FireDAC.Phys.Intf,
FireDAC.DApt.Intf, Data.DB, FireDAC.Comp.DataSet, FireDAC.Comp.Client, FireDAC.DApt.Intf, Data.DB, FireDAC.Comp.DataSet, FireDAC.Comp.Client,
Vcl.Grids, Vcl.DBGrids, Vcl.ExtCtrls, Vcl.StdCtrls, MVCFramework.RESTClient, Vcl.Grids, Vcl.DBGrids, Vcl.ExtCtrls, Vcl.StdCtrls, MVCFramework.RESTClient, MVCFramework.RESTClient.Intf,
Vcl.DBCtrls, MVCFramework.DataSet.Utils; Vcl.DBCtrls, MVCFramework.DataSet.Utils;
type type
@ -42,10 +42,10 @@ type
private private
fFilter: string; fFilter: string;
fLoading: Boolean; fLoading: Boolean;
fRESTClient: TRESTClient; fRESTClient: IMVCRESTClient;
fAPIBinder: TMVCAPIBinder; fAPIBinder: TMVCAPIBinder;
{ Private declarations } { Private declarations }
procedure ShowError(const AResponse: IRESTResponse); procedure ShowError(const AResponse: IMVCRESTResponse);
procedure SetFilter(const Value: string); procedure SetFilter(const Value: string);
public public
property Filter: string read fFilter write SetFilter; property Filter: string read fFilter write SetFilter;
@ -88,19 +88,19 @@ end;
procedure TMainForm.dsArticlesAfterOpen(DataSet: TDataSet); procedure TMainForm.dsArticlesAfterOpen(DataSet: TDataSet);
var var
Res: IRESTResponse; Res: IMVCRESTResponse;
begin begin
if fFilter.IsEmpty then if fFilter.IsEmpty then
begin begin
// this a simple sychronous request... // this a simple sychronous request...
Res := fRESTClient.doGET('/articles', []); Res := fRESTClient.Get('/articles');
end end
else else
begin begin
Res := fRESTClient.doGET('/articles/searches', [], ['q'], [fFilter]); Res := fRESTClient.AddQueryStringParam('q', fFilter).Get('/articles/searches');
end; end;
if Res.HasError then if not Res.Success then
begin begin
ShowError(Res); ShowError(Res);
Exit; Exit;
@ -109,7 +109,7 @@ begin
DataSet.DisableControls; DataSet.DisableControls;
try try
fLoading := true; fLoading := true;
dsArticles.LoadJSONArrayFromJSONObjectProperty('data', Res.BodyAsString); dsArticles.LoadJSONArrayFromJSONObjectProperty('data', Res.Content);
fLoading := false; fLoading := false;
dsArticles.First; dsArticles.First;
finally finally
@ -119,11 +119,11 @@ end;
procedure TMainForm.dsArticlesBeforeDelete(DataSet: TDataSet); procedure TMainForm.dsArticlesBeforeDelete(DataSet: TDataSet);
var var
Res: IRESTResponse; Res: IMVCRESTResponse;
begin begin
if dsArticles.State = dsBrowse then if dsArticles.State = dsBrowse then
Res := fRESTClient.DataSetDelete('/articles', dsArticlesid.AsString); Res := fRESTClient.DataSetDelete('/articles', dsArticlesid.AsString);
if not(Res.ResponseCode in [200]) then if not(Res.StatusCode in [200]) then
begin begin
ShowError(Res); ShowError(Res);
Abort; Abort;
@ -132,15 +132,15 @@ end;
procedure TMainForm.dsArticlesBeforePost(DataSet: TDataSet); procedure TMainForm.dsArticlesBeforePost(DataSet: TDataSet);
var var
Res: IRESTResponse; Res: IMVCRESTResponse;
begin begin
if not fLoading then if not fLoading then
begin begin
if dsArticles.State = dsInsert then if dsArticles.State = dsInsert then
Res := fRESTClient.DataSetInsert('/articles', dsArticles) Res := fRESTClient.DataSetInsert('/articles', dsArticles)
else else
Res := fRESTClient.DataSetUpdate('/articles', dsArticles, dsArticlesid.AsString); Res := fRESTClient.DataSetUpdate('/articles', dsArticlesid.AsString, dsArticles);
if not(Res.ResponseCode in [200, 201]) then if not(Res.StatusCode in [200, 201]) then
begin begin
ShowError(Res); ShowError(Res);
Abort; Abort;
@ -160,23 +160,23 @@ end;
procedure TMainForm.dsArticlesBeforeRowRequest(DataSet: TFDDataSet); procedure TMainForm.dsArticlesBeforeRowRequest(DataSet: TFDDataSet);
var var
Res: IRESTResponse; Res: IMVCRESTResponse;
begin begin
Res := fRESTClient.doGET('/articles', [DataSet.FieldByName('id').AsString]); Res := fRESTClient.AddPathParam('Id', DataSet.FieldByName('id').AsString).Get('/articles/($Id)');
fLoading := true; fLoading := true;
DataSet.LoadJSONObjectFromJSONObjectProperty('data', Res.BodyAsString); DataSet.LoadJSONObjectFromJSONObjectProperty('data', Res.Content);
fLoading := false; fLoading := false;
end; end;
procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction); procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin begin
fAPIBinder.Free; fAPIBinder.Free;
fRESTClient.Free;
end; end;
procedure TMainForm.FormCreate(Sender: TObject); procedure TMainForm.FormCreate(Sender: TObject);
begin begin
fRESTClient := MVCFramework.RESTClient.TRESTClient.Create('localhost', 8080); ReportMemoryLeaksOnShutdown := True;
fRESTClient := TMVCRESTClient.New.BaseURL('localhost', 8080);
fAPIBinder := TMVCAPIBinder.Create(fRESTClient); fAPIBinder := TMVCAPIBinder.Create(fRESTClient);
fAPIBinder.BindDataSetToAPI(dsArticles, '/articles', 'id'); fAPIBinder.BindDataSetToAPI(dsArticles, '/articles', 'id');
end; end;
@ -187,18 +187,12 @@ begin
EditFilter.Text := Value; EditFilter.Text := Value;
end; end;
procedure TMainForm.ShowError(const AResponse: IRESTResponse); procedure TMainForm.ShowError(const AResponse: IMVCRESTResponse);
begin begin
if AResponse.HasError then MessageDlg(
MessageDlg( AResponse.StatusCode.ToString + ': ' + AResponse.StatusText + sLineBreak +
AResponse.Error.HTTPError.ToString + ': ' + AResponse.Error.ExceptionMessage + sLineBreak + '[' + AResponse.Content + ']',
'[' + AResponse.Error.ExceptionClassname + ']', mtError, [mbOK], 0)
mtError, [mbOK], 0)
else
MessageDlg(
AResponse.ResponseCode.ToString + ': ' + AResponse.ResponseText + sLineBreak +
AResponse.BodyAsString,
mtError, [mbOK], 0);
end; end;
end. end.

48
samples/authenticationauthorization/ProjectGroup1.groupproj Normal file
View File

@ -0,0 +1,48 @@
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<ProjectGuid>{5010CC58-A86E-4D28-ADAB-87A72DC8BC4E}</ProjectGuid>
</PropertyGroup>
<ItemGroup>
<Projects Include="AuthenticateAuthorize.dproj">
<Dependencies/>
</Projects>
<Projects Include="vclclient\AuthenticationAuthorizationClient.dproj">
<Dependencies/>
</Projects>
</ItemGroup>
<ProjectExtensions>
<Borland.Personality>Default.Personality.12</Borland.Personality>
<Borland.ProjectType/>
<BorlandProject>
<Default.Personality/>
</BorlandProject>
</ProjectExtensions>
<Target Name="AuthenticateAuthorize">
<MSBuild Projects="AuthenticateAuthorize.dproj"/>
</Target>
<Target Name="AuthenticateAuthorize:Clean">
<MSBuild Projects="AuthenticateAuthorize.dproj" Targets="Clean"/>
</Target>
<Target Name="AuthenticateAuthorize:Make">
<MSBuild Projects="AuthenticateAuthorize.dproj" Targets="Make"/>
</Target>
<Target Name="AuthenticationAuthorizationClient">
<MSBuild Projects="vclclient\AuthenticationAuthorizationClient.dproj"/>
</Target>
<Target Name="AuthenticationAuthorizationClient:Clean">
<MSBuild Projects="vclclient\AuthenticationAuthorizationClient.dproj" Targets="Clean"/>
</Target>
<Target Name="AuthenticationAuthorizationClient:Make">
<MSBuild Projects="vclclient\AuthenticationAuthorizationClient.dproj" Targets="Make"/>
</Target>
<Target Name="Build">
<CallTarget Targets="AuthenticateAuthorize;AuthenticationAuthorizationClient"/>
</Target>
<Target Name="Clean">
<CallTarget Targets="AuthenticateAuthorize:Clean;AuthenticationAuthorizationClient:Clean"/>
</Target>
<Target Name="Make">
<CallTarget Targets="AuthenticateAuthorize:Make;AuthenticationAuthorizationClient:Make"/>
</Target>
<Import Project="$(BDS)\Bin\CodeGear.Group.Targets" Condition="Exists('$(BDS)\Bin\CodeGear.Group.Targets')"/>
</Project>

1175
samples/authenticationauthorization/vclclient/AuthenticationAuthorizationClient.dproj
View File

File diff suppressed because it is too large Load Diff

19
samples/authenticationauthorization/vclclient/MainClientFormU.pas
View File

@ -25,21 +25,18 @@ implementation
{$R *.dfm} {$R *.dfm}
uses uses
MVCFramework.RESTClient; MVCFramework.RESTClient,
MVCFramework.RESTClient.Intf;
procedure TForm5.btnGetClick(Sender: TObject); procedure TForm5.btnGetClick(Sender: TObject);
var var
lClient: TRESTClient; lClient: IMVCRESTClient;
lRest: IRESTResponse; lRest: IMVCRESTResponse;
begin begin
lClient := TRESTClient.Create('localhost', 8080); lClient := TMVCRESTClient.New.BaseURL('localhost', 8080);
try lClient.SetBasicAuthorization('user1', 'user1');
lClient.Authentication('user1', 'user1'); lRest := lClient.Get('/admin/role1?par1=daniele');
lRest := lClient.doGET('/admin/role1?par1=daniele', []); ShowMessage(lRest.Content);
ShowMessage(lRest.BodyAsString);
finally
lClient.Free;
end;
end; end;
end. end.

48
samples/basicdemo_vclclient/ProjectGroup1.groupproj Normal file
View File

@ -0,0 +1,48 @@
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<ProjectGuid>{9F8C0E32-639F-46F4-A716-23C7E5A19B0B}</ProjectGuid>
</PropertyGroup>
<ItemGroup>
<Projects Include="..\basicdemo_server\BasicDemo.dproj">
<Dependencies/>
</Projects>
<Projects Include="BasicDemoVCLClient.dproj">
<Dependencies/>
</Projects>
</ItemGroup>
<ProjectExtensions>
<Borland.Personality>Default.Personality.12</Borland.Personality>
<Borland.ProjectType/>
<BorlandProject>
<Default.Personality/>
</BorlandProject>
</ProjectExtensions>
<Target Name="BasicDemo">
<MSBuild Projects="..\basicdemo_server\BasicDemo.dproj"/>
</Target>
<Target Name="BasicDemo:Clean">
<MSBuild Projects="..\basicdemo_server\BasicDemo.dproj" Targets="Clean"/>
</Target>
<Target Name="BasicDemo:Make">
<MSBuild Projects="..\basicdemo_server\BasicDemo.dproj" Targets="Make"/>
</Target>
<Target Name="BasicDemoVCLClient">
<MSBuild Projects="BasicDemoVCLClient.dproj"/>
</Target>
<Target Name="BasicDemoVCLClient:Clean">
<MSBuild Projects="BasicDemoVCLClient.dproj" Targets="Clean"/>
</Target>
<Target Name="BasicDemoVCLClient:Make">
<MSBuild Projects="BasicDemoVCLClient.dproj" Targets="Make"/>
</Target>
<Target Name="Build">
<CallTarget Targets="BasicDemo;BasicDemoVCLClient"/>
</Target>
<Target Name="Clean">
<CallTarget Targets="BasicDemo:Clean;BasicDemoVCLClient:Clean"/>
</Target>
<Target Name="Make">
<CallTarget Targets="BasicDemo:Make;BasicDemoVCLClient:Make"/>
</Target>
<Import Project="$(BDS)\Bin\CodeGear.Group.Targets" Condition="Exists('$(BDS)\Bin\CodeGear.Group.Targets')"/>
</Project>

25
samples/basicdemo_vclclient/Unit1.pas
View File

@ -25,35 +25,26 @@ var
implementation implementation
uses uses
MVCFramework.RESTClient; MVCFramework.RESTClient,
MVCFramework.RESTClient.Intf;
{$R *.dfm} {$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject); procedure TForm1.Button1Click(Sender: TObject);
var var
Clt: TRestClient; Clt: IMVCRESTClient;
begin begin
Clt := MVCFramework.RESTClient.TRestClient.Create('http://localhost', 8080, nil); Clt := TMVCRESTClient.New.BaseURL('http://localhost', 8080);
try ShowMessage(Clt.Get('/div/10/20').Content);
// Clt.ProxyServer := 'localhost';
// Clt.ProxyPort := 8888;
ShowMessage(Clt.doGET('/div/10/20', []).BodyAsString);
finally
Clt.Free;
end;
end; end;
procedure TForm1.Button2Click(Sender: TObject); procedure TForm1.Button2Click(Sender: TObject);
var var
Clt: TRestClient; Clt: IMVCRESTClient;
begin begin
Clt := MVCFramework.RESTClient.TRestClient.Create('http://localhost', 8080, nil); Clt := TMVCRESTClient.New.BaseURL('http://localhost', 8080);
try ShowMessage(Clt.Post('/hello', '{"name":"Bob äöüß"}').Content);
ShowMessage(Clt.doPOST('/hello', [], '{"name":"Bob äöüß"}').BodyAsString);
finally
Clt.Free;
end;
end; end;
end. end.

BIN
samples/data/ORDERSMANAGER_FB30.FDB
View File

Binary file not shown.

6
samples/jsonwebtoken/vclclient/MainClientFormU.dfm
View File

@ -80,7 +80,7 @@ object Form5: TForm5
Height = 41 Height = 41
Align = alLeft Align = alLeft
Caption = 'Get a protected resource' Caption = 'Get a protected resource'
TabOrder = 1 TabOrder = 2
OnClick = btnGetClick OnClick = btnGetClick
end end
object btnLOGIN: TButton object btnLOGIN: TButton
@ -102,7 +102,7 @@ object Form5: TForm5
Height = 41 Height = 41
Align = alRight Align = alRight
Caption = 'Custom Exception in OnAuthenticate' Caption = 'Custom Exception in OnAuthenticate'
TabOrder = 2 TabOrder = 3
WordWrap = True WordWrap = True
OnClick = btnLoginWithExceptionClick OnClick = btnLoginWithExceptionClick
end end
@ -114,7 +114,7 @@ object Form5: TForm5
Height = 41 Height = 41
Align = alLeft Align = alLeft
Caption = 'Login (mode 2)' Caption = 'Login (mode 2)'
TabOrder = 3 TabOrder = 1
OnClick = btnLoginJsonObjectClick OnClick = btnLoginJsonObjectClick
end end
end end

193
samples/jsonwebtoken/vclclient/MainClientFormU.pas
View File

@ -50,156 +50,125 @@ implementation
uses uses
MVCFramework.RESTClient, MVCFramework.RESTClient,
MVCFramework.RESTClient.Intf,
MVCFramework.SystemJSONUtils, MVCFramework.SystemJSONUtils,
System.JSON; System.JSON;
procedure TForm5.btnGetClick(Sender: TObject); procedure TForm5.btnGetClick(Sender: TObject);
var var
lClient: TRESTClient; lClient: IMVCRESTClient;
lResp: IRESTResponse; lResp: IMVCRESTResponse;
lQueryStringParams: TStringList;
begin begin
{ Getting JSON response } { Getting JSON response }
lClient := TRESTClient.Create('localhost', 8080); lClient := TMVCRESTClient.New.BaseURL('localhost', 8080);
try lClient.ReadTimeOut(0);
lClient.UseBasicAuthentication := False; if not FJWT.IsEmpty then
lClient.ReadTimeOut(0); begin
if not FJWT.IsEmpty then lClient.SetBearerAuthorization(FJWT);
begin
lClient.RequestHeaders.Values[TMVCJWTDefaults.AUTHORIZATION_HEADER] := 'Bearer ' + FJWT;
end;
lQueryStringParams := TStringList.Create;
try
lQueryStringParams.Values['firstname'] := 'Daniele';
lQueryStringParams.Values['lastname'] := 'Teti';
lResp := lClient.doGET('/admin/role1', [], lQueryStringParams);
if lResp.HasError then
ShowMessage(lResp.Error.ExceptionMessage);
finally
lQueryStringParams.Free;
end;
Memo2.Lines.Text := lResp.BodyAsString;
finally
lClient.Free;
end; end;
lResp := lClient
.AddQueryStringParam('firstname', 'Daniele')
.AddQueryStringParam('lastname', 'Teti')
.Get('/admin/role1');
if not lResp.Success then
ShowMessage(lResp.Content);
Memo2.Lines.Text := lResp.Content;
{ Getting HTML response } { Getting HTML response }
lClient := TRESTClient.Create('localhost', 8080);
try
// when the JWT authorization header is named "Authorization", the basic authorization must be disabled // when the JWT authorization header is named "Authorization", the basic authorization must be disabled
lClient.UseBasicAuthentication := False; if not FJWT.IsEmpty then
begin
lClient.ReadTimeOut(0); lClient.SetBearerAuthorization(FJWT);
if not FJWT.IsEmpty then
lClient.RequestHeaders.Values[TMVCJWTDefaults.AUTHORIZATION_HEADER] := 'Bearer ' + FJWT;
lQueryStringParams := TStringList.Create;
try
lQueryStringParams.Values['firstname'] := 'Daniele';
lQueryStringParams.Values['lastname'] := 'Teti';
lResp := lClient.Accept('text/html').doGET('/admin/role1', [], lQueryStringParams);
if lResp.HasError then
ShowMessage(lResp.Error.ExceptionMessage);
finally
lQueryStringParams.Free;
end;
Memo3.Lines.Text := lResp.BodyAsString;
finally
lClient.Free;
end; end;
lResp := lClient
.AddQueryStringParam('firstname', 'Daniele')
.AddQueryStringParam('lastname', 'Teti')
.Accept('text/html')
.Get('/admin/role1');
if not lResp.Success then
ShowMessage(lResp.Content);
Memo3.Lines.Text := lResp.Content;
end; end;
procedure TForm5.btnLOGINClick(Sender: TObject); procedure TForm5.btnLOGINClick(Sender: TObject);
var var
lClient: TRESTClient; lClient: IMVCRESTClient;
lRest: IRESTResponse; lRest: IMVCRESTResponse;
lJSON: TJSONObject; lJSON: TJSONObject;
begin begin
lClient := TRESTClient.Create('localhost', 8080); lClient := TMVCRESTClient.New
.BaseURL('localhost', 8080)
.ReadTimeOut(0)
.SetBasicAuthorization('user1', 'user1');
lRest := lClient.Post('/login');
if not lRest.Success then
begin
ShowMessage(
'HTTP ERROR: ' + lRest.StatusCode.ToString + sLineBreak +
'CONTENT MESSAGE: ' + lRest.Content);
Exit;
end;
lJSON := TSystemJSON.StringAsJSONObject(lRest.Content);
try try
lClient.ReadTimeOut(0); JWT := lJSON.GetValue('token').Value;
lClient.Authentication('user1', 'user1');
lRest := lClient.doPOST('/login', []);
if lRest.HasError then
begin
ShowMessage(
'HTTP ERROR: ' + lRest.Error.HTTPError.ToString + sLineBreak +
'APPLICATION ERROR CODE: ' + lRest.Error.ErrorNumber.ToString + sLineBreak +
'EXCEPTION MESSAGE: ' + lRest.Error.ExceptionMessage);
Exit;
end;
lJSON := TSystemJSON.StringAsJSONObject(lRest.BodyAsString);
try
JWT := lJSON.GetValue('token').Value;
finally
lJSON.Free;
end;
finally finally
lClient.Free; lJSON.Free;
end; end;
end; end;
procedure TForm5.btnLoginJsonObjectClick(Sender: TObject); procedure TForm5.btnLoginJsonObjectClick(Sender: TObject);
var var
lClient: TRESTClient; lClient: IMVCRESTClient;
lRest: IRESTResponse; lRest: IMVCRESTResponse;
lJSON: TJSONObject; lJSON: TJSONObject;
begin begin
lClient := TRESTClient.Create('localhost', 8080); lClient := TMVCRESTClient.New
.BaseURL('localhost', 8080)
.ReadTimeOut(0);
lRest := lClient.Post('/login', '{"jwtusername":"user1","jwtpassword":"user1"}');
if not lRest.Success then
begin
ShowMessage(
'HTTP ERROR: ' + lRest.StatusCode.ToString + sLineBreak +
'CONTENT MESSAGE: ' + lRest.Content);
Exit;
end;
lJSON := TSystemJSON.StringAsJSONObject(lRest.Content);
try try
lClient.ReadTimeOut(0); JWT := lJSON.GetValue('token').Value;
lRest := lClient.doPOST('/login', [], '{"jwtusername":"user1","jwtpassword":"user1"}');
if lRest.HasError then
begin
ShowMessage(
'HTTP ERROR: ' + lRest.Error.HTTPError.ToString + sLineBreak +
'APPLICATION ERROR CODE: ' + lRest.Error.ErrorNumber.ToString + sLineBreak +
'EXCEPTION MESSAGE: ' + lRest.Error.ExceptionMessage);
Exit;
end;
lJSON := TSystemJSON.StringAsJSONObject(lRest.BodyAsString);
try
JWT := lJSON.GetValue('token').Value;
finally
lJSON.Free;
end;
finally finally
lClient.Free; lJSON.Free;
end; end;
end; end;
procedure TForm5.btnLoginWithExceptionClick(Sender: TObject); procedure TForm5.btnLoginWithExceptionClick(Sender: TObject);
var var
lClient: TRESTClient; lClient: IMVCRESTClient;
lRest: IRESTResponse; lRest: IMVCRESTResponse;
lJSON: TJSONObject; lJSON: TJSONObject;
begin begin
lClient := TRESTClient.Create('localhost', 8080); lClient := TMVCRESTClient.New
try .BaseURL('localhost', 8080)
lClient.ReadTimeOut(0); .ReadTimeOut(0)
lClient.Authentication('user_raise_exception', 'user_raise_exception'); .SetBasicAuthorization('user_raise_exception', 'user_raise_exception');
lRest := lClient.doPOST('/login', []);
if lRest.HasError then
begin
ShowMessage(
'HTTP ERROR: ' + lRest.Error.HTTPError.ToString + sLineBreak +
'APPLICATION ERROR CODE: ' + lRest.Error.ErrorNumber.ToString + sLineBreak +
'EXCEPTION MESSAGE: ' + lRest.Error.ExceptionMessage);
Exit;
end;
lJSON := TSystemJSON.StringAsJSONObject(lRest.BodyAsString); lRest := lClient.Post('/login');
try if not lRest.Success then
JWT := lJSON.GetValue('token').Value; begin
finally ShowMessage(
lJSON.Free; 'HTTP ERROR: ' + lRest.StatusCode.ToString + sLineBreak +
end; 'CONTENT MESSAGE: ' + lRest.Content);
Exit;
end;
lJSON := TSystemJSON.StringAsJSONObject(lRest.Content);
try
JWT := lJSON.GetValue('token').Value;
finally finally
lClient.Free; lJSON.Free;
end; end;
end; end;

137
samples/jsonwebtoken_livevaliditywindow/vclclient/MainClientFormU.pas
View File

@ -40,6 +40,7 @@ implementation
uses uses
MVCFramework.RESTClient, MVCFramework.RESTClient,
MVCFramework.RESTClient.Intf,
MVCFramework.Middleware.JWT, MVCFramework.Middleware.JWT,
MVCFramework.Commons, MVCFramework.Commons,
MVCFramework.SystemJSONUtils, MVCFramework.SystemJSONUtils,
@ -48,110 +49,96 @@ uses
procedure TMainForm.btnGetClick(Sender: TObject); procedure TMainForm.btnGetClick(Sender: TObject);
var var
lClient: TRESTClient; lClient: IMVCRESTClient;
lResp: IRESTResponse; lResp: IMVCRESTResponse;
lQueryStringParams: TStringList;
tokenOld, tokenNew: string; // NEW CODE tokenOld, tokenNew: string; // NEW CODE
begin begin
tokenOld := FJWT; // NEW CODE tokenOld := FJWT; // NEW CODE
lClient := TRESTClient.Create('localhost', 8080); lClient := TMVCRESTClient.New
try .BaseURL('localhost', 8080)
lClient.ReadTimeOut(0); .ReadTimeOut(0);
if not FJWT.IsEmpty then if not FJWT.IsEmpty then
begin begin
lClient.RequestHeaders.Values[TMVCJWTDefaults.AUTHORIZATION_HEADER] := 'Bearer ' + FJWT; lClient.SetBearerAuthorization(FJWT);
end;
lQueryStringParams := TStringList.Create;
try
lQueryStringParams.Values['firstname'] := 'Daniele';
lQueryStringParams.Values['lastname'] := 'Teti';
lResp := lClient.doGET('/admin/role1', [], lQueryStringParams);
if lResp.HasError then
ShowMessage(lResp.Error.Status + sLineBreak + lResp.Error.ExceptionMessage);
finally
lQueryStringParams.Free;
end;
Memo2.Lines.Text := lResp.BodyAsString;
// NEW CODE
tokenNew := lResp.HeaderValue(TMVCJWTDefaults.AUTHORIZATION_HEADER);
if tokenNew.StartsWith('Bearer', True) then
begin
tokenNew := tokenNew.Remove(0, 'Bearer'.Length).Trim;
tokenNew := TNetEncoding.URL.URLDecode(tokenNew).Trim;
JWT := tokenNew;
end; // END NEW CODE
finally
lClient.Free;
end; end;
lResp := lClient
.AddQueryStringParam('firstname', 'Daniele')
.AddQueryStringParam('lastname', 'Teti')
.Get('/admin/role1');
if not lResp.Success then
ShowMessage(lResp.StatusCode.ToString + sLineBreak + lResp.Content);
Memo2.Lines.Text := lResp.Content;
// NEW CODE
tokenNew := lResp.HeaderValue(TMVCJWTDefaults.AUTHORIZATION_HEADER);
if tokenNew.StartsWith('Bearer', True) then
begin
tokenNew := tokenNew.Remove(0, 'Bearer'.Length).Trim;
tokenNew := TNetEncoding.URL.URLDecode(tokenNew).Trim;
JWT := tokenNew;
end; // END NEW CODE
end; end;
procedure TMainForm.btnLOGINClick(Sender: TObject); procedure TMainForm.btnLOGINClick(Sender: TObject);
var var
lClient: TRESTClient; lClient: IMVCRESTClient;
lRest: IRESTResponse; lRest: IMVCRESTResponse;
lJSON: TJSONObject; lJSON: TJSONObject;
begin begin
lClient := TRESTClient.Create('localhost', 8080); lClient := TMVCRESTClient.New
.BaseURL('localhost', 8080)
.ReadTimeOut(0)
.AddHeader(TMVCJWTDefaults.USERNAME_HEADER, 'user1')
.AddHeader(TMVCJWTDefaults.PASSWORD_HEADER, 'user1');
lRest := lClient.Get('/login');
lJSON := StrToJSONObject(lRest.Content);
try try
lClient.ReadTimeOut(0); JWT := lJSON.S['token'];
lClient.Header(TMVCJWTDefaults.USERNAME_HEADER, 'user1').Header(TMVCJWTDefaults.PASSWORD_HEADER, 'user1');
lRest := lClient.doGET('/login', []); { any HTTP verbs is OK }
lJSON := StrToJSONObject(lRest.BodyAsString);
try
JWT := lJSON.S['token'];
finally
lJSON.Free;
end;
finally finally
lClient.Free; lJSON.Free;
end; end;
end; end;
procedure TMainForm.btnLoginWithHeaderBasicClick(Sender: TObject); procedure TMainForm.btnLoginWithHeaderBasicClick(Sender: TObject);
var var
lClient: TRESTClient; lClient: IMVCRESTClient;
lRest: IRESTResponse; lRest: IMVCRESTResponse;
lJSON: TJSONObject; lJSON: TJSONObject;
begin begin
lClient := TRESTClient.Create('localhost', 8080); lClient := TMVCRESTClient.New
.BaseURL('localhost', 8080)
.ReadTimeOut(0)
.SetBasicAuthorization('user1', 'user1');
lRest := lClient.Post('/login');
lJSON := StrToJSONObject(lRest.Content);
try try
lClient.ReadTimeOut(0); JWT := lJSON.S['token'];
lClient.Authentication('user1', 'user1');
lRest := lClient.doPOST('/login', []);
lJSON := StrToJSONObject(lRest.BodyAsString);
try
JWT := lJSON.S['token'];
finally
lJSON.Free;
end;
finally finally
lClient.Free; lJSON.Free;
end; end;
end; end;
procedure TMainForm.Button1Click(Sender: TObject); procedure TMainForm.Button1Click(Sender: TObject);
var var
lClient: TRESTClient; lClient: IMVCRESTClient;
lRest: IRESTResponse; lRest: IMVCRESTResponse;
lJSON: TJSONObject; lJSON: TJSONObject;
begin begin
lClient := TRESTClient.Create('localhost', 8080); lClient := TMVCRESTClient.New
try .BaseURL('localhost', 8080)
lClient.ReadTimeOut(0); .ReadTimeOut(0);
lRest := lClient.doPOST('/login', [], '{"jwtusername":"user1","jwtpassword":"user1"}');
lJSON := StrToJSONObject(lRest.BodyAsString);
try
JWT := lJSON.S['token'];
finally
lJSON.Free;
end;
finally
lClient.Free;
end;
lRest := lClient.Post('/login', '{"jwtusername":"user1","jwtpassword":"user1"}');
lJSON := StrToJSONObject(lRest.Content);
try
JWT := lJSON.S['token'];
finally
lJSON.Free;
end;
end; end;
procedure TMainForm.SetJWT(const Value: string); procedure TMainForm.SetJWT(const Value: string);

6
samples/jsonwebtoken_roleauth/vclclient/MainClientFormU.dfm
View File

@ -80,7 +80,7 @@ object Form5: TForm5
Height = 41 Height = 41
Align = alLeft Align = alLeft
Caption = 'Get a protected resource' Caption = 'Get a protected resource'
TabOrder = 1 TabOrder = 2
OnClick = btnGetClick OnClick = btnGetClick
end end
object btnLOGIN: TButton object btnLOGIN: TButton
@ -102,7 +102,7 @@ object Form5: TForm5
Height = 41 Height = 41
Align = alRight Align = alRight
Caption = 'Custom Exception in OnAuthenticate' Caption = 'Custom Exception in OnAuthenticate'
TabOrder = 2 TabOrder = 3
WordWrap = True WordWrap = True
OnClick = btnLoginWithExceptionClick OnClick = btnLoginWithExceptionClick
end end
@ -114,7 +114,7 @@ object Form5: TForm5
Height = 41 Height = 41
Align = alLeft Align = alLeft
Caption = 'Login (mode 2)' Caption = 'Login (mode 2)'
TabOrder = 3 TabOrder = 1
OnClick = btnLoginJsonObjectClick OnClick = btnLoginJsonObjectClick
end end
end end

199
samples/jsonwebtoken_roleauth/vclclient/MainClientFormU.pas
View File

@ -51,155 +51,126 @@ implementation
uses uses
MVCFramework.RESTClient, MVCFramework.RESTClient,
MVCFramework.SystemJSONUtils, MVCFramework.SystemJSONUtils,
System.JSON; System.JSON,
MVCFramework.RESTClient.Intf;
procedure TForm5.btnGetClick(Sender: TObject); procedure TForm5.btnGetClick(Sender: TObject);
var var
lClient: TRESTClient; lClient: IMVCRESTClient;
lResp: IRESTResponse; lResp: IMVCRESTResponse;
lQueryStringParams: TStringList;
begin begin
{ Getting JSON response } { Getting JSON response }
lClient := TRESTClient.Create('localhost', 8080); lClient := TMVCRESTClient.New
try .BaseURL('localhost', 8080)
lClient.UseBasicAuthentication := False; .ReadTimeOut(0);
lClient.ReadTimeOut(0); if not FJWT.IsEmpty then
if not FJWT.IsEmpty then begin
begin lClient.SetBearerAuthorization(FJWT);
lClient.RequestHeaders.Values[TMVCJWTDefaults.AUTHORIZATION_HEADER] := 'Bearer ' + FJWT;
end;
lQueryStringParams := TStringList.Create;
try
lQueryStringParams.Values['firstname'] := 'Daniele';
lQueryStringParams.Values['lastname'] := 'Teti';
lResp := lClient.doGET('/admin/role1', [], lQueryStringParams);
if lResp.HasError then
ShowMessage(lResp.Error.ExceptionMessage);
finally
lQueryStringParams.Free;
end;
Memo2.Lines.Text := lResp.BodyAsString;
finally
lClient.Free;
end; end;
lResp := lClient
.AddQueryStringParam('firstname', 'Daniele')
.AddQueryStringParam('lastname', 'Teti')
.Get('/admin/role1');
if not lResp.Success then
ShowMessage(lResp.Content);
{ Getting HTML response } Memo2.Lines.Text := lResp.Content;
lClient := TRESTClient.Create('localhost', 8080);
try
// when the JWT authorization header is named "Authorization", the basic authorization must be disabled
lClient.UseBasicAuthentication := False;
lClient.ReadTimeOut(0); lResp := lClient
if not FJWT.IsEmpty then .AddQueryStringParam('firstname', 'Daniele')
lClient.RequestHeaders.Values[TMVCJWTDefaults.AUTHORIZATION_HEADER] := 'Bearer ' + FJWT; .AddQueryStringParam('lastname', 'Teti')
lQueryStringParams := TStringList.Create; .Accept('text/html')
try .Get('/admin/role1');
lQueryStringParams.Values['firstname'] := 'Daniele'; if not lResp.Success then
lQueryStringParams.Values['lastname'] := 'Teti'; ShowMessage(lResp.Content);
lResp := lClient.Accept('text/html').doGET('/admin/role1', [], lQueryStringParams);
if lResp.HasError then
ShowMessage(lResp.Error.ExceptionMessage);
finally
lQueryStringParams.Free;
end;
Memo3.Lines.Text := lResp.BodyAsString;
finally
lClient.Free;
end;
Memo3.Lines.Text := lResp.Content;
end; end;
procedure TForm5.btnLOGINClick(Sender: TObject); procedure TForm5.btnLOGINClick(Sender: TObject);
var var
lClient: TRESTClient; lClient: IMVCRESTClient;
lRest: IRESTResponse; lRest: IMVCRESTResponse;
lJSON: TJSONObject; lJSON: TJSONObject;
begin begin
lClient := TRESTClient.Create('localhost', 8080); lClient := TMVCRESTClient.New
.BaseURL('localhost', 8080)
.ReadTimeOut(0)
.SetBasicAuthorization('user1', 'user1');
lRest := lClient.Post('/login');
if not lRest.Success then
begin
ShowMessage(
'HTTP ERROR: ' + lRest.StatusCode.ToString + sLineBreak +
'HTTP MESSAGE: ' + lRest.StatusText + sLineBreak +
'CONTENT MESSAGE: ' + lRest.Content);
Exit;
end;
lJSON := TSystemJSON.StringAsJSONObject(lRest.Content);
try try
lClient.ReadTimeOut(0); JWT := lJSON.GetValue('token').Value;
lClient.Authentication('user1', 'user1');
lRest := lClient.doPOST('/login', []);
if lRest.HasError then
begin
ShowMessage(
'HTTP ERROR: ' + lRest.Error.HTTPError.ToString + sLineBreak +
'APPLICATION ERROR CODE: ' + lRest.Error.ErrorNumber.ToString + sLineBreak +
'EXCEPTION MESSAGE: ' + lRest.Error.ExceptionMessage);
Exit;
end;
lJSON := TSystemJSON.StringAsJSONObject(lRest.BodyAsString);
try
JWT := lJSON.GetValue('token').Value;
finally
lJSON.Free;
end;
finally finally
lClient.Free; lJSON.Free;
end; end;
end; end;
procedure TForm5.btnLoginJsonObjectClick(Sender: TObject); procedure TForm5.btnLoginJsonObjectClick(Sender: TObject);
var var
lClient: TRESTClient; lClient: IMVCRESTClient;
lRest: IRESTResponse; lRest: IMVCRESTResponse;
lJSON: TJSONObject; lJSON: TJSONObject;
begin begin
lClient := TRESTClient.Create('localhost', 8080); lClient := TMVCRESTClient.New
.BaseURL('localhost', 8080)
.ReadTimeOut(0);
lRest := lClient.Post('/login', '{"jwtusername":"user1","jwtpassword":"user1"}');
if not lRest.Success then
begin
ShowMessage(
'HTTP ERROR: ' + lRest.StatusCode.ToString + sLineBreak +
'HTTP MESSAGE: ' + lRest.StatusText + sLineBreak +
'CONTENT MESSAGE: ' + lRest.Content);
Exit;
end;
lJSON := TSystemJSON.StringAsJSONObject(lRest.Content);
try try
lClient.ReadTimeOut(0); JWT := lJSON.GetValue('token').Value;
lRest := lClient.doPOST('/login', [], '{"jwtusername":"user1","jwtpassword":"user1"}');
if lRest.HasError then
begin
ShowMessage(
'HTTP ERROR: ' + lRest.Error.HTTPError.ToString + sLineBreak +
'APPLICATION ERROR CODE: ' + lRest.Error.ErrorNumber.ToString + sLineBreak +
'EXCEPTION MESSAGE: ' + lRest.Error.ExceptionMessage);
Exit;
end;
lJSON := TSystemJSON.StringAsJSONObject(lRest.BodyAsString);
try
JWT := lJSON.GetValue('token').Value;
finally
lJSON.Free;
end;
finally finally
lClient.Free; lJSON.Free;
end; end;
end; end;
procedure TForm5.btnLoginWithExceptionClick(Sender: TObject); procedure TForm5.btnLoginWithExceptionClick(Sender: TObject);
var var
lClient: TRESTClient; lClient: IMVCRESTClient;
lRest: IRESTResponse; lRest: IMVCRESTResponse;
lJSON: TJSONObject; lJSON: TJSONObject;
begin begin
lClient := TRESTClient.Create('localhost', 8080); lClient := TMVCRESTClient.New
try .BaseURL('localhost', 8080)
lClient.ReadTimeOut(0); .ReadTimeOut(0)
lClient.Authentication('user_raise_exception', 'user_raise_exception'); .SetBasicAuthorization('user_raise_exception', 'user_raise_exception');
lRest := lClient.doPOST('/login', []); lRest := lClient.Post('/login');
if lRest.HasError then if not lRest.Success then
begin begin
ShowMessage( ShowMessage(
'HTTP ERROR: ' + lRest.Error.HTTPError.ToString + sLineBreak + 'HTTP ERROR: ' + lRest.StatusCode.ToString + sLineBreak +
'APPLICATION ERROR CODE: ' + lRest.Error.ErrorNumber.ToString + sLineBreak + 'HTTP MESSAGE: ' + lRest.StatusText + sLineBreak +
'EXCEPTION MESSAGE: ' + lRest.Error.ExceptionMessage); 'CONTENT MESSAGE: ' + lRest.Content);
Exit;
end;
lJSON := TSystemJSON.StringAsJSONObject(lRest.BodyAsString); Exit;
try end;
JWT := lJSON.GetValue('token').Value;
finally lJSON := TSystemJSON.StringAsJSONObject(lRest.Content);
lJSON.Free; try
end; JWT := lJSON.GetValue('token').Value;
finally finally
lClient.Free; lJSON.Free;
end; end;
end; end;

6
samples/jsonwebtokenplain/MainClientFormU.dfm
View File

@ -19,7 +19,7 @@ object Form7: TForm7
Width = 145 Width = 145
Height = 66 Height = 66
Caption = 'Get JWT Token' Caption = 'Get JWT Token'
TabOrder = 0 TabOrder = 1
OnClick = Button1Click OnClick = Button1Click
end end
object Button2: TButton object Button2: TButton
@ -28,7 +28,7 @@ object Form7: TForm7
Width = 338 Width = 338
Height = 66 Height = 66
Caption = 'Get Request to a protected resources' Caption = 'Get Request to a protected resources'
TabOrder = 1 TabOrder = 2
OnClick = Button2Click OnClick = Button2Click
end end
object Memo1: TMemo object Memo1: TMemo
@ -38,6 +38,6 @@ object Form7: TForm7
Height = 81 Height = 81
Align = alTop Align = alTop
ReadOnly = True ReadOnly = True
TabOrder = 2 TabOrder = 0
end end
end end

40
samples/jsonwebtokenplain/MainClientFormU.pas
View File

@ -35,42 +35,32 @@ var
implementation implementation
uses uses
mvcframework.restclient; MVCFramework.RESTClient,
MVCFramework.RESTClient.Intf;
{$R *.dfm} {$R *.dfm}
procedure TForm7.Button1Click(Sender: TObject); procedure TForm7.Button1Click(Sender: TObject);
var var
lClt: TRESTClient; lResp: IMVCRESTResponse;
lResp: IRESTResponse;
begin begin
lClt := TRESTClient.Create('localhost', 8080); lResp := TMVCRESTClient.New
try .BaseURL('localhost', 8080)
lResp := lClt.doPOST('/login', [], ''); .Post('/login');
Token := lResp.BodyAsString; Token := lResp.Content;
finally ShowMessage('In the next 15 seconds you can request protected resources. After your token will expires!');
lClt.Free;
end;
ShowMessage
('In the next 15 seconds you can request protected resources. After your token will expires!');
end; end;
procedure TForm7.Button2Click(Sender: TObject); procedure TForm7.Button2Click(Sender: TObject);
var var
lClt: TRESTClient; lResp: IMVCRESTResponse;
lResp: IRESTResponse;
begin begin
lClt := TRESTClient.Create('localhost', 8080); lResp := TMVCRESTClient.New
try .BaseURL('localhost', 8080)
lClt.Header('Authentication', 'bearer ' + FToken); .AddHeader('Authentication', 'bearer ' + FToken, True)
lResp := lClt.doGET('/', []); .Get('/');
ShowMessage(lResp.ResponseText + sLineBreak + ShowMessage(lResp.StatusText + sLineBreak +
lResp.BodyAsString); lResp.Content);
finally
lClt.Free;
end;
end; end;
procedure TForm7.SetToken(const Value: String); procedure TForm7.SetToken(const Value: String);

48
samples/jsonwebtokenplain/ProjectGroup1.groupproj Normal file
View File

@ -0,0 +1,48 @@
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<ProjectGuid>{7F871858-7673-498D-8BBD-6F0E8F423C14}</ProjectGuid>
</PropertyGroup>
<ItemGroup>
<Projects Include="jwtplainserver.dproj">
<Dependencies/>
</Projects>
<Projects Include="jwtplainclient.dproj">
<Dependencies/>
</Projects>
</ItemGroup>
<ProjectExtensions>
<Borland.Personality>Default.Personality.12</Borland.Personality>
<Borland.ProjectType/>
<BorlandProject>
<Default.Personality/>
</BorlandProject>
</ProjectExtensions>
<Target Name="jwtplainserver">
<MSBuild Projects="jwtplainserver.dproj"/>
</Target>
<Target Name="jwtplainserver:Clean">
<MSBuild Projects="jwtplainserver.dproj" Targets="Clean"/>
</Target>
<Target Name="jwtplainserver:Make">
<MSBuild Projects="jwtplainserver.dproj" Targets="Make"/>
</Target>
<Target Name="jwtplainclient">
<MSBuild Projects="jwtplainclient.dproj"/>
</Target>
<Target Name="jwtplainclient:Clean">
<MSBuild Projects="jwtplainclient.dproj" Targets="Clean"/>
</Target>
<Target Name="jwtplainclient:Make">
<MSBuild Projects="jwtplainclient.dproj" Targets="Make"/>
</Target>
<Target Name="Build">
<CallTarget Targets="jwtplainserver;jwtplainclient"/>
</Target>
<Target Name="Clean">
<CallTarget Targets="jwtplainserver:Clean;jwtplainclient:Clean"/>
</Target>
<Target Name="Make">
<CallTarget Targets="jwtplainserver:Make;jwtplainclient:Make"/>
</Target>
<Import Project="$(BDS)\Bin\CodeGear.Group.Targets" Condition="Exists('$(BDS)\Bin\CodeGear.Group.Targets')"/>
</Project>

8
samples/sslclient/MainFormU.dfm
View File

@ -11,7 +11,6 @@ object Form9: TForm9
Font.Name = 'Tahoma' Font.Name = 'Tahoma'
Font.Style = [] Font.Style = []
OldCreateOrder = False OldCreateOrder = False
OnClose = FormClose
OnCreate = FormCreate OnCreate = FormCreate
DesignSize = ( DesignSize = (
538 538
@ -47,7 +46,7 @@ object Form9: TForm9
Lines.Strings = ( Lines.Strings = (
'Memo1') 'Memo1')
ParentFont = False ParentFont = False
TabOrder = 1 TabOrder = 2
end end
object Button2: TButton object Button2: TButton
Left = 111 Left = 111
@ -61,16 +60,15 @@ object Form9: TForm9
Font.Name = 'Tahoma' Font.Name = 'Tahoma'
Font.Style = [] Font.Style = []
ParentFont = False ParentFont = False
TabOrder = 2 TabOrder = 1
OnClick = Button2Click OnClick = Button2Click
end end
object RESTClient1: TRESTClient object RESTClient1: TRESTClient
Accept = 'application/json, text/plain; q=0.9, text/html;q=0.8,' Accept = 'application/json, text/plain; q=0.9, text/html;q=0.8,'
AcceptCharset = 'UTF-8, *;q=0.8' AcceptCharset = 'UTF-8, *;q=0.8'
AcceptEncoding = 'identity' AcceptEncoding = 'identity'
BaseURL = 'https://localhost/' BaseURL = 'https://localhost'
Params = <> Params = <>
HandleRedirects = True
Left = 32 Left = 32
Top = 56 Top = 56
end end

28
samples/sslclient/MainFormU.pas
View File

@ -15,6 +15,7 @@ uses
IPPeerClient, IPPeerClient,
Vcl.StdCtrls, Vcl.StdCtrls,
MVCFramework.RESTClient, MVCFramework.RESTClient,
MVCFramework.RESTClient.Intf,
REST.Client, REST.Client,
Data.Bind.Components, Data.Bind.Components,
Data.Bind.ObjectScope, Data.Bind.ObjectScope,
@ -27,7 +28,8 @@ uses
IdComponent, IdComponent,
IdTCPConnection, IdTCPConnection,
IdTCPClient, IdTCPClient,
IdHTTP; IdHTTP,
REST.Types;
type type
TForm9 = class(TForm) TForm9 = class(TForm)
@ -40,9 +42,8 @@ type
procedure Button1Click(Sender: TObject); procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject); procedure Button2Click(Sender: TObject);
procedure FormCreate(Sender: TObject); procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private private
Clt: MVCFramework.RESTClient.TRESTClient; Clt: IMVCRESTClient;
{ Private declarations } { Private declarations }
public public
{ Public declarations } { Public declarations }
@ -66,29 +67,24 @@ end;
procedure TForm9.Button2Click(Sender: TObject); procedure TForm9.Button2Click(Sender: TObject);
begin begin
Clt.Asynch( Clt.Async(
procedure(Resp: IRESTResponse) procedure(Resp: IMVCRESTResponse)
begin begin
Memo1.Lines.Text := Resp.BodyAsString; Memo1.Lines.Text := Resp.Content;
Memo1.Lines.Add('Request Terminated');
end, end,
procedure(E: Exception) procedure(E: Exception)
begin begin
ShowMessage(E.Message); ShowMessage(E.Message);
end, end,
procedure True
begin )
Memo1.Lines.Add('Request Terminated'); .Get('/people');
end, true).doGET('/people', []);
end;
procedure TForm9.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Clt.Free;
end; end;
procedure TForm9.FormCreate(Sender: TObject); procedure TForm9.FormCreate(Sender: TObject);
begin begin
Clt := MVCFramework.RESTClient.TRESTClient.Create('https://localhost', 443, IdSSLIOHandlerSocketOpenSSL1); Clt := TMVCRESTClient.New.BaseURL('https://localhost', 443);
end; end;
end. end.

48
samples/sslclient/ProjectGroup1.groupproj Normal file
View File

@ -0,0 +1,48 @@
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<ProjectGuid>{607DE600-0137-49D9-BA86-37D20CE1FF66}</ProjectGuid>
</PropertyGroup>
<ItemGroup>
<Projects Include="sslclient.dproj">
<Dependencies/>
</Projects>
<Projects Include="..\sslserver\SSLSample.dproj">
<Dependencies/>
</Projects>
</ItemGroup>
<ProjectExtensions>
<Borland.Personality>Default.Personality.12</Borland.Personality>
<Borland.ProjectType/>
<BorlandProject>
<Default.Personality/>
</BorlandProject>
</ProjectExtensions>
<Target Name="sslclient">
<MSBuild Projects="sslclient.dproj"/>
</Target>
<Target Name="sslclient:Clean">
<MSBuild Projects="sslclient.dproj" Targets="Clean"/>
</Target>
<Target Name="sslclient:Make">
<MSBuild Projects="sslclient.dproj" Targets="Make"/>
</Target>
<Target Name="SSLSample">
<MSBuild Projects="..\sslserver\SSLSample.dproj"/>
</Target>
<Target Name="SSLSample:Clean">
<MSBuild Projects="..\sslserver\SSLSample.dproj" Targets="Clean"/>
</Target>
<Target Name="SSLSample:Make">
<MSBuild Projects="..\sslserver\SSLSample.dproj" Targets="Make"/>
</Target>
<Target Name="Build">
<CallTarget Targets="sslclient;SSLSample"/>
</Target>
<Target Name="Clean">
<CallTarget Targets="sslclient:Clean;SSLSample:Clean"/>
</Target>
<Target Name="Make">
<CallTarget Targets="sslclient:Make;SSLSample:Make"/>
</Target>
<Import Project="$(BDS)\Bin\CodeGear.Group.Targets" Condition="Exists('$(BDS)\Bin\CodeGear.Group.Targets')"/>
</Project>

5
samples/winecellarclient/MainFormU.dfm
View File

@ -12,7 +12,6 @@ object Form5: TForm5
Font.Name = 'Tahoma' Font.Name = 'Tahoma'
Font.Style = [] Font.Style = []
OldCreateOrder = False OldCreateOrder = False
OnClose = FormClose
OnCreate = FormCreate OnCreate = FormCreate
DesignSize = ( DesignSize = (
758 758
@ -35,7 +34,7 @@ object Form5: TForm5
Height = 370 Height = 370
ActivePage = TabSheet1 ActivePage = TabSheet1
Anchors = [akLeft, akTop, akRight, akBottom] Anchors = [akLeft, akTop, akRight, akBottom]
TabOrder = 1 TabOrder = 2
object TabSheet1: TTabSheet object TabSheet1: TTabSheet
Caption = 'Wines' Caption = 'Wines'
object DBGrid1: TDBGrid object DBGrid1: TDBGrid
@ -232,7 +231,7 @@ object Form5: TForm5
Width = 320 Width = 320
Height = 33 Height = 33
DataSource = DataSource1 DataSource = DataSource1
TabOrder = 2 TabOrder = 1
end end
object FDMemTable1: TFDMemTable object FDMemTable1: TFDMemTable
BeforePost = FDMemTable1BeforePost BeforePost = FDMemTable1BeforePost

34
samples/winecellarclient/MainFormU.pas
View File

@ -8,7 +8,7 @@ uses
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.Grids, Vcl.DBGrids, Vcl.ComCtrls, FireDAC.Stan.Intf, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.Grids, Vcl.DBGrids, Vcl.ComCtrls, FireDAC.Stan.Intf,
FireDAC.Stan.Option, FireDAC.Stan.Param, FireDAC.Stan.Error, FireDAC.DatS, FireDAC.Phys.Intf, FireDAC.DApt.Intf, FireDAC.Stan.Option, FireDAC.Stan.Param, FireDAC.Stan.Error, FireDAC.DatS, FireDAC.Phys.Intf, FireDAC.DApt.Intf,
Data.DB, FireDAC.Comp.DataSet, FireDAC.Comp.Client, Vcl.Mask, Vcl.DBCtrls, Vcl.ExtCtrls, Data.DB, FireDAC.Comp.DataSet, FireDAC.Comp.Client, Vcl.Mask, Vcl.DBCtrls, Vcl.ExtCtrls,
MVCFramework.RESTClient; MVCFramework.RESTClient, MVCFramework.RESTClient.Intf;
type type
TForm5 = class(TForm) TForm5 = class(TForm)
@ -45,11 +45,10 @@ type
procedure DBGrid1DblClick(Sender: TObject); procedure DBGrid1DblClick(Sender: TObject);
procedure FDMemTable1BeforePost(DataSet: TDataSet); procedure FDMemTable1BeforePost(DataSet: TDataSet);
procedure FormCreate(Sender: TObject); procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FDMemTable1BeforeDelete(DataSet: TDataSet); procedure FDMemTable1BeforeDelete(DataSet: TDataSet);
private private
RESTClient: TRESTClient; RESTClient: IMVCRESTClient;
Loading: Boolean; Loading: Boolean;
{ Private declarations } { Private declarations }
public public
@ -69,14 +68,14 @@ uses
procedure TForm5.Button1Click(Sender: TObject); procedure TForm5.Button1Click(Sender: TObject);
var var
response: IRESTResponse; response: IMVCRESTResponse;
begin begin
response := RESTClient.doGET('/api/wines', []); response := RESTClient.Get('/api/wines');
Memo1.Lines.Text := response.BodyAsString; Memo1.Lines.Text := response.Content;
FDMemTable1.Close; FDMemTable1.Close;
FDMemTable1.Open; FDMemTable1.Open;
Loading := True; Loading := True;
FDMemTable1.AppendFromJSONArrayString(response.BodyAsString); FDMemTable1.AppendFromJSONArrayString(response.Content);
FDMemTable1.First; FDMemTable1.First;
Loading := False; Loading := False;
end; end;
@ -88,37 +87,32 @@ end;
procedure TForm5.FDMemTable1BeforeDelete(DataSet: TDataSet); procedure TForm5.FDMemTable1BeforeDelete(DataSet: TDataSet);
var var
Resp: IRESTResponse; Resp: IMVCRESTResponse;
begin begin
Resp := RESTClient.DataSetDelete('/api/wines', FDMemTable1id.AsString); Resp := RESTClient.DataSetDelete('/api/wines', FDMemTable1id.AsString);
if not Resp.ResponseCode in [200] then if not Resp.StatusCode in [200] then
raise Exception.Create(Resp.ResponseText); raise Exception.Create(Resp.StatusText);
end; end;
procedure TForm5.FDMemTable1BeforePost(DataSet: TDataSet); procedure TForm5.FDMemTable1BeforePost(DataSet: TDataSet);
var var
Resp: IRESTResponse; Resp: IMVCRESTResponse;
begin begin
if Loading then if Loading then
Exit; Exit;
case FDMemTable1.State of case FDMemTable1.State of
dsEdit: dsEdit:
Resp := RESTClient.DataSetUpdate('/api/wines', FDMemTable1, FDMemTable1id.AsString); Resp := RESTClient.DataSetUpdate('/api/wines', FDMemTable1id.AsString, FDMemTable1);
dsInsert: dsInsert:
Resp := RESTClient.DataSetInsert('/api/wines', FDMemTable1); Resp := RESTClient.DataSetInsert('/api/wines', FDMemTable1);
end; end;
if not Resp.ResponseCode in [200, 201] then if not Resp.StatusCode in [200, 201] then
raise Exception.Create(Resp.ResponseText); raise Exception.Create(Resp.StatusText);
end;
procedure TForm5.FormClose(Sender: TObject; var Action: TCloseAction);
begin
RESTClient.free;
end; end;
procedure TForm5.FormCreate(Sender: TObject); procedure TForm5.FormCreate(Sender: TObject);
begin begin
RESTClient := TRESTClient.Create('localhost', 3000); RESTClient := TMVCRESTClient.New.BaseURL('localhost', 3000);
end; end;
end. end.

BIN
samples/winecellarserver/WINES_FB30.FDB
View File

Binary file not shown.

11
sources/MVCFramework.DataSet.Utils.pas
View File

@ -136,7 +136,7 @@ type
fRESTClient: IMVCRESTClient; fRESTClient: IMVCRESTClient;
fDataSet: TDataSet; fDataSet: TDataSet;
fURI: string; fURI: string;
fPrimaryKeyNAme: string; fPrimaryKeyName: string;
fLoading: boolean; fLoading: boolean;
procedure ShowError(const AResponse: IMVCRESTResponse); procedure ShowError(const AResponse: IMVCRESTResponse);
public public
@ -620,7 +620,7 @@ begin
fRESTClient := aRESTClient; fRESTClient := aRESTClient;
fDataSet := ADataSet; fDataSet := ADataSet;
fURI := aURI; fURI := aURI;
fPrimaryKeyNAme := aPrimaryKeyName; fPrimaryKeyName := aPrimaryKeyName;
// procedure HookBeforePost(DataSet: TDataSet); // procedure HookBeforePost(DataSet: TDataSet);
// procedure HookBeforeDelete(DataSet: TDataSet); // procedure HookBeforeDelete(DataSet: TDataSet);
@ -673,7 +673,7 @@ var
Res: IMVCRESTResponse; Res: IMVCRESTResponse;
begin begin
if DataSet.State = dsBrowse then if DataSet.State = dsBrowse then
Res := fRESTClient.DataSetDelete(fURI, DataSet.FieldByName(fPrimaryKeyNAme).AsString); Res := fRESTClient.DataSetDelete(fURI, DataSet.FieldByName(fPrimaryKeyName).AsString);
if not(Res.StatusCode in [200]) then if not(Res.StatusCode in [200]) then
begin begin
ShowError(Res); ShowError(Res);
@ -694,7 +694,7 @@ begin
end end
else else
begin begin
lLastID := fDataSet.FieldByName(fPrimaryKeyNAme).AsInteger; lLastID := fDataSet.FieldByName(fPrimaryKeyName).AsInteger;
lRes := fRESTClient.DataSetUpdate(fURI, lLastID.ToString, DataSet); lRes := fRESTClient.DataSetUpdate(fURI, lLastID.ToString, DataSet);
end; end;
if not(lRes.StatusCode in [200, 201]) then if not(lRes.StatusCode in [200, 201]) then
@ -721,8 +721,7 @@ end;
procedure TMVCAPIBinder.TMVCAPIBinderItem.ShowError(const AResponse: IMVCRESTResponse); procedure TMVCAPIBinder.TMVCAPIBinderItem.ShowError(const AResponse: IMVCRESTResponse);
begin begin
if not AResponse.Success then if not AResponse.Success then
raise EMVCException.Create(AResponse.StatusCode, AResponse.ErrorMessage + sLineBreak + raise EMVCException.Create(AResponse.StatusCode, AResponse.StatusText + sLineBreak + AResponse.Content)
AResponse.Content)
else else
raise EMVCException.Create(AResponse.Content); raise EMVCException.Create(AResponse.Content);
end; end;

4
sources/MVCFramework.RESTClient.Intf.pas
View File

@ -63,6 +63,9 @@ type
function ProxyPassword(const aProxyPassword: string): IMVCRESTClient; overload; function ProxyPassword(const aProxyPassword: string): IMVCRESTClient; overload;
function ProxyPassword: string; overload; function ProxyPassword: string; overload;
function SecureProtocols(const aSecureProtocols: THTTPSecureProtocols): IMVCRESTClient; overload;
function SecureProtocols: THTTPSecureProtocols; overload;
function UserAgent(const aUserAgent: string): IMVCRESTClient; overload; function UserAgent(const aUserAgent: string): IMVCRESTClient; overload;
function UserAgent: string; overload; function UserAgent: string; overload;
@ -320,7 +323,6 @@ type
function Success: Boolean; function Success: Boolean;
function StatusCode: Integer; function StatusCode: Integer;
function StatusText: string; function StatusText: string;
function ErrorMessage: string;
function Headers: TStrings; function Headers: TStrings;
function HeaderValue(const aName: string): string; function HeaderValue(const aName: string): string;
function Cookies: TCookies; function Cookies: TCookies;

17
sources/MVCFramework.RESTClient.pas
View File

@ -60,9 +60,10 @@ type
/// Provides access to delphi RESTClient library types without the need to use the REST.Types unit. /// Provides access to delphi RESTClient library types without the need to use the REST.Types unit.
/// </summary> /// </summary>
TRESTContentType = REST.Types.TRESTContentType; TRESTContentType = REST.Types.TRESTContentType;
TCookie = System.Net.HttpClient.TCookie; TCookie = System.Net.HttpClient.TCookie;
TCookies = System.Net.HttpClient.TCookies; TCookies = System.Net.HttpClient.TCookies;
THTTPSecureProtocol = System.Net.HttpClient.THTTPSecureProtocol;
THTTPSecureProtocols = System.Net.HttpClient.THTTPSecureProtocols;
/// <summary> /// <summary>
/// Encapsulates the methods of the delphi native RESTClient library. /// Encapsulates the methods of the delphi native RESTClient library.
@ -114,6 +115,9 @@ type
function ProxyPassword(const aProxyPassword: string): IMVCRESTClient; overload; function ProxyPassword(const aProxyPassword: string): IMVCRESTClient; overload;
function ProxyPassword: string; overload; function ProxyPassword: string; overload;
function SecureProtocols(const aSecureProtocols: THTTPSecureProtocols): IMVCRESTClient; overload;
function SecureProtocols: THTTPSecureProtocols; overload;
function UserAgent(const aUserAgent: string): IMVCRESTClient; overload; function UserAgent(const aUserAgent: string): IMVCRESTClient; overload;
function UserAgent: string; overload; function UserAgent: string; overload;
@ -1249,6 +1253,17 @@ begin
Result := fRESTRequest.URLAlreadyEncoded; Result := fRESTRequest.URLAlreadyEncoded;
end; end;
function TMVCRESTClient.SecureProtocols: THTTPSecureProtocols;
begin
Result := fRESTClient.SecureProtocols;
end;
function TMVCRESTClient.SecureProtocols(const aSecureProtocols: THTTPSecureProtocols): IMVCRESTClient;
begin
Result := Self;
fRESTClient.SecureProtocols := aSecureProtocols;
end;
function TMVCRESTClient.SerializeObject(aObject: TObject): string; function TMVCRESTClient.SerializeObject(aObject: TObject): string;
begin begin
if ObjectIsList(aObject) then if ObjectIsList(aObject) then