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

ADDED cookies support to the rest client

Browse Source 
ADDED demo for cookies utilization
REFACTORED some samples
This commit is contained in:
danieleteti 2016-04-24 19:08:21 +02:00
parent 8d0e9dec45
commit d11111aa41
10 changed files with 463 additions and 248 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

58
samples/serversideviewsprimer/DAL.pas
View File

@ -27,24 +27,33 @@ type
implementation
uses
System.IOUtils, System.SysUtils;
System.IOUtils, System.SysUtils, System.SyncObjs;
{ TSimpleDAL }
var
// Hey! The storage is a simple json file, so some synchronization is needed
_CS: TCriticalSection = nil;
{ TSimpleDAL }
procedure TPeopleDAL.AddPerson(FirstName, LastName: String; Age: Integer);
var
LJPeople: TJSONArray;
LJPerson: TJSONObject;
begin
LJPeople := GetPeople;
_CS.Enter;
try
LJPerson := TJSONObject.Create;
LJPeople.AddElement(LJPerson);
LJPerson.AddPair('first_name', FirstName).AddPair('last_name', LastName)
.AddPair('age', TJSONNumber.Create(Age));
TFile.WriteAllText(DATAFILE, LJPeople.ToJSON);
LJPeople := GetPeople;
try
LJPerson := TJSONObject.Create;
LJPeople.AddElement(LJPerson);
LJPerson.AddPair('first_name', FirstName).AddPair('last_name', LastName)
.AddPair('age', TJSONNumber.Create(Age));
TFile.WriteAllText(DATAFILE, LJPeople.ToJSON);
finally
LJPeople.Free;
end;
finally
LJPeople.Free;
_CS.Leave;
end;
end;
@ -57,16 +66,29 @@ function TPeopleDAL.GetPeople: TJSONArray;
var
LData: string;
begin
if TFile.Exists(DATAFILE) then
LData := TFile.ReadAllText(DATAFILE).Trim;
if not LData.IsEmpty then
begin
Result := TJSONObject.ParseJSONValue(LData) as TJSONArray;
end
else
begin
Result := TJSONArray.Create;
_CS.Enter;
try
if TFile.Exists(DATAFILE) then
LData := TFile.ReadAllText(DATAFILE).Trim;
if not LData.IsEmpty then
begin
Result := TJSONObject.ParseJSONValue(LData) as TJSONArray;
end
else
begin
Result := TJSONArray.Create;
end;
finally
_CS.Leave;
end;
end;
initialization
_CS := TCriticalSection.Create;
finalization
_CS.Free;
end.

13
samples/serversideviewsprimer/ServerSideViewsPrimer.dpr
View File

@ -3,11 +3,12 @@ program ServerSideViewsPrimer;
uses
System.SysUtils,
Winapi.ShellAPI,
Winapi.Windows,
IdHTTPWebBrokerBridge,
Web.WebReq,
Web.WebBroker,
WebModuleU in 'WebModuleU.pas' {WebModule1: TWebModule},
WebModuleU in 'WebModuleU.pas' {WebModule1: TWebModule} ,
WebSiteControllerU in 'WebSiteControllerU.pas',
DAL in 'DAL.pas';
@ -27,13 +28,14 @@ begin
LServer.DefaultPort := APort;
LServer.Active := True;
Writeln('Press ESC to stop the server');
ShellExecute(0, 'open', 'http://localhost:8080', nil, nil, SW_SHOW);
LHandle := GetStdHandle(STD_INPUT_HANDLE);
while True do
begin
ReadConsoleInput(LHandle, LInputRecord, 1, LEvent);
if (LInputRecord.EventType = KEY_EVENT) and
LInputRecord.Event.KeyEvent.bKeyDown and
(LInputRecord.Event.KeyEvent.wVirtualKeyCode = VK_ESCAPE) then
LInputRecord.Event.KeyEvent.bKeyDown and
(LInputRecord.Event.KeyEvent.wVirtualKeyCode = VK_ESCAPE) then
break;
end;
finally
@ -43,11 +45,12 @@ end;
begin
try
if WebRequestHandler <> nil then
WebRequestHandler.WebModuleClass := WebModuleClass;
if WebRequestHandler <> nil then
WebRequestHandler.WebModuleClass := WebModuleClass;
RunServer(8080);
except
on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
end
end.

46
samples/serversideviewsprimer/ServerSideViewsPrimer.dproj
View File

@ -88,7 +88,6 @@
</DelphiCompile>
<DCCReference Include="WebModuleU.pas">
<Form>WebModule1</Form>
<FormType>dfm</FormType>
<DesignClass>TWebModule</DesignClass>
</DCCReference>
<DCCReference Include="WebSiteControllerU.pas"/>
@ -119,14 +118,23 @@
<Excluded_Packages Name="$(BDSBIN)\dcloffice2k230.bpl">Microsoft Office 2000 Sample Automation Server Wrapper Components</Excluded_Packages>
</Excluded_Packages>
</Delphi.Personality>
<Deployment Version="2">
<Deployment Version="3">
<DeployFile LocalName="Win32\Debug\ServerSideViewsPrimer.exe" Configuration="Debug" Class="ProjectOutput">
<Platform Name="Win32">
<RemoteName>ServerSideViewsPrimer.exe</RemoteName>
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployClass Name="ProjectiOSDeviceResourceRules"/>
<DeployClass Name="DependencyModule">
<Platform Name="Win32">
<Operation>0</Operation>
<Extensions>.dll;.bpl</Extensions>
</Platform>
<Platform Name="OSX32">
<Operation>1</Operation>
<Extensions>.dylib</Extensions>
</Platform>
</DeployClass>
<DeployClass Name="ProjectOSXResource">
<Platform Name="OSX32">
<RemoteDir>Contents\Resources</RemoteDir>
@ -172,16 +180,19 @@
</Platform>
</DeployClass>
<DeployClass Required="true" Name="ProjectOutput">
<Platform Name="Win32">
<Operation>0</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="OSX32">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice32">
<Platform Name="Win32">
<Operation>0</Operation>
</Platform>
<Platform Name="Linux64">
<Operation>1</Operation>
</Platform>
<Platform Name="OSX32">
<Operation>1</Operation>
</Platform>
<Platform Name="Android">
@ -233,12 +244,7 @@
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="AndroidLibnativeX86File">
<Platform Name="Android">
<RemoteDir>library\lib\x86</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="AndroidLibnativeX86File"/>
<DeployClass Name="iPhone_Launch320">
<Platform Name="iOSSimulator">
<Operation>1</Operation>
@ -440,20 +446,12 @@
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="DependencyModule">
<Platform Name="Win32">
<Operation>0</Operation>
<Extensions>.dll;.bpl</Extensions>
</Platform>
<Platform Name="OSX32">
<Operation>1</Operation>
<Extensions>.dylib</Extensions>
</Platform>
</DeployClass>
<DeployClass Name="ProjectiOSDeviceResourceRules"/>
<ProjectRoot Platform="iOSDevice64" Name="$(PROJECTNAME).app"/>
<ProjectRoot Platform="Win64" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="iOSDevice32" Name="$(PROJECTNAME).app"/>
<ProjectRoot Platform="Win32" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="Linux64" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="OSX32" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="Android" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="iOSSimulator" Name="$(PROJECTNAME).app"/>

37
samples/serversideviewsprimer/WebModuleU.pas
View File

@ -20,25 +20,48 @@ var
implementation
{%CLASSGROUP 'Vcl.Controls.TControl'}
{ %CLASSGROUP 'Vcl.Controls.TControl' }
uses WebSiteControllerU;
uses WebSiteControllerU, MVCFramework.Commons;
{$R *.dfm}
procedure TWebModule1.WebModule1DefaultHandlerAction(Sender: TObject;
Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
begin
Response.Content :=
'<html>' +
Response.Content := '<html>' +
'<head><title>Web Server Application</title></head>' +
'<body>Web Server Application</body>' +
'</html>';
'<body>Web Server Application</body>' + '</html>';
end;
procedure TWebModule1.WebModuleCreate(Sender: TObject);
begin
TMVCEngine.Create(Self).AddController(TWebSiteController);
TMVCEngine.Create(Self,
procedure(Config: TMVCConfig)
begin
// enable static files
Config[TMVCConfigKey.DocumentRoot] :=
ExtractFilePath(GetModuleName(HInstance)) + '\www';
// session timeout (0 means session cookie)
Config[TMVCConfigKey.SessionTimeout] := '0';
// default content-type
Config[TMVCConfigKey.DefaultContentType] :=
TMVCConstants.DEFAULT_CONTENT_TYPE;
// default content charset
Config[TMVCConfigKey.DefaultContentCharset] :=
TMVCConstants.DEFAULT_CONTENT_CHARSET;
// unhandled actions are permitted?
Config[TMVCConfigKey.AllowUnhandledAction] := 'false';
// default view file extension
Config[TMVCConfigKey.DefaultViewFileExtension] := 'html';
// view path
Config[TMVCConfigKey.ViewPath] := 'templates';
// Enable STOMP messaging controller
Config[TMVCConfigKey.Messaging] := 'false';
// Enable Server Signature in response
Config[TMVCConfigKey.ExposeServerSignature] := 'true';
end).AddController(TWebSiteController);
end;
end.

14
samples/serversideviewsprimer/WebSiteControllerU.pas
View File

@ -36,7 +36,7 @@ implementation
{ TWebSiteController }
uses DAL, System.SysUtils, MVCFramework.Commons;
uses DAL, System.SysUtils, MVCFramework.Commons, Web.HTTPApp;
function TWebSiteController.GetSpeed: TJSONString;
begin
@ -67,11 +67,20 @@ end;
procedure TWebSiteController.PeopleList(CTX: TWebContext);
var
LDAL: IPeopleDAL;
lCookie: TCookie;
begin
LDAL := TServicesFactory.GetPeopleDAL;
PushJSONToView('people', LDAL.GetPeople);
PushJSONToView('speed', GetSpeed);
LoadView(['header', 'people_list', 'footer']);
// send a cookie with the server datetime at the page rendering
lCookie := CTX.Response.Cookies.Add;
lCookie.Name := 'lastresponse';
lCookie.Value := DateTimeToStr(now);
lCookie.Expires := 0; // session cookie
// END cookie sending
Render; // rember to call render!!!
end;
@ -88,13 +97,14 @@ begin
if LFirstName.IsEmpty or LLastName.IsEmpty or LAge.IsEmpty then
begin
{ TODO -oDaniele -cGeneral : Show how to propertly render an exception }
{ TODO -oDaniele -cGeneral : Show how to properly render an exception }
raise EMVCException.Create('Invalid data',
'First name, last name and age are not optional', 0);
end;
LPeopleDAL := TServicesFactory.GetPeopleDAL;
LPeopleDAL.AddPerson(LFirstName, LLastName, LAge.ToInteger());
Redirect('/people');
end;

7
samples/serversideviewsprimer/bin/templates/footer.html
View File

@ -11,10 +11,13 @@
</div>
<div class="row_fluid">
<div class="col-sm-8 bg-primary">
<div class="col-sm-4 bg-primary">
<span>Powered by DMVCFramework</span>
</div>
<div class="col-sm-4 bg-info">
<div class="col-sm-4 bg-success">
<span id="lastresponsefromcookie">...</span>
</div>
<div class="col-sm-4 bg-primary">
<span>Page generated in {{speed}}ms</span>
</div>
</div>

21
samples/serversideviewsprimer/bin/templates/header.html
View File

@ -7,7 +7,26 @@
padding: 20px 50px 20px 50px;
}
</style>
<script>
function getCookie(cname) {
var name = cname + "=";
var ca = document.cookie.split(';');
for(var i = 0; i <ca.length; i++) {
var c = ca[i];
while (c.charAt(0)==' ') {
c = c.substring(1);
}
if (c.indexOf(name) == 0) {
return c.substring(name.length,c.length);
}
}
return "";
}
function onWindowLoad(){
document.getElementById('lastresponsefromcookie').innerHTML = 'Last Response: ' + decodeURIComponent(getCookie('lastresponse'));
}
</script>
</header>
<body>
<body onload="onWindowLoad()">
<h1>Server Side Views Primer <small>DMVCFramework</small></h1>
<div id="main" class="container">

469
sources/MVCFramework.RESTClient.pas
View File

@ -1,26 +1,26 @@
{***************************************************************************}
{ }
{ Delphi MVC Framework }
{ }
{ Copyright (c) 2010-2015 Daniele Teti and the DMVCFramework Team }
{ }
{ https://github.com/danieleteti/delphimvcframework }
{ }
{***************************************************************************}
{ }
{ Licensed under the Apache License, Version 2.0 (the "License"); }
{ you may not use this file except in compliance with the License. }
{ You may obtain a copy of the License at }
{ }
{ http://www.apache.org/licenses/LICENSE-2.0 }
{ }
{ Unless required by applicable law or agreed to in writing, software }
{ distributed under the License is distributed on an "AS IS" BASIS, }
{ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. }
{ See the License for the specific language governing permissions and }
{ limitations under the License. }
{ }
{***************************************************************************}
{ *************************************************************************** }
{ }
{ Delphi MVC Framework }
{ }
{ Copyright (c) 2010-2015 Daniele Teti and the DMVCFramework Team }
{ }
{ https://github.com/danieleteti/delphimvcframework }
{ }
{ *************************************************************************** }
{ }
{ Licensed under the Apache License, Version 2.0 (the "License"); }
{ you may not use this file except in compliance with the License. }
{ You may obtain a copy of the License at }
{ }
{ http://www.apache.org/licenses/LICENSE-2.0 }
{ }
{ Unless required by applicable law or agreed to in writing, software }
{ distributed under the License is distributed on an "AS IS" BASIS, }
{ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. }
{ See the License for the specific language governing permissions and }
{ limitations under the License. }
{ }
{ *************************************************************************** }
unit MVCFramework.RESTClient;
@ -31,16 +31,13 @@ uses
IdHTTP,
IdURI,
{$IF CompilerVersion < 27}
{$IF CompilerVersion < 27}
Data.DBXJSON,
{$ELSE}
{$ELSE}
System.JSON,
{$ENDIF}
{$ENDIF}
IdMultipartFormData,
System.SysUtils,
Data.DB,
@ -48,7 +45,7 @@ uses
IdCompressorZLib,
IdSSLOpenSSL,
System.Generics.Collections,
System.StrUtils;
System.StrUtils, Web.HTTPApp, IdCookie;
type
ERESTClientException = class(Exception);
@ -59,12 +56,17 @@ type
IRESTResponse = interface
['{E96178DE-79D4-4EF6-88F6-1A677207265A}']
function GetContentType: string; deprecated 'use method ContentType';
function GetContentEncoding: string; deprecated 'use method ContentEncoding';
function GetHeaderValue(const AName: string): string; deprecated 'use method HeaderValue';
function GetContentEncoding: string;
deprecated 'use method ContentEncoding';
function GetHeaderValue(const AName: string): string;
deprecated 'use method HeaderValue';
procedure SetResponseCode(const AResponseCode: Word); deprecated 'use method UpdateResponseCode';
procedure SetResponseText(const AResponseText: string); deprecated 'use method UpdateResponseText';
procedure SetHeaders(AHeaders: TStrings); deprecated 'use method UpdateHeaders';
procedure SetResponseCode(const AResponseCode: Word);
deprecated 'use method UpdateResponseCode';
procedure SetResponseText(const AResponseText: string);
deprecated 'use method UpdateResponseText';
procedure SetHeaders(AHeaders: TStrings);
deprecated 'use method UpdateHeaders';
function Body: TStringStream;
function BodyAsString: string;
@ -84,6 +86,10 @@ type
function ContentType: string;
function ContentEncoding: string;
function GetCookies: TIdCookies;
procedure SetCookies(aCookie: TIdCookies);
property Cookies: TIdCookies read GetCookies write SetCookies;
end;
TJSONObjectResponseHelper = class helper for TJSONObject
@ -135,28 +141,36 @@ type
procedure SetProxyPort(const AValue: Integer);
strict protected
procedure HandleRequestCookies();
procedure HandleCookies();
procedure HandleCookies(aCookies: TIdCookies;
aRESTResponse: IRESTResponse);
function EncodeQueryStringParams(const AParams: TStrings; AIncludeQuestionMark: Boolean = True): string;
function EncodeResourceParams(const AResourceParams: array of string): string;
function EncodeQueryStringParams(const AParams: TStrings;
AIncludeQuestionMark: Boolean = True): string;
function EncodeResourceParams(const AResourceParams
: array of string): string;
procedure StartAsynchRequest(const ACommand: THTTPCommand; const AResource, ABody: string); overload;
procedure StartAsynchRequest(const ACommand: THTTPCommand; const AResource: string); overload;
procedure StartAsynchRequest(const ACommand: THTTPCommand;
const AResource, ABody: string); overload;
procedure StartAsynchRequest(const ACommand: THTTPCommand;
const AResource: string); overload;
function HTTPCommandToString(const ACommand: THTTPCommand): string;
function SendHTTPCommand(const ACommand: THttpCommand;
const AAccept, AContentType, AResource: string; ABodyParams: TStrings): IRESTResponse;
function SendHTTPCommand(const ACommand: THTTPCommand;
const AAccept, AContentType, AResource: string; ABodyParams: TStrings)
: IRESTResponse;
function SendHTTPCommandWithBody(const ACommand: THTTPCommand;
const AAccept, AContentType, AResource, ABody: string): IRESTResponse;
public
constructor Create(const AHost: string; const APort: Word = 80; AIOHandler: TIdIOHandler = nil); virtual;
constructor Create(const AHost: string; const APort: Word = 80;
AIOHandler: TIdIOHandler = nil); virtual;
destructor Destroy; override;
function ReadTimeOut(const AValue: Integer): TRESTClient; overload;
function ConnectionTimeOut(const AValue: Integer): TRESTClient; overload;
function Authentication(const AUsername, APassword: string; const ABasicAuth: Boolean = True): TRESTClient;
function Authentication(const AUsername, APassword: string;
const ABasicAuth: Boolean = True): TRESTClient;
function ClearHeaders(): TRESTClient;
function Header(const AField, AValue: string): TRESTClient;
function Accept(const AValue: string): TRESTClient; overload;
@ -171,47 +185,78 @@ type
function Compression(const AEnabled: Boolean = True): TRESTClient;
function ResetSession(): TRESTClient;
function AddFile(const AFieldName, AFileName: string; const AContentType: string = ''): TRESTClient;
function AddFile(const AFieldName, AFileName: string;
const AContentType: string = ''): TRESTClient;
function Asynch(AProc: TProc<IRESTResponse>; AProcErr: TProc<Exception> = nil;
AProcAlways: TProc = nil; ASynchronized: Boolean = False): TRESTClient;
function Asynch(AProc: TProc<IRESTResponse>;
AProcErr: TProc<Exception> = nil; AProcAlways: TProc = nil;
ASynchronized: Boolean = False): TRESTClient;
function doGET(): IRESTResponse; overload;
function doGET(const AResource: string; const AParams: array of string): IRESTResponse; overload;
function doGET(const AResource: string; const AParams: array of string)
: IRESTResponse; overload;
function doPOST(const ABody: string): IRESTResponse; overload;
function doPOST(ABody: TJSONValue; const AOwnsBody: Boolean = True): IRESTResponse; overload;
function doPOST<TBodyType: class>(ABody: TBodyType; const AOwnsBody: Boolean = True): IRESTResponse; overload;
function doPOST<TBodyType: class>(ABody: TObjectList<TBodyType>; const AOwnsBody: Boolean = True): IRESTResponse; overload;
function doPOST(const AResource: string; const AParams: array of string): IRESTResponse; overload;
function doPOST(const AResource: string; const AParams: array of string; ABody: TJSONValue; const AOwnsBody: Boolean = True): IRESTResponse; overload;
function doPOST(const AResource: string; const AParams: array of string; const ABody: string): IRESTResponse; overload;
function doPOST(ABody: TJSONValue; const AOwnsBody: Boolean = True)
: IRESTResponse; overload;
function doPOST<TBodyType: class>(ABody: TBodyType;
const AOwnsBody: Boolean = True): IRESTResponse; overload;
function doPOST<TBodyType: class>(ABody: TObjectList<TBodyType>;
const AOwnsBody: Boolean = True): IRESTResponse; overload;
function doPOST(const AResource: string; const AParams: array of string)
: IRESTResponse; overload;
function doPOST(const AResource: string; const AParams: array of string;
ABody: TJSONValue; const AOwnsBody: Boolean = True)
: IRESTResponse; overload;
function doPOST(const AResource: string; const AParams: array of string;
const ABody: string): IRESTResponse; overload;
function doPATCH(const ABody: string): IRESTResponse; overload;
function doPATCH(ABody: TJSONValue; const AOwnsBody: Boolean = True): IRESTResponse; overload;
function doPATCH<TBodyType: class>(ABody: TBodyType; const AOwnsBody: Boolean = True): IRESTResponse; overload;
function doPATCH<TBodyType: class>(ABody: TObjectList<TBodyType>; const AOwnsBody: Boolean = True): IRESTResponse; overload;
function doPATCH(const AResource: string; const AParams: array of string; ABody: TJSONValue; const AOwnsBody: Boolean = True): IRESTResponse; overload;
function doPATCH(const AResource: string; const AParams: array of string; const ABody: string): IRESTResponse; overload;
function doPATCH(ABody: TJSONValue; const AOwnsBody: Boolean = True)
: IRESTResponse; overload;
function doPATCH<TBodyType: class>(ABody: TBodyType;
const AOwnsBody: Boolean = True): IRESTResponse; overload;
function doPATCH<TBodyType: class>(ABody: TObjectList<TBodyType>;
const AOwnsBody: Boolean = True): IRESTResponse; overload;
function doPATCH(const AResource: string; const AParams: array of string;
ABody: TJSONValue; const AOwnsBody: Boolean = True)
: IRESTResponse; overload;
function doPATCH(const AResource: string; const AParams: array of string;
const ABody: string): IRESTResponse; overload;
function doPUT(const ABody: string): IRESTResponse; overload;
function doPUT(ABody: TJSONValue; const AOwnsBody: Boolean = True): IRESTResponse; overload;
function doPUT<TBodyType: class>(ABody: TBodyType; const AOwnsBody: Boolean = True): IRESTResponse; overload;
function doPUT<TBodyType: class>(ABody: TObjectList<TBodyType>; const AOwnsBody: Boolean = True): IRESTResponse; overload;
function doPUT(const AResource: string; const AParams: array of string): IRESTResponse; overload;
function doPUT(const AResource: string; const AParams: array of string; ABody: TJSONValue; const AOwnsBody: Boolean = True): IRESTResponse; overload;
function doPUT(const AResource: string; const AParams: array of string; const ABody: string): IRESTResponse; overload;
function doPUT(ABody: TJSONValue; const AOwnsBody: Boolean = True)
: IRESTResponse; overload;
function doPUT<TBodyType: class>(ABody: TBodyType;
const AOwnsBody: Boolean = True): IRESTResponse; overload;
function doPUT<TBodyType: class>(ABody: TObjectList<TBodyType>;
const AOwnsBody: Boolean = True): IRESTResponse; overload;
function doPUT(const AResource: string; const AParams: array of string)
: IRESTResponse; overload;
function doPUT(const AResource: string; const AParams: array of string;
ABody: TJSONValue; const AOwnsBody: Boolean = True)
: IRESTResponse; overload;
function doPUT(const AResource: string; const AParams: array of string;
const ABody: string): IRESTResponse; overload;
function doDELETE(): IRESTResponse; overload;
function doDELETE(const AResource: string; const AParams: array of string): IRESTResponse; overload;
function doDELETE(const AResource: string; const AParams: array of string)
: IRESTResponse; overload;
function DataSetUpdate(const AResource: string; ADataSet: TDataSet; const AKeyValue: string): IRESTResponse;
function DataSetInsert(const AResource: string; ADataSet: TDataSet): IRESTResponse;
function DataSetDelete(const AResource: string; const AKeyValue: string): IRESTResponse;
function DataSetUpdate(const AResource: string; ADataSet: TDataSet;
const AKeyValue: string): IRESTResponse;
function DataSetInsert(const AResource: string; ADataSet: TDataSet)
: IRESTResponse;
function DataSetDelete(const AResource: string; const AKeyValue: string)
: IRESTResponse;
function DSUpdate(const AResource: string; ADataSet: TDataSet; const AKeyValue: string): IRESTResponse; deprecated 'use method DataSetUpdate';
function DSInsert(const AResource: string; ADataSet: TDataSet): IRESTResponse; deprecated 'use method DataSetInsert';
function DSDelete(const AResource: string; const AKeyValue: string): IRESTResponse; deprecated 'use method DataSetDelete';
function DSUpdate(const AResource: string; ADataSet: TDataSet;
const AKeyValue: string): IRESTResponse;
deprecated 'use method DataSetUpdate';
function DSInsert(const AResource: string; ADataSet: TDataSet)
: IRESTResponse; deprecated 'use method DataSetInsert';
function DSDelete(const AResource: string; const AKeyValue: string)
: IRESTResponse; deprecated 'use method DataSetDelete';
function Accept(): string; overload;
function ContentType(): string; overload;
@ -222,12 +267,14 @@ type
function HasCompression(): Boolean;
property RawBody: TStringStream read GetRawBody;
property MultiPartFormData: TIdMultiPartFormDataStream read GetMultipartFormData;
property MultiPartFormData: TIdMultiPartFormDataStream
read GetMultiPartFormData;
property BodyParams: TStringlist read GetBodyParams;
property SessionID: string read GetSessionID write SetSessionID;
property Username: string read GetUserName write SetUserName;
property Password: string read GetPassword write SetPassword;
property UseBasicAuthentication: Boolean read GetBasicAuth write SetBasicAuth;
property UseBasicAuthentication: Boolean read GetBasicAuth
write SetBasicAuth;
property RequestHeaders: TStringlist read FRequestHeaders;
property QueryStringParams: TStringlist read GetQueryStringParams;
property ProxyServer: string write SetProxyServer;
@ -250,7 +297,10 @@ type
FBodyAsJSONValue: TJSONValue;
FContentType: string;
FContentEncoding: string;
FCookieCollection: TCookieCollection;
function GetHeader(const AValue: string): string;
private
FCookies: TIdCookies;
public
constructor Create; virtual;
destructor Destroy; override;
@ -281,6 +331,10 @@ type
function ContentType(): string;
function ContentEncoding(): string;
function GetCookies: TIdCookies;
procedure SetCookies(aCookie: TIdCookies);
property Cookies: TIdCookies read GetCookies write SetCookies;
end;
{ TRESTResponse }
@ -352,6 +406,7 @@ end;
constructor TRESTResponse.Create;
begin
FHeaders := TStringlist.Create;
FCookies := TIdCookies.Create(nil);
FBody := TStringStream.Create('', TEncoding.UTF8);
FBodyAsJSONValue := nil;
end;
@ -362,6 +417,7 @@ begin
FreeAndNil(FBodyAsJSONValue);
FreeAndNil(FHeaders);
FreeAndNil(FBody);
FreeAndNil(FCookies);
inherited;
end;
@ -375,6 +431,11 @@ begin
Result := ContentType;
end;
function TRESTResponse.GetCookies: TIdCookies;
begin
Result := FCookies;
end;
function TRESTResponse.GetHeader(const AValue: string): string;
var
s: string;
@ -382,7 +443,7 @@ begin
if Assigned(FHeaders) and (FHeaders.Count > 0) then
begin
for s in FHeaders do
if s.StartsWith(AValue + ':', true) then
if s.StartsWith(AValue + ':', True) then
Exit(s);
end
else
@ -426,6 +487,11 @@ begin
Result := FResponseText;
end;
procedure TRESTResponse.SetCookies(aCookie: TIdCookies);
begin
FCookies := aCookie;
end;
procedure TRESTResponse.SetHeaders(AHeaders: TStrings);
begin
UpdateHeaders(AHeaders);
@ -451,11 +517,11 @@ begin
C := GetHeader('content-type');
CT := C.Split([':'])[1].Split([';']);
FContentType := trim(CT[0]);
FContentType := Trim(CT[0]);
FContentEncoding := 'UTF-8';
if Length(CT) > 1 then
if CT[1].Trim.StartsWith('charset', true) then
FContentEncoding := CT[1].trim.Split(['='])[1].trim;
if CT[1].Trim.StartsWith('charset', True) then
FContentEncoding := CT[1].Trim.Split(['='])[1].Trim;
end;
procedure TRESTResponse.UpdateResponseCode(const AResponseCode: Word);
@ -506,14 +572,16 @@ begin
Result := Self;
end;
function TRESTClient.AddFile(const AFieldName, AFileName, AContentType: string): TRESTClient;
function TRESTClient.AddFile(const AFieldName, AFileName, AContentType: string)
: TRESTClient;
begin
MultipartFormData.AddFile(AFieldName, AFileName, AContentType);
MultiPartFormData.AddFile(AFieldName, AFileName, AContentType);
Result := Self;
end;
function TRESTClient.Asynch(AProc: TProc<IRESTResponse>; AProcErr: TProc<Exception>; AProcAlways: TProc;
ASynchronized: Boolean): TRESTClient;
function TRESTClient.Asynch(AProc: TProc<IRESTResponse>;
AProcErr: TProc<Exception>; AProcAlways: TProc; ASynchronized: Boolean)
: TRESTClient;
begin
FNextRequestIsAsynch := True;
FAsynchProc := AProc;
@ -523,9 +591,10 @@ begin
Result := Self;
end;
function TRESTClient.Authentication(const AUsername, APassword: string; const ABasicAuth: Boolean): TRESTClient;
function TRESTClient.Authentication(const AUsername, APassword: string;
const ABasicAuth: Boolean): TRESTClient;
begin
FHTTP.Request.UserName := AUsername;
FHTTP.Request.Username := AUsername;
FHTTP.Request.Password := APassword;
FHTTP.Request.BasicAuthentication := ABasicAuth;
Result := Self;
@ -621,7 +690,8 @@ begin
Result := Self;
end;
constructor TRESTClient.Create(const AHost: string; const APort: Word; AIOHandler: TIdIOHandler);
constructor TRESTClient.Create(const AHost: string; const APort: Word;
AIOHandler: TIdIOHandler);
var
Pieces: TArray<string>;
begin
@ -656,7 +726,7 @@ begin
FProtocol := 'http';
FHTTP := TIdHTTP.Create(nil);
FHTTP.ReadTimeout := 20000;
FHTTP.ReadTimeOut := 20000;
if (AIOHandler <> nil) then
FHTTP.IOHandler := AIOHandler
@ -670,17 +740,20 @@ begin
FHTTP.Request.BasicAuthentication := True;
end;
function TRESTClient.DataSetDelete(const AResource, AKeyValue: string): IRESTResponse;
function TRESTClient.DataSetDelete(const AResource, AKeyValue: string)
: IRESTResponse;
begin
Result := doDELETE(AResource, [AKeyValue]);
end;
function TRESTClient.DataSetInsert(const AResource: string; ADataSet: TDataSet): IRESTResponse;
function TRESTClient.DataSetInsert(const AResource: string; ADataSet: TDataSet)
: IRESTResponse;
begin
Result := doPOST(AResource, [], ADataSet.AsJSONObjectString);
end;
function TRESTClient.DataSetUpdate(const AResource: string; ADataSet: TDataSet; const AKeyValue: string): IRESTResponse;
function TRESTClient.DataSetUpdate(const AResource: string; ADataSet: TDataSet;
const AKeyValue: string): IRESTResponse;
begin
Result := doPUT(AResource, [AKeyValue], ADataSet.AsJSONObjectString);
end;
@ -704,7 +777,8 @@ begin
inherited;
end;
function TRESTClient.doDELETE(const AResource: string; const AParams: array of string): IRESTResponse;
function TRESTClient.doDELETE(const AResource: string;
const AParams: array of string): IRESTResponse;
var
URL: string;
begin
@ -739,7 +813,8 @@ begin
Result := doGET(FResource, FParams);
end;
function TRESTClient.doGET(const AResource: string; const AParams: array of string): IRESTResponse;
function TRESTClient.doGET(const AResource: string;
const AParams: array of string): IRESTResponse;
var
URL: string;
begin
@ -758,14 +833,16 @@ begin
end;
end;
function TRESTClient.doPOST(const AResource: string; const AParams: array of string): IRESTResponse;
function TRESTClient.doPOST(const AResource: string;
const AParams: array of string): IRESTResponse;
var
s: string;
begin
try
Result := SendHTTPCommand(httpPOST, FAccept, FContentType, FProtocol + '://' + FHost + ':'
+ IntToStr(FPort) + AResource + EncodeResourceParams(AParams) +
EncodeQueryStringParams(FQueryStringParams), FBodyParams);
Result := SendHTTPCommand(httpPOST, FAccept, FContentType,
FProtocol + '://' + FHost + ':' + IntToStr(FPort) + AResource +
EncodeResourceParams(AParams) + EncodeQueryStringParams
(FQueryStringParams), FBodyParams);
except
on E: EIdHTTPProtocolException do
s := E.Message;
@ -773,8 +850,9 @@ begin
ClearAllParams;
end;
function TRESTClient.doPOST(const AResource: string; const AParams: array of string; ABody: TJSONValue;
const AOwnsBody: Boolean): IRESTResponse;
function TRESTClient.doPOST(const AResource: string;
const AParams: array of string; ABody: TJSONValue; const AOwnsBody: Boolean)
: IRESTResponse;
begin
if not Assigned(ABody) then
raise ERESTClientException.Create('ABody is nil JSONValue');
@ -782,23 +860,22 @@ begin
try
Result := doPOST(AResource, AParams,
{$IF CompilerVersion >= 28}
{$IF CompilerVersion >= 28}
ABody.ToJSON
{$ELSE}
{$ELSE}
ABody.ToString
{$ENDIF});
{$ENDIF});
finally
if AOwnsBody then
FreeAndNil(ABody);
end;
end;
function TRESTClient.doPATCH(const AResource: string; const AParams: array of string; ABody: TJSONValue;
const AOwnsBody: Boolean): IRESTResponse;
function TRESTClient.doPATCH(const AResource: string;
const AParams: array of string; ABody: TJSONValue; const AOwnsBody: Boolean)
: IRESTResponse;
begin
if not Assigned(ABody) then
raise ERESTClientException.Create('ABody is nil JSONValue');
@ -806,22 +883,21 @@ begin
try
Result := doPATCH(AResource, AParams,
{$IF CompilerVersion >= 28}
{$IF CompilerVersion >= 28}
ABody.ToJSON
{$ELSE}
{$ELSE}
ABody.ToString
{$ENDIF});
{$ENDIF});
finally
if AOwnsBody then
FreeAndNil(ABody);
end;
end;
function TRESTClient.doPATCH(const AResource: string; const AParams: array of string; const ABody: string): IRESTResponse;
function TRESTClient.doPATCH(const AResource: string;
const AParams: array of string; const ABody: string): IRESTResponse;
var
URL: string;
begin
@ -835,7 +911,8 @@ begin
end
else
begin
Result := SendHTTPCommandWithBody(httpPATCH, FAccept, FContentType, URL, ABody);
Result := SendHTTPCommandWithBody(httpPATCH, FAccept, FContentType,
URL, ABody);
ClearAllParams;
end;
end;
@ -851,7 +928,8 @@ begin
Result := doPATCH(FResource, FParams, ABody);
end;
function TRESTClient.doPATCH(ABody: TJSONValue; const AOwnsBody: Boolean): IRESTResponse;
function TRESTClient.doPATCH(ABody: TJSONValue; const AOwnsBody: Boolean)
: IRESTResponse;
begin
if (FResource = '') then
raise ERESTClientException.Create('You must enter the Resource!');
@ -862,7 +940,8 @@ begin
Result := doPATCH(FResource, FParams, ABody, AOwnsBody);
end;
function TRESTClient.doPATCH<TBodyType>(ABody: TBodyType; const AOwnsBody: Boolean): IRESTResponse;
function TRESTClient.doPATCH<TBodyType>(ABody: TBodyType;
const AOwnsBody: Boolean): IRESTResponse;
begin
if (FResource = '') then
raise ERESTClientException.Create('You must enter the Resource!');
@ -870,13 +949,15 @@ begin
if not Assigned(ABody) then
raise ERESTClientException.Create('You must enter the Body!');
Result := doPATCH(FResource, FParams, Mapper.ObjectToJSONObject(ABody) as TJSONValue, True);
Result := doPATCH(FResource, FParams, Mapper.ObjectToJSONObject(ABody)
as TJSONValue, True);
if AOwnsBody then
TObject(ABody).Free;
end;
function TRESTClient.doPATCH<TBodyType>(ABody: TObjectList<TBodyType>; const AOwnsBody: Boolean): IRESTResponse;
function TRESTClient.doPATCH<TBodyType>(ABody: TObjectList<TBodyType>;
const AOwnsBody: Boolean): IRESTResponse;
begin
if (FResource = '') then
raise ERESTClientException.Create('You must enter the Resource!');
@ -886,11 +967,12 @@ begin
ABody.OwnsObjects := AOwnsBody;
Result := doPATCH(FResource, FParams, Mapper.ObjectListToJSONArray<TBodyType>(ABody, AOwnsBody) as TJSONValue, True);
Result := doPATCH(FResource, FParams, Mapper.ObjectListToJSONArray<TBodyType>
(ABody, AOwnsBody) as TJSONValue, True);
end;
function TRESTClient.doPOST(const AResource: string; const AParams: array of string;
const ABody: string): IRESTResponse;
function TRESTClient.doPOST(const AResource: string;
const AParams: array of string; const ABody: string): IRESTResponse;
var
URL: string;
begin
@ -904,7 +986,8 @@ begin
end
else
begin
Result := SendHTTPCommandWithBody(httpPOST, FAccept, FContentType, URL, ABody);
Result := SendHTTPCommandWithBody(httpPOST, FAccept, FContentType,
URL, ABody);
ClearAllParams;
end;
end;
@ -920,7 +1003,8 @@ begin
Result := doPOST(FResource, FParams, ABody);
end;
function TRESTClient.doPOST(ABody: TJSONValue; const AOwnsBody: Boolean): IRESTResponse;
function TRESTClient.doPOST(ABody: TJSONValue; const AOwnsBody: Boolean)
: IRESTResponse;
begin
if (FResource = '') then
raise ERESTClientException.Create('You must enter the Resource!');
@ -931,7 +1015,8 @@ begin
Result := doPOST(FResource, FParams, ABody, AOwnsBody);
end;
function TRESTClient.doPOST<TBodyType>(ABody: TBodyType; const AOwnsBody: Boolean): IRESTResponse;
function TRESTClient.doPOST<TBodyType>(ABody: TBodyType;
const AOwnsBody: Boolean): IRESTResponse;
begin
if (FResource = '') then
raise ERESTClientException.Create('You must enter the Resource!');
@ -939,13 +1024,15 @@ begin
if not Assigned(ABody) then
raise ERESTClientException.Create('You must enter the Body!');
Result := doPOST(FResource, FParams, Mapper.ObjectToJSONObject(ABody) as TJSONValue, True);
Result := doPOST(FResource, FParams, Mapper.ObjectToJSONObject(ABody)
as TJSONValue, True);
if AOwnsBody then
TObject(ABody).Free;
end;
function TRESTClient.doPOST<TBodyType>(ABody: TObjectList<TBodyType>; const AOwnsBody: Boolean): IRESTResponse;
function TRESTClient.doPOST<TBodyType>(ABody: TObjectList<TBodyType>;
const AOwnsBody: Boolean): IRESTResponse;
begin
if (FResource = '') then
raise ERESTClientException.Create('You must enter the Resource!');
@ -955,19 +1042,23 @@ begin
ABody.OwnsObjects := AOwnsBody;
Result := doPOST(FResource, FParams, Mapper.ObjectListToJSONArray<TBodyType>(ABody, AOwnsBody) as TJSONValue, True);
Result := doPOST(FResource, FParams, Mapper.ObjectListToJSONArray<TBodyType>
(ABody, AOwnsBody) as TJSONValue, True);
end;
function TRESTClient.doPUT(const AResource: string; const AParams: array of string): IRESTResponse;
function TRESTClient.doPUT(const AResource: string;
const AParams: array of string): IRESTResponse;
begin
Result := SendHTTPCommand(httpPUT, FAccept, FContentType, FProtocol + '://' + FHost + ':' +
IntToStr(FPort) + AResource + EncodeResourceParams(AParams) +
EncodeQueryStringParams(QueryStringParams), FBodyParams);
Result := SendHTTPCommand(httpPUT, FAccept, FContentType,
FProtocol + '://' + FHost + ':' + IntToStr(FPort) + AResource +
EncodeResourceParams(AParams) + EncodeQueryStringParams(QueryStringParams),
FBodyParams);
ClearAllParams;
end;
function TRESTClient.doPUT(const AResource: string; const AParams: array of string; ABody: TJSONValue;
const AOwnsBody: Boolean): IRESTResponse;
function TRESTClient.doPUT(const AResource: string;
const AParams: array of string; ABody: TJSONValue; const AOwnsBody: Boolean)
: IRESTResponse;
begin
if not Assigned(ABody) then
raise ERESTClientException.Create('ABody is nil JSONValue');
@ -975,22 +1066,21 @@ begin
try
Result := doPUT(AResource, AParams,
{$IF CompilerVersion >= 28}
{$IF CompilerVersion >= 28}
ABody.ToJSON
{$ELSE}
{$ELSE}
ABody.ToString
{$ENDIF});
{$ENDIF});
finally
if AOwnsBody then
FreeAndNil(ABody);
end;
end;
function TRESTClient.doPUT(const AResource: string; const AParams: array of string; const ABody: string): IRESTResponse;
function TRESTClient.doPUT(const AResource: string;
const AParams: array of string; const ABody: string): IRESTResponse;
var
URL: string;
begin
@ -1004,7 +1094,8 @@ begin
end
else
begin
Result := SendHTTPCommandWithBody(httpPUT, FAccept, FContentType, URL, ABody);
Result := SendHTTPCommandWithBody(httpPUT, FAccept, FContentType,
URL, ABody);
ClearAllParams;
end;
end;
@ -1020,7 +1111,8 @@ begin
Result := doPUT(FResource, FParams, ABody);
end;
function TRESTClient.doPUT(ABody: TJSONValue; const AOwnsBody: Boolean): IRESTResponse;
function TRESTClient.doPUT(ABody: TJSONValue; const AOwnsBody: Boolean)
: IRESTResponse;
begin
if (FResource = '') then
raise ERESTClientException.Create('You must enter the Resource!');
@ -1031,7 +1123,8 @@ begin
Result := doPUT(FResource, FParams, ABody, AOwnsBody);
end;
function TRESTClient.doPUT<TBodyType>(ABody: TBodyType; const AOwnsBody: Boolean): IRESTResponse;
function TRESTClient.doPUT<TBodyType>(ABody: TBodyType;
const AOwnsBody: Boolean): IRESTResponse;
begin
if (FResource = '') then
raise ERESTClientException.Create('You must enter the Resource!');
@ -1039,13 +1132,15 @@ begin
if not Assigned(ABody) then
raise ERESTClientException.Create('You must enter the Body!');
Result := doPUT(FResource, FParams, Mapper.ObjectToJSONObject(ABody) as TJSONValue, True);
Result := doPUT(FResource, FParams, Mapper.ObjectToJSONObject(ABody)
as TJSONValue, True);
if AOwnsBody then
TObject(ABody).Free;
end;
function TRESTClient.doPUT<TBodyType>(ABody: TObjectList<TBodyType>; const AOwnsBody: Boolean): IRESTResponse;
function TRESTClient.doPUT<TBodyType>(ABody: TObjectList<TBodyType>;
const AOwnsBody: Boolean): IRESTResponse;
begin
if (FResource = '') then
raise ERESTClientException.Create('You must enter the Resource!');
@ -1055,25 +1150,30 @@ begin
ABody.OwnsObjects := AOwnsBody;
Result := doPUT(FResource, FParams, Mapper.ObjectListToJSONArray<TBodyType>(ABody, AOwnsBody) as TJSONValue, True);
Result := doPUT(FResource, FParams, Mapper.ObjectListToJSONArray<TBodyType>
(ABody, AOwnsBody) as TJSONValue, True);
end;
function TRESTClient.DSDelete(const AResource, AKeyValue: string): IRESTResponse;
function TRESTClient.DSDelete(const AResource, AKeyValue: string)
: IRESTResponse;
begin
Result := DataSetDelete(AResource, AKeyValue);
end;
function TRESTClient.DSInsert(const AResource: string; ADataSet: TDataSet): IRESTResponse;
function TRESTClient.DSInsert(const AResource: string; ADataSet: TDataSet)
: IRESTResponse;
begin
Result := DataSetInsert(AResource, ADataSet);
end;
function TRESTClient.DSUpdate(const AResource: string; ADataSet: TDataSet; const AKeyValue: string): IRESTResponse;
function TRESTClient.DSUpdate(const AResource: string; ADataSet: TDataSet;
const AKeyValue: string): IRESTResponse;
begin
Result := DataSetUpdate(AResource, ADataSet, AKeyValue);
end;
function TRESTClient.EncodeQueryStringParams(const AParams: TStrings; AIncludeQuestionMark: Boolean): string;
function TRESTClient.EncodeQueryStringParams(const AParams: TStrings;
AIncludeQuestionMark: Boolean): string;
var
I: Integer;
begin
@ -1089,17 +1189,19 @@ begin
begin
if I > 0 then
Result := Result + '&';
Result := Result + AParams.Names[I] + '=' + TIdURI.ParamsEncode(AParams.ValueFromIndex[I]);
Result := Result + AParams.Names[I] + '=' + TIdURI.ParamsEncode
(AParams.ValueFromIndex[I]);
end;
end;
function TRESTClient.EncodeResourceParams(const AResourceParams: array of string): string;
function TRESTClient.EncodeResourceParams(const AResourceParams
: array of string): string;
var
I: Integer;
begin
Result := '';
for I := Low(AResourceParams) to High(AResourceParams) do
Result := Result + '/' + TIdURI.ParamsEncode(AResourceParams[i]);
Result := Result + '/' + TIdURI.ParamsEncode(AResourceParams[I]);
end;
function TRESTClient.GetBasicAuth: Boolean;
@ -1147,17 +1249,26 @@ end;
function TRESTClient.GetUserName: string;
begin
Result := FHTTP.Request.UserName;
Result := FHTTP.Request.Username;
end;
procedure TRESTClient.HandleCookies;
procedure TRESTClient.HandleCookies(aCookies: TIdCookies;
aRESTResponse: IRESTResponse);
var
s: string;
arr: TArray<string>;
begin
aCookies.LockCookieList(caReadWrite);
try
aRESTResponse.Cookies.Clear;
aRESTResponse.Cookies.AddCookies(aCookies);
finally
aCookies.UnlockCookieList(caReadWrite);
end;
for s in FHTTP.Response.RawHeaders do
begin
if s.StartsWith('Set-Cookie', true) then
if s.StartsWith('Set-Cookie', True) then
begin
arr := s.Split([':'], 2);
if arr[1].Trim.StartsWith('dtsessionid') then
@ -1168,6 +1279,7 @@ begin
Break;
end;
end;
end;
procedure TRESTClient.HandleRequestCookies;
@ -1178,7 +1290,8 @@ begin
FHTTP.CookieManager.CookieCollection.Clear;
if not FLastSessionID.Trim.IsEmpty then
FHTTP.Request.CustomHeaders.AddValue('Cookie', 'dtsessionid=' + FLastSessionID);
FHTTP.Request.CustomHeaders.AddValue('Cookie',
'dtsessionid=' + FLastSessionID);
for I := 0 to FRequestHeaders.Count - 1 do
begin
@ -1215,7 +1328,8 @@ begin
httpDELETE:
Result := 'DELETE';
else
raise ERESTClientException.Create('Unknown HTTPCommand in TRESTClient.HTTPCommandToString');
raise ERESTClientException.Create
('Unknown HTTPCommand in TRESTClient.HTTPCommandToString');
end;
end;
@ -1231,13 +1345,13 @@ end;
function TRESTClient.ReadTimeOut(const AValue: Integer): TRESTClient;
begin
FHTTP.ReadTimeout := AValue;
FHTTP.ReadTimeOut := AValue;
Result := Self;
end;
function TRESTClient.ReadTimeOut: Integer;
begin
Result := FHTTP.ReadTimeout;
Result := FHTTP.ReadTimeOut;
end;
function TRESTClient.ResetSession: TRESTClient;
@ -1255,8 +1369,9 @@ begin
Result := Self;
end;
function TRESTClient.SendHTTPCommand(const ACommand: THttpCommand; const AAccept, AContentType, AResource: string;
ABodyParams: TStrings): IRESTResponse;
function TRESTClient.SendHTTPCommand(const ACommand: THTTPCommand;
const AAccept, AContentType, AResource: string; ABodyParams: TStrings)
: IRESTResponse;
begin
Result := TRESTResponse.Create;
@ -1276,21 +1391,22 @@ begin
httpPOST:
begin
if (MultipartFormData.Size = 0) then
if (MultiPartFormData.Size = 0) then
begin
Result.Body.Position := 0;
FHTTP.Post(AResource, RawBody, Result.Body);
end
else
begin
FHTTP.Post(AResource, MultipartFormData, Result.Body);
MultipartFormData.Clear;
FHTTP.Post(AResource, MultiPartFormData, Result.Body);
MultiPartFormData.Clear;
end;
end;
httpPUT:
begin
if (MultipartFormData.Size <> 0) then { TODO -oDaniele -cGeneral : Rework please!!! }
if (MultiPartFormData.Size <> 0)
then { TODO -oDaniele -cGeneral : Rework please!!! }
raise ERESTClientException.Create('Only POST can Send Files');
Result.Body.Position := 0;
@ -1318,7 +1434,7 @@ begin
raise;
end;
HandleCookies;
HandleCookies(FHTTP.CookieManager.CookieCollection, Result);
Result.UpdateResponseCode(FHTTP.Response.ResponseCode);
Result.UpdateResponseText(FHTTP.Response.ResponseText);
@ -1345,21 +1461,19 @@ begin
httpPOST:
begin
if (MultipartFormData.Size <> 0) then
if (MultiPartFormData.Size <> 0) then
raise ERESTClientException.Create('This method cannot send files');
RawBody.Position := 0;
RawBody.Size := 0;
{$WARNINGS OFF}
{$WARNINGS OFF}
if (LowerCase(FHTTP.Request.CharSet) = 'utf-8') then
RawBody.WriteString(UTF8ToString(ABody))
else
RawBody.WriteString(ABody);
{$WARNINGS ON}
{$WARNINGS ON}
FHTTP.Post(AResource, RawBody, Result.Body);
end;
@ -1374,15 +1488,13 @@ begin
RawBody.Position := 0;
RawBody.Size := 0;
{$WARNINGS OFF}
{$WARNINGS OFF}
if (LowerCase(FHTTP.Request.CharSet) = 'utf-8') then
RawBody.WriteString(UTF8ToString(ABody))
else
RawBody.WriteString(ABody);
{$WARNINGS ON}
{$WARNINGS ON}
FHTTP.Put(AResource, RawBody, Result.Body);
end;
@ -1399,7 +1511,7 @@ begin
raise;
end;
HandleCookies;
HandleCookies(FHTTP.CookieManager.CookieCollection, Result);
Result.UpdateResponseCode(FHTTP.Response.ResponseCode);
Result.UpdateResponseText(FHTTP.Response.ResponseText);
@ -1435,7 +1547,7 @@ end;
procedure TRESTClient.SetUserName(const AValue: string);
begin
FHTTP.Request.UserName := AValue;
FHTTP.Request.Username := AValue;
end;
function TRESTClient.SSL(const AEnabled: Boolean): TRESTClient;
@ -1456,12 +1568,14 @@ begin
Result := Self;
end;
procedure TRESTClient.StartAsynchRequest(const ACommand: THTTPCommand; const AResource: string);
procedure TRESTClient.StartAsynchRequest(const ACommand: THTTPCommand;
const AResource: string);
begin
StartAsynchRequest(ACommand, AResource, '');
end;
procedure TRESTClient.StartAsynchRequest(const ACommand: THTTPCommand; const AResource, ABody: string);
procedure TRESTClient.StartAsynchRequest(const ACommand: THTTPCommand;
const AResource, ABody: string);
var
th: TThread;
begin
@ -1471,7 +1585,8 @@ begin
R: IRESTResponse;
begin
try
R := SendHTTPCommandWithBody(ACommand, FAccept, FContentType, AResource, ABody);
R := SendHTTPCommandWithBody(ACommand, FAccept, FContentType,
AResource, ABody);
TMonitor.Enter(TObject(R));
try
if FSynchronized then

22
unittests/Several/LiveServerTestU.pas
View File

@ -26,6 +26,7 @@ type
// procedure TestPATCHWithParamsAndJSONBody;
procedure TestPOSTWithObjectJSONBody;
procedure TestPUTWithParamsAndJSONBody;
procedure TestCookies;
procedure TestSession;
procedure TestInvalidateSession;
procedure TestAsynchRequestPOST;
@ -299,6 +300,27 @@ begin
CheckEquals('"johndoe"', LRes.BodyAsString);
end;
procedure TServerTest.TestCookies;
var
res: IRESTResponse;
s: string;
I: Integer;
begin
res := RESTClient.doGET('/lotofcookies', []);
CheckEquals(HTTP_STATUS.OK, res.ResponseCode);
CheckEquals(4, res.Cookies.Count, 'Wrong number of cookies');
for I := 0 to 3 do
begin
CheckEquals('usersettings' + IntToStr(I + 1),
res.Cookies.Cookies[I].CookieName);
CheckEquals('usersettings' + IntToStr(I + 1) + '-value',
res.Cookies.Cookies[I].Value);
CheckEquals('/usersettings' + IntToStr(I + 1),
res.Cookies.Cookies[I].Path);
end;
end;
procedure TServerTest.TestEncodingRenderJSONValue;
var
res: IRESTResponse;

24
unittests/TestServer/TestServerControllerU.pas
View File

@ -171,28 +171,28 @@ var
begin
v := ctx.Request.Cookie('usersettings');
c := ctx.Response.Cookies.Add;
c.Name := 'usersettings';
c.Value := '01234-5678-90';
c.Path := '/';
c.Expires := 0;
c := ctx.Response.Cookies.Add;
c.Name := 'usersettings1';
c.Value := '11234-5678-90';
c.Path := '/';
c.Value := 'usersettings1-value';
c.Path := '/usersettings1';
c.Expires := 0;
c := ctx.Response.Cookies.Add;
c.Name := 'usersettings2';
c.Value := '21234-5678-90';
c.Path := '/';
c.Value := 'usersettings2-value';
c.Path := '/usersettings2';
c.Expires := 0;
c := ctx.Response.Cookies.Add;
c.Name := 'usersettings3';
c.Value := '31234-5678-90';
c.Path := '/';
c.Value := 'usersettings3-value';
c.Path := '/usersettings3';
c.Expires := 0;
c := ctx.Response.Cookies.Add;
c.Name := 'usersettings4';
c.Value := 'usersettings4-value';
c.Path := '/usersettings4';
c.Expires := 0;
end;