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

* Fix bug in ReadContent

Browse Source 
git-svn-id: trunk@17532 -
This commit is contained in:
michael 2011-05-23 16:47:11 +00:00
parent 4d572aa08d
commit c334ad1f8b
1 changed files with 24 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -555,6 +555,16 @@ end;
procedure TFPCustomHTTPClient.ReadResponse(Stream: TStream; Const AllowedResponseCodes : Array of Integer); procedure TFPCustomHTTPClient.ReadResponse(Stream: TStream; Const AllowedResponseCodes : Array of Integer);
Function Transfer(LB : Integer) : Integer;
begin
Result:=FSocket.Read(FBuffer[1],LB);
If Result<0 then
Raise EHTTPClient.Create(SErrReadingSocket);
if (Result>0) then
Stream.Write(FBuffer[1],Result);
end;
Var Var
L,LB,R : Integer; L,LB,R : Integer;
ResponseOK : Boolean; ResponseOK : Boolean;
@ -567,19 +577,25 @@ begin
LB:=Length(FBuffer); LB:=Length(FBuffer);
If (LB>0) then If (LB>0) then
Stream.WriteBuffer(FBuffer[1],LB); Stream.WriteBuffer(FBuffer[1],LB);
// Now write the rest, if any. // Now read the rest, if any.
SetLength(FBuffer,ReadBuflen);
L:=CheckContentLength; L:=CheckContentLength;
If (L>LB) then If (L>LB) then
Stream.CopyFrom(FSocket,L-LB) begin
// We cannot use copyfrom, it uses ReadBuffer, and this is dangerous with sockets
L:=L-LB;
Repeat
LB:=ReadBufLen;
If (LB>L) then
LB:=L;
R:=Transfer(LB);
L:=L-R;
until (L=0) or (R=0);
end
else if L<0 then else if L<0 then
// No content-length, so we read till no more data available. // No content-length, so we read till no more data available.
Repeat Repeat
SetLength(FBuffer,ReadBufLen); R:=Transfer(ReadBufLen);
R:=FSocket.Read(FBuffer[1],ReadBufLen);
If R<0 then
Raise EHTTPClient.Create(SErrReadingSocket);
if (R>0) then
Stream.Write(FBuffer[1],R);
until (R=0); until (R=0);
end; end;