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

* Some changes suggested by Edgar Fernando

Browse Source
This commit is contained in:
Michael Van Canneyt 2023-03-31 19:13:45 +02:00
parent 644ffa8e7a
commit 652f54fe31
2 changed files with 20 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
packages/fcl-web/src/base/fpwebfile.pp
View File

@ -318,7 +318,6 @@ begin
Result:=D+Copy(AFileName,Length(localBaseURL)+1,MaxInt) Result:=D+Copy(AFileName,Length(localBaseURL)+1,MaxInt)
else else
Result:=D+AFileName; Result:=D+AFileName;
DoDirSeparators(Result);
Result:=ExpandFileName(Result); Result:=ExpandFileName(Result);
end; end;
end; end;

24
packages/fcl-web/src/base/httpdefs.pp
View File

@ -510,6 +510,7 @@ type
constructor Create; override; constructor Create; override;
destructor destroy; override; destructor destroy; override;
Function GetNextPathInfo : String; Function GetNextPathInfo : String;
Function ToString: ansistring; override;
Property RequestID : String Read FRequestID; Property RequestID : String Read FRequestID;
Property RouteParams[AParam : String] : String Read GetRP Write SetRP; Property RouteParams[AParam : String] : String Read GetRP Write SetRP;
Property ReturnedPathInfo : String Read FReturnedPathInfo Write FReturnedPathInfo; Property ReturnedPathInfo : String Read FReturnedPathInfo Write FReturnedPathInfo;
@ -565,6 +566,7 @@ type
Procedure SendHeaders; Procedure SendHeaders;
Procedure SendResponse; // Delphi compatibility Procedure SendResponse; // Delphi compatibility
Procedure SendRedirect(const TargetURL:String); Procedure SendRedirect(const TargetURL:String);
Function ToString: ansistring; override;
// Set Code and CodeText. Send content if aSend=True // Set Code and CodeText. Send content if aSend=True
Procedure SetStatus(aStatus : Cardinal; aSend : Boolean = False); Procedure SetStatus(aStatus : Cardinal; aSend : Boolean = False);
Property Request : TRequest Read FRequest; Property Request : TRequest Read FRequest;
@ -1297,12 +1299,12 @@ end;
function THTTPHeader.GetContentLength: Integer; function THTTPHeader.GetContentLength: Integer;
begin begin
Result:=StrToIntDef(GetFieldValue(9),0); Result:=StrToIntDef(GetHeader(hhContentLength),0);
end; end;
procedure THTTPHeader.SetContentLength(Value: Integer); procedure THTTPHeader.SetContentLength(Value: Integer);
begin begin
SetFieldValue(9,IntToStr(Value)); SetHeader(hhContentLength,IntToStr(Value));
end; end;
@ -1351,7 +1353,7 @@ end;
function THTTPHeader.GetServerPort: Word; function THTTPHeader.GetServerPort: Word;
begin begin
Result:=StrToIntDef(GetFieldValue(30),0); Result:=StrToIntDef(GetHTTPVariable(hvServerPort),0);
end; end;
procedure THTTPHeader.SetHTTPVariable(AIndex: Integer; AValue: String); procedure THTTPHeader.SetHTTPVariable(AIndex: Integer; AValue: String);
@ -1373,7 +1375,7 @@ end;
procedure THTTPHeader.SetServerPort(AValue: Word); procedure THTTPHeader.SetServerPort(AValue: Word);
begin begin
SetFieldValue(30,IntToStr(AValue)); SetHTTPVariable(hvServerPort,IntToStr(AValue));
end; end;
function THTTPHeader.GetSetFieldValue(Index: Integer): String; function THTTPHeader.GetSetFieldValue(Index: Integer): String;
@ -2156,6 +2158,11 @@ begin
{$ifdef CGIDEBUG}SendDebug(Format('Pathinfo: "%s" "%s" : %s',[P,FReturnedPathInfo,Result]));{$ENDIF} {$ifdef CGIDEBUG}SendDebug(Format('Pathinfo: "%s" "%s" : %s',[P,FReturnedPathInfo,Result]));{$ENDIF}
end; end;
function TRequest.ToString: ansistring;
begin
Result:='['+RequestID+'] : '+URL;
end;
procedure TRequest.ParseFirstHeaderLine(const line: String); procedure TRequest.ParseFirstHeaderLine(const line: String);
var var
i: Integer; i: Integer;
@ -2875,6 +2882,15 @@ begin
end; end;
end; end;
function TResponse.ToString: ansistring;
begin
if assigned(Request) then
Result:=Request.ToString
else
Result:='Unknown request';
Result:=Result+': '+IntToStr(Code)+' '+CodeText;
end;
procedure TResponse.SetStatus(aStatus: Cardinal; aSend: Boolean = False); procedure TResponse.SetStatus(aStatus: Cardinal; aSend: Boolean = False);
begin begin
Code:=aStatus; Code:=aStatus;