delphimvcframework/sources/MVCFramework.RESTClient.pas

1737 lines
48 KiB
ObjectPascal
Raw Normal View History

// ***************************************************************************
//
// Delphi MVC Framework
//
// Copyright (c) 2010-2016 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.
//
// *************************************************************************** }
2015-12-22 12:38:17 +01:00
2013-10-30 00:48:23 +01:00
unit MVCFramework.RESTClient;
interface
uses
2015-12-18 20:59:40 +01:00
System.Classes,
2013-10-30 00:48:23 +01:00
IdHTTP,
2015-12-18 20:59:40 +01:00
IdURI,
ObjectsMappers,
2016-09-25 22:31:33 +02:00
MVCFramework.Commons,
2015-12-18 20:59:40 +01:00
{$IF CompilerVersion < 27}
2014-04-16 22:52:25 +02:00
Data.DBXJSON,
2015-12-18 20:59:40 +01:00
{$ELSE}
2014-04-16 22:52:25 +02:00
System.JSON,
2015-12-18 20:59:40 +01:00
{$ENDIF}
2013-10-30 00:48:23 +01:00
IdMultipartFormData,
2015-12-18 20:59:40 +01:00
System.SysUtils,
Data.DB,
IdIOHandler,
IdCompressorZLib,
IdSSLOpenSSL,
System.Generics.Collections,
System.StrUtils, Web.HTTPApp, IdCookie;
2013-10-30 00:48:23 +01:00
type
2015-12-18 20:59:40 +01:00
ERESTClientException = class(Exception);
2013-10-30 00:48:23 +01:00
TArrayOfString = array of string;
2015-12-18 20:59:40 +01:00
THTTPCommand = (httpGET, httpPOST, httpPUT, httpDELETE, httpPATCH, httpTRACE);
2013-10-30 00:48:23 +01:00
[MapperJSONNaming(JSONNameLowerCase)]
TMVCExceptionObj = class(TObject)
private
FStatus: string;
Fclassname: string;
FMessage: string;
FHttp_error: Integer;
public
property Status: string read FStatus write FStatus;
[MapperJSONSer('classname')]
property ExceptionClassname: string read Fclassname write Fclassname;
[MapperJSONSer('message')]
property ExceptionMessage: string read FMessage write FMessage;
[MapperJSONSer('http_error')]
property HTTPError: Integer read FHttp_error write FHttp_error;
end;
2013-10-30 00:48:23 +01:00
IRESTResponse = interface
2015-12-18 20:59:40 +01:00
['{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';
2015-12-18 20:59:40 +01:00
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';
2015-12-18 20:59:40 +01:00
function Body: TStream;
2013-10-30 00:48:23 +01:00
function BodyAsString: string;
2015-12-18 20:59:40 +01:00
function BodyAsJSONValue: TJSONValue;
function BodyAsJSONObject: TJSONObject;
function BodyAsJSONArray: TJSONArray;
procedure UpdateResponseCode(const AResponseCode: Word);
procedure UpdateResponseText(const AResponseText: string);
procedure UpdateHeaders(AHeaders: TStrings);
2013-10-30 00:48:23 +01:00
function ResponseCode: Word;
function ResponseText: string;
2015-12-18 20:59:40 +01:00
2013-10-30 00:48:23 +01:00
function Headers: TStringlist;
2015-12-18 20:59:40 +01:00
function HeaderValue(const AName: string): string;
function ContentType: string;
function ContentEncoding: string;
function GetCookies: TIdCookies;
procedure SetCookies(aCookie: TIdCookies);
function GetHasError: Boolean;
procedure SetHasError(const aHasError: Boolean);
function Error: TMVCExceptionObj;
property Cookies: TIdCookies read GetCookies write SetCookies;
property HasError: Boolean read GetHasError write SetHasError;
2013-10-30 00:48:23 +01:00
end;
2015-12-18 20:59:40 +01:00
TJSONObjectResponseHelper = class helper for TJSONObject
2013-10-30 00:48:23 +01:00
public
2015-12-18 20:59:40 +01:00
function AsObject<T: class, constructor>(): T;
end;
2015-12-18 20:59:40 +01:00
TJSONArrayResponseHelper = class helper for TJSONArray
public
function AsObjectList<T: class, constructor>(): TObjectList<T>;
2013-10-30 00:48:23 +01:00
end;
TRESTClient = class(TInterfacedObject)
2015-12-18 20:59:40 +01:00
strict private
FHost: string;
FPort: Word;
2013-11-05 14:57:50 +01:00
FBodyParams: TStringlist;
FQueryStringParams: TStringlist;
FAccept: string;
FRawBody: TStringStream;
FHTTP: TIdHTTP;
FContentType: string;
2015-12-18 20:59:40 +01:00
FPrimaryThread: TThread;
FProtocol: string;
FRequestHeaders: TStringlist;
FResource: string;
FParams: array of string;
2013-11-05 14:57:50 +01:00
FLastSessionID: string;
2013-10-30 00:48:23 +01:00
FNextRequestIsAsynch: Boolean;
FAsynchProc: TProc<IRESTResponse>;
FAsynchProcErr: TProc<Exception>;
FAsynchProcAlways: TProc;
2015-12-18 20:59:40 +01:00
FMultiPartFormData: TIdMultiPartFormDataStream;
2014-04-02 20:27:17 +02:00
FSynchronized: Boolean;
2014-06-27 15:30:39 +02:00
FContentEncoding: string;
2015-12-18 20:59:40 +01:00
function GetRawBody(): TStringStream;
function GetMultiPartFormData(): TIdMultiPartFormDataStream;
2015-12-22 12:17:13 +01:00
function GetSessionID(): string;
function GetBasicAuth(): Boolean;
function GetPassword(): string;
function GetUserName(): string;
function GetBodyParams(): TStringlist;
function GetQueryStringParams(): TStringlist;
2015-12-18 20:59:40 +01:00
procedure SetBasicAuth(const AValue: Boolean);
procedure SetPassword(const AValue: string);
procedure SetUserName(const AValue: string);
procedure SetSessionID(const AValue: string);
procedure SetProxyServer(const AValue: string);
procedure SetProxyPort(const AValue: Integer);
2013-10-30 00:48:23 +01:00
strict protected
2015-12-18 20:59:40 +01:00
procedure HandleRequestCookies();
procedure HandleCookies(aCookies: TIdCookies;
aRESTResponse: IRESTResponse);
2015-12-18 20:59:40 +01:00
function EncodeQueryStringParams(const AParams: TStrings;
AIncludeQuestionMark: Boolean = True): string;
function EncodeResourceParams(const AResourceParams
: array of string): string;
2015-12-18 20:59:40 +01:00
procedure StartAsynchRequest(const ACommand: THTTPCommand;
const AResource, ABody: string); overload;
procedure StartAsynchRequest(const ACommand: THTTPCommand;
const AResource: string); overload;
2015-12-18 20:59:40 +01:00
function HTTPCommandToString(const ACommand: THTTPCommand): string;
2013-10-30 00:48:23 +01:00
function SendHTTPCommand(const ACommand: THTTPCommand;
const AAccept, AContentType, AResource: string; ABodyParams: TStrings)
: IRESTResponse;
2013-10-30 00:48:23 +01:00
2015-12-18 20:59:40 +01:00
function SendHTTPCommandWithBody(const ACommand: THTTPCommand;
const AAccept, AContentType, AResource, ABody: string): IRESTResponse;
procedure OnHTTPRedirect(Sender: TObject; var dest: string; var NumRedirect: Integer;
var Handled: Boolean; var VMethod: TIdHTTPMethod);
2013-10-30 00:48:23 +01:00
public
constructor Create(const AHost: string; const APort: Word = 80;
AIOHandler: TIdIOHandler = nil); virtual;
2013-10-30 00:48:23 +01:00
destructor Destroy; override;
2015-12-18 20:59:40 +01:00
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;
2015-12-18 20:59:40 +01:00
function ClearHeaders(): TRESTClient;
function Header(const AField, AValue: string): TRESTClient;
function Accept(const AValue: string): TRESTClient; overload;
function AcceptCharSet(const AValue: string): TRESTClient;
function ContentType(const AValue: string): TRESTClient; overload;
function ContentCharSet(const AValue: string): TRESTClient;
function ContentEncoding(const AValue: string): TRESTClient; overload;
function Resource(const AValue: string): TRESTClient;
function Params(const AValues: array of string): TRESTClient;
function ClearAllParams(): TRESTClient;
function SSL(const AEnabled: Boolean = True): TRESTClient;
function Compression(const AEnabled: Boolean = True): TRESTClient;
2015-12-22 12:17:13 +01:00
function ResetSession(): TRESTClient;
2015-12-18 20:59:40 +01:00
function AddFile(const AFieldName, AFileName: string;
const AContentType: string = ''): TRESTClient;
2015-04-01 17:01:23 +02:00
function Asynch(AProc: TProc<IRESTResponse>;
AProcErr: TProc<Exception> = nil; AProcAlways: TProc = nil;
ASynchronized: Boolean = False): TRESTClient;
2015-12-18 20:59:40 +01:00
2015-12-22 12:17:13 +01:00
function doGET(): IRESTResponse; overload;
function doGET(const AResource: string; const AParams: array of string;
const aQueryStringParams: TStrings = nil)
: IRESTResponse; overload;
2015-12-18 20:59:40 +01:00
2015-12-22 12:17:13 +01:00
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;
2015-12-22 12:17:13 +01:00
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;
2015-12-22 12:17:13 +01:00
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;
2015-12-18 20:59:40 +01:00
2015-12-22 12:17:13 +01:00
function doDELETE(): 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 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';
2015-12-18 20:59:40 +01:00
function Accept(): string; overload;
function ContentType(): string; overload;
function ContentEncoding(): string; overload;
function ConnectionTimeOut(): Integer; overload;
function ReadTimeOut(): Integer; overload;
2015-12-22 12:17:13 +01:00
function HasSSL(): Boolean;
function HasCompression(): Boolean;
2015-12-18 20:59:40 +01:00
2013-10-30 00:48:23 +01:00
property RawBody: TStringStream read GetRawBody;
property MultiPartFormData: TIdMultiPartFormDataStream
read GetMultiPartFormData;
2015-12-18 20:59:40 +01:00
property BodyParams: TStringlist read GetBodyParams;
2013-10-30 00:48:23 +01:00
property SessionID: string read GetSessionID write SetSessionID;
2015-12-18 20:59:40 +01:00
property Username: string read GetUserName write SetUserName;
property Password: string read GetPassword write SetPassword;
property UseBasicAuthentication: Boolean read GetBasicAuth
write SetBasicAuth;
2015-12-18 20:59:40 +01:00
property RequestHeaders: TStringlist read FRequestHeaders;
property QueryStringParams: TStringlist read GetQueryStringParams;
property ProxyServer: string write SetProxyServer;
property ProxyPort: Integer write SetProxyPort;
2013-10-30 00:48:23 +01:00
end;
implementation
2016-09-13 19:10:26 +02:00
{$IFNDEF ANDROID OR IOS}
{$IF CompilerVersion > 30}
uses
2016-09-25 22:31:33 +02:00
System.AnsiStrings;
{$ENDIF}
2016-09-13 19:10:26 +02:00
{$ENDIF}
2015-12-18 20:59:40 +01:00
type
TRESTResponse = class(TInterfacedObject, IRESTResponse)
strict private
FBody: TMemoryStream;
2015-12-18 20:59:40 +01:00
FResponseCode: Word;
FResponseText: string;
FHeaders: TStringlist;
FBodyAsJSONValue: TJSONValue;
FContentType: string;
FContentEncoding: string;
function GetHeader(const AValue: string): string;
private
FCookies: TIdCookies;
FHasError: Boolean;
FErrorObject: TMVCExceptionObj;
protected
function GetHasError: Boolean;
procedure SetHasError(const aHasError: Boolean);
2015-12-18 20:59:40 +01:00
public
constructor Create; virtual;
destructor Destroy; override;
2013-10-30 00:48:23 +01:00
function GetContentType: string;
function GetContentEncoding: string;
function GetHeaderValue(const AName: string): string;
2015-12-18 20:59:40 +01:00
procedure SetResponseCode(const AResponseCode: Word);
procedure SetResponseText(const AResponseText: string);
procedure SetHeaders(AHeaders: TStrings);
2015-12-18 20:59:40 +01:00
function Body(): TStream;
2015-12-22 12:17:13 +01:00
function BodyAsString(): string;
function BodyAsJSONValue(): TJSONValue;
function BodyAsJSONObject(): TJSONObject;
function BodyAsJSONArray(): TJSONArray;
2015-12-18 20:59:40 +01:00
procedure UpdateResponseCode(const AResponseCode: Word);
procedure UpdateResponseText(const AResponseText: string);
procedure UpdateHeaders(AHeaders: TStrings);
2015-12-22 12:17:13 +01:00
function ResponseCode(): Word;
function ResponseText(): string;
2015-12-18 20:59:40 +01:00
function Headers: TStringlist;
function HeaderValue(const AName: string): string;
2015-12-22 12:17:13 +01:00
function ContentType(): string;
function ContentEncoding(): string;
function Error: TMVCExceptionObj;
function GetCookies: TIdCookies;
procedure SetCookies(aCookie: TIdCookies);
property Cookies: TIdCookies read GetCookies write SetCookies;
2015-12-18 20:59:40 +01:00
end;
{ TRESTResponse }
function TRESTResponse.Body: TStream;
2013-10-30 00:48:23 +01:00
begin
2015-12-18 20:59:40 +01:00
Result := FBody;
2013-10-30 00:48:23 +01:00
end;
2015-12-18 20:59:40 +01:00
function TRESTResponse.BodyAsJSONArray: TJSONArray;
2013-10-30 00:48:23 +01:00
begin
2015-12-18 20:59:40 +01:00
Result := BodyAsJSONValue as TJSONArray;
2013-10-30 00:48:23 +01:00
end;
2015-12-18 20:59:40 +01:00
function TRESTResponse.BodyAsJSONObject: TJSONObject;
2013-10-30 00:48:23 +01:00
begin
2015-12-18 20:59:40 +01:00
Result := BodyAsJSONValue as TJSONObject;
2013-10-30 00:48:23 +01:00
end;
2015-12-18 20:59:40 +01:00
function TRESTResponse.BodyAsJSONValue: TJSONValue;
begin
2015-12-18 20:59:40 +01:00
try
if not Assigned(FBodyAsJSONValue) then
begin
2015-12-18 20:59:40 +01:00
if (BodyAsString = '') then
FBodyAsJSONValue := nil
else
begin
try
FBodyAsJSONValue := TJSONObject.ParseJSONValue(BodyAsString);
except
FBodyAsJSONValue := nil;
end;
end;
end;
2015-12-18 20:59:40 +01:00
Result := FBodyAsJSONValue;
except
on E: Exception do
raise ERESTClientException.Create(E.Message);
end;
end;
2015-12-18 20:59:40 +01:00
function TRESTResponse.BodyAsString: string;
var
ss: TStringStream;
begin
2015-12-18 20:59:40 +01:00
if (FContentEncoding = '') then
FContentEncoding := 'UTF-8';
ss := TStringStream.Create('', TEncoding.GetEncoding(FContentEncoding));
try
FBody.Position := 0;
FBody.SaveToStream(ss);
Result := ss.DataString;
finally
FreeAndNil(ss);
end;
end;
function TRESTResponse.ContentEncoding: string;
begin
Result := FContentEncoding;
end;
function TRESTResponse.ContentType: string;
begin
Result := FContentType;
end;
constructor TRESTResponse.Create;
begin
FHeaders := TStringlist.Create;
FCookies := TIdCookies.Create(nil);
2015-12-18 20:59:40 +01:00
FBody := TStringStream.Create('', TEncoding.UTF8);
FBodyAsJSONValue := nil;
FHasError := False;
2015-12-18 20:59:40 +01:00
end;
destructor TRESTResponse.Destroy;
begin
if Assigned(FBodyAsJSONValue) then
FreeAndNil(FBodyAsJSONValue);
FreeAndNil(FHeaders);
FreeAndNil(FBody);
FreeAndNil(FCookies);
FreeAndNil(FErrorObject);
2015-12-18 20:59:40 +01:00
inherited;
end;
function TRESTResponse.Error: TMVCExceptionObj;
begin
if not FHasError then
Exit(nil);
if not Assigned(FErrorObject) then
begin
FErrorObject := Mapper.JSONObjectToObject<TMVCExceptionObj>(self.BodyAsJSONObject);
end;
Result := FErrorObject;
end;
2015-12-18 20:59:40 +01:00
function TRESTResponse.GetContentEncoding: string;
begin
Result := ContentEncoding;
end;
function TRESTResponse.GetContentType: string;
begin
Result := ContentType;
end;
function TRESTResponse.GetCookies: TIdCookies;
begin
Result := FCookies;
end;
function TRESTResponse.GetHasError: Boolean;
begin
Result := FHasError;
end;
2015-12-18 20:59:40 +01:00
function TRESTResponse.GetHeader(const AValue: string): string;
var
s: string;
begin
if Assigned(FHeaders) and (FHeaders.Count > 0) then
begin
2015-12-18 20:59:40 +01:00
for s in FHeaders do
if s.StartsWith(AValue + ':', True) then
2015-12-18 20:59:40 +01:00
Exit(s);
end
else
2015-12-18 20:59:40 +01:00
Result := '';
end;
function TRESTResponse.GetHeaderValue(const AName: string): string;
begin
Result := HeaderValue(AName);
end;
function TRESTResponse.Headers: TStringlist;
begin
Result := FHeaders;
end;
function TRESTResponse.HeaderValue(const AName: string): string;
var
s: string;
arr: TArray<string>;
begin
Result := '';
for s in self.Headers do
begin
2015-12-18 20:59:40 +01:00
arr := s.Split([':'], 2);
if SameText(arr[0].Trim, AName) then
begin
2015-12-18 20:59:40 +01:00
Result := arr[1].Trim;
Break;
end;
end;
2015-12-18 20:59:40 +01:00
end;
function TRESTResponse.ResponseCode: Word;
begin
Result := FResponseCode;
end;
function TRESTResponse.ResponseText: string;
begin
Result := FResponseText;
end;
procedure TRESTResponse.SetCookies(aCookie: TIdCookies);
begin
FCookies := aCookie;
end;
procedure TRESTResponse.SetHasError(const aHasError: Boolean);
begin
FHasError := aHasError;
end;
2015-12-18 20:59:40 +01:00
procedure TRESTResponse.SetHeaders(AHeaders: TStrings);
begin
UpdateHeaders(AHeaders);
end;
procedure TRESTResponse.SetResponseCode(const AResponseCode: Word);
begin
UpdateResponseCode(AResponseCode);
end;
procedure TRESTResponse.SetResponseText(const AResponseText: string);
begin
UpdateResponseText(AResponseText);
end;
procedure TRESTResponse.UpdateHeaders(AHeaders: TStrings);
var
CT: TArray<string>;
C: string;
begin
FHeaders.Assign(AHeaders);
C := GetHeader('content-type');
if not C.IsEmpty then
begin
CT := C.Split([':'])[1].Split([';']);
FContentType := Trim(CT[0]);
end
else
begin
SetLength(CT, 0);
FContentType := TMVCConstants.DEFAULT_CONTENT_TYPE;
end;
2015-12-18 20:59:40 +01:00
FContentEncoding := 'UTF-8';
if Length(CT) > 1 then
if CT[1].Trim.StartsWith('charset', True) then
FContentEncoding := CT[1].Trim.Split(['='])[1].Trim;
2015-12-18 20:59:40 +01:00
end;
procedure TRESTResponse.UpdateResponseCode(const AResponseCode: Word);
begin
FResponseCode := AResponseCode;
end;
procedure TRESTResponse.UpdateResponseText(const AResponseText: string);
begin
FResponseText := AResponseText;
end;
{ TJSONObjectResponseHelper }
function TJSONObjectResponseHelper.AsObject<T>: T;
begin
Result := Mapper.JSONObjectToObject<T>(self);
2015-12-18 20:59:40 +01:00
end;
{ TJSONArrayResponseHelper }
function TJSONArrayResponseHelper.AsObjectList<T>: TObjectList<T>;
begin
Result := Mapper.JSONArrayToObjectList<T>(self, False, True);
2015-12-18 20:59:40 +01:00
end;
{ TRESTClient }
function TRESTClient.Accept(const AValue: string): TRESTClient;
begin
FAccept := AValue;
Result := self;
2015-12-18 20:59:40 +01:00
end;
function TRESTClient.Accept: string;
begin
Result := FAccept;
end;
function TRESTClient.AcceptCharSet(const AValue: string): TRESTClient;
begin
if (FAccept = '') then
raise ERESTClientException.Create('First set the Accept property!');
if not AnsiContainsText(FAccept, 'charset') then
self.Accept(FAccept + ';charset=' + AValue);
2015-12-18 20:59:40 +01:00
Result := self;
end;
function TRESTClient.AddFile(const AFieldName, AFileName, AContentType: string)
: TRESTClient;
2013-10-30 00:48:23 +01:00
begin
MultiPartFormData.AddFile(AFieldName, AFileName, AContentType);
Result := self;
2013-10-30 00:48:23 +01:00
end;
function TRESTClient.Asynch(AProc: TProc<IRESTResponse>;
AProcErr: TProc<Exception>; AProcAlways: TProc; ASynchronized: Boolean)
: TRESTClient;
2013-10-30 00:48:23 +01:00
begin
2015-12-18 20:59:40 +01:00
FNextRequestIsAsynch := True;
FAsynchProc := AProc;
FAsynchProcErr := AProcErr;
FAsynchProcAlways := AProcAlways;
2014-04-02 20:27:17 +02:00
FSynchronized := ASynchronized;
Result := self;
2013-10-30 00:48:23 +01:00
end;
function TRESTClient.Authentication(const AUsername, APassword: string;
const ABasicAuth: Boolean): TRESTClient;
2015-12-18 20:59:40 +01:00
begin
FHTTP.Request.Username := AUsername;
2015-12-18 20:59:40 +01:00
FHTTP.Request.Password := APassword;
FHTTP.Request.BasicAuthentication := ABasicAuth;
Result := self;
2015-12-18 20:59:40 +01:00
end;
function TRESTClient.ClearHeaders: TRESTClient;
begin
FRequestHeaders.Clear;
Result := self;
2015-12-18 20:59:40 +01:00
end;
2013-10-30 00:48:23 +01:00
function TRESTClient.ClearAllParams: TRESTClient;
begin
2015-12-22 12:17:13 +01:00
RawBody.Size := 0;
RawBody.Position := 0;
2015-12-18 20:59:40 +01:00
BodyParams.Clear;
2015-12-22 12:17:13 +01:00
QueryStringParams.Clear;
2015-12-18 20:59:40 +01:00
FNextRequestIsAsynch := False;
FAsynchProc := nil;
FAsynchProcErr := nil;
FAsynchProcAlways := nil;
2015-12-22 12:17:13 +01:00
FSynchronized := False;
FHTTP.Request.Username := '';
FHTTP.Request.Password := '';
FHTTP.Request.BasicAuthentication := True;
2015-12-18 20:59:40 +01:00
SetLength(FParams, 0);
Result := self;
2015-12-18 20:59:40 +01:00
end;
function TRESTClient.Compression(const AEnabled: Boolean): TRESTClient;
begin
if AEnabled then
begin
if not Assigned(FHTTP.Compressor) then
FHTTP.Compressor := TIdCompressorZLib.Create(FHTTP);
end
else
begin
if (FHTTP.Compressor <> nil) then
begin
FHTTP.Compressor.Free;
FHTTP.Compressor := nil;
end;
end;
Result := self;
2013-10-30 00:48:23 +01:00
end;
2015-12-18 20:59:40 +01:00
function TRESTClient.ConnectionTimeOut(const AValue: Integer): TRESTClient;
2014-04-10 13:56:23 +02:00
begin
2015-12-18 20:59:40 +01:00
FHTTP.ConnectTimeout := AValue;
Result := self;
2015-12-18 20:59:40 +01:00
end;
function TRESTClient.ConnectionTimeOut: Integer;
begin
Result := FHTTP.ConnectTimeout;
end;
function TRESTClient.ContentCharSet(const AValue: string): TRESTClient;
begin
if (FContentType = '') then
raise ERESTClientException.Create('First set the ContentType property!');
if not AnsiContainsText(FContentType, 'charset') then
self.ContentType(FContentType + ';charset=' + AValue);
2015-12-18 20:59:40 +01:00
Result := self;
2014-04-10 13:56:23 +02:00
end;
function TRESTClient.ContentEncoding: string;
begin
Result := FContentEncoding;
end;
2015-12-18 20:59:40 +01:00
function TRESTClient.ContentEncoding(const AValue: string): TRESTClient;
begin
FContentEncoding := AValue;
Result := self;
2015-12-18 20:59:40 +01:00
end;
2013-10-30 00:48:23 +01:00
function TRESTClient.ContentType: string;
begin
Result := FContentType;
end;
2015-12-18 20:59:40 +01:00
function TRESTClient.ContentType(const AValue: string): TRESTClient;
2013-10-30 00:48:23 +01:00
begin
2015-12-18 20:59:40 +01:00
FContentType := AValue;
Result := self;
2013-10-30 00:48:23 +01:00
end;
constructor TRESTClient.Create(const AHost: string; const APort: Word;
AIOHandler: TIdIOHandler);
2014-04-01 22:32:57 +02:00
var
2014-06-27 15:30:39 +02:00
Pieces: TArray<string>;
2013-10-30 00:48:23 +01:00
begin
inherited Create;
2015-12-18 20:59:40 +01:00
FHost := AHost;
FPort := APort;
2013-10-30 00:48:23 +01:00
FPrimaryThread := TThread.CurrentThread;
2015-12-18 20:59:40 +01:00
FBodyParams := nil;
FQueryStringParams := nil;
FRawBody := nil;
2013-10-30 00:48:23 +01:00
FAccept := 'application/json';
FContentType := 'application/json; charset=utf-8';
2015-12-18 20:59:40 +01:00
FResource := '';
FContentEncoding := '';
2013-10-30 00:48:23 +01:00
FRequestHeaders := TStringlist.Create;
2015-12-18 20:59:40 +01:00
FLastSessionID := '';
FNextRequestIsAsynch := False;
FAsynchProc := nil;
FAsynchProcErr := nil;
FAsynchProcAlways := nil;
FMultiPartFormData := nil;
FSynchronized := False;
SetLength(FParams, 0);
if FHost.Contains('://') then
2014-04-01 22:32:57 +02:00
begin
2015-12-18 20:59:40 +01:00
Pieces := FHost.Split(['://'], 2, TStringSplitOptions.ExcludeEmpty);
2014-04-01 22:32:57 +02:00
FProtocol := Pieces[0];
2015-12-18 20:59:40 +01:00
FHost := Pieces[1];
2014-04-01 22:32:57 +02:00
end
else
FProtocol := 'http';
2013-10-30 00:48:23 +01:00
FHTTP := TIdHTTP.Create(nil);
FHTTP.HandleRedirects := False; // DT 2016/09/16
FHTTP.OnRedirect := OnHTTPRedirect; // DT 2016/09/16
FHTTP.ReadTimeOut := 20000;
2015-12-18 20:59:40 +01:00
if (AIOHandler <> nil) then
FHTTP.IOHandler := AIOHandler
else
2015-12-18 20:59:40 +01:00
SSL(False);
Compression(False);
FHTTP.HandleRedirects := True;
FHTTP.Request.CustomHeaders.FoldLines := False;
FHTTP.Request.BasicAuthentication := True;
2015-12-18 20:59:40 +01:00
end;
function TRESTClient.DataSetDelete(const AResource, AKeyValue: string)
: IRESTResponse;
2015-12-18 20:59:40 +01:00
begin
Result := doDELETE(AResource, [AKeyValue]);
end;
function TRESTClient.DataSetInsert(const AResource: string; ADataSet: TDataSet)
: IRESTResponse;
2015-12-18 20:59:40 +01:00
begin
Result := doPOST(AResource, [], ADataSet.AsJSONObjectString);
end;
function TRESTClient.DataSetUpdate(const AResource: string; ADataSet: TDataSet;
const AKeyValue: string): IRESTResponse;
2015-12-18 20:59:40 +01:00
begin
2015-12-22 12:17:13 +01:00
Result := doPUT(AResource, [AKeyValue], ADataSet.AsJSONObjectString);
2013-10-30 00:48:23 +01:00
end;
destructor TRESTClient.Destroy;
begin
2015-12-18 20:59:40 +01:00
if Assigned(FBodyParams) then
FreeAndNil(FBodyParams);
if Assigned(FQueryStringParams) then
FreeAndNil(FQueryStringParams);
if Assigned(FRawBody) then
FreeAndNil(FRawBody);
if Assigned(FMultiPartFormData) then
FreeAndNil(FMultiPartFormData);
2013-10-30 00:48:23 +01:00
FreeAndNil(FRequestHeaders);
2015-12-18 20:59:40 +01:00
FreeAndNil(FHTTP);
2013-10-30 00:48:23 +01:00
inherited;
end;
function TRESTClient.doDELETE(const AResource: string;
const AParams: array of string): IRESTResponse;
2013-10-30 00:48:23 +01:00
var
URL: string;
2013-10-30 00:48:23 +01:00
begin
2015-12-22 12:17:13 +01:00
URL := FProtocol + '://' + FHost + ':' + IntToStr(FPort) + AResource +
2015-12-18 20:59:40 +01:00
EncodeResourceParams(AParams) + EncodeQueryStringParams(QueryStringParams);
2013-10-30 00:48:23 +01:00
if FNextRequestIsAsynch then
begin
Result := nil;
StartAsynchRequest(httpDELETE, URL);
2013-10-30 00:48:23 +01:00
end
else
begin
Result := SendHTTPCommand(httpDELETE, FAccept, FContentType, URL, nil);
2013-10-30 00:48:23 +01:00
ClearAllParams;
end;
end;
2015-12-22 12:17:13 +01:00
function TRESTClient.doDELETE: IRESTResponse;
begin
if (FResource = '') then
raise ERESTClientException.Create('You must enter the Resource!');
Result := doDELETE(FResource, FParams);
end;
function TRESTClient.doGET: IRESTResponse;
begin
if (FResource = '') then
raise ERESTClientException.Create('You must enter the Resource!');
Result := doGET(FResource, FParams);
end;
function TRESTClient.doGET(const AResource: string;
const AParams: array of string; const aQueryStringParams: TStrings): IRESTResponse;
2013-10-30 00:48:23 +01:00
var
URL: string;
2013-10-30 00:48:23 +01:00
begin
2015-12-18 20:59:40 +01:00
URL := FProtocol + '://' + FHost + ':' + IntToStr(FPort) + AResource +
EncodeResourceParams(AParams);
if aQueryStringParams = nil then
URL := URL + EncodeQueryStringParams(FQueryStringParams)
else
URL := URL + EncodeQueryStringParams(aQueryStringParams);
2013-10-30 00:48:23 +01:00
if FNextRequestIsAsynch then
begin
Result := nil;
StartAsynchRequest(httpGET, URL);
2013-10-30 00:48:23 +01:00
end
else
begin
Result := SendHTTPCommand(httpGET, FAccept, FContentType, URL, nil);
2013-10-30 00:48:23 +01:00
ClearAllParams;
end;
end;
function TRESTClient.doPOST(const AResource: string;
const AParams: array of string): IRESTResponse;
2013-10-30 00:48:23 +01:00
var
s: string;
begin
try
Result := SendHTTPCommand(httpPOST, FAccept, FContentType,
FProtocol + '://' + FHost + ':' + IntToStr(FPort) + AResource +
EncodeResourceParams(AParams) + EncodeQueryStringParams
(FQueryStringParams), FBodyParams);
2013-10-30 00:48:23 +01:00
except
on E: EIdHTTPProtocolException do
s := E.Message;
end;
ClearAllParams;
end;
function TRESTClient.doPOST(const AResource: string;
const AParams: array of string; ABody: TJSONValue; const AOwnsBody: Boolean)
: IRESTResponse;
2015-12-18 20:59:40 +01:00
begin
if not Assigned(ABody) then
raise ERESTClientException.Create('ABody is nil JSONValue');
try
Result := doPOST(AResource, AParams,
{$IF CompilerVersion >= 28}
2015-12-18 20:59:40 +01:00
ABody.ToJSON
{$ELSE}
2015-12-18 20:59:40 +01:00
ABody.ToString
{$ENDIF});
2015-12-18 20:59:40 +01:00
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;
begin
2015-12-18 20:59:40 +01:00
if not Assigned(ABody) then
raise ERESTClientException.Create('ABody is nil JSONValue');
try
2015-12-18 20:59:40 +01:00
Result := doPATCH(AResource, AParams,
{$IF CompilerVersion >= 28}
2015-12-18 20:59:40 +01:00
ABody.ToJSON
{$ELSE}
2015-12-18 20:59:40 +01:00
ABody.ToString
{$ENDIF});
finally
2015-12-18 20:59:40 +01:00
if AOwnsBody then
FreeAndNil(ABody);
end;
end;
function TRESTClient.doPATCH(const AResource: string;
const AParams: array of string; const ABody: string): IRESTResponse;
2014-03-24 17:37:08 +01:00
var
URL: string;
2014-03-24 17:37:08 +01:00
begin
2015-12-22 12:17:13 +01:00
URL := FProtocol + '://' + FHost + ':' + IntToStr(FPort) + AResource +
2015-12-18 20:59:40 +01:00
EncodeResourceParams(AParams) + EncodeQueryStringParams(QueryStringParams);
2014-03-24 17:37:08 +01:00
if FNextRequestIsAsynch then
begin
Result := nil;
2015-12-18 20:59:40 +01:00
StartAsynchRequest(httpPOST, URL, ABody);
2014-03-24 17:37:08 +01:00
end
else
begin
Result := SendHTTPCommandWithBody(httpPATCH, FAccept, FContentType,
URL, ABody);
2014-03-24 17:37:08 +01:00
ClearAllParams;
end;
end;
2015-12-22 12:17:13 +01:00
function TRESTClient.doPATCH(const ABody: string): IRESTResponse;
begin
if (FResource = '') then
raise ERESTClientException.Create('You must enter the Resource!');
if (ABody = '') then
raise ERESTClientException.Create('You must enter the Body!');
Result := doPATCH(FResource, FParams, ABody);
end;
function TRESTClient.doPATCH(ABody: TJSONValue; const AOwnsBody: Boolean)
: IRESTResponse;
2015-12-22 12:17:13 +01:00
begin
if (FResource = '') then
raise ERESTClientException.Create('You must enter the Resource!');
if not Assigned(ABody) then
raise ERESTClientException.Create('You must enter the Body!');
Result := doPATCH(FResource, FParams, ABody, AOwnsBody);
end;
function TRESTClient.doPATCH<TBodyType>(ABody: TBodyType;
const AOwnsBody: Boolean): IRESTResponse;
2015-12-22 12:17:13 +01:00
begin
if (FResource = '') then
raise ERESTClientException.Create('You must enter the Resource!');
if not Assigned(ABody) then
raise ERESTClientException.Create('You must enter the Body!');
Result := doPATCH(FResource, FParams, Mapper.ObjectToJSONObject(ABody)
as TJSONValue, True);
2015-12-22 12:17:13 +01:00
if AOwnsBody then
TObject(ABody).Free;
end;
function TRESTClient.doPATCH<TBodyType>(ABody: TObjectList<TBodyType>;
const AOwnsBody: Boolean): IRESTResponse;
2015-12-22 12:17:13 +01:00
begin
if (FResource = '') then
raise ERESTClientException.Create('You must enter the Resource!');
if not Assigned(ABody) then
raise ERESTClientException.Create('You must enter the Body!');
ABody.OwnsObjects := AOwnsBody;
Result := doPATCH(FResource, FParams, Mapper.ObjectListToJSONArray<TBodyType>
(ABody, AOwnsBody) as TJSONValue, True);
2015-12-22 12:17:13 +01:00
end;
function TRESTClient.doPOST(const AResource: string;
const AParams: array of string; const ABody: string): IRESTResponse;
2013-10-30 00:48:23 +01:00
var
URL: string;
2013-10-30 00:48:23 +01:00
begin
2015-12-22 12:17:13 +01:00
URL := FProtocol + '://' + FHost + ':' + IntToStr(FPort) + AResource +
2015-12-18 20:59:40 +01:00
EncodeResourceParams(AParams) + EncodeQueryStringParams(QueryStringParams);
2013-10-30 00:48:23 +01:00
if FNextRequestIsAsynch then
begin
Result := nil;
2015-12-18 20:59:40 +01:00
StartAsynchRequest(httpPOST, URL, ABody);
2013-10-30 00:48:23 +01:00
end
else
begin
Result := SendHTTPCommandWithBody(httpPOST, FAccept, FContentType,
URL, ABody);
ClearAllParams;
2013-10-30 00:48:23 +01:00
end;
end;
2015-12-22 12:17:13 +01:00
function TRESTClient.doPOST(const ABody: string): IRESTResponse;
begin
if (FResource = '') then
raise ERESTClientException.Create('You must enter the Resource!');
if (ABody = '') then
raise ERESTClientException.Create('You must enter the Body!');
Result := doPOST(FResource, FParams, ABody);
end;
function TRESTClient.doPOST(ABody: TJSONValue; const AOwnsBody: Boolean)
: IRESTResponse;
2015-12-22 12:17:13 +01:00
begin
if (FResource = '') then
raise ERESTClientException.Create('You must enter the Resource!');
if not Assigned(ABody) then
raise ERESTClientException.Create('You must enter the Body!');
Result := doPOST(FResource, FParams, ABody, AOwnsBody);
end;
function TRESTClient.doPOST<TBodyType>(ABody: TBodyType;
const AOwnsBody: Boolean): IRESTResponse;
2015-12-22 12:17:13 +01:00
begin
if (FResource = '') then
raise ERESTClientException.Create('You must enter the Resource!');
if not Assigned(ABody) then
raise ERESTClientException.Create('You must enter the Body!');
Result := doPOST(FResource, FParams, Mapper.ObjectToJSONObject(ABody)
as TJSONValue, True);
2015-12-22 12:17:13 +01:00
if AOwnsBody then
TObject(ABody).Free;
end;
function TRESTClient.doPOST<TBodyType>(ABody: TObjectList<TBodyType>;
const AOwnsBody: Boolean): IRESTResponse;
2015-12-22 12:17:13 +01:00
begin
if (FResource = '') then
raise ERESTClientException.Create('You must enter the Resource!');
if not Assigned(ABody) then
raise ERESTClientException.Create('You must enter the Body!');
ABody.OwnsObjects := AOwnsBody;
Result := doPOST(FResource, FParams, Mapper.ObjectListToJSONArray<TBodyType>
(ABody, AOwnsBody) as TJSONValue, True);
2015-12-22 12:17:13 +01:00
end;
function TRESTClient.doPUT(const AResource: string;
const AParams: array of string): IRESTResponse;
2015-12-18 20:59:40 +01:00
begin
Result := SendHTTPCommand(httpPUT, FAccept, FContentType,
FProtocol + '://' + FHost + ':' + IntToStr(FPort) + AResource +
EncodeResourceParams(AParams) + EncodeQueryStringParams(QueryStringParams),
FBodyParams);
2015-12-18 20:59:40 +01:00
ClearAllParams;
end;
function TRESTClient.doPUT(const AResource: string;
const AParams: array of string; ABody: TJSONValue; const AOwnsBody: Boolean)
: IRESTResponse;
2015-12-18 20:59:40 +01:00
begin
if not Assigned(ABody) then
raise ERESTClientException.Create('ABody is nil JSONValue');
try
Result := doPUT(AResource, AParams,
{$IF CompilerVersion >= 28}
2015-12-18 20:59:40 +01:00
ABody.ToJSON
{$ELSE}
2015-12-18 20:59:40 +01:00
ABody.ToString
{$ENDIF});
2015-12-18 20:59:40 +01:00
finally
if AOwnsBody then
FreeAndNil(ABody);
end;
end;
function TRESTClient.doPUT(const AResource: string;
const AParams: array of string; const ABody: string): IRESTResponse;
2013-10-30 00:48:23 +01:00
var
URL: string;
2013-10-30 00:48:23 +01:00
begin
2015-12-22 12:17:13 +01:00
URL := FProtocol + '://' + FHost + ':' + IntToStr(FPort) + AResource +
2015-12-18 20:59:40 +01:00
EncodeResourceParams(AParams) + EncodeQueryStringParams(QueryStringParams);
2013-10-30 00:48:23 +01:00
if FNextRequestIsAsynch then
begin
Result := nil;
2015-12-18 20:59:40 +01:00
StartAsynchRequest(httpPUT, URL, ABody);
2013-10-30 00:48:23 +01:00
end
else
begin
Result := SendHTTPCommandWithBody(httpPUT, FAccept, FContentType,
URL, ABody);
2013-11-11 12:23:49 +01:00
ClearAllParams;
end;
end;
2015-12-22 12:17:13 +01:00
function TRESTClient.doPUT(const ABody: string): IRESTResponse;
begin
if (FResource = '') then
raise ERESTClientException.Create('You must enter the Resource!');
if (ABody = '') then
raise ERESTClientException.Create('You must enter the Body!');
Result := doPUT(FResource, FParams, ABody);
end;
function TRESTClient.doPUT(ABody: TJSONValue; const AOwnsBody: Boolean)
: IRESTResponse;
2015-12-22 12:17:13 +01:00
begin
if (FResource = '') then
raise ERESTClientException.Create('You must enter the Resource!');
if not Assigned(ABody) then
raise ERESTClientException.Create('You must enter the Body!');
Result := doPUT(FResource, FParams, ABody, AOwnsBody);
end;
function TRESTClient.doPUT<TBodyType>(ABody: TBodyType;
const AOwnsBody: Boolean): IRESTResponse;
2015-12-22 12:17:13 +01:00
begin
if (FResource = '') then
raise ERESTClientException.Create('You must enter the Resource!');
if not Assigned(ABody) then
raise ERESTClientException.Create('You must enter the Body!');
Result := doPUT(FResource, FParams, Mapper.ObjectToJSONObject(ABody)
as TJSONValue, True);
2015-12-22 12:17:13 +01:00
if AOwnsBody then
TObject(ABody).Free;
end;
function TRESTClient.doPUT<TBodyType>(ABody: TObjectList<TBodyType>;
const AOwnsBody: Boolean): IRESTResponse;
2015-12-22 12:17:13 +01:00
begin
if (FResource = '') then
raise ERESTClientException.Create('You must enter the Resource!');
if not Assigned(ABody) then
raise ERESTClientException.Create('You must enter the Body!');
ABody.OwnsObjects := AOwnsBody;
Result := doPUT(FResource, FParams, Mapper.ObjectListToJSONArray<TBodyType>
(ABody, AOwnsBody) as TJSONValue, True);
2015-12-22 12:17:13 +01:00
end;
function TRESTClient.DSDelete(const AResource, AKeyValue: string)
: IRESTResponse;
begin
2015-12-18 20:59:40 +01:00
Result := DataSetDelete(AResource, AKeyValue);
end;
function TRESTClient.DSInsert(const AResource: string; ADataSet: TDataSet)
: IRESTResponse;
begin
2015-12-18 20:59:40 +01:00
Result := DataSetInsert(AResource, ADataSet);
end;
function TRESTClient.DSUpdate(const AResource: string; ADataSet: TDataSet;
const AKeyValue: string): IRESTResponse;
begin
2015-12-18 20:59:40 +01:00
Result := DataSetUpdate(AResource, ADataSet, AKeyValue);
end;
function TRESTClient.EncodeQueryStringParams(const AParams: TStrings;
AIncludeQuestionMark: Boolean): string;
2015-12-18 20:59:40 +01:00
var
I: Integer;
2013-11-11 12:23:49 +01:00
begin
2015-12-18 20:59:40 +01:00
Result := '';
2013-11-11 12:23:49 +01:00
2015-12-18 20:59:40 +01:00
if not Assigned(AParams) or (AParams.Count = 0) then
Exit;
2013-10-30 00:48:23 +01:00
2015-12-18 20:59:40 +01:00
if AIncludeQuestionMark then
Result := '?';
for I := 0 to AParams.Count - 1 do
begin
if I > 0 then
Result := Result + '&';
Result := Result + AParams.Names[I] + '=' + TIdURI.ParamsEncode
(AParams.ValueFromIndex[I]);
2015-12-18 20:59:40 +01:00
end;
2013-10-30 00:48:23 +01:00
end;
function TRESTClient.EncodeResourceParams(const AResourceParams
: array of string): string;
2013-10-30 00:48:23 +01:00
var
2015-12-18 20:59:40 +01:00
I: Integer;
2013-10-30 00:48:23 +01:00
begin
Result := '';
for I := low(AResourceParams) to high(AResourceParams) do
Result := Result + '/' + TIdURI.ParamsEncode(AResourceParams[I]);
2013-10-30 00:48:23 +01:00
end;
2015-12-18 20:59:40 +01:00
function TRESTClient.GetBasicAuth: Boolean;
begin
Result := FHTTP.Request.BasicAuthentication;
end;
2013-10-30 00:48:23 +01:00
function TRESTClient.GetBodyParams: TStringlist;
begin
if not Assigned(FBodyParams) then
FBodyParams := TStringlist.Create;
Result := FBodyParams;
end;
2015-12-18 20:59:40 +01:00
function TRESTClient.GetMultiPartFormData: TIdMultiPartFormDataStream;
2013-10-30 00:48:23 +01:00
begin
if not Assigned(FMultiPartFormData) then
FMultiPartFormData := TIdMultiPartFormDataStream.Create;
Result := FMultiPartFormData;
end;
2015-04-01 17:01:23 +02:00
function TRESTClient.GetPassword: string;
begin
Result := FHTTP.Request.Password;
end;
2013-10-30 00:48:23 +01:00
function TRESTClient.GetQueryStringParams: TStringlist;
begin
if not Assigned(FQueryStringParams) then
FQueryStringParams := TStringlist.Create;
Result := FQueryStringParams;
end;
function TRESTClient.GetRawBody: TStringStream;
begin
if not Assigned(FRawBody) then
FRawBody := TStringStream.Create('');
Result := FRawBody;
end;
2015-12-18 20:59:40 +01:00
function TRESTClient.GetSessionID: string;
2013-10-30 00:48:23 +01:00
begin
2015-12-18 20:59:40 +01:00
Result := FLastSessionID;
2013-10-30 00:48:23 +01:00
end;
2015-12-18 20:59:40 +01:00
function TRESTClient.GetUserName: string;
2013-10-30 00:48:23 +01:00
begin
Result := FHTTP.Request.Username;
2013-10-30 00:48:23 +01:00
end;
procedure TRESTClient.HandleCookies(aCookies: TIdCookies;
aRESTResponse: IRESTResponse);
2013-10-30 00:48:23 +01:00
var
2013-11-05 14:57:50 +01:00
s: string;
2013-10-30 00:48:23 +01:00
arr: TArray<string>;
begin
aCookies.LockCookieList(caReadWrite);
try
aRESTResponse.Cookies.Clear;
aRESTResponse.Cookies.AddCookies(aCookies);
finally
aCookies.UnlockCookieList(caReadWrite);
end;
2013-10-30 00:48:23 +01:00
for s in FHTTP.Response.RawHeaders do
begin
if s.StartsWith('Set-Cookie', True) then
2013-10-30 00:48:23 +01:00
begin
arr := s.Split([':'], 2);
2015-12-18 20:59:40 +01:00
if arr[1].Trim.StartsWith('dtsessionid') then
2013-10-30 00:48:23 +01:00
begin
arr := arr[1].Split(['='], 2);
FLastSessionID := TIdURI.URLDecode(arr[1].Split([';'])[0]);
if FLastSessionID.Contains('invalid') then
FLastSessionID := '';
2013-10-30 00:48:23 +01:00
end;
Break;
end;
end;
end;
procedure TRESTClient.HandleRequestCookies;
var
2015-12-18 20:59:40 +01:00
I: Integer;
2013-10-30 00:48:23 +01:00
begin
if Assigned(FHTTP.CookieManager) then
FHTTP.CookieManager.CookieCollection.Clear;
2015-12-18 20:59:40 +01:00
if not FLastSessionID.Trim.IsEmpty then
FHTTP.Request.CustomHeaders.AddValue('Cookie',
'dtsessionid=' + FLastSessionID);
2013-10-30 00:48:23 +01:00
2015-12-18 20:59:40 +01:00
for I := 0 to FRequestHeaders.Count - 1 do
2013-10-30 00:48:23 +01:00
begin
2015-12-18 20:59:40 +01:00
FHTTP.Request.CustomHeaders.AddValue(FRequestHeaders.Names[I],
FRequestHeaders.ValueFromIndex[I]);
2013-10-30 00:48:23 +01:00
end;
end;
2015-12-22 12:17:13 +01:00
function TRESTClient.HasCompression: Boolean;
begin
Result := (FHTTP.Compressor <> nil);
end;
function TRESTClient.HasSSL: Boolean;
begin
Result := (FHTTP.IOHandler <> nil);
end;
2015-12-18 20:59:40 +01:00
function TRESTClient.Header(const AField, AValue: string): TRESTClient;
begin
FRequestHeaders.Add(AField + '=' + AValue);
Result := self;
2015-12-18 20:59:40 +01:00
end;
function TRESTClient.HTTPCommandToString(const ACommand: THTTPCommand): string;
2013-10-30 00:48:23 +01:00
begin
2015-12-18 20:59:40 +01:00
case ACommand of
2013-10-30 00:48:23 +01:00
httpGET:
Result := 'GET';
httpPOST:
Result := 'POST';
httpPUT:
Result := 'PUT';
httpDELETE:
Result := 'DELETE';
2013-11-05 14:57:50 +01:00
else
raise ERESTClientException.Create
('Unknown HTTPCommand in TRESTClient.HTTPCommandToString');
2013-10-30 00:48:23 +01:00
end;
end;
procedure TRESTClient.OnHTTPRedirect(Sender: TObject; var dest: string;
var NumRedirect: Integer; var Handled: Boolean; var VMethod: TIdHTTPMethod);
begin
Handled := False;
end;
2015-12-18 20:59:40 +01:00
function TRESTClient.Params(const AValues: array of string): TRESTClient;
var
I: Integer;
begin
SetLength(FParams, Length(AValues));
for I := low(AValues) to high(AValues) do
2015-12-18 20:59:40 +01:00
FParams[I] := AValues[I];
Result := self;
2015-12-18 20:59:40 +01:00
end;
function TRESTClient.ReadTimeOut(const AValue: Integer): TRESTClient;
begin
FHTTP.ReadTimeOut := AValue;
Result := self;
2015-12-18 20:59:40 +01:00
end;
function TRESTClient.ReadTimeOut: Integer;
begin
Result := FHTTP.ReadTimeOut;
2015-12-18 20:59:40 +01:00
end;
2013-10-30 00:48:23 +01:00
function TRESTClient.ResetSession: TRESTClient;
begin
SessionID := '';
if Assigned(FHTTP.CookieManager) then
FHTTP.CookieManager.CookieCollection.Clear;
FHTTP.Request.RawHeaders.Clear;
Result := self;
2013-10-30 00:48:23 +01:00
end;
2015-12-18 20:59:40 +01:00
function TRESTClient.Resource(const AValue: string): TRESTClient;
begin
FResource := AValue;
Result := self;
2015-12-18 20:59:40 +01:00
end;
function TRESTClient.SendHTTPCommand(const ACommand: THTTPCommand;
const AAccept, AContentType, AResource: string; ABodyParams: TStrings)
: IRESTResponse;
2013-10-30 00:48:23 +01:00
begin
Result := TRESTResponse.Create;
2015-12-18 20:59:40 +01:00
2013-10-30 00:48:23 +01:00
FHTTP.Request.RawHeaders.Clear;
FHTTP.Request.CustomHeaders.Clear;
FHTTP.Request.Accept := AAccept;
FHTTP.Request.ContentType := AContentType;
2015-12-18 20:59:40 +01:00
2013-10-30 00:48:23 +01:00
HandleRequestCookies;
try
case ACommand of
httpGET:
begin
Result.Body.Position := 0;
2015-12-18 20:59:40 +01:00
FHTTP.Get(AResource, Result.Body);
2013-10-30 00:48:23 +01:00
end;
httpPOST:
begin
if (MultiPartFormData.Size = 0) then
2013-10-30 00:48:23 +01:00
begin
Result.Body.Position := 0;
2015-12-18 20:59:40 +01:00
FHTTP.Post(AResource, RawBody, Result.Body);
2013-10-30 00:48:23 +01:00
end
else
begin
FHTTP.Post(AResource, MultiPartFormData, Result.Body);
MultiPartFormData.Clear;
2013-10-30 00:48:23 +01:00
end;
end;
httpPUT:
begin
if (MultiPartFormData.Size <> 0)
then { TODO -oDaniele -cGeneral : Rework please!!! }
2015-12-18 20:59:40 +01:00
raise ERESTClientException.Create('Only POST can Send Files');
2013-10-30 00:48:23 +01:00
Result.Body.Position := 0;
2015-12-18 20:59:40 +01:00
2013-10-30 00:48:23 +01:00
if Assigned(ABodyParams) and (ABodyParams.Count > 0) then
begin
2015-12-18 20:59:40 +01:00
RawBody.Size := 0;
RawBody.WriteString(EncodeQueryStringParams(ABodyParams, False));
2013-10-30 00:48:23 +01:00
end;
2015-12-18 20:59:40 +01:00
FHTTP.Put(AResource, RawBody, Result.Body);
2013-10-30 00:48:23 +01:00
end;
httpDELETE:
begin
Result.Body.Position := 0;
2015-12-18 20:59:40 +01:00
FHTTP.Delete(AResource);
RawBody.Size := 0;
2013-10-30 00:48:23 +01:00
end;
end;
except
on E: EIdHTTPProtocolException do
begin
Result.HasError := True;
Result.Body.Write(UTF8Encode(E.ErrorMessage)[1],
{$IF CompilerVersion > 30}
ElementToCharLen(string(UTF8Encode(E.ErrorMessage)),
{$ELSE}
ElementToCharLen(UTF8Encode(E.ErrorMessage),
{$ENDIF}
Length(E.ErrorMessage) * 2));
end
2015-12-18 20:59:40 +01:00
else
raise;
2013-10-30 00:48:23 +01:00
end;
2015-12-18 20:59:40 +01:00
HandleCookies(FHTTP.CookieManager.CookieCollection, Result);
2015-12-18 20:59:40 +01:00
Result.UpdateResponseCode(FHTTP.Response.ResponseCode);
Result.UpdateResponseText(FHTTP.Response.ResponseText);
Result.UpdateHeaders(FHTTP.Response.RawHeaders);
2013-10-30 00:48:23 +01:00
end;
2015-12-18 20:59:40 +01:00
function TRESTClient.SendHTTPCommandWithBody(const ACommand: THTTPCommand;
const AAccept, AContentType, AResource, ABody: string): IRESTResponse;
2013-10-30 00:48:23 +01:00
begin
Result := TRESTResponse.Create;
2015-12-18 20:59:40 +01:00
2013-10-30 00:48:23 +01:00
FHTTP.Request.RawHeaders.Clear;
FHTTP.Request.CustomHeaders.Clear;
FHTTP.Request.Accept := AAccept;
FHTTP.Request.ContentType := AContentType;
2015-12-18 20:59:40 +01:00
2013-10-30 00:48:23 +01:00
HandleRequestCookies;
try
case ACommand of
httpGET:
begin
2015-12-18 20:59:40 +01:00
FHTTP.Get(AResource, Result.Body);
2013-10-30 00:48:23 +01:00
end;
httpPOST:
begin
if (MultiPartFormData.Size <> 0) then
2015-12-18 20:59:40 +01:00
raise ERESTClientException.Create('This method cannot send files');
2013-10-30 00:48:23 +01:00
RawBody.Position := 0;
2015-12-18 20:59:40 +01:00
RawBody.Size := 0;
{$WARNINGS OFF}
2015-12-18 20:59:40 +01:00
if (LowerCase(FHTTP.Request.CharSet) = 'utf-8') then
RawBody.WriteString(UTF8ToString(ABody))
else
2015-12-18 20:59:40 +01:00
RawBody.WriteString(ABody);
{$WARNINGS ON}
2015-12-18 20:59:40 +01:00
FHTTP.Post(AResource, RawBody, Result.Body);
2013-10-30 00:48:23 +01:00
end;
2014-03-24 17:37:08 +01:00
httpPATCH:
begin
2015-12-18 20:59:40 +01:00
raise ERESTClientException.Create
2015-04-01 17:01:23 +02:00
('Sorry, PATCH is not supported by the RESTClient because is not supportd by the TidHTTP');
2014-03-24 17:37:08 +01:00
end;
2013-10-30 00:48:23 +01:00
httpPUT:
begin
RawBody.Position := 0;
2015-12-18 20:59:40 +01:00
RawBody.Size := 0;
{$WARNINGS OFF}
2015-12-18 20:59:40 +01:00
if (LowerCase(FHTTP.Request.CharSet) = 'utf-8') then
RawBody.WriteString(UTF8ToString(ABody))
else
2015-12-18 20:59:40 +01:00
RawBody.WriteString(ABody);
{$WARNINGS ON}
2015-12-18 20:59:40 +01:00
FHTTP.Put(AResource, RawBody, Result.Body);
2013-10-30 00:48:23 +01:00
end;
httpDELETE:
begin
2015-12-18 20:59:40 +01:00
FHTTP.Delete(AResource);
2013-10-30 00:48:23 +01:00
RawBody.Size := 0;
end;
end;
except
on E: EIdHTTPProtocolException do
begin
Result.HasError := True;
Result.Body.Write(UTF8Encode(E.ErrorMessage)[1],
{$IF CompilerVersion > 30}
ElementToCharLen(string(UTF8Encode(E.ErrorMessage)),
{$ELSE}
ElementToCharLen(UTF8Encode(E.ErrorMessage),
{$ENDIF}
Length(E.ErrorMessage) * 2));
end
2015-12-18 20:59:40 +01:00
else
raise;
2013-10-30 00:48:23 +01:00
end;
HandleCookies(FHTTP.CookieManager.CookieCollection, Result);
2013-10-30 00:48:23 +01:00
2015-12-18 20:59:40 +01:00
Result.UpdateResponseCode(FHTTP.Response.ResponseCode);
Result.UpdateResponseText(FHTTP.Response.ResponseText);
Result.UpdateHeaders(FHTTP.Response.RawHeaders);
2013-10-30 00:48:23 +01:00
end;
2015-12-18 20:59:40 +01:00
procedure TRESTClient.SetBasicAuth(const AValue: Boolean);
2015-04-01 17:01:23 +02:00
begin
2015-12-18 20:59:40 +01:00
FHTTP.Request.BasicAuthentication := AValue;
2015-04-01 17:01:23 +02:00
end;
2015-12-18 20:59:40 +01:00
procedure TRESTClient.SetPassword(const AValue: string);
2013-10-30 00:48:23 +01:00
begin
2015-12-18 20:59:40 +01:00
FHTTP.Request.Password := AValue;
2013-10-30 00:48:23 +01:00
end;
procedure TRESTClient.SetProxyPort(const AValue: Integer);
begin
FHTTP.ProxyParams.ProxyPort := AValue;
end;
procedure TRESTClient.SetProxyServer(const AValue: string);
begin
FHTTP.ProxyParams.ProxyServer := AValue;
end;
2015-12-18 20:59:40 +01:00
procedure TRESTClient.SetSessionID(const AValue: string);
2013-10-30 00:48:23 +01:00
begin
2015-12-18 20:59:40 +01:00
FLastSessionID := AValue;
2013-10-30 00:48:23 +01:00
if Assigned(FHTTP.CookieManager) then
FHTTP.CookieManager.CookieCollection.Clear;
end;
2015-12-18 20:59:40 +01:00
procedure TRESTClient.SetUserName(const AValue: string);
2013-11-05 14:57:50 +01:00
begin
FHTTP.Request.Username := AValue;
2013-11-05 14:57:50 +01:00
end;
2015-12-18 20:59:40 +01:00
function TRESTClient.SSL(const AEnabled: Boolean): TRESTClient;
2013-11-05 14:57:50 +01:00
begin
2015-12-18 20:59:40 +01:00
if AEnabled then
2013-11-05 14:57:50 +01:00
begin
2015-12-18 20:59:40 +01:00
if not Assigned(FHTTP.IOHandler) then
FHTTP.IOHandler := TIdSSLIOHandlerSocketOpenSSL.Create(FHTTP);
2013-11-05 14:57:50 +01:00
end
else
begin
2015-12-18 20:59:40 +01:00
if (FHTTP.IOHandler <> nil) then
begin
2015-12-18 20:59:40 +01:00
FHTTP.IOHandler.Free;
FHTTP.IOHandler := nil;
end;
end;
Result := self;
end;
procedure TRESTClient.StartAsynchRequest(const ACommand: THTTPCommand;
const AResource: string);
2013-10-30 00:48:23 +01:00
begin
2015-12-18 20:59:40 +01:00
StartAsynchRequest(ACommand, AResource, '');
2013-10-30 00:48:23 +01:00
end;
procedure TRESTClient.StartAsynchRequest(const ACommand: THTTPCommand;
const AResource, ABody: string);
2013-11-05 14:57:50 +01:00
var
2015-12-18 20:59:40 +01:00
th: TThread;
2013-10-30 00:48:23 +01:00
begin
2015-12-18 20:59:40 +01:00
th := TThread.CreateAnonymousThread(
procedure
var
R: IRESTResponse;
2013-11-05 14:57:50 +01:00
begin
2015-12-18 20:59:40 +01:00
try
R := SendHTTPCommandWithBody(ACommand, FAccept, FContentType,
AResource, ABody);
2015-12-18 20:59:40 +01:00
TMonitor.Enter(TObject(R));
try
if FSynchronized then
TThread.Synchronize(nil,
procedure
begin
FAsynchProc(R);
end)
else
FAsynchProc(R);
finally
TMonitor.Exit(TObject(R));
end;
except
on E: Exception do
begin
if FSynchronized then
TThread.Synchronize(nil,
procedure
begin
FAsynchProcErr(E);
end)
else
FAsynchProcErr(E);
end;
end;
if Assigned(FAsynchProcAlways) then
begin
if FSynchronized then
TThread.Synchronize(nil,
procedure
begin
FAsynchProcAlways();
end)
else
FAsynchProcAlways();
end;
ClearAllParams;
end);
th.Start;
2013-10-30 00:48:23 +01:00
end;
end.