2014年5月25日星期日

给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没封装好,想扩展不能正当扩展。

没有评论:

发表评论