* Delphi compatibility improvements

packages/fcl-web/src/base/httpprotocol.pp

@@ -148,9 +148,15 @@ Const
                     HeaderTransferEncoding, HeaderUpgrade , HeaderUserAgent, HeaderVary,
                     HeaderVia, HeaderWarning, HeaderWWWAuthenticate);
 
+Type
+   THTTPUnsafeChar = Byte;
+   THTTPUnsafeChars = set of THTTPUnsafeChar;
+
 Function HeaderName(AHeader : THeader) : String;
 Function HeaderType(AHeader : String) : THeader;
 Function HTTPDecode(const AStr: String): String;
+Function HTTPDecode(const AStr: String; aPlusAsSpaces : Boolean): String;
+Function HTTPEncode(const AStr: String; aUnsafeChars : THTTPUnsafeChars; aSpacesAsPlus : Boolean): String;
 Function HTTPEncode(const AStr: String): String;
 Function IncludeHTTPPathDelimiter(const AStr: String): String;
 Function ExcludeHTTPPathDelimiter(const AStr: String): String;
@@ -174,6 +180,12 @@ end;
 
 function HTTPDecode(const AStr: String): String;
 
+begin
+  Result:=HTTPDecode(aStr,True);
+end;
+
+Function HTTPDecode(const AStr: String; aPlusAsSpaces : Boolean): String;
+
 var
   S,SS, R : PChar;
   H : String[3];
@@ -191,7 +203,10 @@ begin
   while (S-SS)<L do
     begin
     case S^ of
-      '+': R^ := ' ';
+      '+': if aPlusAsSpaces then
+             R^:=' '
+           else
+             R^:='+';
       '%': begin
            Inc(S);
            if ((S-SS)<L) then
@@ -222,13 +237,7 @@ begin
   SetLength(Result,R-PChar(Result));
 end;
 
-function HTTPEncode(const AStr: String): String;
-
-const
-  HTTPAllowed = ['A'..'Z','a'..'z',
-                 '*','@','.','_','-',
-                 '0'..'9',
-                 '$','!','''','(',')'];
+function DoHTTPEncode(const AStr: String; HTTPAllowed : THTTPUnsafeChars; aSpacesAsPlus : Boolean): String;
 
 var
   SS,S,R: PChar;
@@ -246,10 +255,15 @@ begin
   SS:=S; // Avoid #0 limit !!
   while ((S-SS)<L) do
     begin
-    if S^ in HTTPAllowed then
+    if Ord(S^) in HTTPAllowed then
       R^:=S^
     else if (S^=' ') then
-      R^:='+'
+      begin
+      if aSpacesAsPlus then
+        R^:='+'
+      else
+        R^:=' '
+      end
     else
       begin
       R^:='%';
@@ -265,6 +279,27 @@ begin
   SetLength(Result,R-PChar(Result));
 end;
 
+const
+  OrdHTTPAllowed = [Ord('A')..Ord('Z'),Ord('a')..Ord('z'),
+                    Ord('*'),Ord('@'),Ord('.'),Ord('_'),Ord('-'),
+                    Ord('0')..Ord('9'),
+                    Ord('$'),Ord('!'),Ord(''''),Ord('('),Ord(')')];
+  OrdDelphiHTTPAllowed = OrdHTTPAllowed + [Ord('%')];
+
+function HTTPEncode(const AStr: String): String;
+
+begin
+  // Backwards compatible: % is not allowed.
+  Result:=DoHTTPEncode(aStr,OrdHTTPAllowed,True);
+end;
+
+Function HTTPEncode(const AStr: String; aUnsafeChars : THTTPUnsafeChars; aSpacesAsPlus : Boolean): String;
+
+begin
+  Result:=DoHTTPEncode(aStr,OrdDelphiHTTPAllowed-aUnsafeChars,aSpacesAsPlus);
+end;
+
+
 function IncludeHTTPPathDelimiter(const AStr: String): String;
 
 Var

packages/vcl-compat/src/system.netencoding.pp

@@ -22,15 +22,19 @@ unit System.NetEncoding;
 interface
 
 {$IFDEF FPC_DOTTEDUNITS}
-uses System.SysUtils, System.Classes;
+uses System.SysUtils, System.Classes, System.Types;
 {$ELSE FPC_DOTTEDUNITS}
-uses Sysutils, Classes;
+uses Sysutils, Classes, Types;
 {$ENDIF FPC_DOTTEDUNITS}
 
 type
   // Not used here
   EHTTPException = class(Exception);
 
+  UnsafeChar = Byte;
+  TUnsafeChars = set of UnsafeChar;
+  TURLEncoding = Class;
+
   { TNetEncoding }
 
   TNetEncoding = class
@@ -41,6 +45,7 @@ type
       FStdEncodings : Array[1..StdCount] of TNetEncoding;
     Class Function GetStdEncoding(aIndex : Integer) : TNetEncoding; Static;
     Class Destructor Destroy;
+    class function GetURLEncoding: TURLEncoding; static;
   protected
     // These must be implemented by descendents
     Function DoDecode(const aInput: RawByteString): RawByteString; overload; virtual; abstract;
@@ -82,7 +87,7 @@ type
     // Default instances
     class property Base64: TNetEncoding Index 1 read GetStdEncoding;
     class property HTML: TNetEncoding Index 2 read GetStdEncoding;
-    class property URL: TNetEncoding Index 3 read GetStdEncoding;
+    class property URL: TURLEncoding read GetURLEncoding;
   end;
 
   { TBase64Encoding }
@@ -96,10 +101,25 @@ type
     Function DoEncode(const aInput: RawByteString): RawByteString; overload; override;
   end;
 
+  { TURLEncoding }
+
   TURLEncoding = class(TNetEncoding)
   protected
     Function DoEncode(const aInput: RawBytestring): RawBytestring; overload; override;
     Function DoDecode(const aInput: RawBytestring): RawBytestring; overload; override;
+  Public
+    Type
+      UnsafeChar = Byte;
+      TUnsafeChars = set of UnsafeChar;
+      TEncodeOption = (SpacesAsPlus, EncodePercent);
+      TEncodeOptions = set of TEncodeOption;
+      TDecodeOption = (PlusAsSpaces);
+      TDecodeOptions = set of TDecodeOption;
+  Public
+    function Encode(const aInput: string; const aSet: TUnsafeChars; const aOptions: TEncodeOptions; aEncoding: TEncoding = nil): string; overload;
+    function EncodeQuery(const aInput: string; const aExtraUnsafeChars: TUnsafeChars): string;
+    function EncodePath(const aPath: string; const aExtraUnsafeChars: TUnsafeChars): string;
+    class function URIDecode(const aValue: string; aPlusAsSpaces: Boolean): string;
   end;
 
   THTMLEncoding = class(TNetEncoding)
@@ -181,7 +201,12 @@ begin
   FreeStdEncodings;
 end;
 
-class Function TNetEncoding.GetStdEncoding(aIndex: Integer): TNetEncoding;
+class function TNetEncoding.GetURLEncoding: TURLEncoding; static;
+begin
+  Result:=TURLEncoding(GetStdEncoding(3));
+end;
+
+class function TNetEncoding.GetStdEncoding(aIndex: Integer): TNetEncoding;
 begin
   if FStdEncodings[aIndex]=Nil then
     case aIndex of
@@ -194,53 +219,53 @@ end;
 
 // Public API
 
-Function TNetEncoding.Encode(const aInput: array of Byte): TBytes;
+function TNetEncoding.Encode(const aInput: array of Byte): TBytes;
 begin
   Result:=DoEncode(aInput);
 end;
 
-Function TNetEncoding.Encode(const aInput, aOutput: TStream): Integer;
+function TNetEncoding.Encode(const aInput, aOutput: TStream): Integer;
 begin
   Result:=DoEncode(aInput, aOutput);
 end;
 
-Function TNetEncoding.Decode(const aInput: RawByteString): RawByteString; overload;
+function TNetEncoding.Decode(const aInput: RawByteString): RawByteString;
 begin
   Result:=DoDecode(aInput);
 end;
 
-Function TNetEncoding.Encode(const aInput: RawByteString): RawByteString; overload;
+function TNetEncoding.Encode(const aInput: RawByteString): RawByteString;
 
 begin
   Result:=DoEncode(aInput);
 end;
 
-Function TNetEncoding.Encode(const aInput: UnicodeString): UnicodeString;
+function TNetEncoding.Encode(const aInput: UnicodeString): UnicodeString;
 begin
   Result:=DoEncode(aInput);
 end;
 
-Function TNetEncoding.EncodeBytesToString(const aInput: array of Byte): UnicodeString;
+function TNetEncoding.EncodeBytesToString(const aInput: array of Byte): UnicodeString;
 begin
   Result:=DoEncodeBytesToString(aInput);
 end;
 
-Function TNetEncoding.EncodeBytesToString(const aInput: Pointer; Size: Integer): UnicodeString;
+function TNetEncoding.EncodeBytesToString(const aInput: Pointer; Size: Integer): UnicodeString;
 begin
   Result:=DoEncodeBytesToString(aInput, Size);
 end;
 
-Function TNetEncoding.Decode(const aInput, aOutput: TStream): Integer;
+function TNetEncoding.Decode(const aInput, aOutput: TStream): Integer;
 begin
   Result:=DoDecode(aInput,aOutput);
 end;
 
-Function TNetEncoding.Decode(const aInput: UnicodeString): UnicodeString;
+function TNetEncoding.Decode(const aInput: UnicodeString): UnicodeString;
 begin
   Result:=DoDecode(aInput);
 end;
 
-Function TNetEncoding.DecodeStringToBytes(const aInput: UnicodeString): TBytes;
+function TNetEncoding.DecodeStringToBytes(const aInput: UnicodeString): TBytes;
 begin
   Result:=DoDecodeStringToBytes(aInput);
 end;
@@ -250,14 +275,14 @@ begin
   Result:=DoDecodeStringToBytes(aInput);
 end;
 
-Function TNetEncoding.Decode(const aInput: array of Byte): TBytes;
+function TNetEncoding.Decode(const aInput: array of Byte): TBytes;
 begin
   Result:=DoDecode(aInput);
 end;
 
 // Protected
 
-Function TNetEncoding.DoDecode(const aInput: UnicodeString): UnicodeString;
+function TNetEncoding.DoDecode(const aInput: UnicodeString): UnicodeString;
 
 Var
   U : UTF8String;
@@ -267,7 +292,7 @@ begin
   Result:=UTF8Decode(DoDecode(U));
 end;
 
-Function TNetEncoding.DoEncode(const aInput: UnicodeString): UnicodeString;
+function TNetEncoding.DoEncode(const aInput: UnicodeString): UnicodeString;
 
 Var
   U : UTF8String;
@@ -277,7 +302,7 @@ begin
   Result:=UTF8Decode(DoEncode(U));
 end;
 
-Function TNetEncoding.DoDecode(const aInput: array of Byte): TBytes;
+function TNetEncoding.DoDecode(const aInput: array of Byte): TBytes;
 
 begin
   if Length(aInput)=0 then
@@ -286,7 +311,7 @@ begin
     Result:=TEncoding.UTF8.GetBytes(DoDecode(UTF8ToString(aInput)));
 end;
 
-Function TNetEncoding.DoDecode(const aInput, aOutput: TStream): Integer;
+function TNetEncoding.DoDecode(const aInput, aOutput: TStream): Integer;
 
 var
   Src,Dest: TBytes;
@@ -306,13 +331,13 @@ begin
     end
 end;
 
-Function TNetEncoding.DoDecodeStringToBytes(const aInput: UnicodeString): TBytes;
+function TNetEncoding.DoDecodeStringToBytes(const aInput: UnicodeString): TBytes;
 
 begin
   Result:=TEncoding.UTF8.GetBytes(DoDecode(aInput));
 end;
 
-Function TNetEncoding.DoEncode(const aInput: array of Byte): TBytes;
+function TNetEncoding.DoEncode(const aInput: array of Byte): TBytes;
 begin
   if Length(aInput)=0 then
     Result:=Default(TBytes)
@@ -332,13 +357,13 @@ begin
   Result:=DoDecodeStringToBytes(UTF8Decode(U));
 end;
 
-Function TNetEncoding.DoEncodeBytesToString(const aInput: array of Byte): UnicodeString;
+function TNetEncoding.DoEncodeBytesToString(const aInput: array of Byte): UnicodeString;
 begin
   Result:=TEncoding.UTF8.GetString(DoEncode(aInput));
 end;
 
 
-Function TNetEncoding.DoEncodeBytesToString(const aInput: Pointer; Size: Integer): UnicodeString;
+function TNetEncoding.DoEncodeBytesToString(const aInput: Pointer; Size: Integer): UnicodeString;
 
 Var
   Src : TBytes;
@@ -350,7 +375,7 @@ begin
   Result:=DoEncodeBytesToString(Src);
 end;
 
-Function TNetEncoding.DoEncode(const aInput, aOutput: TStream): Integer;
+function TNetEncoding.DoEncode(const aInput, aOutput: TStream): Integer;
 var
   InBuf: array of Byte;
   OutBuf: TBytes;
@@ -373,18 +398,68 @@ end;
 
 { TURLEncoding }
 
-Function TURLEncoding.DoDecode(const aInput: RawByteString): RawByteString;
+function TURLEncoding.DoDecode(const aInput: RawBytestring): RawBytestring;
 
 begin
   Result:=HTTPDecode(aInput);
 end;
 
-Function TURLEncoding.DoEncode(const aInput: RawByteString): RawByteString;
+function TURLEncoding.Encode(const aInput: string; const aSet: TUnsafeChars; const aOptions: TEncodeOptions; aEncoding: TEncoding): string;
+
+
+var
+  S : TUnsafeChars;
+
+begin
+  S:=aSet;
+  if (TEncodeOption.EncodePercent in aOptions) then
+    S:=aSet+[Ord('%')];
+  Result:=HttpEncode(aInput,S,TEncodeOption.SpacesAsPlus in aOptions);
+end;
+
+function TURLEncoding.DoEncode(const aInput: RawBytestring): RawBytestring;
 
 begin
   Result:=HTTPEncode(aInput)
 end;
 
+function TURLEncoding.EncodeQuery(const aInput: string; const aExtraUnsafeChars: TUnsafeChars): string;
+
+const
+  QueryUnsafeChars: TUnsafeChars = [Ord('''')+Ord('%')];
+
+var
+  Unsafe: TUnsafeChars;
+
+begin
+  Unsafe:=QueryUnsafeChars+aExtraUnsafeChars;
+  Result:=HTTPEncode(aInput,Unsafe,True);
+end;
+
+function TURLEncoding.EncodePath(const aPath: string; const aExtraUnsafeChars: TUnsafeChars): string;
+
+
+var
+  lPaths: TStringDynArray;
+  I,Last: Integer;
+  LUnsafeChars: TUnsafeChars;
+
+begin
+  if APath = '' then
+    Exit('/');
+  Result:='';
+  lPaths:=APath.Split(['/'], TStringSplitOptions.ExcludeEmpty);
+  Last:=Length(lPaths)-1;
+  for I:=0 to Last do
+    Result:=Result+'/'+HTTPEncode(LPaths[I],aExtraUnsafeChars,True);
+end;
+
+class function TURLEncoding.URIDecode(const aValue: string; aPlusAsSpaces: Boolean): string;
+begin
+  Result:=HTTPDecode(aValue,aPlusAsSpaces);
+end;
+
+
 { THTMLEncoding }
 
 Function THTMLEncoding.DoEncode(const aInput: UnicodeString): UnicodeString;