Skip to content

Commit fabe2e8

Browse files
fabriciocolombofabriciocolombo
committed
Add support to custom connection providers
1 parent 2a8516f commit fabe2e8

8 files changed

+204
-17
lines changed

‎src/HttpConnection.pas

+1-1
Original file line numberDiff line numberDiff line change
@@ -5,7 +5,7 @@ interface
55
uses Classes;
66

77
type
8-
THttpConnectionType = (hctUnknown, hctIndy, hctWinHttp);
8+
THttpConnectionType = (hctUnknown, hctIndy, hctWinHttp, hctCustom);
99

1010
IHttpConnection = interface
1111
['{B9611100-5243-4874-A777-D91448517116}']

‎src/HttpConnectionIndy.pas

+1
Original file line numberDiff line numberDiff line change
@@ -116,6 +116,7 @@ procedure THttpConnectionIndy.SetEnabledCompression(const Value: Boolean);
116116

117117
if FEnabledCompression then
118118
begin
119+
//NOTE: This does not work in Delphi XE2. Access violation occurs.
119120
FIdHttp.Compressor := TIdCompressorZLib.Create(FIdHttp);
120121
end
121122
else

‎src/RestClient.pas

+45-5
Original file line numberDiff line numberDiff line change
@@ -25,13 +25,20 @@ interface
2525

2626
TResource = class;
2727

28+
TCustomCreateConnection = procedure(Sender: TObject; AConnectionType: THttpConnectionType; out AConnection: IHttpConnection) of object;
29+
30+
ERestClientException = class(Exception);
31+
EInvalidHttpConnectionConfiguration = class(ERestClientException);
32+
ECustomCreateConnectionException = class(ERestClientException);
33+
EInactiveConnection = class(ERestClientException);
34+
2835
TRestClient = class(TComponent)
2936
private
3037
FHttpConnection: IHttpConnection;
3138
FResources: TObjectList;
3239
FConnectionType: THttpConnectionType;
3340
FEnabledCompression: Boolean;
34-
41+
FOnCustomCreateConnection: TCustomCreateConnection;
3542

3643
{$IFDEF DELPHI_2009_UP}
3744
FTempHandler: TRestResponseHandlerFunc;
@@ -48,8 +55,10 @@ TRestClient = class(TComponent)
4855

4956
procedure CheckConnection;
5057

51-
procedure SetEnabledCompression(const Value: Boolean); protected
58+
procedure SetEnabledCompression(const Value: Boolean);
5259

60+
function DoCustomCreateConnection: IHttpConnection;
61+
protected
5362
procedure Loaded; override;
5463
public
5564
constructor Create(Owner: TComponent); override;
@@ -59,9 +68,11 @@ TRestClient = class(TComponent)
5968

6069
function Resource(URL: String): TResource;
6170

71+
function UnWrapConnection: IHttpConnection;
6272
published
6373
property ConnectionType: THttpConnectionType read FConnectionType write SetConnectionType;
6474
property EnabledCompression: Boolean read FEnabledCompression write SetEnabledCompression default True;
75+
property OnCustomCreateConnection: TCustomCreateConnection read FOnCustomCreateConnection write FOnCustomCreateConnection;
6576
end;
6677

6778
TCookie = class
@@ -156,6 +167,23 @@ destructor TRestClient.Destroy;
156167
inherited;
157168
end;
158169

170+
function TRestClient.DoCustomCreateConnection: IHttpConnection;
171+
begin
172+
if Assigned(FOnCustomCreateConnection) then
173+
begin
174+
FOnCustomCreateConnection(Self, FConnectionType, Result);
175+
176+
if Result = nil then
177+
begin
178+
raise ECustomCreateConnectionException.Create('HttpConnection not supplied by OnCustomCreateConnection');
179+
end;
180+
end
181+
else
182+
begin
183+
raise EInvalidHttpConnectionConfiguration.Create('ConnectionType is set to Custom but OnCustomCreateConnection event is not implemented.');
184+
end;
185+
end;
186+
159187
function TRestClient.DoRequest(Method: TRequestMethod; ResourceRequest: TResource; AHandler: TRestResponseHandler): WideString;
160188
var
161189
vResponse: TStringStream;
@@ -224,16 +252,23 @@ procedure TRestClient.RecreateConnection;
224252
begin
225253
if not (csDesigning in ComponentState) then
226254
begin
227-
FHttpConnection := THttpConnectionFactory.NewConnection(FConnectionType);
228-
FHttpConnection.EnabledCompression := FEnabledCompression;
255+
if FConnectionType = hctCustom then
256+
begin
257+
FHttpConnection := DoCustomCreateConnection;
258+
end
259+
else
260+
begin
261+
FHttpConnection := THttpConnectionFactory.NewConnection(FConnectionType);
262+
FHttpConnection.EnabledCompression := FEnabledCompression;
263+
end;
229264
end;
230265
end;
231266

232267
procedure TRestClient.CheckConnection;
233268
begin
234269
if (FHttpConnection = nil) then
235270
begin
236-
raise Exception.CreateFmt('%s: Connection is not active.', [Name]);
271+
raise EInactiveConnection.CreateFmt('%s: Connection is not active.', [Name]);
237272
end;
238273
end;
239274

@@ -272,6 +307,11 @@ procedure TRestClient.SetEnabledCompression(const Value: Boolean);
272307
end;
273308
end;
274309

310+
function TRestClient.UnWrapConnection: IHttpConnection;
311+
begin
312+
Result := FHttpConnection;
313+
end;
314+
275315
{ TResource }
276316

277317
function TResource.Accept(AcceptType: String): TResource;

‎unittest/RunCoverage.bat

+8
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,8 @@
1+
@echo off
2+
3+
rmdir target\coverage /S /Q
4+
mkdir target\coverage
5+
6+
C:\Elotech\CodeCoverage.exe -e Debug\Win32\UnitTest.exe -m Debug\Win32\UnitTest.map -od target\coverage -uf UnitTest.dpr -a /text -sp ..\src
7+
8+
call target\coverage\CodeCoverage_summary.html

‎unittest/TestRegister.pas

+13
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,13 @@
1+
unit TestRegister;
2+
3+
interface
4+
5+
{$I DelphiRest.inc}
6+
7+
{$IFDEF USE_GENERICS}
8+
uses TestDBXJson, TestSerializer;
9+
{$ENDIF}
10+
11+
implementation
12+
13+
end.

‎unittest/TestRestClient.pas

+118
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,118 @@
1+
unit TestRestClient;
2+
3+
interface
4+
5+
{$I DelphiRest.inc}
6+
7+
uses TestFramework, RestClient, HttpConnection, Classes, SysUtils;
8+
9+
type
10+
TTestRestClient = class(TTestCase)
11+
private
12+
FRest: TRestClient;
13+
FCustomCreateConnectionCalled: Boolean;
14+
15+
procedure OnCreateCustomConnectionNull(Sender: TObject; AConnectionType: THttpConnectionType; out AConnection: IHttpConnection);
16+
procedure OnCreateCustomConnection(Sender: TObject; AConnectionType: THttpConnectionType; out AConnection: IHttpConnection);
17+
protected
18+
procedure TearDown; override;
19+
procedure SetUp; override;
20+
published
21+
procedure InvalidCustomConnectionConfiguration;
22+
procedure InvalidCustomConnectionConfigurationResult;
23+
procedure UsingCustomConnection;
24+
procedure RaiseExceptionWhenInactiveConnection;
25+
procedure RaiseExceptionWhenInactiveConnection2;
26+
end;
27+
28+
implementation
29+
30+
type
31+
IStubConnection = interface(IHttpConnection)
32+
['{9CCD27F6-ADA6-47CE-84C4-B7126F8D3281}']
33+
end;
34+
35+
TStubConnection = class(TInterfacedObject, IHttpConnection, IStubConnection)
36+
function SetAcceptTypes(AAcceptTypes: string): IHttpConnection;virtual;abstract;
37+
function SetContentTypes(AContentTypes: string): IHttpConnection;virtual;abstract;
38+
function SetAcceptedLanguages(AAcceptedLanguages: string): IHttpConnection;virtual;abstract;
39+
function SetHeaders(AHeaders: TStrings): IHttpConnection;virtual;abstract;
40+
41+
procedure Get(AUrl: string; AResponse: TStream);virtual;abstract;
42+
procedure Post(AUrl: string; AContent, AResponse: TStream);virtual;abstract;
43+
procedure Put(AUrl: string; AContent, AResponse: TStream);virtual;abstract;
44+
procedure Delete(AUrl: string; AContent: TStream);virtual;abstract;
45+
46+
function GetResponseCode: Integer;virtual;abstract;
47+
function GetEnabledCompression: Boolean;virtual;abstract;
48+
49+
procedure SetEnabledCompression(const Value: Boolean);virtual;abstract;
50+
end;
51+
52+
{ TTestRestClient }
53+
54+
procedure TTestRestClient.InvalidCustomConnectionConfiguration;
55+
begin
56+
ExpectedException := EInvalidHttpConnectionConfiguration;
57+
FRest.ConnectionType := hctCustom;
58+
end;
59+
60+
procedure TTestRestClient.InvalidCustomConnectionConfigurationResult;
61+
begin
62+
ExpectedException := ECustomCreateConnectionException;
63+
FRest.OnCustomCreateConnection := OnCreateCustomConnectionNull;
64+
FRest.ConnectionType := hctCustom;
65+
end;
66+
67+
procedure TTestRestClient.OnCreateCustomConnection(Sender: TObject; AConnectionType: THttpConnectionType; out AConnection: IHttpConnection);
68+
begin
69+
FCustomCreateConnectionCalled := True;
70+
{$WARN CONSTRUCTING_ABSTRACT OFF}
71+
AConnection := TStubConnection.Create;
72+
{$WARN CONSTRUCTING_ABSTRACT ON}
73+
end;
74+
75+
procedure TTestRestClient.OnCreateCustomConnectionNull(Sender: TObject;
76+
AConnectionType: THttpConnectionType; out AConnection: IHttpConnection);
77+
begin
78+
AConnection := nil;
79+
end;
80+
81+
procedure TTestRestClient.RaiseExceptionWhenInactiveConnection;
82+
begin
83+
ExpectedException := EInactiveConnection;
84+
FRest.ResponseCode;
85+
end;
86+
87+
procedure TTestRestClient.RaiseExceptionWhenInactiveConnection2;
88+
begin
89+
ExpectedException := EInactiveConnection;
90+
FRest.Resource('https://www.google.com.br').Get;
91+
end;
92+
93+
procedure TTestRestClient.SetUp;
94+
begin
95+
inherited;
96+
FRest := TRestClient.Create(nil);
97+
FRest.Name := ClassName + '_' + FRest.ClassName;;
98+
end;
99+
100+
procedure TTestRestClient.TearDown;
101+
begin
102+
inherited;
103+
FRest.Free;
104+
end;
105+
106+
procedure TTestRestClient.UsingCustomConnection;
107+
begin
108+
FRest.OnCustomCreateConnection := OnCreateCustomConnection;
109+
FRest.ConnectionType := hctCustom;
110+
111+
CheckTrue(FCustomCreateConnectionCalled);
112+
CheckTrue(Supports(FRest.UnWrapConnection, IStubConnection));
113+
end;
114+
115+
initialization
116+
RegisterTest(TTestRestClient.Suite);
117+
118+
end.

‎unittest/UnitTest.dpr

+6-6
Original file line numberDiff line numberDiff line change
@@ -10,6 +10,8 @@ program UnitTest;
1010
1111
}
1212

13+
{.$DEFINE CONSOLE_TESTRUNNER}
14+
1315
{$IFDEF CONSOLE_TESTRUNNER}
1416
{$APPTYPE CONSOLE}
1517
{$ENDIF}
@@ -24,10 +26,6 @@ uses
2426
TestHelloWorld in 'TestHelloWorld.pas',
2527
TestPeople in 'TestPeople.pas',
2628
BaseTestRest in 'BaseTestRest.pas',
27-
{$IFDEF USE_GENERICS}
28-
TestDBXJson in 'TestDBXJson.pas',
29-
TestSerializer in 'TestSerializer.pas',
30-
{$ENDIF}
3129
TestHeader in 'TestHeader.pas',
3230
TestResponseHandler in 'TestResponseHandler.pas',
3331
TestDataSetHandler in 'TestDataSetHandler.pas',
@@ -37,14 +35,16 @@ uses
3735
HttpConnection in '..\src\HttpConnection.pas',
3836
HttpConnectionFactory in '..\src\HttpConnectionFactory.pas',
3937
HttpConnectionWinHttp in '..\src\HttpConnectionWinHttp.pas',
40-
WinHttp_TLB in '..\lib\WinHttp_TLB.pas';
38+
WinHttp_TLB in '..\lib\WinHttp_TLB.pas',
39+
TestRegister in 'TestRegister.pas',
40+
TestRestClient in 'TestRestClient.pas';
4141

4242
{$R *.RES}
4343

4444
begin
4545
Application.Initialize;
4646

47-
// ReportMemoryLeaksOnShutdown := True;
47+
ReportMemoryLeaksOnShutdown := True;
4848

4949
if IsConsole then
5050
with TextTestRunner.RunRegisteredTests do

‎unittest/UnitTest.dproj

+12-5
Original file line numberDiff line numberDiff line change
@@ -47,13 +47,13 @@
4747
<Base>true</Base>
4848
</PropertyGroup>
4949
<PropertyGroup Condition="'$(Base)'!=''">
50+
<Manifest_File>None</Manifest_File>
5051
<VerInfo_Locale>1046</VerInfo_Locale>
5152
<VerInfo_Keys>CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=</VerInfo_Keys>
5253
<DCC_Namespace>Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;$(DCC_Namespace)</DCC_Namespace>
5354
<DCC_UnitSearchPath>$(BDS)\Source\DUnit\src;$(DCC_UnitSearchPath)</DCC_UnitSearchPath>
5455
<DCC_ImageBase>00400000</DCC_ImageBase>
5556
<DCC_ExeOutput>.\$(Config)\$(Platform)</DCC_ExeOutput>
56-
<DCC_Define>_CONSOLE_TESTRUNNER;$(DCC_Define)</DCC_Define>
5757
<DCC_DcuOutput>.</DCC_DcuOutput>
5858
<DCC_N>false</DCC_N>
5959
<DCC_S>false</DCC_S>
@@ -69,16 +69,16 @@
6969
<DCC_Namespace>Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)</DCC_Namespace>
7070
<VerInfo_Locale>1033</VerInfo_Locale>
7171
<Manifest_File>$(BDS)\bin\default_app.manifest</Manifest_File>
72-
<VerInfo_Keys>CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=</VerInfo_Keys>
7372
</PropertyGroup>
7473
<PropertyGroup Condition="'$(Cfg_1)'!=''">
75-
<Manifest_File>None</Manifest_File>
7674
<DCC_UnitSearchPath>..\src;..\lib\superobject;$(DCC_UnitSearchPath)</DCC_UnitSearchPath>
7775
<DCC_Define>DEBUG;$(DCC_Define)</DCC_Define>
7876
<DCC_Optimize>false</DCC_Optimize>
7977
<DCC_GenerateStackFrames>true</DCC_GenerateStackFrames>
8078
</PropertyGroup>
8179
<PropertyGroup Condition="'$(Cfg_1_Win32)'!=''">
80+
<Manifest_File>$(BDS)\bin\default_app.manifest</Manifest_File>
81+
<DCC_MapFile>3</DCC_MapFile>
8282
<VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo>
8383
<VerInfo_Locale>1033</VerInfo_Locale>
8484
<DCC_DebugDCUs>true</DCC_DebugDCUs>
@@ -90,6 +90,8 @@
9090
<DCC_DebugInformation>false</DCC_DebugInformation>
9191
</PropertyGroup>
9292
<PropertyGroup Condition="'$(Cfg_2_Win32)'!=''">
93+
<DCC_Define>CONSOLE_TESTRUNNER;$(DCC_Define)</DCC_Define>
94+
<Manifest_File>$(BDS)\bin\default_app.manifest</Manifest_File>
9395
<VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo>
9496
<DCC_UnitSearchPath>..\src;..\lib\superobject;$(DCC_UnitSearchPath)</DCC_UnitSearchPath>
9597
<VerInfo_Locale>1033</VerInfo_Locale>
@@ -111,6 +113,8 @@
111113
<DCCReference Include="..\src\HttpConnectionFactory.pas"/>
112114
<DCCReference Include="..\src\HttpConnectionWinHttp.pas"/>
113115
<DCCReference Include="..\lib\WinHttp_TLB.pas"/>
116+
<DCCReference Include="TestRegister.pas"/>
117+
<DCCReference Include="TestRestClient.pas"/>
114118
<BuildConfiguration Include="Release">
115119
<Key>Cfg_2</Key>
116120
<CfgParent>Base</CfgParent>
@@ -161,8 +165,11 @@
161165
<Source Name="MainSource">UnitTest.dpr</Source>
162166
</Source>
163167
<Excluded_Packages>
164-
<Excluded_Packages Name="$(BDSBIN)\dcloffice2k170.bpl">Microsoft Office 2000 Sample Automation Server Wrapper Components</Excluded_Packages>
165-
<Excluded_Packages Name="$(BDSBIN)\dclofficexp170.bpl">Microsoft Office XP Sample Automation Server Wrapper Components</Excluded_Packages>
168+
<Excluded_Packages Name="C:\Program Files (x86)\RemObjects Software\Everwood\Bin\RemObjects_Everwood_D16.bpl">File C:\Program Files (x86)\RemObjects Software\Everwood\Bin\RemObjects_Everwood_D16.bpl not found</Excluded_Packages>
169+
<Excluded_Packages Name="$(BDSBIN)\bcboffice2k160.bpl">Embarcadero C++Builder Office 2000 Servers Package</Excluded_Packages>
170+
<Excluded_Packages Name="$(BDSBIN)\bcbofficexp160.bpl">Embarcadero C++Builder Office XP Servers Package</Excluded_Packages>
171+
<Excluded_Packages Name="$(BDSBIN)\dcloffice2k160.bpl">Microsoft Office 2000 Sample Automation Server Wrapper Components</Excluded_Packages>
172+
<Excluded_Packages Name="$(BDSBIN)\dclofficexp160.bpl">Microsoft Office XP Sample Automation Server Wrapper Components</Excluded_Packages>
166173
</Excluded_Packages>
167174
</Delphi.Personality>
168175
<Platforms>

0 commit comments

Comments
 (0)