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那么没法子,只能在Active之前,给设置Schedule了。因而只能重载TDSHTTPServerIndy.InitializeServer了。.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;
可是 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没封装好,想扩展不能正当扩展。
没有评论:
发表评论