Skip to content

Commit 12b9818

Browse files
vincentparrettvincentparrett
committed
Updated dependencies, added D12 support
1 parent 17eae27 commit 12b9818

8 files changed

Lines changed: 1279 additions & 436 deletions

File tree

‎Source/VSoft.HttpClient.WinHttpClient.pas‎

Lines changed: 29 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -35,6 +35,7 @@ THttpClient = class(THttpClientBase, IHttpClient, IHttpClientInternal)
3535
FBytesWritten : DWORD;
3636
FClientError : DWORD;
3737
FUseHttp2 : boolean;
38+
FEnableTLS1_3 : boolean;
3839
FAllowSelfSignedCertificates : boolean;
3940
FLastStatusCode : DWORD;
4041
FProxyAuthScheme : DWORD;
@@ -78,6 +79,9 @@ THttpClient = class(THttpClientBase, IHttpClient, IHttpClientInternal)
7879

7980
function GetUseHttp2 : boolean;
8081
procedure SetUseHttp2(const value : boolean);
82+
function GetEnableTLS1_3 : boolean;
83+
procedure SetEnableTLS1_3(const value : boolean);
84+
8185

8286
function GetConnectionTimeout : integer;
8387
procedure SetConnectionTimeout(const value : integer);
@@ -211,6 +215,7 @@ constructor THttpClient.Create(const uri : IUri);
211215
FUri := uri;
212216
FUserAgent := 'VSoft.HttpClient';
213217
FWaitEvent := TEvent.Create(nil,false, false,'');
218+
FEnableTLS1_3 := false;
214219
end;
215220

216221

@@ -264,6 +269,11 @@ function THttpClient.GetConnectionTimeout: integer;
264269
result := FConnectionTimeout;
265270
end;
266271

272+
function THttpClient.GetEnableTLS1_3: boolean;
273+
begin
274+
result := FEnableTLS1_3;
275+
end;
276+
267277
function THttpClient.GetPassword: string;
268278
begin
269279
result := FPassword;
@@ -626,7 +636,6 @@ procedure THttpClient.ReleaseRequest(const request: TRequest);
626636

627637
const WAIT_OBJECT_1 = WAIT_OBJECT_0 + 1;
628638

629-
const tlsProtocols : DWORD = WINHTTP_FLAG_SECURE_PROTOCOL_TLS1_2 + WINHTTP_FLAG_SECURE_PROTOCOL_TLS1_3;
630639

631640

632641
//simple get/post etc.
@@ -651,6 +660,9 @@ function THttpClient.Send(const request: TRequest; const cancellationToken: ICan
651660

652661
sResource : string;
653662
hr : DWORD;
663+
tlsProtocols : DWORD;
664+
665+
654666
begin
655667
if FCurrentRequest <> nil then
656668
raise Exception.Create('A request is in progress.. winhttp is not reentrant!');
@@ -663,11 +675,14 @@ function THttpClient.Send(const request: TRequest; const cancellationToken: ICan
663675
FBytesWritten := 0;
664676
FCurrentRequest := request;
665677
EnsureSession;
678+
tlsProtocols := WINHTTP_FLAG_SECURE_PROTOCOL_TLS1_2;
679+
if FEnableTLS1_3 then
680+
tlsProtocols := tlsProtocols + WINHTTP_FLAG_SECURE_PROTOCOL_TLS1_3;
666681

667682
if not WinHttpSetOption(FSession, WINHTTP_OPTION_SECURE_PROTOCOLS, @tlsProtocols, sizeof(tlsProtocols)) then
668683
begin
669684
FClientError := GetLastError;
670-
raise EHttpClientException.Create(ClientErrorToString(FClientError), FClientError);
685+
raise EHttpClientException.Create(ClientErrorToString('Error setting secure protocol options',FClientError), FClientError);
671686
end;
672687

673688

@@ -684,7 +699,7 @@ function THttpClient.Send(const request: TRequest; const cancellationToken: ICan
684699
if not WinHttpCrackUrl(PWideChar(FUri.BaseUriString), 0, 0, urlComp ) then
685700
begin
686701
FClientError := GetLastError;
687-
raise EHttpClientException.Create(ClientErrorToString(FClientError), FClientError);
702+
raise EHttpClientException.Create(ClientErrorToString('Error parsing Uri', FClientError), FClientError);
688703
end;
689704

690705
SetString(host, urlComp.lpszHostName, urlComp.dwHostNameLength);
@@ -693,7 +708,7 @@ function THttpClient.Send(const request: TRequest; const cancellationToken: ICan
693708
if hConnection = nil then
694709
begin
695710
FClientError := GetLastError;
696-
raise EHttpClientException.Create(ClientErrorToString(FClientError), FClientError);
711+
raise EHttpClientException.Create(ClientErrorToString('Error connecting', FClientError), FClientError);
697712
end;
698713

699714
option := 0;
@@ -703,7 +718,7 @@ function THttpClient.Send(const request: TRequest; const cancellationToken: ICan
703718
if not WinHttpSetOption(hConnection,WINHTTP_OPTION_ENABLE_HTTP_PROTOCOL, @option, SizeOf(DWORD)) then
704719
begin
705720
FClientError := GetLastError;
706-
raise EHttpClientException.Create(ClientErrorToString(FClientError), FClientError);
721+
raise EHttpClientException.Create(ClientErrorToString('Error setting http options', FClientError), FClientError);
707722
end;
708723

709724
dwOpenRequestFlags := WINHTTP_FLAG_REFRESH + WINHTTP_FLAG_ESCAPE_PERCENT;
@@ -718,7 +733,7 @@ function THttpClient.Send(const request: TRequest; const cancellationToken: ICan
718733
if hRequest = nil then
719734
begin
720735
FClientError := GetLastError;
721-
raise EHttpClientException.Create(ClientErrorToString(FClientError), FClientError);
736+
raise EHttpClientException.Create(ClientErrorToString('Error opening request', FClientError), FClientError);
722737
end;
723738

724739
if WinHttpSetTimeouts(hRequest, request.ConnectionTimeout, request.ConnectionTimeout, request.SendTimeout, request.ResponseTimeout) = False then
@@ -783,7 +798,7 @@ function THttpClient.Send(const request: TRequest; const cancellationToken: ICan
783798
//if all is ok, then return the response.
784799
if FClientError <> 0 then
785800
begin
786-
raise EHttpClientException.Create(ClientErrorToString(FClientError), FClientError);
801+
raise EHttpClientException.Create(ClientErrorToString('',FClientError), FClientError);
787802
//raise exception?
788803
end;
789804

@@ -793,15 +808,15 @@ function THttpClient.Send(const request: TRequest; const cancellationToken: ICan
793808
WAIT_OBJECT_1 :
794809
begin
795810
//cancellation token triggered
796-
raise EHttpClientException.Create(ClientErrorToString(FClientError), FClientError);
811+
raise EHttpClientException.Create(ClientErrorToString('',FClientError), FClientError);
797812

798813
FResponse := nil;
799814
exit;
800815
end;
801816
WAIT_TIMEOUT :
802817
begin
803818
//timed out, clean up and return.
804-
raise EHttpClientException.Create(ClientErrorToString(ERROR_WINHTTP_TIMEOUT), ERROR_WINHTTP_TIMEOUT);
819+
raise EHttpClientException.Create(ClientErrorToString('Timed out',ERROR_WINHTTP_TIMEOUT), ERROR_WINHTTP_TIMEOUT);
805820
FResponse := nil;
806821
exit;
807822
end;
@@ -837,6 +852,11 @@ procedure THttpClient.SetConnectionTimeout(const value: integer);
837852
FConnectionTimeout := value;
838853
end;
839854

855+
procedure THttpClient.SetEnableTLS1_3(const value: boolean);
856+
begin
857+
FEnableTLS1_3 := false;
858+
end;
859+
840860
procedure THttpClient.SetPassword(const value: string);
841861
begin
842862
FPassword := value;

‎Source/VSoft.HttpClient.pas‎

Lines changed: 9 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -243,6 +243,10 @@ TRequest = class
243243
function GetUseHttp2 : boolean;
244244
procedure SetUseHttp2(const value : boolean);
245245

246+
function GetEnableTLS1_3 : boolean;
247+
procedure SetEnableTLS1_3(const value : boolean);
248+
249+
246250
function GetUserName : string;
247251
procedure SetUserName(const value : string);
248252

@@ -277,7 +281,7 @@ TRequest = class
277281

278282

279283
property UseHttp2 : boolean read GetUseHttp2 write SetUseHttp2;
280-
284+
property EnableTLS1_3 : boolean read GetEnableTLS1_3 write SetEnableTLS1_3;
281285

282286
end;
283287

@@ -309,7 +313,7 @@ EHttpClientException = class(Exception)
309313

310314
function HttpMethodToString(const value : THttpMethod) : string;
311315

312-
function ClientErrorToString(const value : HRESULT) : string;
316+
function ClientErrorToString(const message : string; const value : HRESULT) : string;
313317

314318
const
315319
cAcceptHeader = 'Accept';
@@ -333,7 +337,7 @@ implementation
333337
VSoft.HttpClient.WinHttpClient,
334338
VSoft.HttpClient.MultipartFormData;
335339

336-
function ClientErrorToString(const value : HRESULT) : string;
340+
function ClientErrorToString(const message : string; const value : HRESULT) : string;
337341
begin
338342
case value of
339343
ERROR_WINHTTP_OUT_OF_HANDLES : result := 'Out of handles.';
@@ -407,9 +411,10 @@ function ClientErrorToString(const value : HRESULT) : string;
407411

408412
E_UNEXPECTED : result := 'Unexpected value';
409413
else
410-
result := 'Unknown Error';
414+
result := 'Unknown Error 0x' + IntToHex(value,8);
411415
end;
412416

417+
result := message + ': ' + result;
413418

414419
end;
415420

‎Tests/VSoft.HttpClient.Tests.dproj‎

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -11,11 +11,11 @@
1111
<AppType>Console</AppType>
1212
</PropertyGroup>
1313
<PropertyGroup>
14-
<DPMCompiler>11.0</DPMCompiler>
14+
<DPMCompiler>XE2</DPMCompiler>
1515
<DPMCache Condition="'$(DPMCache)' == ''">$(APPDATA)\.dpm\packages</DPMCache>
1616
<DPM>$(DPMCache)\$(DPMCompiler)\$(Platform)</DPM>
17-
<DPMSearch Condition="'$(Platform)'=='Win32'">$(DPM)\VSoft.CancellationToken\0.1.0\lib;$(DPM)\VSoft.Uri\0.3.0\src;$(DPM)\VSoft.DUnitX\0.3.1\src;</DPMSearch>
18-
<DPMSearch Condition="'$(Platform)'=='Win64'">$(DPM)\VSoft.CancellationToken\0.1.0\lib;$(DPM)\VSoft.Uri\0.3.0\src;$(DPM)\VSoft.DUnitX\0.3.1\src;</DPMSearch>
17+
<DPMSearch Condition="'$(Platform)'=='Win32'">$(DPM)\VSoft.Uri\0.3.0\src;$(DPM)\VSoft.DUnitX\0.3.1\src;$(DPM)\VSoft.CancellationToken\0.1.0\lib;</DPMSearch>
18+
<DPMSearch Condition="'$(Platform)'=='Win64'">$(DPM)\VSoft.Uri\0.3.0\src;$(DPM)\VSoft.DUnitX\0.3.1\src;$(DPM)\VSoft.CancellationToken\0.1.0\lib;</DPMSearch>
1919
</PropertyGroup>
2020
<PropertyGroup Condition="'$(Config)'=='Base' or '$(Base)'!=''">
2121
<Base>true</Base>

‎Tests/VSoftHttpClientTests.pas‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -146,7 +146,7 @@ procedure TMyTestObject.TestResponseStream;
146146

147147
stream := TMemoryStream.Create;
148148
try
149-
stream.CopyFrom(response.ResponseStream);
149+
stream.CopyFrom(response.ResponseStream,response.ResponseStream.Size);
150150
Assert.AreEqual(response.ContentLength, stream.Size);
151151

152152
finally

‎VSoft.HttpClient.dspec‎

Lines changed: 54 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,7 @@
11
{
22
"metadata":{
33
"id":"VSoft.HttpClient",
4-
"version":"0.10.4-beta.3",
4+
"version":"0.11.0-beta.10",
55
"description":"WinHttp base http client",
66
"authors":"Vincent Parrett",
77
"projectUrl":"https://github.com/VSoftTechnologies/VSoft.HttpClient",
@@ -75,6 +75,11 @@
7575
"compiler":"11.0",
7676
"platforms":"Win32, Win64",
7777
"template":"default"
78+
},
79+
{
80+
"compiler":"12.0",
81+
"platforms":"Win32, Win64",
82+
"template":"12+"
7883
}
7984
],
8085
"templates":[
@@ -83,7 +88,7 @@
8388
"dependencies":[
8489
{
8590
"id":"VSoft.CancellationToken",
86-
"version":"[0.1.1,]"
91+
"version":"[0.1.2,]"
8792
},
8893
{
8994
"id":"VSoft.Uri",
@@ -123,6 +128,52 @@
123128
"copyLocal" : true
124129
}
125130
]
126-
}
131+
},
132+
{
133+
"name":"12+",
134+
"dependencies":[
135+
{
136+
"id":"VSoft.CancellationToken",
137+
"version":"[0.1.2,]"
138+
},
139+
{
140+
"id":"VSoft.Uri",
141+
"version":"[0.3.2,]"
142+
}
143+
],
144+
"source":[
145+
{
146+
"src":"source\\*.pas",
147+
"flatten":true,
148+
"dest":"source"
149+
},
150+
{
151+
"src": "packages\\Rad Studio $compilerNoPoint$\\*.dpk",
152+
"dest": "packages\\Rad Studio $compilerNoPoint$"
153+
},
154+
{
155+
"src": "packages\\Rad Studio $compilerNoPoint$\\*.dproj",
156+
"dest": "packages\\Rad Studio $compilerNoPoint$"
157+
}
158+
],
159+
"searchPaths":[
160+
{
161+
"path":"source"
162+
}
163+
],
164+
"build": [
165+
{
166+
"id": "Runtime",
167+
"project": ".\\packages\\Rad Studio $compilerNoPoint$\\VSoft.HttpClientR.dproj"
168+
}
169+
],
170+
"runtime" : [
171+
{
172+
"buildId" : "Runtime",
173+
"src" : "bin\\VSoft.HttpClientR$LibSuffix$.bpl",
174+
"copyLocal" : true
175+
}
176+
]
177+
}
127178
]
128179
}

0 commit comments

Comments
 (0)