* Fixed (BLOB) display, added support for transcoding

git-svn-id: http://svn.freepascal.org/svn/fpc/trunk@15893 3ad0048d-3df7-0310-abae-a5850022a9f2

3 files changed, 27 insertions, 3 deletions

diff --git a/packages/fcl-web/src/webdata/extjsjson.pp b/packages/fcl-web/src/webdata/extjsjson.pp
index 22daedb7c3..d93379bfc4 100644
--- a/packages/fcl-web/src/webdata/extjsjson.pp
+++ b/packages/fcl-web/src/webdata/extjsjson.pp
@@ -106,6 +106,10 @@ end;
 
 function TExtJSJSONDataFormatter.AddFieldToJSON(O : TJSONObject; AFieldName : String; F : TField): TJSONData;
 
+Var
+  S : String;
+
+
 begin
  if F.IsNull then
    Result:=O.Items[O.Add(AFieldName)]
@@ -129,9 +133,18 @@ begin
     ftMemo,
     ftFmtMemo,
     ftWideMemo,
-    ftBlob :O.Items[O.Add(AFieldName,F.AsString)];
+    ftBlob :
+      begin
+      S:=F.AsString;
+      If (OnTranscode<>Nil) then
+        OnTranscode(Self,F,S,True);
+      Result:=O.Items[O.Add(AFieldName,S)];
+      end;
   else
-    Result:=O.Items[O.Add(AFieldName,F.DisplayText)];
+    S:=F.DisplayText;
+    If (OnTranscode<>Nil) then
+      OnTranscode(Self,F,S,True);
+    Result:=O.Items[O.Add(AFieldName,S)];
   end;
 end;
 
diff --git a/packages/fcl-web/src/webdata/extjsxml.pp b/packages/fcl-web/src/webdata/extjsxml.pp
index 02e6951768..2a94294e2d 100644
--- a/packages/fcl-web/src/webdata/extjsxml.pp
+++ b/packages/fcl-web/src/webdata/extjsxml.pp
@@ -172,6 +172,7 @@ Var
   E : TDOMElement;
   F : TField;
   I : Integer;
+  S : String;
 begin
   Result:=Doc.CreateElement(RecordProperty);
   try
@@ -180,7 +181,13 @@ begin
       begin
       F:=Dataset.Fields[i];
       E:=Doc.CreateElement(F.FieldName);
-      E.AppendChild(Doc.CreateTextNode(F.DisplayText));
+      If F.DataType in [ftMemo, ftFmtMemo, ftWideMemo, ftBlob ] then
+        S:=F.AsString
+      else
+        S:=F.DisplayText;
+      If (OnTranscode<>Nil) then
+        OnTranscode(Self,F,S,True);
+      E.AppendChild(Doc.CreateTextNode(S));
       Result.AppendChild(E);
       end;
     DoAfterRow(Result);
diff --git a/packages/fcl-web/src/webdata/fpwebdata.pp b/packages/fcl-web/src/webdata/fpwebdata.pp
index dbdffc3a74..a4d8f5da67 100644
--- a/packages/fcl-web/src/webdata/fpwebdata.pp
+++ b/packages/fcl-web/src/webdata/fpwebdata.pp
@@ -122,12 +122,15 @@ type
   // Handle request for read/create/update/delete and return a result.
 
   { TCustomHTTPDataContentProducer }
+  // Support for transcoding from/to UTF-8. If outbound is true, the value is going from server to browser.
+  TOnTranscodeEvent = Procedure (Sender : TObject; F : TField; Var S : String; Outbound : Boolean) of object;
 
   TCustomHTTPDataContentProducer = Class(THTTPContentProducer)
   Private
     FAllowPageSize: Boolean;
     FDataProvider: TFPCustomWebDataProvider;
     FMetadata: Boolean;
+    FOnTranscode: TOnTranscodeEvent;
     FPageSize: Integer;
     FPageStart: Integer;
     FSD: Boolean;
@@ -161,6 +164,7 @@ type
     Property SortField : String Read FSortField Write FSortField;
     Property SortDescending : Boolean Read FSD Write FSD default False;
     Property AllowPageSize : Boolean Read FAllowPageSize Write FAllowPageSize default True;
+    Property OnTransCode : TOnTranscodeEvent Read FOnTranscode Write FOnTranscode;
   end;
   TCustomHTTPDataContentProducerClass = Class of TCustomHTTPDataContentProducer;