paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-18 23:09:18 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Added IOTimeout

Browse Source 
git-svn-id: trunk@33168 -
This commit is contained in:
michael 2016-03-05 19:21:36 +00:00
parent 29daae5d6d
commit 2ab3458074
1 changed files with 17 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
packages/fcl-web/src/base/fphttpclient.pp
View File

@ -54,6 +54,7 @@ Type
FOnPassword: TPasswordEvent; FOnPassword: TPasswordEvent;
FOnRedirect: TRedirectEvent; FOnRedirect: TRedirectEvent;
FPassword: String; FPassword: String;
FIOTimeout: Integer;
FSentCookies, FSentCookies,
FCookies: TStrings; FCookies: TStrings;
FHTTPVersion: String; FHTTPVersion: String;
@ -73,6 +74,7 @@ Type
Procedure ResetResponse; Procedure ResetResponse;
Procedure SetCookies(const AValue: TStrings); Procedure SetCookies(const AValue: TStrings);
Procedure SetRequestHeaders(const AValue: TStrings); Procedure SetRequestHeaders(const AValue: TStrings);
procedure SetIOTimeout(AValue: Integer);
protected protected
// Called whenever data is read. // Called whenever data is read.
Procedure DoDataRead; virtual; Procedure DoDataRead; virtual;
@ -211,6 +213,8 @@ Type
// Simple form of Posting a file // Simple form of Posting a file
Class Procedure SimpleFileFormPost(const AURL, AFieldName, AFileName: string; const Response: TStream); Class Procedure SimpleFileFormPost(const AURL, AFieldName, AFileName: string; const Response: TStream);
Protected Protected
// Timeouts
Property IOTimeout : Integer read FIOTimeout write SetIOTimeout;
// Before request properties. // Before request properties.
// Additional headers for request. Host; and Authentication are automatically added. // Additional headers for request. Host; and Authentication are automatically added.
Property RequestHeaders : TStrings Read FRequestHeaders Write SetRequestHeaders; Property RequestHeaders : TStrings Read FRequestHeaders Write SetRequestHeaders;
@ -256,6 +260,7 @@ Type
TFPHTTPClient = Class(TFPCustomHTTPClient) TFPHTTPClient = Class(TFPCustomHTTPClient)
Public Public
Property IOTimeout;
Property RequestHeaders; Property RequestHeaders;
Property RequestBody; Property RequestBody;
Property ResponseHeaders; Property ResponseHeaders;
@ -384,6 +389,14 @@ begin
FRequestHeaders.Assign(AValue); FRequestHeaders.Assign(AValue);
end; end;
procedure TFPCustomHTTPClient.SetIOTimeout(AValue: Integer);
begin
if AValue=FIOTimeout then exit;
FIOTimeout:=AValue;
if Assigned(FSocket) then
FSocket.IOTimeout:=AValue;
end;
procedure TFPCustomHTTPClient.DoDataRead; procedure TFPCustomHTTPClient.DoDataRead;
begin begin
If Assigned(FOnDataReceived) Then If Assigned(FOnDataReceived) Then
@ -457,6 +470,8 @@ begin
G:=GetSocketHandler(UseSSL); G:=GetSocketHandler(UseSSL);
FSocket:=TInetSocket.Create(AHost,APort,G); FSocket:=TInetSocket.Create(AHost,APort,G);
try try
if FIOTimeout<>0 then
FSocket.IOTimeout:=FIOTimeout;
FSocket.Connect; FSocket.Connect;
except except
FreeAndNil(FSocket); FreeAndNil(FSocket);
@ -956,6 +971,8 @@ end;
constructor TFPCustomHTTPClient.Create(AOwner: TComponent); constructor TFPCustomHTTPClient.Create(AOwner: TComponent);
begin begin
inherited Create(AOwner); inherited Create(AOwner);
// Infinite timeout on most platforms
FIOTimeout:=0;
FRequestHeaders:=TStringList.Create; FRequestHeaders:=TStringList.Create;
FResponseHeaders:=TStringList.Create; FResponseHeaders:=TStringList.Create;
FHTTPVersion:='1.1'; FHTTPVersion:='1.1';