DataSnap Server HTTP json格式修改 返回图片

DataSnap Server HTTP json 格式修改

 http://127.0.0.1:8080/datasnap/rest/TServerMethods1/EchoString/hello

{"result":["hello"]}

 {"result":["{\"success\":true}"]}

["{\"success\":true}"]

"{\"success\":true}"

php

{"success":true}

触发的顺序
 GetCommandResponse>DSHTTPService1FormatResult>(if not Handled then) GetCommandResponse

1、去掉result符号

能否只返回["hello"] ,不加result标识，和tcp/IP返回的结果一样？

 

procedure TServerContainer1.DSHTTPService1FormatResult(Sender: TObject;
  var ResultVal: TJSONValue; const Command: TDBXCommand; var Handled: Boolean);
var
  str: string;
begin
  // str :=ResultVal.ToString;
  Handled := true;//加上这句话就可以了。
end;

在Datasnap.DSHTTPCommon.pas，有

procedure TDSJsonResponseHandler.GetCommandResponse

if not Handled  then

ResponseObj := TJSONObject.Create(TJSONPair.Create(TJSONString.Create('result'), JsonParam));的处理，所以可以屏蔽。Handled 设为true就好了。

还有URL编码，特别是汉字，如何能禁止呢？？再查。

2、去掉转义字符

元凶在这Datasnap.DSHTTPCommon.pas,TDBXJSONTools.DBXToJSON,

'["[{\"PID\":\"0001\",\"Name\":\"\u5F20\u4E09\u4E30\",\"Sex\":\"\u7537\",\"Age\":100},{\"PID\":\"002\",\"Name\":\"\u90ED\u9756\",\"Sex\":\"\u7537\",\"Age\":80}]"]'

            JsonParam := TDBXJSONTools.DBXToJSON(Command.Parameters[I].Value,
              Command.Parameters[I].DataType, FDSService.LocalConnection);
//用下面这句话就可以了，DBXToJSON引起的。
            JsonParam := TJSONObject.ParseJSONValue(Command.Parameters[I].Value.AsString) as TJSONValue;

TJSONString

2016.10.11 做了二次修改，兼容单个键值，数值值。例如，进返回时间["2012.0.0.0."]

procedure TDSJsonResponseHandler.GetCommandResponse(Command: TDBXCommand; out Response: TJSONValue;
                                                    out ResponseStream: TStream);
var
  JsonParams: TJSONArray;
  JsonParam,JsonParamBak,jv: TJSONValue;
  I: Integer;
  ParamDirection: TDBXParameterDirection;
  OwnParams: Boolean;
  ConvList: TObjectList<TDBXRequestFilter>;
  ResponseObj: TJSONObject;
  Handled: Boolean;
  tstr:string;
  strStream:TStringStream;
  useDefault:Boolean;
begin
  JsonParams := nil;
  OwnParams := false;
  ConvList := nil;
  ResponseStream := nil;
  Handled := False;

  try
    // collect the output/return parameters
    JsonParams := TJSONArray.Create;
    OwnParams := true;
    useDefault:=false;
    ConvList := TObjectList<TDBXRequestFilter>.Create(false);

    for I :=  to Command.Parameters.Count -  do
    begin
      // select the output and return parameters for the response
      ParamDirection := Command.Parameters[I].ParameterDirection;
      if (ParamDirection = TDBXParameterDirections.OutParameter) or
         (ParamDirection = TDBXParameterDirections.InOutParameter) or
         (ParamDirection = TDBXParameterDirections.ReturnParameter) then
      begin
        JsonParam := nil;
        ConvList.Clear;

        {If a subclass doesn't handle the parameter themselves, then manage the parameter by either
         applying a filter on the result, or passing back the pure JSON representation}
        if not HandleParameter(Command, Command.Parameters[I], JsonParam, ResponseStream) then
        begin
          FDSService.FiltersForCriteria([I], I = Command.Parameters.Count - , ConvList);
          if ConvList.Count =  then
          begin
            if not ConvList.Items[].CanConvert(Command.Parameters[I].Value) then
              Raise TDSServiceException.Create(Format(SCannotConvertParam, [I, ConvList.Items[].Name]));
            JsonParam := ConvList.Items[].ToJSON(Command.Parameters[I].Value, FDSService.LocalConnection);
          end
          else
          begin
                        JsonParam := TJSONObject.ParseJSONValue(Command.Parameters[I].Value.AsString) as TJSONValue;
                        if JsonParam=nil then
                        begin
                           useDefault:=true;
                                  JsonParam := TDBXJSONTools.DBXToJSON(Command.Parameters[I].Value,
                              Command.Parameters[I].DataType, FDSService.LocalConnection);
                        end;
          end;
        end;

        if JsonParam <> nil then
          JsonParams.AddElement(JsonParam);
      end;
    end;

    //Store the result array as a JSON Value, to make it more generic for the event and result object
     JsonParamBak:=JsonParam;
        JsonParam := JsonParams;

    if Assigned(FResultEvent) then
      FResultEvent(Self, JsonParam, Command, Handled);

    if not Handled then
    begin
      ResponseObj := TJSONObject.Create(TJSONPair.Create(TJSONString.Create('result'), JsonParam));
      //allow subclasses to add to the result object if they wish
      ProcessResultObject(ResponseObj, Command);
      Response := ResponseObj;
    end
    else
    begin
      if          (JsonParams.Count = ) and (useDefault=false) then
      Response := JsonParamBak
      else
       Response := JsonParam;
    end;

    OwnParams := false;
  finally
    FreeAndNil(ConvList);
    if OwnParams then
      JsonParams.Free;
  end;
end;

GetCommandResponse

3、 防止汉字转成unicode数字

[{"PID":"0001","Name":"张三丰","Sex":"男","Age":100},{"PID":"002","Name":"郭靖","Sex":"男","Age":80}]

通过浏览器打开URL，返回的是

[[{"PID":"0001","Name":"\u5F20\u4E09\u4E30","Sex":"\u7537","Age":100},{"PID":"002","Name":"\u90ED\u9756","Sex":"\u7537","Age":80}]]

 Datasnap.DSHTTP.pas   function PopulateContent

ResponseInfo.ContentText := StringOf(ByteContent(Response))

改为：

ResponseInfo.ContentText := Response.ToString;

Response.Value 为空的原因是结构不一致不，从tjson读取后看value不为空，那么返回value测试一下不。或者对于 Command.Parameters[I].DataType是字符的特殊处理。

CharSet

IdCustomHTTPServer.pas

FConnection.IOHandler.Write(ContentText, CharsetToEncoding(CharSet));

IdCustomHTTPServer.pas

ResponseInfo.ContentText 这个就是返回字符串，

ResponseInfo.ContentText :=  Response.ToString;//      Response.ToJSON;
      ResponseInfo.ContentText :=   AnsiReplaceStr(ResponseInfo.ContentText,  '\"','"');

还是因为这个引起的，System.JSON.pas

function TJSONString.ToString: string;
begin
  if FStrBuffer = nil then
    Result := ''
  else
    Result := '"' + AnsiReplaceStr(FStrBuffer.ToString, '"', '\"') + '"';
end;

var
  jo: TJSONObject;
  Command: TDBXCommand;
  pa: TDBXParameter;
  JsonParam: TJSONValue;
begin

  pa := TDBXParameter.Create(nil);
  pa.DataType := TDBXDataTypes.AnsiStringType;
  pa.Value.AsString := '[{"name":"david"}]';

  JsonParam := TDBXJSONTools.DBXToJSON(pa.Value, pa.DataType, false);
  self.Caption := JsonParam.Value;

JsonParam.ToString;

4、字符编码

text/html与text/plain

在浏览器打开的时候汉字是乱码，查看网页属性，编码是windows-132，而asp。net生成的webapi网页是utf-8，查找IdCustomHTTPServer.pas

procedure TIdHTTPResponseInfo.WriteHeader;
var
  i: Integer;
  LBufferingStarted: Boolean;
begin
  if HeaderHasBeenWritten then begin
    raise EIdHTTPHeaderAlreadyWritten.Create(RSHTTPHeaderAlreadyWritten);
  end;
  FHeaderHasBeenWritten := True;

  if AuthRealm <> '' then
  begin
    ResponseNo := ;
    if (Length(ContentText) = ) and (not Assigned(ContentStream)) then
    begin
      ContentType := 'text/html; charset=utf-8';    {Do not Localize}
      ContentText := '<HTML><BODY><B>' + IntToStr(ResponseNo) + ' ' + ResponseText + '</B></BODY></HTML>';    {Do not Localize}
      ContentLength := -; // calculated below
    end;
  end;

  // RLebeau 5/15/2012: for backwards compatibility. We really should
  // make the user set this every time instead...
  if ContentType = '' then begin
    if (ContentText <> '') or (Assigned(ContentStream)) then begin
      ContentType := 'text/html; charset=ISO-8859-1'; {Do not Localize}//ContentType := 'text/plain; charset=utf-8';
    end;
  end;

字符编码是charset=ISO-8859-1，改成utf-8就好了！！！

给TDBXParameter赋值

procedure TForm4.Button1Click(Sender: TObject);
var
  LDBXParameter: TDBXParameter;
  LJSONParam: TJSONValue;
  pin: TDBXParameter;
begin
  LDBXParameter := TDBXParameter.Create();

  pin := TDBXParameter.Create();
  pin.DataType := TDBXDataTypes.AnsiStringType;
  pin.Value.AsString := '[{"PatientID":"aaaaaaaaa","PictuerName":"BBBBBBBBBBB"}]';
  LJSONParam := TDBXJSONTools.DBXToJSON(pin.Value, pin.DataType, false);

  //下面这句直接赋值给LJSONParam 不行,导致下面的JSONToDBX转换失败，所以改用上面的方法DBXToJSON
  // LJSONParam := TJSONObject.ParseJSONValue('[{"PatientID":"aaaaaaaaa","PictuerName":"BBBBBBBBBBB"}]');

  LDBXParameter.DataType := TDBXDataTypes.WideStringType;
  TDBXJSONTools.JSONToDBX(LJSONParam, LDBXParameter.Value, LDBXParameter.DataType, true, true (* Owns *) );
  Memo1.Lines.Text := LDBXParameter.Value.AsString

end;

Datasnap.DSService.pas

procedure TDSRESTService.ProcessParameters(const ADSMethodName: string; const Params: TStrings; Content: TArray<Byte>; const ACommand: TDBXCommand);

dataSnap服务器获取get、post方法参数

URL格式

http://localhost:8023/datasnap/rest/TServerMethods1/EchoString?p1=p1325325&p2=anme

uses Data.DBXPlatform;

function TServerMethods1.EchoString(Value: string): string;
begin
  p1 := GetInvocationMetadata.QueryParams.Values['p1'];
  p2 := GetInvocationMetadata.QueryParams.Values['p2'];
end;

这样只能获取到列表的参数，无法获取流参数。

获取POST方法

把方法名加update前缀

function TServerMethods1.updateEchoString(Value: string): string;
begin
  p1 := GetInvocationMetadata.QueryParams.Values['p1'];
  p2 := GetInvocationMetadata.QueryParams.Values['p2'];
Value就是post里的字符串
end;

RESTDebug发送汉字编码处理（未使用utf8编码）

RESTDebug，发送汉字，TEncoding.ANSI.GetString(Content)可以接收汉字。如下修改正常了。 Datasnap.DSService.pas文件。原版代码接收到的是乱码。

var

as1:AnsiString;
  utf8Bytes:TBytes;

as1 := TEncoding.ANSI.GetString(Content);
utf8Bytes:=TEncoding.UTF8.GetBytes(as1);

LBody := TJSONObject.ParseJSONValue(utf8Bytes, 0,True);

如果汉字经过ut8编码0x，比如在线工具里的utf8编码0x0x0x则，接收正常，无需任何改动。

用http://ouapi.com/在线post工具发送明文汉字

datasnap服务器接收乱码。

返回数据自己修改

2018.1.18

想返回什么格式都行啦！！！

function TServerMethods1.EchoString(Value: string): string;
begin
  Result := Value;
  GetInvocationMetadata.ResponseContent:='abc';
end;

like  this

http://blog.csdn.net/maxwoods/article/details/25163357

https://stackoverflow.com/questions/13879238/return-an-image-from-a-delphi-rest-server-and-show-it-in-a-browser/13879240#13879240

还可以设置返回的格式，这样的话不需要任何修改了，不需要修改原文件，各种跨平台前端都支持！

GetInvocationMetadata.ResponseContentType := 'image/png';

  GetInvocationMetadata.ResponseContentType :=  'image/jpeg';

  GetInvocationMetadata.ResponseContentType := 'application/json';

GetInvocationMetadata().ResponseContentType := 'application/json; charset=utf-8';

 GetInvocationMetaData.CloseSession := True;

thanks

http://www.itgo.me/a/x5918832448088122623/how-to-download-jpeg-image-for-browsers-in-delphi-c-builder-rest-webbroker

void TCommerMethods::DownloadImage()
{
TStringStream *Stream;
String S;
  Stream = new TStringStream;
  Stream->LoadFromFile("C:\\Temp\\MyImage.jpg");
  S = Stream->DataString;
  delete Stream;
  GetInvocationMetadata()->ResponseContentType = "image/jpeg";
  GetInvocationMetadata()->ResponseContent = S;
}

https://pastebin.com/tgiNep52

function CarregarImagem(const sCaminho: String): AnsiString;
var
  oFileStream : TFileStream;
begin
  oFileStream:= TFileStream.Create(sCaminho, fmOpenRead or fmShareDenyWrite);
try
 if oFileStream.Size >  then
 begin
   SetLength(Result, oFileStream.Size);
   oFileStream.Read(Pointer(Result)^, oFileStream.Size);
 end;
finally
  FreeAndNil(oFileStream);
end;

sImagem := CarregarImagem(sDirImagem);
if (bExtPNG) then
  GetInvocationMetadata().ResponseContentType := 'image/png'
else
begin
  GetInvocationMetadata().ResponseContentType := 'image/jpeg';
  GetInvocationMetadata().ResponseCode := ;
  GetInvocationMetadata().ResponseContent := sImagem;
  GetInvocationMetadata().CloseSession    := True;
end;

http://kelvermerlotti.com/por-que-o-datasnap-rest-retorna-um-json-sujo/#more-203

procedure TWebModule1.DSHTTPWebDispatcher1FormatResult(Sender: TObject;
  var ResultVal: TJSONValue; const Command: TDBXCommand; var Handled: Boolean);
var
  Aux: TJSONValue;
begin
  Aux := ResultVal;
  ResultVal := TJSONArray(Aux).Items[0];
  TJSONArray(Aux).Remove(0);
  Aux.Free;
  Handled := True;
end