* improved version that is still readable and has hex inline. Most importantly, it writes directly to result string rather than a temp, saving a copy that is hurting specially for longer strings.

packages/fcl-json/src/fpjson.pp

@@ -801,7 +801,7 @@ Function GetJSONStringParserHandler: TJSONStringParserHandler;
 
 implementation
 
-Uses typinfo;
+Uses typinfo,sysconst;
 
 Resourcestring
   SErrCannotConvertFromNull = 'Cannot convert data from Null value';
@@ -881,57 +881,67 @@ end;
 function StringToJSONString(const S: TJSONStringType; Strict : Boolean = False): TJSONStringType;
 
 Var
-  I,J,L, cnt : Integer;
-  C : Char;
-  fs:TMemoryStream;
+  rp,ra,sp,sn,litStart : SizeInt;
+  outerResult : TJSONStringType absolute result;
 
-  procedure W(const ss:string); inline;
+  procedure W(Ws: PChar; NWs: SizeInt);
   begin
-    fs.Write(ss[1],length(ss));
+    if ra-rp<NWs then
+      begin
+        // rp+NWs are the strict minimum to allocate;
+        // the rest is a speculation based on the remaining S tail (sn-sp) and the previously allocated value (ra).
+        ra:=rp+NWs+(sn-sp)+8+SizeInt(SizeUint(ra+(sn-sp)) div 4);
+        SetLength(outerResult,ra);
+      end;
+    Move(Ws^,PChar(pointer(outerResult))[rp],NWS*sizeof(char));
+    rp:=rp+NWs;
   end;
 
+var
+  hex : array[0..5] of char;
+  C : Char;
+
 begin
-  fs:=TMemoryStream.Create;
-  try
-    I:=1;
-    J:=1;
-    fs.Size:=0;
-    Result:='';
-    L:=Length(S);
-    While I<=L do
-      begin
-      C:=S[I];
+  rp:=0;
+  ra:=0;
+  result:='';
+  sp:=0;
+  sn:=length(S);
+  litStart:=0;
+  hex:='\u00';
+  While sp<sn do
+    begin
+      C:=PChar(pointer(S))[sp];
       if (C in ['"','/','\',#0..#31]) then
         begin
-          fs.Write(S[J],I-J); // Result:=Result+Copy(S,J,I-J);
+          W(PChar(pointer(S))+litStart,sp-litStart);
           Case C of
-            '\' : W('\\'); //Result:=Result+'\\';
+            '\' : W('\\',2);
             '/' : if Strict then
-                    W('\/') //Result:=Result+'\/'
+                    W('\/',2)
                   else
-                    W('/');//Result:=Result+'/';
-            '"' : W('\"');//Result:=Result+'\"';
-            #8  : W('\b');//Result:=Result+'\b';
-            #9  : W('\t');//Result:=Result+'\t';
-            #10 : W('\n');//Result:=Result+'\n';
-            #12 : W('\f');//Result:=Result+'\f';
-            #13 : W('\r');//Result:=Result+'\r';
+                    W('/',1);
+            '"' : W('\"',2);
+            #8  : W('\b',2);
+            #9  : W('\t',2);
+            #10 : W('\n',2);
+            #12 : W('\f',2);
+            #13 : W('\r',2);
           else
-            W('\u'+HexStr(Ord(C),4)); //Result:=Result+'\u'+HexStr(Ord(C),4);
+            begin
+              hex[4]:=hexdigits[(ord(C) shr 4)];
+              hex[5]:=hexdigits[(ord(C) and $F)];
+              W(@hex[0],6);
+            end;
           end;
-        J:=I+1;
+          litStart:=sp+1;
         end;
-      Inc(I);
-      end;
-    //Result:=Result+Copy(S,J,I-1);
-    cnt:=L-J+1; //
-    if cnt>0 then
-      fs.Write(S[J],cnt);
-    fs.Position:=0;
-    setstring(Result,Pchar(fs.Memory),fs.Size);
-  finally
-    fs.Free;
-  end;
+      Inc(sp);
+    end;
+  if litStart=0 then
+    exit(S); // Optimization of the unchanged string case.
+  W(PChar(pointer(S))+litStart,sp-litStart);
+  SetLength(result,rp);
 end;
 
 function JSONStringToString(const S: TJSONStringType): TJSONStringType;