delphimvcframework/sources/MVCFramework.RESTClient.pas
daniele.teti 19d0686644 Refactoring
ADD Session demo
2014-03-31 22:02:31 +00:00

961 lines
26 KiB
ObjectPascal

unit MVCFramework.RESTClient;
interface
uses
Classes,
IdBaseComponent,
IdComponent,
IdTCPConnection,
IdTCPClient,
IdHTTP,
idURI,
DBXJSON,
IdMultipartFormData,
System.SysUtils;
type
TArrayOfString = array of string;
THttpCommand = (httpGET, httpPOST, httpPUT, httpDELETE, httpPATCH, httpTRACE);
IRESTResponse = interface
function BodyAsString: string;
function BodyAsJsonObject: TJSONObject;
function BodyAsJsonValue: TJSONValue;
function ResponseCode: Word;
function ResponseText: string;
function Headers: TStringlist;
function GetContentType: String;
function GetContentEncoding: String;
function Body: TStringStream;
function GetHeaderValue(const Name: String): String;
procedure SetResponseCode(AResponseCode: Word);
procedure SetResponseText(AResponseText: string);
procedure SetHeaders(AHeaders: TStrings);
end;
TRESTResponse = class(TInterfacedObject, IRESTResponse)
private
FBody: TStringStream;
FResponseCode: Word;
FResponseText: string;
FHeaders: TStringlist;
FBodyAsJSONValue: TJSONValue;
FContentType: string;
FContentEncoding: String;
function GetHeader(const Value: String): String;
public
function BodyAsString: string;
function BodyAsJsonObject: TJSONObject;
function BodyAsJsonValue: TJSONValue;
function ResponseCode: Word;
function ResponseText: string;
function Headers: TStringlist;
function Body: TStringStream;
function GetContentType: String;
function GetContentEncoding: String;
procedure SetResponseCode(AResponseCode: Word);
procedure SetResponseText(AResponseText: string);
procedure SetHeaders(AHeaders: TStrings);
constructor Create; virtual;
destructor Destroy; override;
function GetHeaderValue(const Name: string): string;
end;
TRESTClient = class(TInterfacedObject)
private
FServerName: string;
FServerPort: Word;
FBodyParams: TStringlist;
FQueryStringParams: TStringlist;
FAccept: string;
FRawBody: TStringStream;
FHTTP: TIdHTTP;
FContentType: string;
FLastSessionID: string;
FNextRequestIsAsynch: Boolean;
FAsynchProc: TProc<IRESTResponse>;
FAsynchProcErr: TProc<Exception>;
FPrimaryThread: TThread;
FMultiPartFormData: TIdMultiPartFormDataStream;
FAsynchProcAlways: TProc;
function EncodeQueryStringParams(const AQueryStringParams: TStrings;
IncludeQuestionMark: Boolean = true): string;
procedure SetBodyParams(const Value: TStringlist);
procedure SetQueryStringParams(const Value: TStringlist);
procedure SetAccept(const Value: string);
procedure SetContentType(const Value: string);
function GetSessionID: string;
procedure SetSessionID(const Value: string);
function GetBodyParams: TStringlist;
function GetQueryStringParams: TStringlist;
function GetRawBody: TStringStream;
procedure SetReadTimeout(const Value: Integer);
function GetReadTimeout: Integer;
procedure StartAsynchRequest(AHTTPMethod: THttpCommand; AUrl: string;
ABodyString: String); overload;
procedure StartAsynchRequest(AHTTPMethod: THttpCommand;
AUrl: string); overload;
procedure SetConnectionTimeout(const Value: Integer);
function GetConnectionTimeout: Integer;
procedure SetRequestHeaders(const Value: TStringlist);
strict protected
FRequestHeaders: TStringlist;
protected
procedure HandleCookies;
function EncodeResourceParams(AResourceParams: array of string): string;
function HttpCommandToString(const AHttpCommand: THttpCommand): string;
function SendHTTPCommand(const ACommand: THttpCommand;
const AAccept, AContentType, AUrl: string; ABodyParams: TStrings)
: IRESTResponse;
function SendHTTPCommandWithBody(const ACommand: THttpCommand;
const AAccept, AContentType, AUrl: string; ABodyString: String)
: IRESTResponse;
procedure HandleRequestCookies;
function GetMultipartFormData: TIdMultiPartFormDataStream;
public
constructor Create(const AServerName: string;
AServerPort: Word = 80); virtual;
destructor Destroy; override;
function AddFile(const FieldName, FileName: string;
const ContentType: string = ''): TRESTClient;
function Asynch(AProc: TProc<IRESTResponse>;
AProcErr: TProc<Exception> = nil; AProcAlways: TProc = nil): TRESTClient;
function ClearAllParams: TRESTClient;
function ResetSession: TRESTClient;
function Accept(const AcceptHeader: string): TRESTClient; overload;
function Accept: string; overload;
function ContentType(const ContentTypeHeader: string): TRESTClient;
overload;
function ContentType: string; overload;
// requests
function doGET(AResource: string; AResourceParams: array of string)
: IRESTResponse;
function doPOST(AResource: string; AResourceParams: array of string)
: IRESTResponse; overload;
function doPOST(AResource: string; AResourceParams: array of string;
AJSONValue: TJSONValue; AOwnsJSONBody: Boolean = true)
: IRESTResponse; overload;
function doPOST(AResource: string; AResourceParams: array of string;
ABodyString: String): IRESTResponse; overload;
function doPATCH(AResource: string; AResourceParams: array of string;
AJSONValue: TJSONValue; AOwnsJSONBody: Boolean = true)
: IRESTResponse; overload;
function doPATCH(AResource: string; AResourceParams: array of string;
ABodyString: String): IRESTResponse; overload;
function doPUT(AResource: string; AResourceParams: array of string)
: IRESTResponse; overload;
function doPUT(AResource: string; AResourceParams: array of string;
AJSONValue: TJSONValue; AOwnsJSONBody: Boolean = true)
: IRESTResponse; overload;
function doPUT(AResource: string; AResourceParams: array of string;
ABodyString: String): IRESTResponse; overload;
function doDELETE(AResource: string; AResourceParams: array of string)
: IRESTResponse;
property BodyParams: TStringlist read GetBodyParams write SetBodyParams;
property RawBody: TStringStream read GetRawBody;
property QueryStringParams: TStringlist read GetQueryStringParams
write SetQueryStringParams;
property SessionID: string read GetSessionID write SetSessionID;
property ReadTimeout: Integer read GetReadTimeout write SetReadTimeout;
property ConnectionTimeout: Integer read GetConnectionTimeout
write SetConnectionTimeout;
property RequestHeaders: TStringlist read FRequestHeaders
write SetRequestHeaders;
end;
function StringsToArrayOfString(const AStrings: TStrings): TArrayOfString;
implementation
{ TRSF }
function StringsToArrayOfString(const AStrings: TStrings): TArrayOfString;
var
i: Integer;
begin
SetLength(Result, AStrings.Count);
if AStrings.Count = 0 then
Exit;
for i := 0 to AStrings.Count - 1 do
Result[i] := AStrings[i];
end;
function TRESTClient.Accept(const AcceptHeader: string): TRESTClient;
begin
SetAccept(AcceptHeader);
Result := Self;
end;
function TRESTClient.Accept: string;
begin
Result := FAccept;
end;
function TRESTClient.AddFile(const FieldName, FileName, ContentType: string)
: TRESTClient;
begin
GetMultipartFormData.AddFile(FieldName, FileName, ContentType);
end;
function TRESTClient.Asynch(AProc: TProc<IRESTResponse>;
AProcErr: TProc<Exception>; AProcAlways: TProc): TRESTClient;
begin
FNextRequestIsAsynch := true;
FAsynchProc := AProc;
FAsynchProcErr := AProcErr;
FAsynchProcAlways := AProcAlways;
Result := Self;
end;
function TRESTClient.ClearAllParams: TRESTClient;
begin
if Assigned(FRawBody) then
begin
FRawBody.Size := 0;
FRawBody.Position := 0;
end;
if Assigned(FBodyParams) then
FBodyParams.Clear;
if Assigned(FQueryStringParams) then
FQueryStringParams.Clear;
Result := Self;
FNextRequestIsAsynch := False;
FAsynchProc := nil;
FAsynchProcErr := nil;
FAsynchProcAlways := nil;
end;
function TRESTClient.ContentType: string;
begin
Result := FContentType;
end;
function TRESTClient.ContentType(const ContentTypeHeader: string): TRESTClient;
begin
SetContentType(ContentTypeHeader);
Result := Self;
end;
constructor TRESTClient.Create(const AServerName: string; AServerPort: Word);
begin
inherited Create;
FPrimaryThread := TThread.CurrentThread;
FServerName := AServerName;
FServerPort := AServerPort;
FBodyParams := nil; // TStringlist.Create;
FQueryStringParams := nil; // TStringlist.Create;
FRawBody := nil; // TStringStream.Create('');
FAccept := 'application/json';
FContentType := 'application/json; charset=utf-8';
FRequestHeaders := TStringlist.Create;
FHTTP := TIdHTTP.Create(nil);
FHTTP.ReadTimeout := 20000;
// FHTTP.AllowCookies := true;
end;
destructor TRESTClient.Destroy;
begin
FreeAndNil(FBodyParams);
FreeAndNil(FQueryStringParams);
FreeAndNil(FRawBody);
FreeAndNil(FRequestHeaders);
FreeAndNil(FMultiPartFormData);
FHTTP.Free;
inherited;
end;
function TRESTClient.doDELETE(AResource: string;
AResourceParams: array of string): IRESTResponse;
var
url: string;
begin
url := 'http://' + FServerName + ':' + inttostr(FServerPort) + AResource +
EncodeResourceParams(AResourceParams) + EncodeQueryStringParams
(FQueryStringParams);
if FNextRequestIsAsynch then
begin
Result := nil;
StartAsynchRequest(httpDELETE, url);
end
else
begin
Result := SendHTTPCommand(httpDELETE, FAccept, FContentType, url, nil);
ClearAllParams;
end;
end;
procedure TRESTClient.StartAsynchRequest(AHTTPMethod: THttpCommand;
AUrl: string);
begin
StartAsynchRequest(AHTTPMethod, AUrl, '');
end;
procedure TRESTClient.StartAsynchRequest(AHTTPMethod: THttpCommand;
AUrl: string; ABodyString: String);
var
th: TThread;
begin
th := TThread.CreateAnonymousThread(
procedure
var
R: IRESTResponse;
begin
try
R := SendHTTPCommandWithBody(AHTTPMethod, FAccept, FContentType, AUrl,
ABodyString);
TMonitor.Enter(TObject(R));
try
FAsynchProc(R);
ClearAllParams;
finally
TMonitor.Exit(TObject(R));
end;
except
on E: Exception do
begin
FAsynchProcErr(E);
end;
end;
if Assigned(FAsynchProcAlways) then
FAsynchProcAlways();
end);
th.Start;
end;
function TRESTClient.doGET(AResource: string; AResourceParams: array of string)
: IRESTResponse;
var
url: string;
begin
url := 'http://' + FServerName + ':' + inttostr(FServerPort) + AResource +
EncodeResourceParams(AResourceParams) + EncodeQueryStringParams
(FQueryStringParams);
if FNextRequestIsAsynch then
begin
Result := nil;
StartAsynchRequest(httpGET, url);
end
else
begin
Result := SendHTTPCommand(httpGET, FAccept, FContentType, url, nil);
ClearAllParams;
end;
end;
function TRESTClient.doPOST(AResource: string; AResourceParams: array of string)
: IRESTResponse;
var
s: string;
begin
try
Result := SendHTTPCommand(httpPOST, FAccept, FContentType,
'http://' + FServerName + ':' + inttostr(FServerPort) + AResource +
EncodeResourceParams(AResourceParams) + EncodeQueryStringParams
(FQueryStringParams), FBodyParams);
except
on E: EIdHTTPProtocolException do
begin
s := E.Message;
end;
end;
ClearAllParams;
end;
function TRESTClient.doPOST(AResource: string; AResourceParams: array of string;
AJSONValue: TJSONValue; AOwnsJSONBody: Boolean): IRESTResponse;
begin
if not Assigned(AJSONValue) then
raise Exception.Create('AJSONValue is nil');
try
Result := doPOST(AResource, AResourceParams, AJSONValue.ToString);
finally
if AOwnsJSONBody then
FreeAndNil(AJSONValue);
end;
end;
function TRESTClient.doPATCH(AResource: string; AResourceParams: array of string; ABodyString: String): IRESTResponse;
var
url: string;
begin
url := 'http://' + FServerName + ':' + inttostr(FServerPort) + AResource +
EncodeResourceParams(AResourceParams) + EncodeQueryStringParams
(FQueryStringParams);
if FNextRequestIsAsynch then
begin
Result := nil;
StartAsynchRequest(httpPOST, url, ABodyString);
end
else
begin
Result := SendHTTPCommandWithBody(httpPATCH, FAccept, FContentType, url,
ABodyString);
ClearAllParams;
end;
end;
function TRESTClient.doPATCH(AResource: string; AResourceParams: array of string; AJSONValue: TJSONValue;
AOwnsJSONBody: Boolean): IRESTResponse;
begin
if not Assigned(AJSONValue) then
raise Exception.Create('AJSONValue is nil');
try
Result := doPATCH(AResource, AResourceParams, AJSONValue.ToString);
finally
if AOwnsJSONBody then
FreeAndNil(AJSONValue);
end;
end;
function TRESTClient.doPOST(AResource: string; AResourceParams: array of string;
ABodyString: String): IRESTResponse;
var
url: string;
begin
url := 'http://' + FServerName + ':' + inttostr(FServerPort) + AResource +
EncodeResourceParams(AResourceParams) + EncodeQueryStringParams
(FQueryStringParams);
if FNextRequestIsAsynch then
begin
Result := nil;
StartAsynchRequest(httpPOST, url, ABodyString);
end
else
begin
Result := SendHTTPCommandWithBody(httpPOST, FAccept, FContentType, url,
ABodyString);
ClearAllParams;
end;
end;
function TRESTClient.doPUT(AResource: string; AResourceParams: array of string;
ABodyString: String): IRESTResponse;
var
url: string;
begin
url := 'http://' + FServerName + ':' + inttostr(FServerPort) + AResource +
EncodeResourceParams(AResourceParams) + EncodeQueryStringParams
(FQueryStringParams);
if FNextRequestIsAsynch then
begin
Result := nil;
StartAsynchRequest(httpPUT, url, ABodyString);
end
else
begin
Result := SendHTTPCommandWithBody(httpPUT, FAccept, FContentType, url,
ABodyString);
ClearAllParams;
end;
end;
function TRESTClient.doPUT(AResource: string; AResourceParams: array of string;
AJSONValue: TJSONValue; AOwnsJSONBody: Boolean = true): IRESTResponse;
begin
if not Assigned(AJSONValue) then
raise Exception.Create('AJSONValue is nil');
try
Result := doPUT(AResource, AResourceParams, AJSONValue.ToString);
finally
if AOwnsJSONBody then
FreeAndNil(AJSONValue);
end;
end;
function TRESTClient.doPUT(AResource: string; AResourceParams: array of string)
: IRESTResponse;
begin
Result := SendHTTPCommand(httpPUT, FAccept, FContentType,
'http://' + FServerName + ':' + inttostr(FServerPort) + AResource +
EncodeResourceParams(AResourceParams) + EncodeQueryStringParams
(FQueryStringParams), FBodyParams);
ClearAllParams;
end;
function TRESTClient.EncodeResourceParams(AResourceParams
: array of string): string;
var
i: Integer;
begin
Result := '';
for i := low(AResourceParams) to high(AResourceParams) do
Result := Result + '/' + TIdURI.ParamsEncode(AResourceParams[i]);
end;
function TRESTClient.GetBodyParams: TStringlist;
begin
if not Assigned(FBodyParams) then
FBodyParams := TStringlist.Create;
Result := FBodyParams;
end;
function TRESTClient.GetConnectionTimeout: Integer;
begin
Result := FHTTP.ConnectTimeout;
end;
function TRESTClient.GetMultipartFormData: TIdMultiPartFormDataStream;
begin
if not Assigned(FMultiPartFormData) then
FMultiPartFormData := TIdMultiPartFormDataStream.Create;
Result := FMultiPartFormData;
end;
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;
function TRESTClient.GetSessionID: string;
begin
Result := Self.FLastSessionID;
end;
function TRESTClient.GetReadTimeout: Integer;
begin
Result := FHTTP.ReadTimeout;
end;
function TRESTClient.EncodeQueryStringParams(const AQueryStringParams: TStrings;
IncludeQuestionMark: Boolean = true): string;
var
i: Integer;
begin
Result := '';
if not Assigned(AQueryStringParams) or (AQueryStringParams.Count = 0) then
Exit;
if IncludeQuestionMark then
Result := '?';
for i := 0 to AQueryStringParams.Count - 1 do
begin
if i > 0 then
Result := Result + '&';
Result := Result + AQueryStringParams.Names[i] + '=' +
TIdURI.ParamsEncode(AQueryStringParams.ValueFromIndex[i]);
end;
end;
procedure TRESTClient.HandleCookies;
var
s: string;
arr: TArray<string>;
begin
// Log('Received cookies', FHTTP.Response.RawHeaders.Text);
for s in FHTTP.Response.RawHeaders do
begin
if s.StartsWith('Set-Cookie', true) then
begin
arr := s.Split([':'], 2);
if arr[1].trim.StartsWith('dtsessionid') then
begin
arr := arr[1].Split(['='], 2);
FLastSessionID := TIdURI.URLDecode(arr[1].Split([';'])[0]);
end;
Break;
end;
end;
end;
procedure TRESTClient.HandleRequestCookies;
var
i: Integer;
begin
if Assigned(FHTTP.CookieManager) then
FHTTP.CookieManager.CookieCollection.Clear;
if not FLastSessionID.trim.IsEmpty then
FHTTP.Request.CustomHeaders.AddValue('Cookie',
'dtsessionid=' + FLastSessionID);
for i := 0 to FRequestHeaders.Count - 1 do
begin
FHTTP.Request.CustomHeaders.AddValue(FRequestHeaders.Names[i],
FRequestHeaders.ValueFromIndex[i]);
end;
end;
function TRESTClient.HttpCommandToString(const AHttpCommand
: THttpCommand): string;
begin
case AHttpCommand of
httpGET:
Result := 'GET';
httpPOST:
Result := 'POST';
httpPUT:
Result := 'PUT';
httpDELETE:
Result := 'DELETE';
else
raise Exception.Create('Unknown HttpCommand in TRSF.HttpCommandToString');
end;
end;
function TRESTClient.ResetSession: TRESTClient;
begin
SessionID := '';
if Assigned(FHTTP.CookieManager) then
FHTTP.CookieManager.CookieCollection.Clear;
FHTTP.Request.RawHeaders.Clear;
Result := Self;
end;
function TRESTClient.SendHTTPCommand(const ACommand: THttpCommand;
const AAccept, AContentType, AUrl: string; ABodyParams: TStrings)
: IRESTResponse;
begin
Result := TRESTResponse.Create;
FHTTP.Request.RawHeaders.Clear;
FHTTP.Request.CustomHeaders.Clear;
FHTTP.Request.Accept := AAccept;
FHTTP.Request.ContentType := AContentType;
HandleRequestCookies;
try
case ACommand of
httpGET:
begin
Result.Body.Position := 0;
FHTTP.Get(AUrl, Result.Body);
end;
httpPOST:
begin
if GetMultipartFormData.Size = 0 then
begin
Result.Body.Position := 0;
GetRawBody; // creates the body
FHTTP.Post(AUrl, FRawBody, Result.Body);
end
else
begin
FHTTP.Post(AUrl, GetMultipartFormData, Result.Body);
GetMultipartFormData.Clear;
end;
end;
httpPUT:
begin
if GetMultipartFormData.Size <> 0
then { TODO -oDaniele -cGeneral : Rework please!!! }
raise Exception.Create('Only POST can Send Files');
Result.Body.Position := 0;
if Assigned(ABodyParams) and (ABodyParams.Count > 0) then
begin
GetRawBody.Size := 0;
GetRawBody.WriteString(EncodeQueryStringParams(ABodyParams, False));
end;
FHTTP.Put(AUrl, FRawBody, Result.Body);
end;
httpDELETE:
begin
Result.Body.Position := 0;
FHTTP.Delete(AUrl);
GetRawBody.Size := 0;
end;
end;
except
on E: EIdHTTPProtocolException do
begin
Result.Body.WriteString(E.ErrorMessage);
end;
end;
HandleCookies;
Result.SetResponseCode(FHTTP.Response.ResponseCode);
Result.SetResponseText(FHTTP.Response.ResponseText);
Result.SetHeaders(FHTTP.Response.RawHeaders);
end;
function TRESTClient.SendHTTPCommandWithBody(const ACommand: THttpCommand;
const AAccept, AContentType, AUrl: string; ABodyString: String): IRESTResponse;
begin
Result := TRESTResponse.Create;
FHTTP.Request.RawHeaders.Clear;
FHTTP.Request.CustomHeaders.Clear;
FHTTP.Request.Accept := AAccept;
FHTTP.Request.ContentType := AContentType;
HandleRequestCookies;
try
case ACommand of
httpGET:
begin
FHTTP.Get(AUrl, Result.Body);
end;
httpPOST:
begin
if GetMultipartFormData.Size <> 0 then
raise Exception.Create('This method cannot send files');
RawBody.Position := 0;
FRawBody.Size := 0;
FRawBody.WriteString(UTF8Encode(ABodyString));
FHTTP.Post(AUrl, FRawBody, Result.Body);
end;
httpPATCH:
begin
raise Exception.Create
('Sorry, PATCH is not supported by the RESTClient because is not supportd by the TidHTTP');
end;
httpPUT:
begin
RawBody.Position := 0;
FRawBody.Size := 0;
FRawBody.WriteString(UTF8Encode(ABodyString));
FHTTP.Put(AUrl, FRawBody, Result.Body);
end;
httpDELETE:
begin
FHTTP.Delete(AUrl);
RawBody.Size := 0;
end;
end;
except
on E: EIdHTTPProtocolException do
begin
Result.Body.WriteString(E.ErrorMessage);
end;
end;
HandleCookies;
Result.SetResponseCode(FHTTP.Response.ResponseCode);
Result.SetResponseText(FHTTP.Response.ResponseText);
Result.SetHeaders(FHTTP.Response.RawHeaders);
end;
procedure TRESTClient.SetAccept(const Value: string);
begin
FAccept := Value;
end;
procedure TRESTClient.SetBodyParams(const Value: TStringlist);
begin
FBodyParams := Value;
end;
procedure TRESTClient.SetConnectionTimeout(const Value: Integer);
begin
FHTTP.ConnectTimeout := Value;
end;
procedure TRESTClient.SetContentType(const Value: string);
begin
FContentType := Value;
end;
procedure TRESTClient.SetQueryStringParams(const Value: TStringlist);
begin
FQueryStringParams := Value;
end;
procedure TRESTClient.SetSessionID(const Value: string);
begin
FLastSessionID := Value;
if Assigned(FHTTP.CookieManager) then
FHTTP.CookieManager.CookieCollection.Clear;
end;
procedure TRESTClient.SetReadTimeout(const Value: Integer);
begin
FHTTP.ReadTimeout := Value;
end;
procedure TRESTClient.SetRequestHeaders(const Value: TStringlist);
begin
FRequestHeaders.Assign(Value);
end;
{ TRESTResponse }
function TRESTResponse.Body: TStringStream;
begin
Result := FBody;
end;
function TRESTResponse.BodyAsJsonObject: TJSONObject;
begin
Result := BodyAsJsonValue as TJSONObject;
end;
function TRESTResponse.BodyAsJsonValue: TJSONValue;
begin
try
if not Assigned(FBodyAsJSONValue) then
begin
if BodyAsString = '' then
FBodyAsJSONValue := nil
else
begin
try
FBodyAsJSONValue := TJSONObject.ParseJSONValue(BodyAsString);
// if Assigned(V) then
// FBodyAsJSONObject := V as TJSONObject;
except
FBodyAsJSONValue := nil;
end;
end;
end;
Result := FBodyAsJSONValue;
except
on E: Exception do
begin
raise;
end;
end;
end;
function TRESTResponse.BodyAsString: string;
var
ss: TStringStream;
begin
if FContentEncoding.IsEmpty then
FContentEncoding := 'UTF-8';
ss := TStringStream.Create('', TEncoding.GetEncoding(FContentEncoding));
try
FBody.Position := 0;
FBody.SaveToStream(ss);
Result := ss.DataString;
finally
ss.Free;
end;
end;
constructor TRESTResponse.Create;
begin
inherited;
FHeaders := TStringlist.Create;
FBody := TStringStream.Create('', TEncoding.UTF8);
FBodyAsJSONValue := nil;
end;
destructor TRESTResponse.Destroy;
begin
FreeAndNil(FBodyAsJSONValue);
FHeaders.Free;
FBody.Free;
inherited;
end;
function TRESTResponse.GetContentEncoding: String;
begin
Result := FContentEncoding;
end;
function TRESTResponse.GetContentType: String;
begin
Result := FContentType;
end;
function TRESTResponse.GetHeader(const Value: String): String;
var
s: String;
begin
if Assigned(FHeaders) and (FHeaders.Count > 0) then
begin
for s in FHeaders do
begin
if s.StartsWith(Value + ':', true) then
begin
Exit(s);
end;
end;
end
else
begin
Result := '';
end;
end;
function TRESTResponse.GetHeaderValue(const Name: string): string;
var
s: string;
arr: TArray<string>;
begin
Result := '';
for s in Self.Headers do
begin
arr := s.Split([':'], 2);
if SameText(arr[0].trim, name) then
begin
Result := arr[1].trim;
Break;
end;
end;
end;
function TRESTResponse.Headers: TStringlist;
begin
Result := FHeaders;
end;
function TRESTResponse.ResponseCode: Word;
begin
Result := FResponseCode;
end;
function TRESTResponse.ResponseText: string;
begin
Result := FResponseText;
end;
procedure TRESTResponse.SetHeaders(AHeaders: TStrings);
var
CT: TArray<string>;
C: String;
begin
FHeaders.Assign(AHeaders);
C := GetHeader('content-type');
CT := C.Split([':'])[1].Split([';']);
FContentType := trim(CT[0]);
FContentEncoding := 'UTF-8'; // default encoding
if Length(CT) > 1 then
begin
if CT[1].trim.StartsWith('charset', true) then
begin
FContentEncoding := CT[1].trim.Split(['='])[1].trim;
end;
end;
end;
procedure TRESTResponse.SetResponseCode(AResponseCode: Word);
begin
FResponseCode := AResponseCode;
end;
procedure TRESTResponse.SetResponseText(AResponseText: string);
begin
FResponseText := AResponseText;
end;
end.