paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-11-02 10:49:33 +01:00
Code Issues Packages Projects Releases Wiki Activity

* Added TRequest.LocalPathPrefix property

Browse Source 
git-svn-id: trunk@16371 -
This commit is contained in:
joost 2010-11-19 14:44:34 +00:00
parent 23e74d5d46
commit 8c836d1d1a
1 changed files with 26 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -268,6 +268,8 @@ type
FURI: String;
FFiles : TUploadedFiles;
FReturnedPathInfo : String;
FLocalPathPrefix : string;
function GetLocalPathPrefix: string;
procedure ParseFirstHeaderLine(const line: String);override;
function GetFirstHeaderLine: String;
Protected
@ -287,6 +289,7 @@ type
destructor destroy; override;
Function GetNextPathInfo : String;
Property ReturnedPathInfo : String Read FReturnedPathInfo Write FReturnedPathInfo;
Property LocalPathPrefix : string Read GetLocalPathPrefix;
Property CommandLine : String Read FCommandLine;
Property Command : String read FCommand;
Property URI : String read FURI; // Uniform Resource Identifier
@ -381,9 +384,11 @@ Function IncludeHTTPPathDelimiter(const AStr: String): String;
implementation
uses
{$ifdef CGIDEBUG}
uses dbugintf;
dbugintf,
{$endif}
strutils;
Resourcestring
SErrContentAlreadySent = 'HTTP Response content was already sent';
@ -907,6 +912,7 @@ begin
inherited create;
FHandleGetOnPost:=True;
FFiles:=TUploadedFiles.Create(TUPloadedFile);
FLocalPathPrefix:='-';
end;
destructor TRequest.destroy;
@ -976,6 +982,25 @@ begin
end;
end;
function TRequest.GetLocalPathPrefix: string;
var
pi: String;
i: Cardinal;
begin
if FLocalPathPrefix='-' then
begin
pi := PathInfo;
FLocalPathPrefix := '';
i := 0;
repeat
i := PosEx('/',PI,i+1);
if i > 0 then
FLocalPathPrefix := FLocalPathPrefix + '../';
until i=0;
end;
result := FLocalPathPrefix;
end;
function TRequest.GetFieldValue(AIndex: integer): String;
begin
if AIndex = 35 then // Content