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

50
samples/CustomAuth/MainClientFormU.pas
View File

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

16
samples/CustomRoleAuth/MainClientFormU.dfm
View File

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

64
samples/CustomRoleAuth/MainClientFormU.pas
View File

@ -32,7 +32,7 @@ uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.AppEvnts,
MVCFramework.RESTClient,
MVCFramework.RESTClient, MVCFramework.RESTClient.Intf,
Vcl.ExtCtrls;
type
@ -71,10 +71,11 @@ type
procedure Button6Click(Sender: TObject);
procedure Button7Click(Sender: TObject);
private
FRESTClient: TRESTClient;
FRESTClient: IMVCRESTClient;
FLogoutUrl: string;
FLogoutMethod: string;
procedure FillMemo(Response: IRESTResponse);
FSessionId: string;
procedure FillMemo(Response: IMVCRESTResponse);
{ Private declarations }
public
{ Public declarations }
@ -87,13 +88,13 @@ implementation
uses
System.JSON,
MVCFramework.SystemJSONUtils;
MVCFramework.SystemJSONUtils, MVCFramework.Commons;
{$R *.dfm}
procedure TForm7.ApplicationEvents1Idle(Sender: TObject; var Done: Boolean);
begin
if FRESTClient.SessionID.IsEmpty then
if FSessionID.IsEmpty then
begin
btnLogInLogOut.Caption := 'LOGIN';
Panel1.Caption := 'Not Logged';
@ -103,7 +104,7 @@ begin
else
begin
btnLogInLogOut.Caption := 'LOGOUT';
Panel1.Caption := 'SessionID = ' + FRESTClient.SessionID;
Panel1.Caption := 'SessionID = ' + FSessionID;
edtUsername.Enabled := False;
edtPassword.Enabled := False;
end;
@ -113,7 +114,7 @@ end;
procedure TForm7.btnLogInLogOutClick(Sender: TObject);
var
lJObj: TJSONObject;
lRes: IRESTResponse;
lRes: IMVCRESTResponse;
begin
if btnLogInLogOut.Caption = 'LOGIN' then
begin
@ -121,11 +122,11 @@ begin
try
lJObj.AddPair('username', edtUsername.Text);
lJObj.AddPair('password', edtPassword.Text);
lRes := FRESTClient.doPOST('/system/users/logged', [],
lRes := FRESTClient.Post('/system/users/logged',
TSystemJSON.JSONValueToString(lJObj, False));
if lRes.HasError then
if not lRes.Success then
begin
ShowMessage(lRes.Error.ExceptionMessage);
ShowMessage(lRes.Content);
end;
FLogoutUrl := lRes.HeaderValue('X-LOGOUT-URL');
FLogoutMethod := lRes.HeaderValue('X-LOGOUT-METHOD');
@ -136,79 +137,82 @@ begin
else
begin
Assert(FLogoutMethod = 'DELETE');
lRes := FRESTClient.doDELETE(FLogoutUrl, []);
if lRes.HasError then
lRes := FRESTClient.Delete(FLogoutUrl);
if not lRes.Success then
begin
ShowMessage(lRes.Error.ExceptionMessage);
ShowMessage(lRes.Content);
end;
end;
FSessionId := lRes.CookieByName(TMVCConstants.SESSION_TOKEN_NAME).Value;
if FSessionId.Contains('invalid') then
FSessionId := '';
end;
procedure TForm7.Button1Click(Sender: TObject);
var
lRes: IRESTResponse;
lRes: IMVCRESTResponse;
begin
lRes := FRESTClient.doGET('/private/public/action', []);
lRes := FRESTClient.Get('/private/public/action');
FillMemo(lRes);
end;
procedure TForm7.Button2Click(Sender: TObject);
var
lRes: IRESTResponse;
lRes: IMVCRESTResponse;
begin
lRes := FRESTClient.doGET('/private/role1', []);
lRes := FRESTClient.Get('/private/role1');
FillMemo(lRes);
end;
procedure TForm7.Button3Click(Sender: TObject);
var
lRes: IRESTResponse;
lRes: IMVCRESTResponse;
begin
lRes := FRESTClient.doGET('/private/role2', []);
lRes := FRESTClient.Get('/private/role2');
FillMemo(lRes);
end;
procedure TForm7.Button4Click(Sender: TObject);
var
lRes: IRESTResponse;
lRes: IMVCRESTResponse;
begin
lRes := FRESTClient.doGET('/private/role1and2', []);
lRes := FRESTClient.Get('/private/role1and2');
FillMemo(lRes);
end;
procedure TForm7.Button5Click(Sender: TObject);
var
lRes: IRESTResponse;
lRes: IMVCRESTResponse;
begin
lRes := FRESTClient.doGET('/private/role/admin', []);
lRes := FRESTClient.Get('/private/role/admin');
FillMemo(lRes);
end;
procedure TForm7.Button6Click(Sender: TObject);
var
lRes: IRESTResponse;
lRes: IMVCRESTResponse;
begin
lRes := FRESTClient.doGET('/private/authenticatedOnly', []);
lRes := FRESTClient.Get('/private/authenticatedOnly');
FillMemo(lRes);
end;
procedure TForm7.Button7Click(Sender: TObject);
var
lRes: IRESTResponse;
lRes: IMVCRESTResponse;
begin
lRes := FRESTClient.doGET('/private/role1or2', []);
lRes := FRESTClient.Get('/private/role1or2');
FillMemo(lRes);
end;
procedure TForm7.FillMemo(Response: IRESTResponse);
procedure TForm7.FillMemo(Response: IMVCRESTResponse);
begin
Memo1.Lines.Add(Format('[%s] [%s] %s', [TimeToStr(Time),
Response.ResponseText, Response.BodyAsString]));
Response.StatusText, Response.Content]));
end;
procedure TForm7.FormCreate(Sender: TObject);
begin
FRESTClient := TRESTClient.Create('localhost', 8080);
FRESTClient := TMVCRESTClient.New.BaseURL('localhost', 8080);
end;
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.Style = []
OldCreateOrder = False
OnClose = FormClose
OnCreate = FormCreate
PixelsPerInch = 96
TextHeight = 13
@ -30,8 +29,7 @@ object MainForm: TMainForm
Height = 40
DataSource = dsrcArticles
Align = alRight
TabOrder = 0
ExplicitHeight = 31
TabOrder = 3
end
object btnOpen: TButton
AlignWithMargins = True
@ -41,9 +39,8 @@ object MainForm: TMainForm
Height = 40
Align = alLeft
Caption = 'Open'
TabOrder = 1
TabOrder = 0
OnClick = btnOpenClick
ExplicitHeight = 31
end
object btnRefreshRecord: TButton
AlignWithMargins = True
@ -55,7 +52,6 @@ object MainForm: TMainForm
Caption = 'Refresh Record'
TabOrder = 2
OnClick = btnRefreshRecordClick
ExplicitHeight = 35
end
object Button1: TButton
AlignWithMargins = True
@ -65,9 +61,8 @@ object MainForm: TMainForm
Height = 40
Align = alLeft
Caption = 'Close'
TabOrder = 3
TabOrder = 1
OnClick = btnCloseClick
ExplicitHeight = 31
end
object Panel2: TPanel
Left = 1
@ -77,7 +72,6 @@ object MainForm: TMainForm
Align = alBottom
BevelOuter = bvNone
TabOrder = 4
ExplicitTop = 48
object Label1: TLabel
Left = 3
Top = 11
@ -90,7 +84,7 @@ object MainForm: TMainForm
Top = 30
Width = 156
Height = 21
TabOrder = 0
TabOrder = 1
end
object btnFilter: TButton
Left = 165
@ -98,7 +92,7 @@ object MainForm: TMainForm
Width = 107
Height = 40
Caption = 'Filter'
TabOrder = 1
TabOrder = 0
OnClick = btnFilterClick
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.DApt.Intf, Data.DB, FireDAC.Comp.DataSet, FireDAC.Comp.Client,
Vcl.Grids, Vcl.DBGrids, Vcl.ExtCtrls, Vcl.StdCtrls, MVCFramework.RESTClient,
Vcl.DBCtrls;
Vcl.DBCtrls, MVCFramework.RESTClient.Intf;
type
TMainForm = class(TForm)
@ -31,7 +31,6 @@ type
procedure FormCreate(Sender: TObject);
procedure dsArticlesBeforePost(DataSet: TDataSet);
procedure dsArticlesBeforeDelete(DataSet: TDataSet);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure dsArticlesBeforeRefresh(DataSet: TDataSet);
procedure dsArticlesAfterOpen(DataSet: TDataSet);
procedure btnOpenClick(Sender: TObject);
@ -42,9 +41,9 @@ type
private
fFilter: string;
fLoading: Boolean;
fRESTClient: TRESTClient;
fRESTClient: IMVCRESTClient;
{ Private declarations }
procedure ShowError(const AResponse: IRESTResponse);
procedure ShowError(const AResponse: IMVCRESTResponse);
procedure SetFilter(const Value: string);
public
property Filter: string read fFilter write SetFilter;
@ -87,19 +86,19 @@ end;
procedure TMainForm.dsArticlesAfterOpen(DataSet: TDataSet);
var
Res: IRESTResponse;
Res: IMVCRESTResponse;
begin
if fFilter.IsEmpty then
begin
// this a simple sychronous request...
Res := fRESTClient.doGET('/articles', []);
Res := fRESTClient.Get('/articles');
end
else
begin
Res := fRESTClient.doGET('/articles/searches', [], ['q'], [fFilter]);
Res := fRESTClient.AddQueryStringParam('q', fFilter).Get('/articles/searches');
end;
if Res.HasError then
if not Res.Success then
begin
ShowError(Res);
Exit;
@ -108,7 +107,7 @@ begin
DataSet.DisableControls;
try
fLoading := true;
dsArticles.LoadJSONArrayFromJSONObjectProperty('data', Res.BodyAsString);
dsArticles.LoadJSONArrayFromJSONObjectProperty('data', Res.Content);
fLoading := false;
dsArticles.First;
finally
@ -118,11 +117,11 @@ end;
procedure TMainForm.dsArticlesBeforeDelete(DataSet: TDataSet);
var
Res: IRESTResponse;
Res: IMVCRESTResponse;
begin
if dsArticles.State = dsBrowse then
Res := fRESTClient.DataSetDelete('/articles', dsArticlesid.AsString);
if not(Res.ResponseCode in [200]) then
if not(Res.StatusCode in [200]) then
begin
ShowError(Res);
Abort;
@ -131,15 +130,15 @@ end;
procedure TMainForm.dsArticlesBeforePost(DataSet: TDataSet);
var
Res: IRESTResponse;
Res: IMVCRESTResponse;
begin
if not fLoading then
begin
if dsArticles.State = dsInsert then
Res := fRESTClient.DataSetInsert('/articles', dsArticles)
else
Res := fRESTClient.DataSetUpdate('/articles', dsArticles, dsArticlesid.AsString);
if not(Res.ResponseCode in [200, 201]) then
Res := fRESTClient.DataSetUpdate('/articles', dsArticlesid.AsString, dsArticles);
if not(Res.StatusCode in [200, 201]) then
begin
ShowError(Res);
Abort;
@ -159,22 +158,19 @@ end;
procedure TMainForm.dsArticlesBeforeRowRequest(DataSet: TFDDataSet);
var
Res: IRESTResponse;
Res: IMVCRESTResponse;
begin
Res := fRESTClient.doGET('/articles', [DataSet.FieldByName('id').AsString]);
Res := fRESTClient
.AddPathParam('Id', DataSet.FieldByName('id').AsString)
.Get('/articles/($Id)');
fLoading := true;
DataSet.LoadJSONObjectFromJSONObjectProperty('data', Res.BodyAsString);
DataSet.LoadJSONObjectFromJSONObjectProperty('data', Res.Content);
fLoading := false;
end;
procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
fRESTClient.Free;
end;
procedure TMainForm.FormCreate(Sender: TObject);
begin
fRESTClient := MVCFramework.RESTClient.TRESTClient.Create('localhost', 8080);
fRESTClient := TMVCRESTClient.New.BaseURL('localhost', 8080);
end;
procedure TMainForm.SetFilter(const Value: string);
@ -183,17 +179,17 @@ begin
EditFilter.Text := Value;
end;
procedure TMainForm.ShowError(const AResponse: IRESTResponse);
procedure TMainForm.ShowError(const AResponse: IMVCRESTResponse);
begin
if AResponse.HasError then
if not AResponse.Success then
MessageDlg(
AResponse.Error.HTTPError.ToString + ': ' + AResponse.Error.ExceptionMessage + sLineBreak +
'[' + AResponse.Error.ExceptionClassname + ']',
AResponse.StatusCode.ToString + ': ' + AResponse.StatusText + sLineBreak +
'[' + AResponse.Content + ']',
mtError, [mbOK], 0)
else
MessageDlg(
AResponse.ResponseCode.ToString + ': ' + AResponse.ResponseText + sLineBreak +
AResponse.BodyAsString,
AResponse.StatusCode.ToString + ': ' + AResponse.StatusText + sLineBreak +
AResponse.Content,
mtError, [mbOK], 0);
end;

10
samples/articles_crud_vcl_client_api_binder/MainFormU.dfm
View File

@ -30,7 +30,7 @@ object MainForm: TMainForm
Height = 40
DataSource = dsrcArticles
Align = alRight
TabOrder = 0
TabOrder = 3
end
object btnOpen: TButton
AlignWithMargins = True
@ -40,7 +40,7 @@ object MainForm: TMainForm
Height = 40
Align = alLeft
Caption = 'Open'
TabOrder = 1
TabOrder = 0
OnClick = btnOpenClick
end
object btnRefreshRecord: TButton
@ -62,7 +62,7 @@ object MainForm: TMainForm
Height = 40
Align = alLeft
Caption = 'Close'
TabOrder = 3
TabOrder = 1
OnClick = btnCloseClick
end
object Panel2: TPanel
@ -85,7 +85,7 @@ object MainForm: TMainForm
Top = 30
Width = 156
Height = 21
TabOrder = 0
TabOrder = 1
end
object btnFilter: TButton
Left = 165
@ -93,7 +93,7 @@ object MainForm: TMainForm
Width = 107
Height = 40
Caption = 'Filter'
TabOrder = 1
TabOrder = 0
OnClick = btnFilterClick
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,
FireDAC.Stan.Param, FireDAC.Stan.Error, FireDAC.DatS, FireDAC.Phys.Intf,
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;
type
@ -42,10 +42,10 @@ type
private
fFilter: string;
fLoading: Boolean;
fRESTClient: TRESTClient;
fRESTClient: IMVCRESTClient;
fAPIBinder: TMVCAPIBinder;
{ Private declarations }
procedure ShowError(const AResponse: IRESTResponse);
procedure ShowError(const AResponse: IMVCRESTResponse);
procedure SetFilter(const Value: string);
public
property Filter: string read fFilter write SetFilter;
@ -88,19 +88,19 @@ end;
procedure TMainForm.dsArticlesAfterOpen(DataSet: TDataSet);
var
Res: IRESTResponse;
Res: IMVCRESTResponse;
begin
if fFilter.IsEmpty then
begin
// this a simple sychronous request...
Res := fRESTClient.doGET('/articles', []);
Res := fRESTClient.Get('/articles');
end
else
begin
Res := fRESTClient.doGET('/articles/searches', [], ['q'], [fFilter]);
Res := fRESTClient.AddQueryStringParam('q', fFilter).Get('/articles/searches');
end;
if Res.HasError then
if not Res.Success then
begin
ShowError(Res);
Exit;
@ -109,7 +109,7 @@ begin
DataSet.DisableControls;
try
fLoading := true;
dsArticles.LoadJSONArrayFromJSONObjectProperty('data', Res.BodyAsString);
dsArticles.LoadJSONArrayFromJSONObjectProperty('data', Res.Content);
fLoading := false;
dsArticles.First;
finally
@ -119,11 +119,11 @@ end;
procedure TMainForm.dsArticlesBeforeDelete(DataSet: TDataSet);
var
Res: IRESTResponse;
Res: IMVCRESTResponse;
begin
if dsArticles.State = dsBrowse then
Res := fRESTClient.DataSetDelete('/articles', dsArticlesid.AsString);
if not(Res.ResponseCode in [200]) then
if not(Res.StatusCode in [200]) then
begin
ShowError(Res);
Abort;
@ -132,15 +132,15 @@ end;
procedure TMainForm.dsArticlesBeforePost(DataSet: TDataSet);
var
Res: IRESTResponse;
Res: IMVCRESTResponse;
begin
if not fLoading then
begin
if dsArticles.State = dsInsert then
Res := fRESTClient.DataSetInsert('/articles', dsArticles)
else
Res := fRESTClient.DataSetUpdate('/articles', dsArticles, dsArticlesid.AsString);
if not(Res.ResponseCode in [200, 201]) then
Res := fRESTClient.DataSetUpdate('/articles', dsArticlesid.AsString, dsArticles);
if not(Res.StatusCode in [200, 201]) then
begin
ShowError(Res);
Abort;
@ -160,23 +160,23 @@ end;
procedure TMainForm.dsArticlesBeforeRowRequest(DataSet: TFDDataSet);
var
Res: IRESTResponse;
Res: IMVCRESTResponse;
begin
Res := fRESTClient.doGET('/articles', [DataSet.FieldByName('id').AsString]);
Res := fRESTClient.AddPathParam('Id', DataSet.FieldByName('id').AsString).Get('/articles/($Id)');
fLoading := true;
DataSet.LoadJSONObjectFromJSONObjectProperty('data', Res.BodyAsString);
DataSet.LoadJSONObjectFromJSONObjectProperty('data', Res.Content);
fLoading := false;
end;
procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
fAPIBinder.Free;
fRESTClient.Free;
end;
procedure TMainForm.FormCreate(Sender: TObject);
begin
fRESTClient := MVCFramework.RESTClient.TRESTClient.Create('localhost', 8080);
ReportMemoryLeaksOnShutdown := True;
fRESTClient := TMVCRESTClient.New.BaseURL('localhost', 8080);
fAPIBinder := TMVCAPIBinder.Create(fRESTClient);
fAPIBinder.BindDataSetToAPI(dsArticles, '/articles', 'id');
end;
@ -187,18 +187,12 @@ begin
EditFilter.Text := Value;
end;
procedure TMainForm.ShowError(const AResponse: IRESTResponse);
procedure TMainForm.ShowError(const AResponse: IMVCRESTResponse);
begin
if AResponse.HasError then
MessageDlg(
AResponse.Error.HTTPError.ToString + ': ' + AResponse.Error.ExceptionMessage + sLineBreak +
'[' + AResponse.Error.ExceptionClassname + ']',
mtError, [mbOK], 0)
else
MessageDlg(
AResponse.ResponseCode.ToString + ': ' + AResponse.ResponseText + sLineBreak +
AResponse.BodyAsString,
mtError, [mbOK], 0);
MessageDlg(
AResponse.StatusCode.ToString + ': ' + AResponse.StatusText + sLineBreak +
'[' + AResponse.Content + ']',
mtError, [mbOK], 0)
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}
uses
MVCFramework.RESTClient;
MVCFramework.RESTClient,
MVCFramework.RESTClient.Intf;
procedure TForm5.btnGetClick(Sender: TObject);
var
lClient: TRESTClient;
lRest: IRESTResponse;
lClient: IMVCRESTClient;
lRest: IMVCRESTResponse;
begin
lClient := TRESTClient.Create('localhost', 8080);
try
lClient.Authentication('user1', 'user1');
lRest := lClient.doGET('/admin/role1?par1=daniele', []);
ShowMessage(lRest.BodyAsString);
finally
lClient.Free;
end;
lClient := TMVCRESTClient.New.BaseURL('localhost', 8080);
lClient.SetBasicAuthorization('user1', 'user1');
lRest := lClient.Get('/admin/role1?par1=daniele');
ShowMessage(lRest.Content);
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
uses
MVCFramework.RESTClient;
MVCFramework.RESTClient,
MVCFramework.RESTClient.Intf;
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
var
Clt: TRestClient;
Clt: IMVCRESTClient;
begin
Clt := MVCFramework.RESTClient.TRestClient.Create('http://localhost', 8080, nil);
try
// Clt.ProxyServer := 'localhost';
// Clt.ProxyPort := 8888;
ShowMessage(Clt.doGET('/div/10/20', []).BodyAsString);
finally
Clt.Free;
end;
Clt := TMVCRESTClient.New.BaseURL('http://localhost', 8080);
ShowMessage(Clt.Get('/div/10/20').Content);
end;
procedure TForm1.Button2Click(Sender: TObject);
var
Clt: TRestClient;
Clt: IMVCRESTClient;
begin
Clt := MVCFramework.RESTClient.TRestClient.Create('http://localhost', 8080, nil);
try
ShowMessage(Clt.doPOST('/hello', [], '{"name":"Bob äöüß"}').BodyAsString);
finally
Clt.Free;
end;
Clt := TMVCRESTClient.New.BaseURL('http://localhost', 8080);
ShowMessage(Clt.Post('/hello', '{"name":"Bob äöüß"}').Content);
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
Align = alLeft
Caption = 'Get a protected resource'
TabOrder = 1
TabOrder = 2
OnClick = btnGetClick
end
object btnLOGIN: TButton
@ -102,7 +102,7 @@ object Form5: TForm5
Height = 41
Align = alRight
Caption = 'Custom Exception in OnAuthenticate'
TabOrder = 2
TabOrder = 3
WordWrap = True
OnClick = btnLoginWithExceptionClick
end
@ -114,7 +114,7 @@ object Form5: TForm5
Height = 41
Align = alLeft
Caption = 'Login (mode 2)'
TabOrder = 3
TabOrder = 1
OnClick = btnLoginJsonObjectClick
end
end

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

@ -50,156 +50,125 @@ implementation
uses
MVCFramework.RESTClient,
MVCFramework.RESTClient.Intf,
MVCFramework.SystemJSONUtils,
System.JSON;
procedure TForm5.btnGetClick(Sender: TObject);
var
lClient: TRESTClient;
lResp: IRESTResponse;
lQueryStringParams: TStringList;
lClient: IMVCRESTClient;
lResp: IMVCRESTResponse;
begin
{ Getting JSON response }
lClient := TRESTClient.Create('localhost', 8080);
try
lClient.UseBasicAuthentication := False;
lClient.ReadTimeOut(0);
if not FJWT.IsEmpty then
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;
lClient := TMVCRESTClient.New.BaseURL('localhost', 8080);
lClient.ReadTimeOut(0);
if not FJWT.IsEmpty then
begin
lClient.SetBearerAuthorization(FJWT);
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 }
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);
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;
if not FJWT.IsEmpty then
begin
lClient.SetBearerAuthorization(FJWT);
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;
procedure TForm5.btnLOGINClick(Sender: TObject);
var
lClient: TRESTClient;
lRest: IRESTResponse;
lClient: IMVCRESTClient;
lRest: IMVCRESTResponse;
lJSON: TJSONObject;
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
lClient.ReadTimeOut(0);
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;
JWT := lJSON.GetValue('token').Value;
finally
lClient.Free;
lJSON.Free;
end;
end;
procedure TForm5.btnLoginJsonObjectClick(Sender: TObject);
var
lClient: TRESTClient;
lRest: IRESTResponse;
lClient: IMVCRESTClient;
lRest: IMVCRESTResponse;
lJSON: TJSONObject;
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
lClient.ReadTimeOut(0);
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;
JWT := lJSON.GetValue('token').Value;
finally
lClient.Free;
lJSON.Free;
end;
end;
procedure TForm5.btnLoginWithExceptionClick(Sender: TObject);
var
lClient: TRESTClient;
lRest: IRESTResponse;
lClient: IMVCRESTClient;
lRest: IMVCRESTResponse;
lJSON: TJSONObject;
begin
lClient := TRESTClient.Create('localhost', 8080);
try
lClient.ReadTimeOut(0);
lClient.Authentication('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;
lClient := TMVCRESTClient.New
.BaseURL('localhost', 8080)
.ReadTimeOut(0)
.SetBasicAuthorization('user_raise_exception', 'user_raise_exception');
lJSON := TSystemJSON.StringAsJSONObject(lRest.BodyAsString);
try
JWT := lJSON.GetValue('token').Value;
finally
lJSON.Free;
end;
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
JWT := lJSON.GetValue('token').Value;
finally
lClient.Free;
lJSON.Free;
end;
end;

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

@ -40,6 +40,7 @@ implementation
uses
MVCFramework.RESTClient,
MVCFramework.RESTClient.Intf,
MVCFramework.Middleware.JWT,
MVCFramework.Commons,
MVCFramework.SystemJSONUtils,
@ -48,110 +49,96 @@ uses
procedure TMainForm.btnGetClick(Sender: TObject);
var
lClient: TRESTClient;
lResp: IRESTResponse;
lQueryStringParams: TStringList;
lClient: IMVCRESTClient;
lResp: IMVCRESTResponse;
tokenOld, tokenNew: string; // NEW CODE
begin
tokenOld := FJWT; // NEW CODE
lClient := TRESTClient.Create('localhost', 8080);
try
lClient.ReadTimeOut(0);
if not FJWT.IsEmpty then
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.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;
lClient := TMVCRESTClient.New
.BaseURL('localhost', 8080)
.ReadTimeOut(0);
if not FJWT.IsEmpty then
begin
lClient.SetBearerAuthorization(FJWT);
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;
procedure TMainForm.btnLOGINClick(Sender: TObject);
var
lClient: TRESTClient;
lRest: IRESTResponse;
lClient: IMVCRESTClient;
lRest: IMVCRESTResponse;
lJSON: TJSONObject;
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
lClient.ReadTimeOut(0);
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;
JWT := lJSON.S['token'];
finally
lClient.Free;
lJSON.Free;
end;
end;
procedure TMainForm.btnLoginWithHeaderBasicClick(Sender: TObject);
var
lClient: TRESTClient;
lRest: IRESTResponse;
lClient: IMVCRESTClient;
lRest: IMVCRESTResponse;
lJSON: TJSONObject;
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
lClient.ReadTimeOut(0);
lClient.Authentication('user1', 'user1');
lRest := lClient.doPOST('/login', []);
lJSON := StrToJSONObject(lRest.BodyAsString);
try
JWT := lJSON.S['token'];
finally
lJSON.Free;
end;
JWT := lJSON.S['token'];
finally
lClient.Free;
lJSON.Free;
end;
end;
procedure TMainForm.Button1Click(Sender: TObject);
var
lClient: TRESTClient;
lRest: IRESTResponse;
lClient: IMVCRESTClient;
lRest: IMVCRESTResponse;
lJSON: TJSONObject;
begin
lClient := TRESTClient.Create('localhost', 8080);
try
lClient.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;
lClient := TMVCRESTClient.New
.BaseURL('localhost', 8080)
.ReadTimeOut(0);
lRest := lClient.Post('/login', '{"jwtusername":"user1","jwtpassword":"user1"}');
lJSON := StrToJSONObject(lRest.Content);
try
JWT := lJSON.S['token'];
finally
lJSON.Free;
end;
end;
procedure TMainForm.SetJWT(const Value: string);

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

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

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

@ -51,155 +51,126 @@ implementation
uses
MVCFramework.RESTClient,
MVCFramework.SystemJSONUtils,
System.JSON;
System.JSON,
MVCFramework.RESTClient.Intf;
procedure TForm5.btnGetClick(Sender: TObject);
var
lClient: TRESTClient;
lResp: IRESTResponse;
lQueryStringParams: TStringList;
lClient: IMVCRESTClient;
lResp: IMVCRESTResponse;
begin
{ Getting JSON response }
lClient := TRESTClient.Create('localhost', 8080);
try
lClient.UseBasicAuthentication := False;
lClient.ReadTimeOut(0);
if not FJWT.IsEmpty then
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;
lClient := TMVCRESTClient.New
.BaseURL('localhost', 8080)
.ReadTimeOut(0);
if not FJWT.IsEmpty then
begin
lClient.SetBearerAuthorization(FJWT);
end;
lResp := lClient
.AddQueryStringParam('firstname', 'Daniele')
.AddQueryStringParam('lastname', 'Teti')
.Get('/admin/role1');
if not lResp.Success then
ShowMessage(lResp.Content);
{ Getting HTML response }
lClient := TRESTClient.Create('localhost', 8080);
try
// when the JWT authorization header is named "Authorization", the basic authorization must be disabled
lClient.UseBasicAuthentication := False;
Memo2.Lines.Text := lResp.Content;
lClient.ReadTimeOut(0);
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;
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;
procedure TForm5.btnLOGINClick(Sender: TObject);
var
lClient: TRESTClient;
lRest: IRESTResponse;
lClient: IMVCRESTClient;
lRest: IMVCRESTResponse;
lJSON: TJSONObject;
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
lClient.ReadTimeOut(0);
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;
JWT := lJSON.GetValue('token').Value;
finally
lClient.Free;
lJSON.Free;
end;
end;
procedure TForm5.btnLoginJsonObjectClick(Sender: TObject);
var
lClient: TRESTClient;
lRest: IRESTResponse;
lClient: IMVCRESTClient;
lRest: IMVCRESTResponse;
lJSON: TJSONObject;
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
lClient.ReadTimeOut(0);
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;
JWT := lJSON.GetValue('token').Value;
finally
lClient.Free;
lJSON.Free;
end;
end;
procedure TForm5.btnLoginWithExceptionClick(Sender: TObject);
var
lClient: TRESTClient;
lRest: IRESTResponse;
lClient: IMVCRESTClient;
lRest: IMVCRESTResponse;
lJSON: TJSONObject;
begin
lClient := TRESTClient.Create('localhost', 8080);
try
lClient.ReadTimeOut(0);
lClient.Authentication('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;
lClient := TMVCRESTClient.New
.BaseURL('localhost', 8080)
.ReadTimeOut(0)
.SetBasicAuthorization('user_raise_exception', 'user_raise_exception');
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);
lJSON := TSystemJSON.StringAsJSONObject(lRest.BodyAsString);
try
JWT := lJSON.GetValue('token').Value;
finally
lJSON.Free;
end;
Exit;
end;
lJSON := TSystemJSON.StringAsJSONObject(lRest.Content);
try
JWT := lJSON.GetValue('token').Value;
finally
lClient.Free;
lJSON.Free;
end;
end;

6
samples/jsonwebtokenplain/MainClientFormU.dfm
View File

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

40
samples/jsonwebtokenplain/MainClientFormU.pas
View File

@ -35,42 +35,32 @@ var
implementation
uses
mvcframework.restclient;
MVCFramework.RESTClient,
MVCFramework.RESTClient.Intf;
{$R *.dfm}
procedure TForm7.Button1Click(Sender: TObject);
var
lClt: TRESTClient;
lResp: IRESTResponse;
lResp: IMVCRESTResponse;
begin
lClt := TRESTClient.Create('localhost', 8080);
try
lResp := lClt.doPOST('/login', [], '');
Token := lResp.BodyAsString;
finally
lClt.Free;
end;
ShowMessage
('In the next 15 seconds you can request protected resources. After your token will expires!');
lResp := TMVCRESTClient.New
.BaseURL('localhost', 8080)
.Post('/login');
Token := lResp.Content;
ShowMessage('In the next 15 seconds you can request protected resources. After your token will expires!');
end;
procedure TForm7.Button2Click(Sender: TObject);
var
lClt: TRESTClient;
lResp: IRESTResponse;
lResp: IMVCRESTResponse;
begin
lClt := TRESTClient.Create('localhost', 8080);
try
lClt.Header('Authentication', 'bearer ' + FToken);
lResp := lClt.doGET('/', []);
ShowMessage(lResp.ResponseText + sLineBreak +
lResp.BodyAsString);
finally
lClt.Free;
end;
lResp := TMVCRESTClient.New
.BaseURL('localhost', 8080)
.AddHeader('Authentication', 'bearer ' + FToken, True)
.Get('/');
ShowMessage(lResp.StatusText + sLineBreak +
lResp.Content);
end;
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.Style = []
OldCreateOrder = False
OnClose = FormClose
OnCreate = FormCreate
DesignSize = (
538
@ -47,7 +46,7 @@ object Form9: TForm9
Lines.Strings = (
'Memo1')
ParentFont = False
TabOrder = 1
TabOrder = 2
end
object Button2: TButton
Left = 111
@ -61,16 +60,15 @@ object Form9: TForm9
Font.Name = 'Tahoma'
Font.Style = []
ParentFont = False
TabOrder = 2
TabOrder = 1
OnClick = Button2Click
end
object RESTClient1: TRESTClient
Accept = 'application/json, text/plain; q=0.9, text/html;q=0.8,'
AcceptCharset = 'UTF-8, *;q=0.8'
AcceptEncoding = 'identity'
BaseURL = 'https://localhost/'
BaseURL = 'https://localhost'
Params = <>
HandleRedirects = True
Left = 32
Top = 56
end

28
samples/sslclient/MainFormU.pas
View File

@ -15,6 +15,7 @@ uses
IPPeerClient,
Vcl.StdCtrls,
MVCFramework.RESTClient,
MVCFramework.RESTClient.Intf,
REST.Client,
Data.Bind.Components,
Data.Bind.ObjectScope,
@ -27,7 +28,8 @@ uses
IdComponent,
IdTCPConnection,
IdTCPClient,
IdHTTP;
IdHTTP,
REST.Types;
type
TForm9 = class(TForm)
@ -40,9 +42,8 @@ type
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
Clt: MVCFramework.RESTClient.TRESTClient;
Clt: IMVCRESTClient;
{ Private declarations }
public
{ Public declarations }
@ -66,29 +67,24 @@ end;
procedure TForm9.Button2Click(Sender: TObject);
begin
Clt.Asynch(
procedure(Resp: IRESTResponse)
Clt.Async(
procedure(Resp: IMVCRESTResponse)
begin
Memo1.Lines.Text := Resp.BodyAsString;
Memo1.Lines.Text := Resp.Content;
Memo1.Lines.Add('Request Terminated');
end,
procedure(E: Exception)
begin
ShowMessage(E.Message);
end,
procedure
begin
Memo1.Lines.Add('Request Terminated');
end, true).doGET('/people', []);
end;
procedure TForm9.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Clt.Free;
True
)
.Get('/people');
end;
procedure TForm9.FormCreate(Sender: TObject);
begin
Clt := MVCFramework.RESTClient.TRESTClient.Create('https://localhost', 443, IdSSLIOHandlerSocketOpenSSL1);
Clt := TMVCRESTClient.New.BaseURL('https://localhost', 443);
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.Style = []
OldCreateOrder = False
OnClose = FormClose
OnCreate = FormCreate
DesignSize = (
758
@ -35,7 +34,7 @@ object Form5: TForm5
Height = 370
ActivePage = TabSheet1
Anchors = [akLeft, akTop, akRight, akBottom]
TabOrder = 1
TabOrder = 2
object TabSheet1: TTabSheet
Caption = 'Wines'
object DBGrid1: TDBGrid
@ -232,7 +231,7 @@ object Form5: TForm5
Width = 320
Height = 33
DataSource = DataSource1
TabOrder = 2
TabOrder = 1
end
object FDMemTable1: TFDMemTable
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,
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,
MVCFramework.RESTClient;
MVCFramework.RESTClient, MVCFramework.RESTClient.Intf;
type
TForm5 = class(TForm)
@ -45,11 +45,10 @@ type
procedure DBGrid1DblClick(Sender: TObject);
procedure FDMemTable1BeforePost(DataSet: TDataSet);
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FDMemTable1BeforeDelete(DataSet: TDataSet);
private
RESTClient: TRESTClient;
RESTClient: IMVCRESTClient;
Loading: Boolean;
{ Private declarations }
public
@ -69,14 +68,14 @@ uses
procedure TForm5.Button1Click(Sender: TObject);
var
response: IRESTResponse;
response: IMVCRESTResponse;
begin
response := RESTClient.doGET('/api/wines', []);
Memo1.Lines.Text := response.BodyAsString;
response := RESTClient.Get('/api/wines');
Memo1.Lines.Text := response.Content;
FDMemTable1.Close;
FDMemTable1.Open;
Loading := True;
FDMemTable1.AppendFromJSONArrayString(response.BodyAsString);
FDMemTable1.AppendFromJSONArrayString(response.Content);
FDMemTable1.First;
Loading := False;
end;
@ -88,37 +87,32 @@ end;
procedure TForm5.FDMemTable1BeforeDelete(DataSet: TDataSet);
var
Resp: IRESTResponse;
Resp: IMVCRESTResponse;
begin
Resp := RESTClient.DataSetDelete('/api/wines', FDMemTable1id.AsString);
if not Resp.ResponseCode in [200] then
raise Exception.Create(Resp.ResponseText);
if not Resp.StatusCode in [200] then
raise Exception.Create(Resp.StatusText);
end;
procedure TForm5.FDMemTable1BeforePost(DataSet: TDataSet);
var
Resp: IRESTResponse;
Resp: IMVCRESTResponse;
begin
if Loading then
Exit;
case FDMemTable1.State of
dsEdit:
Resp := RESTClient.DataSetUpdate('/api/wines', FDMemTable1, FDMemTable1id.AsString);
Resp := RESTClient.DataSetUpdate('/api/wines', FDMemTable1id.AsString, FDMemTable1);
dsInsert:
Resp := RESTClient.DataSetInsert('/api/wines', FDMemTable1);
end;
if not Resp.ResponseCode in [200, 201] then
raise Exception.Create(Resp.ResponseText);
end;
procedure TForm5.FormClose(Sender: TObject; var Action: TCloseAction);
begin
RESTClient.free;
if not Resp.StatusCode in [200, 201] then
raise Exception.Create(Resp.StatusText);
end;
procedure TForm5.FormCreate(Sender: TObject);
begin
RESTClient := TRESTClient.Create('localhost', 3000);
RESTClient := TMVCRESTClient.New.BaseURL('localhost', 3000);
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;
fDataSet: TDataSet;
fURI: string;
fPrimaryKeyNAme: string;
fPrimaryKeyName: string;
fLoading: boolean;
procedure ShowError(const AResponse: IMVCRESTResponse);
public
@ -620,7 +620,7 @@ begin
fRESTClient := aRESTClient;
fDataSet := ADataSet;
fURI := aURI;
fPrimaryKeyNAme := aPrimaryKeyName;
fPrimaryKeyName := aPrimaryKeyName;
// procedure HookBeforePost(DataSet: TDataSet);
// procedure HookBeforeDelete(DataSet: TDataSet);
@ -673,7 +673,7 @@ var
Res: IMVCRESTResponse;
begin
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
begin
ShowError(Res);
@ -694,7 +694,7 @@ begin
end
else
begin
lLastID := fDataSet.FieldByName(fPrimaryKeyNAme).AsInteger;
lLastID := fDataSet.FieldByName(fPrimaryKeyName).AsInteger;
lRes := fRESTClient.DataSetUpdate(fURI, lLastID.ToString, DataSet);
end;
if not(lRes.StatusCode in [200, 201]) then
@ -721,8 +721,7 @@ end;
procedure TMVCAPIBinder.TMVCAPIBinderItem.ShowError(const AResponse: IMVCRESTResponse);
begin
if not AResponse.Success then
raise EMVCException.Create(AResponse.StatusCode, AResponse.ErrorMessage + sLineBreak +
AResponse.Content)
raise EMVCException.Create(AResponse.StatusCode, AResponse.StatusText + sLineBreak + AResponse.Content)
else
raise EMVCException.Create(AResponse.Content);
end;

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

@ -63,6 +63,9 @@ type
function ProxyPassword(const aProxyPassword: string): IMVCRESTClient; 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: string; overload;
@ -320,7 +323,6 @@ type
function Success: Boolean;
function StatusCode: Integer;
function StatusText: string;
function ErrorMessage: string;
function Headers: TStrings;
function HeaderValue(const aName: string): string;
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.
/// </summary>
TRESTContentType = REST.Types.TRESTContentType;
TCookie = System.Net.HttpClient.TCookie;
TCookies = System.Net.HttpClient.TCookies;
THTTPSecureProtocol = System.Net.HttpClient.THTTPSecureProtocol;
THTTPSecureProtocols = System.Net.HttpClient.THTTPSecureProtocols;
/// <summary>
/// Encapsulates the methods of the delphi native RESTClient library.
@ -114,6 +115,9 @@ type
function ProxyPassword(const aProxyPassword: string): IMVCRESTClient; 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: string; overload;
@ -1249,6 +1253,17 @@ begin
Result := fRESTRequest.URLAlreadyEncoded;
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;
begin
if ObjectIsList(aObject) then