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才走的通。

在任意地方，得到socket的信息

用java写servlet时，随时我们都可以得到HttpServletRequest，HttpServletResponse以及session，那么在datasnap里面呢，比如我在服务里面知道当前是哪个ip在call我的服务
跟踪代码，发现session是可以得到，但是比如我打算枚举session的内容，缺没提供方法了。于是，我使用RTTI的盗窃法子，读取了私有变量

procedure RttiGetPrivateValue(AClass: TClass; AInstance: TObject; FieldName: string; var Value: TObject);
var
  ref:  TRttiContext;
  typ: TRttiType;
  mthd: TRttiMethod;
  fld: TRttiField;
begin
  typ := ref.GetType(AClass);
  fld := typ.GetField(FieldName); //can get private value
  Value := fld.GetValue(AInstance).AsObject;
end;

procedure EnumSessionData(const Session: TDSSession);
var
  SessionData: TDSSessionDictionaryData;
  MetaData: TDictionary;
  MetaObjects: TDictionary;
  Key: string;
begin
  RttiGetPrivateValue(TDSSession, Session, 'FSessionData', TObject(SessionData));
  RttiGetPrivateValue(TDSSessionDictionaryData, SessionData, 'FMetaData', TObject(MetaData));
  RttiGetPrivateValue(TDSSessionDictionaryData, SessionData, 'FMetaObjects', TObject(MetaObjects));
  for Key in MetaData.Keys do
    log.Debug('Sesion[%s] = %s', [Key, MetaData[Key]]);
  for Key in MetaObjects.Keys do
    log.Debug('SesionObjects[%s] = %s', [Key, MetaObjects[Key].ClassName]);
end;

function TdmServer.DSServerTrace(TraceInfo: TDBXTraceInfo): CBRType;
var
  Session: TDSSession;
begin
  log.TrackMethod('TdmServer.DSServerTrace');
  Session := TDSSessionManager.GetThreadSession;
  if Session.ObjectCreator <> nil then
    log.Debug(Session.ObjectCreator.ClassName);
  log.Debug(TraceInfo.Message);
  EnumSessionData(Session); //在这里试着枚举读取一下
  Result := cbrUSEDEF;
end;

可以看到,Session里面对于Tcp，默认的只有两个变量，
Sesion[remoteip] = 192.168.101.11
Sesion[communicationprotocol] = tcp/ip
这里的remoteip就是调用者ip了，但是如果想到得到sessioin对应的tunnel的具体socket信息，缺是不能了。 这两个值是在 TDSTCPServerTransport.DoOnConnect里放入的，代码如下

procedure TDSTCPServerTransport.DoOnConnect(AContext: IIPContext);
var
  IndyChannel: TDBXChannel;
  FilterChannel: TDBXFilterSocketChannel;
  Event: TDSTCPConnectEventObject;
begin
  FilterChannel := TDBXFilterSocketChannel.Create(Filters);

  IndyChannel := CreateTcpChannel(AContext);

{$IFNDEF POSIX}
  if CoInitFlags = -1 then
    CoInitializeEx(nil, COINIT_MULTITHREADED)
  else
    CoInitializeEx(nil, CoInitFlags);
{$ENDIF}
  IndyChannel.Open;

  // set the delegate
  FilterChannel.Channel := IndyChannel;

  AContext.Data := FProtocolHandlerFactory.CreateProtocolHandler(FilterChannel);
  if AContext.Data is TDBXJSonServerProtocolHandler then
  begin
    if TDBXJSonServerProtocolHandler(AContext.Data).DSSession = nil then
    begin
      TDBXJSonServerProtocolHandler(AContext.Data).DSSession :=
        TDSSessionManager.Instance.CreateSession(
          function: TDSSession
          begin
            Result := TDSTCPSession.Create(AuthenticationManager);
            Result.PutData('CommunicationProtocol', 'tcp/ip'); //这里放了进去
            Result.PutData('RemoteIP', AContext.Connection.Socket.Binding.PeerIP); //这里放了进去信息
          end,
          ''
        );
    end;
  end;

  if Assigned(FTDSTCPConnectEvent) and (AContext <> nil) and (AContext.Connection <> nil) and
    (FTcpServer <> nil) and FTcpServer.Active then
  begin
    if IndyChannel Is TDSTCPChannel then
    begin
      //enable keep alive, disable it, or leave the OS default setting as it is
      if FKeepAliveEnablement = kaEnabled then
        TDSTCPChannel(IndyChannel).EnableKeepAlive(FKeepAliveTime, FKeepAliveInterval)
      else if FKeepAliveEnablement = kaDisabled then
        TDSTCPChannel(IndyChannel).DisableKeepAlive;

      Event := TDSTCPConnectEventObject.Create(AContext.Connection.GetObject, TDSTCPChannel(IndyChannel));
    end
    else
      Event := TDSTCPConnectEventObject.Create(AContext.Connection.GetObject, nil);

    try
      OnConnect(Event);
    except
    end;
  end;
end;

留意一下key的大小写进去的是RmoteIp，出来却变成了remoteip了，所以默认的Session是不关系大小写的，这是因为TDictionary创建是并没指定TStringComparer.Ordinal。目前DataSnap还不支持自定义TDSSessionData的派生，因为TDSSession.CreateSessionData不是虚的。

我写的一个注册服务方法的Unit

先定义一个基础服务方法类

unit uServerMethod;

interface

uses
  System.SysUtils, System.Classes,
  Datasnap.DSProviderDataModuleAdapter,
  Datasnap.DSServer, Datasnap.DSCommonServer, Datasnap.DSReflect;

type
  {$METHODINFO ON}
  TServerMethod = class(TPersistent)
  public
    constructor Create; virtual;
    destructor Destroy; override;
  end;
  {$METHODINFO OFF}

  TServerMethodClass = class of TServerMethod;

procedure RegisterServerMethodClass(AClass: TServerMethodClass);
procedure RegisterServerMethodClasss(AOwner: TComponent; AServer: TDSServer);

implementation

uses
  uLog;

type
  TDSServerClass = class(Datasnap.DSServer.TDSServerClass)
    private
      FServerMethodClass: TServerMethodClass;
    protected
      function GetDSClass: TDSClass; override;
      procedure CreateInstance(const CreateInstanceEventObject: TDSCreateInstanceEventObject); override;
      procedure DestroyInstance(const DestroyInstanceEventObject: TDSDestroyInstanceEventObject); override;
    public
      constructor Create(AOwner: TComponent; AServer: TDSCustomServer; AClass: TServerMethodClass); reintroduce; overload;
      destructor Destroy; override;
    end;

var
  ServerMethodList: TList;
procedure RegisterServerMethodClass(AClass: TServerMethodClass);
begin
  ServerMethodList.Add(AClass);
end;

procedure RegisterServerMethodClasss(AOwner: TComponent; AServer: TDSServer);
var
  I: Integer;
begin
  for I := 0 to ServerMethodList.Count - 1 do
  begin
    TDSServerClass.Create(AOwner, AServer, ServerMethodList[I]);
  end;
end;

{ TDSServerClass }

constructor TDSServerClass.Create(AOwner: TComponent; AServer: TDSCustomServer;
  AClass: TServerMethodClass);
begin
  inherited Create(AOwner);
  FServerMethodClass := AClass;
  Self.Server := AServer;
end;

procedure TDSServerClass.CreateInstance(
  const CreateInstanceEventObject: TDSCreateInstanceEventObject);
var
  AObject: TServerMethod;
begin
  inherited;
  if CreateInstanceEventObject.ServerClassInstance = nil then
  begin
    CreateInstanceEventObject.ServerClassInstance := FServerMethodClass.Create; //不要让TDSClass.CreateInstance去创建
  end;
end;

destructor TDSServerClass.Destroy;
begin
  inherited;
end;

procedure TDSServerClass.DestroyInstance(
  const DestroyInstanceEventObject: TDSDestroyInstanceEventObject);
begin
  inherited;

end;

function TDSServerClass.GetDSClass: TDSClass;
begin
  Result := TDSClass.Create(FServerMethodClass, False);
end;

{ TServerMethod }

constructor TServerMethod.Create;
begin
  log.Debug('%s.Create', [ClassName]);
end;

destructor TServerMethod.Destroy;
begin
  log.Debug('%s.Destroy', [ClassName]);
  inherited;
end;

initialization
  ServerMethodList := TList.Create;
finalization
  FreeAndNil(ServerMethodList);

end.

然后就可以开始继承实现做应用了，写个例子

unit sSample;

interface

uses
  uServerMethod;

type
  TSmSample = class(TServerMethod)
  public
    function EchoString(Value: string): string;
    function ReverseString(Value: string): string;
  end;

implementation

{ TSmSample }

uses
  System.StrUtils;

function TSmSample.EchoString(Value: string): string;
begin
  Result := Value;
end;

function TSmSample.ReverseString(Value: string): string;
begin
  Result := System.StrUtils.ReverseString(Value);
end;

initialization
  RegisterServerMethodClass(TSmSample);

finalization

end.

以后关注服务方法实现就可以了。

TObject.Create is not a virtual method

DataSnap在创建服务方法类的时候，如果从TPersistent继承写服务方法，不写DSServerClass的DSServerClass1CreateInstance事件，是会有问题

比如我定义一个服务方法
 

  {$METHODINFO ON}
  TServerMethod = class(TPersistent)
  public
    constructor Create; virtual;
    destructor Destroy; override;
  end;
  {$METHODINFO OFF}

由于TObject.Create不是虚方法，在使用

var
  ClassRef: TTPersistentClass;
  M: TServerMethod;
begin
  ClassRef := TServerMethod；
  M := ClassRef.Create; //这里有问题，这个的Create，不会call到TServerMethod.Create，只会call TObject.Create，也就是啥也没干
end;

请看代码

function TDSServerConnectionHandler.CreateInstance(const ServerClass: TDSCustomServerClass; const DsClass: TDSClass): TObject;
var
  Instance: TObject;
begin
  if ServerClass <> nil then
  begin
    FCreateInstanceEventObject.ServerClassInstance := nil;
    ServerClass.CreateInstance(FCreateInstanceEventObject); //如果没有实现DSServerClass1CreateInstanc事件，这里的FCreateInstanceEventObject.ServerClassInstance会是nil
    Instance := FCreateInstanceEventObject.ServerClassInstance;
    if Instance <> nil then
      Exit(Instance);
  end;
  Result := DsClass.CreateInstance;//所以会走到这里
end;

function TDSClass.CreateInstance: TObject;
var
  AdapteeInstance: TObject;
  Component: TComponent;
begin
  if Assigned(FClassRef) then
  begin
    if Assigned(FAdapteeClass) then
    begin
      AdapteeInstance := FAdapteeClass.CreateInstance;
      Result := TDSAdapterClassType(FClassRef).Create(AdapteeInstance);
    end
    else
    begin
      if FClassRef.InheritsFrom(TComponent) then
      begin
        // Allows Forms and DataModules to read in the components
        // they contain.
        //
        Component := FClassRef.NewInstance as TComponent;
        Component.Create(nil);
        Result := Component;
      end
      else
        Result := FClassRef.Create//然后再走到这里，FClassRef是一个TTPersistentClass，它的Create，不会触发TServerMethod.Create
    end;
  end
  else
    Result := nil;
end;

郁闷吧，TObjec.Create不是虚方法多少年前都已经讨论过，自然有它的道理。 要解决这个问题，用上面对待TComponent方法来做可以，这样的方法其实在TApplication.CreateForm里面也用到了。

        //Result := FClassRef.Create//然后再走到这里，FClassRef是一个TTPersistentClass，它的Create，不会触发TServerMethod.Create
        //修改为，先定义一个TServerMethod的变量，再NewInstance再Create，再赋值。        

FireDac的的初步2

FireDac和UniDac一样了，也支持所谓的连接池，但是限制比较多。

要支持连接池，必须让FDManager连管理，也就是，必须：1，FDConnectionDefs.ini在定义一个连接，2，必须FDConnection的Params必须是空的。第二个条件比较容易理解，因为要是不同的FDConnection指定了不同的连接参数，那么连接池里面的连接属性肯定需要不一样才行。第一个条件就比较恶心了，莫非都得需要这个配置文件才可？？岂不是App都要带一个这个FDConnectionDefs.ini？？

仔细看了这里

发现可以定义FireDAC supports 3 connection definition kinds:的Private类型也可以只是Pool。

代码如下了

procedure TForm1.FormCreate(Sender: TObject);
var
  oParams: TStrings;
begin
  with FDManager do
  begin
    oParams := TStringList.Create;
    oParams.Add('Database=xxx.xxx.xxx.xxx:1521/orac');
    oParams.Add('Pooled=True');
    oParams.Add('DriverID=Ora');
    oParams.Add('User_Name=username');
    oParams.Add('Password=password');
    oParams.Add('OSAuthent=No');
    oParams.Add('POOL_MaximumItems=1'); //搞一个测试看看
    FDManager.AddConnectionDef('Ora_Pooled', 'Ora', oParams);
    FreeAndNil(oParams);
  end;
end;

这样就可以定义一个 Private的连接了

另外，看了文档，也明白了，连接定义FDConnectionDefs.ini的名字可以自己起，然后设置上 
FDManager的ConnectionDefFileName就可以，这样还灵活一点点。 

这个【Private】的意思，没看明白，因为就算【Persistent】也肯定是不能跨Exe来Pool的。

连接池的使用，直接定义一个conn，然后设置

procedure TForm1.Button1Click(Sender: TObject);
var
  conn: TFDCustomConnection;
begin
  conn := TFDCustomConnection.Create(nil);
  conn.ConnectionDefName := 'Ora_Pooled';
  FDQuery1.Connection := conn;
  FDQuery1.Active := True;

  conn := TFDCustomConnection.Create(nil);
  conn.ConnectionDefName := 'Ora_Pooled';
  FDQuery2.Connection := conn;
  FDQuery2.Active := True;
end;

启动了pool后，conn的close也不是真的close，只是还给pool。 当超过

POOL_MaximumItems定义的值时，conn的发起连接时就会报异常了。

监视oracle会发现有两个连接连接上了。

另外连接池和

  FDManager.AcquireConnection
  FDManager.ReleaseConnection

一分钱关系都没有

FireDAC的初步1

把AnyDac买进来后，Embarcadero重新起了个名字叫FireDAC，以前用RO时挂过AnyDAC，当时觉得deploy程序的时候，配置太繁琐了，也一直没用，因为有UniDAC的存在，AnyDac的确是既生瑜何生亮。选择UniDac的另一个原因是，UniDac对Oracle的Direct连接，不需要套Oracle客户端dll，deploy时真的时方便又快捷。

UniDac是要钱的，打算再次摸一摸FireDac，做个笔记，记录一下。另外老被吹嘘的dbExpress也算是寿终正寝了。目前FireDac的Driver是不支持DataSnap的，估计dbExpress还会保留一段时间。

基本上，我都是用Oracle，所以比较关心without oracle client的数据库连接是否能做到。

测试了几下，FireDac连接Oracle，在没有Oracle Client的情况下，是可以连接上的。方式是

前提：需要文件

    oci.dll
    oraocci11.dll
    oraociei11.dll
    orasql11.dll

这几个文件，可以放在exe同一个目录下，或者path里面能找到得到的地方。有了这4个文件，就可以连接oracle了

具体参考了这个

我不喜欢tnsname.ora的配置，因为需要外挂一个配置文件。还是Oracle easy connect string方式来的最简单直接，形式如

OraSrv:1521/orcl ，这个就和UniDac的Direct连接时指定(OraSrv:1521:orc)差不多了。