DataSnapCompatibility=true

测试中，当oracle定义一个字段为Number，不指定精度时，FireDac的Query拿到的时Precision和Scale都是38的TFmtBCD，而Data.DB.TFMTBCDField.Precision的定义又明确说了Precision是不能超过32的。

Precision can be a value from 0 through 32. Some database servers support more than 32 digits, but these can't be handled by client datasets, and so TFMTBCDField limits the value of Precision to be no greater than 32.

所以当服务器返回dataset到客户端后，客户端解析dataset后，也会的到一个Precision为32(服务器的38到变了32了)和Scale是38的TFMTBCDField，这个字段的值TBcd由于Scale是38超过Precision的32了，转换为其他类型比如字符串，在客户端会报Bcd OverFlow的。
追了一下在哪里将38变成32的，这是在客户端变的，代码在Data.SqlExpr的TCustomSQLDataSet.AddFieldDesc里，TCustomSQLDataSet是DBX框架里用来解析返回的TDBXReader得到DataSet的一个类。

  if FieldDesc.iFldType in [TDBXDataTypes.CurrencyType, TDBXDataTypes.BcdType] then
  begin
    FieldDesc.iUnits2 := Abs(FieldDesc.iUnits2);
    if FieldDesc.iUnits1 < FieldDesc.iUnits2 then   // iUnits1 indicates Oracle 'usable decimals'
      FieldDesc.iUnits1 := FieldDesc.iUnits2;
    // ftBCD supports only up to 18-4.  If Prec > 14 or Scale > 4, make FMTBcd
    if (FieldDesc.iUnits1 > (MaxBcdPrecision-4)) or (FieldDesc.iUnits2 > MaxBcdScale) or FNumericMapping then
    begin
      LType := ftFMTBcd;
      FieldDesc.iFldType := TDBXDataTypes.BcdType;
      if FieldDesc.iUnits1 > MaxFMTBcdDigits then //38 > 32，被强制指定为32了。
        FieldDesc.iUnits1 := MaxFMTBcdDigits;
    end;
  end;

解决的法子是，在服务器端设置FDConnection或者FDQuery也或者FDManager的DataSnapCompatibility为true，服务器的Query拿到这个字段，会设置Precision="32" Scale="12"， 这样到了客户端，Precision为32，SignSpecialPlaces为12，就可以进行正常计算了。处理的代码在FireDAC.Phys里DoDefineDataTable函数里

              dtBCD,
              dtFmtBCD:
                begin
                  if oFmtOpts.DataSnapCompatibility and (rColInfo.FPrec > 32) then begin
                    if rColInfo.FPrec = rColInfo.FScale then
                      rColInfo.FScale := rColInfo.FPrec div 3; //38 div 3 = 12
                    rColInfo.FPrec := 32;
                  end;
                  oCol.Precision := rColInfo.FPrec;
                  oCol.Scale := rColInfo.FScale;
                end;

这里，可能会问，为啥服务器上TFMTBCDField.asString不会报Bcd OverFlow，因为再服务器上时Precision和Scale都是38，所以ok，看代码

function BcdToStr(const Bcd: TBcd; Format: TFormatSettings): string;
var
  Buf: array [0..66] of Char; //64 Nibbles + 1 sign + 1 decimal + #0
  PBuf: PChar;
  DecimalPos: Byte;
  I: Integer;
begin
  if Bcd.Precision = 0 then
    Exit('0');
  if (Bcd.Precision > MaxFMTBcdFractionSize) or  //MaxFMTBcdFractionSize为64，MaxFMTBcdDigits为32。这两个是嘛关系？
     ((Bcd.SignSpecialPlaces and $3F) > Bcd.Precision) then //这里关掉了SignSpecialPlaces的前两个bit后去和Precision比较，客户端因为38>32，所以异常了。
    OverflowError(SBcdOverflow);

...

有些乱，Data.DB.TFMTBCDField.Precision不能超过32，TBcd却可以到64。

用TFDMemTable代替TClientDataSet

测试了TFDMemTable，的确是比以前好吃非常快的TClientDataSet还要快，那么前面写的返回数据集的就可以修改一下了

function TSmSample.GetTblImage: TDataSet;
var
  Conn: TFDConnection;
  Query: TFDQuery;
begin
  //GetInvocationMetaData.CloseSession,n := True;
  Conn := dmConn.AcquireConnection;
  Query := TFDQuery.Create(nil);

  try
    Query.Connection := Conn;
    Query.SQL.Text := 'SELECT * FROM tbl_image';
    Query.Active := True;

    Result := TFDMemTable.Create(nil);
    TFDMemTable(Result).Data := Query.Data;
    //CopyQueryToClientDataSet(Query, Result);
  finally
    if Assigned(Query) then
      FreeAndNil(Query);
    dmConn.ReleaseConnection(Conn);
  end;
end;

这里直接指定Data就可以，不必先CopyDataSet(Query, [coStructure])拷贝结构后再设置Data

给DSHTTPService追加线程缓存池2

前面写的给DSHTTPService太凌乱，后来觉得不如直接hack TIdHTTPServer类更简单，在StartUp前设置上Schedule，测试后发现可以走通，代码就清爽了很多了。

unit uIdHTTPServer;

interface

uses
  IdSchedulerOfThreadPool, IdSchedulerOfThread, IdTCPConnection, IdHTTPServer, IdScheduler,
  System.Classes;

type
  TIdHTTPServer = class(IdHTTPServer.TIdHTTPServer)
  protected
    procedure StartupPooled;
  end;


implementation

uses
  uCodeRedirect;

var
  P: TCodeRedirect;

{ TIdHTTPServer }

procedure TIdHTTPServer.StartupPooled;
var
  LScheduler: TIdScheduler;
begin
  LScheduler := Scheduler;
  if not Assigned(LScheduler) then
  begin
    LScheduler := TIdSchedulerOfThreadPool.Create(Self);
    with TIdSchedulerOfThreadPool(LScheduler) do
    begin
      MaxThreads := 100;
      PoolSize := 30;
    end;
    Scheduler := LScheduler;
  end;

  P.Disable;
  Startup; //call old Startup
  P.Enable;
end;


initialization
  P := TCodeRedirect.Create(@TIdHTTPServer.Startup, @TIdHTTPServer.StartupPooled);

finalization
  P.Free;

end.

只要包含了这个unit就行了。

DataSnap是否该继续投资下去？

在众多框架里，选择学习DataSnap，是有原因的，虽然知道它问题肯定很多：慢，bug多，不能做大应用。
别的语言Grizzly, WCF，Note.js就不说了，在Pascal的世界里，有RemoteObject，有RealThinClient，还有mORMot，为啥当初选择投资DataSnap，最主要还是看中DataSnap的可以用到iOS上。
RemoteObject据说是两个人写的，以前说过，RemoteSDK不错，但是DA写的实在不怎样，再说作者也没打算发展Pascal的RO了。RealThinClient估计是一个人写的，没怎么用过。mORMot到目前为止应该还是没扩平台。考虑到投资的可持续性，选择一个公司比个人好，所以用了DataSnap。
如果但但做Windows的应用，基于http.sys的mORMot是最好的选择，开源，快而且简单。但是目前还没看见它的移动客户端。

DataSnap慢，到底慢在何处？Json的Parser是最大的杀手，其次应该是基于Indy的框架了。
对于小的应用，我感觉DataSnap还是可以的，挺好。

给DSHTTPService追加线程缓存池

DSServer的start开始，DSHTTPService.Start, TDSHTTPService的FHttpServer是TDSHTTPServerIndy,TDSHTTPServerIndy的FServer是TIdHTTPServerPeer,TIdHTTPServerPeer是TIdHTTPServer的一个Peer，从而DSServer的Start开始了，TIdHTTPServer的Start。

TIdHTTPServer的Start，开始了TIdCustomTCPServer的Start，也就是正常的socket通讯开始了。这里留意的是DS一直没指定TIdCustomTCPServer的Scheduler，那么默认的Scheduler就是用了TIdSchedulerOfThreadDefault，这个是没有缓存线程的。那也就是DSHTTPService是没有线程缓存的。

咋办呢

EMBT肯定考虑到了这个问题，查看代码知道 TDSHTTPService.Start里面，

procedure TDSHTTPService.Start;
begin
  inherited;
  RequiresServer;  //如果没有，会创建
  if Assigned(FHttpServer) then
  begin
    // Moved
    //TDSHTTPServerIndy(FHttpServer).Server.UseNagle := False;
    TDSHTTPServerIndy(FHttpServer).Active := True;
  end;
end;
procedure TCustomDSRESTServerTransport.RequiresServer;
begin
  if FRestServer = nil then
  begin
    FRESTServer := CreateRESTServer; //虚的
    InitializeRESTServer;  ///虚的
  end;
end;

默认情况下，TCustomDSRESTServerTransport.Loaded是会调用RequiresServer，并走到

function TDSHTTPService.CreateHttpServer: TDSHTTPServer;
var
  LHTTPServer: TDSHTTPServerIndy;
begin
  if Assigned(FCertFiles) then
    LHTTPServer := TDSHTTPSServerIndy.Create(Self.Server, IPImplementationID)
  else
    LHTTPServer := TDSHTTPServerIndy.Create(Self.Server, IPImplementationID);
  Result := LHTTPServer;
  LHTTPServer.HTTPOtherContext := HTTPOtherContext;
end;

也就是让TDSHTTPSServerIndy来做HttpServer，也就是RestServer了。DSServer的start开始后，TDSHTTPSServerIndy的Active=True时TDSHTTPSServerIndy在父亲TDSHTTPServerIndy里面的Active里面，通过Peer才真正创建TIdHTTPServe。
但是看源码

  TIdHTTPServerIP = class(TIdHTTPServer)
  private
    FSetDestroyedProc: TProc;
  public
    destructor Destroy; override;
  end;
constructor TIdHTTPServerPeer.Create(AOwner: TComponent);
begin
  FContexts := TDictionary.Create;
  FSocketHandles := nil;
  FServerIOHandler := nil;
  FScheduler := nil;
  FOnConnectEvent := nil;
  FOnCommandGet := nil;
  FOnCommandOther := nil;
  FOnDisconnectEvent := nil;
  FOnExecuteEvent := nil;
  FHTTPServer := TIdHTTPServerIP.Create(AOwner); //这里是写死的，也就是一定要用TIdHTTPServer来做了。
  FHTTPServer.FSetDestroyedProc := SetDestroyed;
end;

那么没法子，只能在Active之前，给设置Schedule了。因而只能重载TDSHTTPServerIndy.InitializeServer了。
可是 Datasnap.DSHTTP里面， TDSHTTPServerIndy类外面是看不见的。也就无从访问TDSHTTPServerIndy.Server.SetScheduler了。
另外，TCustomDSHTTPServerTransport.HttpServer的属性，是readonly的，也是没法指定了，想给TIdHTTPServer挂上TIdSchedulerOfThreadPool好像越来越没戏

考虑用Rtti.FindType来classloader一下Datasnap.DSHTTP.TDSHTTPServerIndy类，也是不行，因为不可见，findtype返回nil。

后来找到了方法，这么做的，但是很别扭的

procedure RttiGetProperty(AClass: TClass; AInstance: TObject; PropertyName: string; var Value: TValue);
var
  ref:  TRttiContext;
  typ: TRttiType;
  mthd: TRttiMethod;
  prop: TRttiProperty;
begin
  typ := ref.GetType(AClass);
  prop := typ.GetProperty(PropertyName);
  Value := prop.GetValue(AInstance);
end;

procedure RttiSetProperty(AClass: TClass; AInstance: TObject; PropertyName: string; var Value: TValue);
var
  ref:  TRttiContext;
  typ: TRttiType;
  mthd: TRttiMethod;
  prop: TRttiProperty;
begin
  typ := ref.GetType(AClass);
  prop := typ.GetProperty(PropertyName);
  prop.SetValue(AInstance, Value);
end;

procedure TdmServer.DataModuleCreate(Sender: TObject);
  procedure SetSchedulePooled;
  var
    ref:  TRttiContext;
    class1, class2: TClass;
    obj1: TObject;  //TDSHTTPServerIndy;
    if1: IIPHTTPServer;
    obj2: TObject;  //TIdHTTPServerIP;
    V: TValue;
    //Scheduler: IIPSchedulerOfThreadPool;
    Scheduler: TIdSchedulerOfThreadPool;
  begin
    ref := TRttiContext.Create;

    obj1 := DSHTTPService.HttpServer;
    class1 := obj1.ClassType;
    RttiGetProperty(class1, obj1, 'Server', V);
    if1 := V.AsInterface as IIPHTTPServer; //TDSHTTPServerIndy.Server, IIPHTTPServer

    obj2 := if1.GetObject;
    class2 := obj2.ClassType;

    {
    Scheduler := PeerFactory.CreatePeer(IPImpId, IIPSchedulerOfThreadPool, obj2 as TComponent) as IIPSchedulerOfThreadPool;
    Scheduler.MaxThreads := 100;
    Scheduler.PoolSize := 30;
    Scheduler._AddRef;  //keep it
    V := TValue.From(Scheduler.GetObject);
    RttiSetProperty(class2, obj2, 'Scheduler', V);
    }

    Scheduler := TIdSchedulerOfThreadPool.Create(TComponent(obj2));
    Scheduler.MaxThreads := 100;
    Scheduler.PoolSize := 30;
    V := TValue.From(Scheduler);
    RttiSetProperty(class2, obj2, 'Scheduler', V);
  end;
begin
  RegisterServerLogFilter(DSTCPServerTransport.Filters);
  RegisterServerLogFilter(DSHTTPService.Filters);
  RegisterServerMethodClasss(Self, DSServer);
  DSServer.Start; //let's create TDSHTTPServerIndy(DSHTTPService.HttpServer).Server

  DSServer.Stop;
  SetSchedulePooled;
  DSServer.Start;
end;

先start再stop，就为了创建 TDSHTTPServerIndy(DSHTTPService.HttpServer).Server，很别扭。这是因为虽然可以自己创建IIPHTTPServer然后设置给TDSHTTPServerIndy.FServer，但ref.GetType(class1).GetMethod('InitializeServer')去取得TDSHTTPServerIndy的方法InitializeServer取不到，protected的方法。
这些靠RTTI来做的事情，都不过是一些淫技罢了，只能说EMBT没封装好，想扩展不能正当扩展。

DataSnap的Session

DataSnap的内存管理，太依赖于客户端发来的command，这实在是很糟糕的设计，也是DataSnap被人诟病最多的地方了:DataSnap只是玩具，没法用来做实际应用。

假设网络状况不好，或者客户端死了，比如reader_close, command_close这些命令没法传递到服务器上，也或者这些命令传递到服务器上缺丢了字节，解析失败等。DataSnap的框架目前没考虑到这些，至少目前我还没找到代码在处理这些。这些垃圾就被永远留在了服务器的内存里了。SessionTimeOut？那个不起作用的了。

吹嘘了N年，仍然没啥进步，对于24*7的服务器，内存一直飙升，最后爆表，玩完。

datasnap里面用连接池

目前FireDac支持连接池，用来给Datasnap做池子，写代码测试了一下。
先写池子的函数

const
  COraclePooledName = 'Ora_Pooled';

function TdmConn.AcquireConnection: TFDConnection;
begin
  log.TrackMethod('TdmConn.AcquireConnection');
  Result := TFDConnection.Create(nil);
  Result.ConnectionDefName := COraclePooledName;
  try
    Result.Connected := True;
  except
    on E: Exception do
    begin
      FreeAndNil(Result);
      log.LogException(E);
      raise E;
    end;
  end;
end;

function TdmConn.ReleaseConnection(var Conn: TFDConnection): Boolean;
begin
  log.TrackMethod('TdmConn.ReleaseConnection');
  Result := True;
  Conn.Close;
  FreeAndNil(Conn);
end;

procedure TdmConn.DataModuleCreate(Sender: TObject);
const
  Section = 'Oracle';
var
  Params: TStringList;
begin
  Params := TStringList.Create;
  with TIniFile.Create(ChangeFileExt(ParamStr(0), '.ini')) do
  begin
    FDManager.Close;

    Params.Add(Format('Database=%s', [ReadString(Section, 'ConnStr', '')]));
    Params.Add('Pooled=True');
    Params.Add('DriverID=Ora');
    Params.Add('User_Name=xxx');
    Params.Add('Password=xxx');
    Params.Add('OSAuthent=No');
    Params.Add(Format('POOL_MaximumItems=%d', [ReadInteger(Section, 'PoolMaximumItems', 30)]));
    Params.Add(Format('POOL_CleanupTimeout=%d', [ReadInteger(Section, 'PoolCleanupTimeOut', 30000)]));
    Params.Add(Format('POOL_ExpireTimeout=%d', [ReadInteger(Section, 'PoolExpireTimeout', 90000)]));

    FDManager.AddConnectionDef(COraclePooledName, 'Ora', Params);

    Free;
  end;
  FreeAndNil(Params);
end;

procedure TdmConn.DataModuleDestroy(Sender: TObject);
begin
  FDManager.CloseConnectionDef(COraclePooledName); //close all pooled conn
  FDManager.Close;
end;

然后再使用池子

unit sSample;

interface

uses
  Data.DB, Datasnap.DBClient, Datasnap.Provider,
  FireDAC.Comp.Client, System.SysUtils,
  Data.DBXJSONReflect, System.JSON,
  uServerMethod;

type
  TSmSample = class(TServerMethod)
  public
    function ServerTime: TDateTime;
    function GetTblImage: TDataSet;
  end;

implementation

{ TSmSample }

uses
  dConn, uLog, System.StrUtils;

procedure CopyQueryToClientDataSet(SrcQuery: TDataSet; var DstQuery: TDataSet);
var
  DataSetProvider: TDataSetProvider;
begin
  try
    if DstQuery = nil then
      DstQuery := TClientDataSet.Create(nil); //will be freed by TDSServerConnectionHandler.DbxCommandClose or TDSMethodValues.AssignParameterValues 's ClearReferenceParameters
    DataSetProvider := TDataSetProvider.Create(nil);
    DataSetProvider.DataSet := SrcQuery;
    TClientDataSet(DstQuery).Data := DataSetProvider.Data;
  finally
    FreeAndNil(DataSetProvider);
  end;
end;

function TSmSample.GetTblImage: TDataSet;
var
  Conn: TFDConnection;
  Query: TFDQuery;
begin
  Conn := dmConn.AcquireConnection;
  Query := TFDQuery.Create(nil);

  try
    Query.Connection := Conn;
    Query.SQL.Text := 'SELECT * FROM tbl_image';
    Query.Active := True;
    CopyQueryToClientDataSet(Query, Result);
  finally
    if Assigned(Query) then
      FreeAndNil(Query);
    dmConn.ReleaseConnection(Conn);
  end;
end;

function TSmSample.ServerTime: TDateTime;
var
  Conn: TFDConnection;
  Query: TFDQuery;
begin
  //raise Exception.Create('hahaha');
  Conn := dmConn.AcquireConnection;
  Query := TFDQuery.Create(nil);
  try
    Query.Connection := Conn;
    Query.SQL.Text := 'SELECT sysdate FROM dual';
    Query.Active := True;
    Result := Query.FieldByName('sysdate').AsDateTime;
  finally
    FreeAndNil(Query);
    dmConn.ReleaseConnection(Conn);
  end;
end;

initialization
  RegisterServerMethodClass(TSmSample);

finalization

end.

是不是觉得挺爽，这里需要留意的是由于Conn要在服务方法内一定还给连接池，所以做的TFDQuery需要Copy给TClientDataSet这样的内存DataSet才走的通。