paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-20 19:29:26 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Fix content sending

Browse Source 
git-svn-id: trunk@38585 -
This commit is contained in:
michael 2018-03-21 10:22:34 +00:00
parent 250e924ad3
commit 5a8a3ddc21
1 changed files with 16 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
packages/fcl-web/src/base/fphtml.pp
View File

@ -1158,6 +1158,7 @@ Var
FWriter : THTMLWriter;
B : Boolean;
M : TMemoryStream;
begin
FDocument := CreateDocument;
@ -1168,20 +1169,23 @@ begin
If Assigned(OnGetContent) then
OnGetContent(Self,ARequest,FWriter,B);
If Not B then
begin
Actions.HandleRequest(ARequest,FWriter,B);
If Not B then
Raise EHTMLError.Create(SErrRequestNotHandled);
end
else
If Not B then
Raise EHTMLError.Create(SErrRequestNotHandled);
If (AResponse.ContentStream=Nil) then
begin
If (AResponse.ContentStream=Nil) then
begin
M:=TMemoryStream.Create;
AResponse.ContentStream:=M;
AResponse.FreeContentStream:=True;
FDocument.SaveToStream(AResponse.ContentStream);
end;
M:=TMemoryStream.Create;
AResponse.ContentStream:=M;
AResponse.FreeContentStream:=True;
end;
if not AResponse.ContentSent then
begin
FDocument.SaveToStream(AResponse.ContentStream);
AResponse.ContentStream.Position:=0;
if (AResponse.ContentType='') then
AResponse.ContentType:='text/html';
AResponse.ContentLength:=AResponse.ContentStream.Size;
AResponse.SendContent;
end;
Finally
FreeAndNil(FWriter);