diff --git a/packages/fcl-web/src/base/httpdefs.pp b/packages/fcl-web/src/base/httpdefs.pp index b5d700b13e..1ff07a1d37 100644 --- a/packages/fcl-web/src/base/httpdefs.pp +++ b/packages/fcl-web/src/base/httpdefs.pp @@ -59,8 +59,13 @@ const fieldSetCookie = 'Set-Cookie'; fieldUserAgent = 'User-Agent'; fieldWWWAuthenticate = 'WWW-Authenticate'; + // These cannot be added to the NoHTTPFields constant + // They are in the extra array. + fieldHost = 'Host'; + fieldCacheControl = 'Cache-Control'; + fieldXRequestedWith = 'X-Requested-With'; - NoHTTPFields = 24; + NoHTTPFields = 27; HTTPDateFmt = '"%s", dd "%s" yyyy hh:mm:ss'; // For use in FormatDateTime SCookieExpire = ' "Expires="'+HTTPDateFmt+' "GMT"'; @@ -79,9 +84,12 @@ const Type - THttpFields = Array[1..NoHTTPFields] of string; + THttpFields = Array[1..NoHTTPFields] of string; + THttpIndexes = Array[1..NoHTTPFields] of integer; + Const + // For this constant, the header names corresponds to the property index used in THTTPHeader. HTTPFieldNames : THttpFields = (fieldAccept, fieldAcceptCharset, fieldAcceptEncoding, fieldAcceptLanguage, fieldAuthorization, fieldConnection, @@ -89,8 +97,20 @@ Const fieldContentType, fieldCookie, fieldDate, fieldExpires, fieldFrom, fieldIfModifiedSince, fieldLastModified, fieldLocation, fieldPragma, fieldReferer, fieldRetryAfter, fieldServer, - fieldSetCookie, fieldUserAgent, fieldWWWAuthenticate); - + fieldSetCookie, fieldUserAgent, fieldWWWAuthenticate, + fieldHost, fieldCacheControl,fieldXRequestedWith); + // Map header names on indexes in property getter/setter. 0 means not mapped ! + HTTPFieldIndexes : THTTPIndexes + = (1,2,3, + 4,5,6, + 7,8,9, + 10,11,12,13, + 14,15,16,17, + 18,19,20,21, + 22,23,24, + 34,0,36); + + type TRequest = Class; @@ -242,7 +262,6 @@ type function GetSetFieldName(AIndex: Integer): String; procedure SetCookieFields(const AValue: TStrings); Function GetFieldCount : Integer; - Function GetFieldName(Index : Integer) : String; Function GetContentLength : Integer; Procedure SetContentLength(Value : Integer); Function GetFieldIndex(AIndex : Integer) : Integer; @@ -331,6 +350,8 @@ type FHandleGetOnPost: Boolean; FOnUnknownEncoding: TOnUnknownEncodingEvent; FPathInfo, + FHost : string; + FRequestedWith : String; FURI: String; FFiles : TUploadedFiles; FReturnedPathInfo : String; @@ -382,6 +403,7 @@ type TResponse = class(THttpHeader) private + FCacheControl: String; FContents: TStrings; FContentStream : TStream; FCode: Integer; @@ -415,6 +437,7 @@ type Property Request : TRequest Read FRequest; Property Code: Integer Read FCode Write FCode; Property CodeText: String Read FCodeText Write FCodeText; + Property CacheControl : String Read FCacheControl Write FCacheControl; Property FirstHeaderLine : String Read GetFirstHeaderLine Write SetFirstHeaderLine; Property ContentStream : TStream Read FContentStream Write SetContentStream; Property Content : String Read GetContent Write SetContent; @@ -519,6 +542,8 @@ begin Result:=NoHTTPFields; While (Result>0) and (UpperCase(HTTPFieldNames[Result])<>Name) do Dec(Result); + If Result>0 then + Result:=HTTPFieldIndexes[Result]; end; function HTTPDecode(const AStr: String): String; @@ -835,17 +860,6 @@ begin end; -function THttpHeader.GetFieldName(Index: Integer): String; - -Var - I : Integer; - -begin - I:=GetFieldIndex(Index); - If (I<>-1) then - Result := HTTPFieldNames[i]; -end; - Function THttpHeader.GetFieldValue(Index : Integer) : String; begin @@ -869,7 +883,7 @@ end; Procedure THttpHeader.SetFieldValue(Index : Integer; Value : String); begin - if (Index>1) and (Index1) and (Index<=NoHTTPFields) then begin FFields[Index]:=Value; If (Index=11) then @@ -941,7 +955,9 @@ var begin I:=GetFieldNameIndex(AName); If (I<>0) then - Result:=self.GetFieldValue(i); + Result:=self.GetFieldValue(i) + else + Result:=''; end; Function THTTPHeader.LoadFromStream(Stream: TStream; IncludeCommand : Boolean) : Integer; @@ -1308,6 +1324,8 @@ begin 25 : Result:=FPathInfo; 31 : Result:=FCommand; 32 : Result:=FURI; + 34 : Result:=FHost; + 36 : Result:=FRequestedWith; 35 : begin If Not FContentRead and AllowReadContent then begin @@ -1328,6 +1346,8 @@ begin 30 : FServerPort:=Value; 31 : FCommand:=Value; 32 : FURI:=Value; + 34 : FHost:=Value; + 36 : FRequestedWith:=Value; else inherited SetFieldValue(Index, Value); end