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

+ Added response stream

Browse Source
This commit is contained in:
michael 2003-10-03 08:43:13 +00:00
parent c68a577f09
commit 9f38a09fb8
1 changed files with 50 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

60
fcl/inc/cgiapp.pp
View File

@ -59,6 +59,7 @@ Type
TCgiApplication = Class(TCustomApplication) TCgiApplication = Class(TCustomApplication)
Private Private
FResponse : TStream;
FEmail : String; FEmail : String;
FAdministrator : String; FAdministrator : String;
FContentTypeEmitted : Boolean; FContentTypeEmitted : Boolean;
@ -81,6 +82,10 @@ Type
Public Public
Constructor Create(AOwner : TComponent); override; Constructor Create(AOwner : TComponent); override;
Destructor Destroy; override; Destructor Destroy; override;
Procedure AddResponse(Const S : String);
Procedure AddResponse(Const Fmt : String; Args : Array of const);
Procedure AddResponseLn(Const S : String);
Procedure AddResponseLn(Const Fmt : String; Args : Array of const);
Procedure Initialize; override; Procedure Initialize; override;
Procedure GetCGIVarList(List : TStrings); Procedure GetCGIVarList(List : TStrings);
Procedure GetRequestVarList(List : TStrings); Procedure GetRequestVarList(List : TStrings);
@ -114,6 +119,7 @@ Type
Property Administrator : String Read GetAdministrator Write FAdministrator; Property Administrator : String Read GetAdministrator Write FAdministrator;
Property RequestVariables[VarName : String] : String Read GetRequestVariable; Property RequestVariables[VarName : String] : String Read GetRequestVariable;
Property RequestVariableCount : Integer Read GetRequestVariableCount; Property RequestVariableCount : Integer Read GetRequestVariableCount;
Property Response : TStream Read FResponse;
end; end;
ResourceString ResourceString
@ -129,6 +135,9 @@ ResourceString
Implementation Implementation
uses
iostream;
Constructor TCgiApplication.Create(AOwner : TComponent); Constructor TCgiApplication.Create(AOwner : TComponent);
begin begin
@ -173,6 +182,7 @@ begin
Inherited; Inherited;
InitCGIVars; InitCGIVars;
InitRequestVars; InitRequestVars;
FResponse:=TIOStream.Create(iosOutput);
end; end;
Procedure TCgiApplication.GetCGIVarList(List : TStrings); Procedure TCgiApplication.GetCGIVarList(List : TStrings);
@ -258,8 +268,8 @@ begin
S:=ContentType; S:=ContentType;
If (S='') then If (S='') then
S:='text/html'; S:='text/html';
writeln('Content-Type: ',ContentType); AddResponseLn('Content-Type: '+ContentType);
writeln; AddResponseLn('');
FContentTypeEmitted:=True; FContentTypeEmitted:=True;
end; end;
end; end;
@ -277,16 +287,16 @@ begin
end; end;
If (ContentType='text/html') then If (ContentType='text/html') then
begin begin
writeln('<html><head><title>',Title,SCGIError,'</title></head>'); AddResponseLN('<html><head><title>'+Title+': '+SCGIError+'</title></head>');
writeln('<body>'); AddResponseLN('<body>');
writeln('<center><hr><h1>',Title,': ERROR</h1><hr></center><br><br>'); AddResponseLN('<center><hr><h1>'+Title+': ERROR</h1><hr></center><br><br>');
writeln(SAppEncounteredError ,'<br>'); AddResponseLN(SAppEncounteredError+'<br>');
writeln('<ul>'); AddResponseLN('<ul>');
writeln('<li>',SError,' <b>',E.Message,'</b></ul><hr>'); AddResponseLN('<li>'+SError+' <b>'+E.Message+'</b></ul><hr>');
TheEmail:=Email; TheEmail:=Email;
If (TheEmail<>'') then If (TheEmail<>'') then
writeln('<h5><p><i>',SNotify,Administrator,': <a href="mailto:',TheEmail,'">',TheEmail,'</a></i></p></h5>'); AddResponseLN('<h5><p><i>'+SNotify+Administrator+': <a href="mailto:'+TheEmail+'">'+TheEmail+'</a></i></p></h5>');
writeln('</body></html>'); AddResponseLN('</body></html>');
end; end;
end; end;
@ -512,4 +522,34 @@ begin
Result:=0; Result:=0;
end; end;
Procedure TCGIApplication.AddResponse(Const S : String);
Var
L : Integer;
begin
L:=Length(S);
If L>0 then
FResponse.Write(S[1],L);
end;
Procedure TCGIApplication.AddResponse(Const Fmt : String; Args : Array of const);
begin
AddResponse(Format(Fmt,Args));
end;
Procedure TCGIApplication.AddResponseLN(Const S : String);
begin
AddResponse(S+LineEnding);
end;
Procedure TCGIApplication.AddResponseLN(Const Fmt : String; Args : Array of const);
begin
AddResponseLN(Format(Fmt,Args));
end;
end. end.