diff --git a/wst/trunk/base_service_intf.pas b/wst/trunk/base_service_intf.pas index 367b272e3..b40aff717 100644 --- a/wst/trunk/base_service_intf.pas +++ b/wst/trunk/base_service_intf.pas @@ -15,7 +15,7 @@ unit base_service_intf; interface uses - Classes, SysUtils, TypInfo, Contnrs; + Classes, SysUtils, TypInfo, Contnrs, syncobjs, semaphore; {$INCLUDE wst.inc} {$INCLUDE wst_delphi.inc} @@ -90,6 +90,7 @@ type IItemFactoryEx = interface(IItemFactory) ['{66B77926-7E45-4780-8FFB-FB78625EDC1D}'] + procedure ReleaseInstance(var AInstance : IInterface); function GetPropertyManager( const APropertyGroup : string; const ACreateIfNotExists : Boolean @@ -987,26 +988,84 @@ type private FItemClass : TSimpleFactoryItemClass; protected - function CreateInstance():IInterface; + function CreateInstance():IInterface;virtual; + function GetItemClass() : TSimpleFactoryItemClass; public constructor Create(AItemClass : TSimpleFactoryItemClass); End; + { TIntfPoolItem } + + TIntfPoolItem = class + private + FIntf: IInterface; + FUsed: Boolean; + public + constructor Create(AIntf : IInterface; const AUsed : Boolean); + destructor Destroy();override; + property Intf : IInterface read FIntf; + property Used : Boolean read FUsed write FUsed; + end; + + TIntfPool = class + private + FList : TObjectList; + FCS : TCriticalSection; + FLock : TSemaphoreObject; + FFactory : IItemFactory; + FMin : PtrInt; + FMax : PtrInt; + private + function CreateNew() : TIntfPoolItem; + function TryGet(const AIndex : PtrInt) : Boolean; + public + constructor Create( + const AMin, AMax : PtrInt; + AFactory : IItemFactory + ); + destructor Destroy();override; + function Get(const ATimeOut : Cardinal) : IInterface; + procedure Release(var AItem : IInterface); + property Min : PtrInt read FMin; + property Max : PtrInt read FMax; + end; + { TSimpleItemFactoryEx } TSimpleItemFactoryEx = class(TSimpleItemFactory,IInterface,IItemFactory,IItemFactoryEx) private + FPooled: Boolean; + FPoolMax: PtrInt; + FPoolMin: PtrInt; FPropertyNames : TStringList; FProperties : IInterfaceList; + FPool : TIntfPool; + FTimeOut: PtrUInt; + private + procedure PreparePool(); + procedure SetPooled(const AValue: Boolean); + procedure SetPoolMax(const AValue: PtrInt); + procedure SetPoolMin(const AValue: PtrInt); protected + function CreateInstance():IInterface;override; + procedure ReleaseInstance(var AInstance : IInterface);virtual; function GetPropertyManager( const APropertyGroup : string; const ACreateIfNotExists : Boolean ):IPropertyManager; public - constructor Create(AItemClass : TSimpleFactoryItemClass); + constructor Create( + AItemClass : TSimpleFactoryItemClass; + const APropsString : string + );overload; + constructor Create(AItemClass : TSimpleFactoryItemClass);overload; destructor Destroy();override; - End; + published + property PoolMax : PtrInt read FPoolMax write SetPoolMax; + property PoolMin : PtrInt read FPoolMin write SetPoolMin; + property Pooled : Boolean read FPooled write SetPooled; + property TimeOut : PtrUInt read FTimeOut write FTimeOut; + end; TTypeRegistryItemOption = ( trioNonVisibleToMetadataService ); TTypeRegistryItemOptions = set of TTypeRegistryItemOption; @@ -1107,6 +1166,7 @@ const function IsStoredPropClass(AClass : TClass;PropInfo : PPropInfo) : TPropStoreType; implementation +uses imp_utils; Var TypeRegistryInstance : TTypeRegistry = Nil; @@ -1999,6 +2059,11 @@ begin Result := FItemClass.Create() as IInterface; end; +function TSimpleItemFactory.GetItemClass(): TSimpleFactoryItemClass; +begin + Result := FItemClass; +end; + constructor TSimpleItemFactory.Create(AItemClass: TSimpleFactoryItemClass); begin Assert(Assigned(AItemClass)); @@ -2007,6 +2072,62 @@ end; { TSimpleItemFactoryEx } +procedure TSimpleItemFactoryEx.PreparePool(); +begin + if ( FPool = nil ) then begin + FPool := TIntfPool.Create(PoolMin,PoolMax,TSimpleItemFactory.Create(FItemClass)); + end; +end; + +procedure TSimpleItemFactoryEx.SetPooled(const AValue: Boolean); +begin + if ( FPooled = AValue ) then + Exit; + FreeAndNil(FPool); + if AValue then begin + if ( PoolMin < 0 ) or ( PoolMin > PoolMax ) or ( PoolMax < 1 ) then + raise EServiceException.Create('Invalid pool parametters.'); + PreparePool(); + end; + FPooled := AValue; +end; + +procedure TSimpleItemFactoryEx.SetPoolMax(const AValue: PtrInt); +begin + if ( FPoolMax = AValue ) then + Exit; + if Pooled then + raise EServiceException.Create('Operation not allowed on an active pool.'); + FPoolMax := AValue; +end; + +procedure TSimpleItemFactoryEx.SetPoolMin(const AValue: PtrInt); +begin + if ( FPoolMin = AValue ) then + Exit; + if Pooled then + raise EServiceException.Create('Operation not allowed on an active pool.'); + FPoolMin := AValue; +end; + +function TSimpleItemFactoryEx.CreateInstance(): IInterface; +begin + if Pooled then begin + Result := FPool.Get(TimeOut); + end else begin + Result := inherited CreateInstance(); + end; +end; + +procedure TSimpleItemFactoryEx.ReleaseInstance(var AInstance: IInterface); +begin + if Pooled then begin + FPool.Release(AInstance); + end else begin + AInstance := nil; + end; +end; + function TSimpleItemFactoryEx.GetPropertyManager( const APropertyGroup : string; const ACreateIfNotExists : Boolean @@ -2022,22 +2143,37 @@ begin if not ACreateIfNotExists then Exit; i := FPropertyNames.Add(s); - FProperties.Add(TStoredPropertyManager.Create() as IInterface); + if ( s = '' ) then + FProperties.Add(TPublishedPropertyManager.Create(Self) as IInterface) + else + FProperties.Add(TStoredPropertyManager.Create() as IInterface); end; Result := FProperties.Get(i) as IPropertyManager; end; -constructor TSimpleItemFactoryEx.Create(AItemClass: TSimpleFactoryItemClass); +constructor TSimpleItemFactoryEx.Create( + AItemClass : TSimpleFactoryItemClass; + const APropsString : string +); begin inherited Create(AItemClass); FPropertyNames := TStringList.Create(); FProperties := TInterfaceList.Create(); + if ( Length(APropsString) > 0 ) then begin + GetPropertyManager('',True).SetProperties(APropsString); + end; +end; + +constructor TSimpleItemFactoryEx.Create(AItemClass: TSimpleFactoryItemClass); +begin + Create(AItemClass,''); end; destructor TSimpleItemFactoryEx.Destroy(); begin FreeAndNil(FPropertyNames); FProperties := nil; + FreeAndNil(FPool); inherited Destroy(); end; @@ -4138,6 +4274,110 @@ begin (AObject as TComplexBooleanContentRemotable).Value := i; end; +{ TIntfPoolItem } + +constructor TIntfPoolItem.Create(AIntf: IInterface; const AUsed: Boolean); +begin + FIntf := AIntf; + FUsed := AUsed; +end; + +destructor TIntfPoolItem.Destroy(); +begin + FIntf := nil; + inherited Destroy(); +end; + +{ TIntfPool } + +function TIntfPool.CreateNew(): TIntfPoolItem; +begin + FCS.Acquire(); + try + Result := TIntfPoolItem.Create(FFactory.CreateInstance(),True); + FList.Add(Result); + finally + FCS.Release(); + end; +end; + +function TIntfPool.TryGet(const AIndex: PtrInt): Boolean; +var + itm : TIntfPoolItem; +begin + FCS.Acquire(); + try + itm := TIntfPoolItem(FList[AIndex]); + Result := not itm.Used; + if Result then begin + itm.Used := True; + end; + finally + FCS.Release(); + end; +end; + +constructor TIntfPool.Create( + const AMin, AMax : PtrInt; + AFactory : IItemFactory +); +var + i : PtrInt; +begin + Assert( ( AMin >= 0 ) and ( AMax >= AMin ) and ( AFactory <> nil ) ); + FMax := AMax; + FMin := AMin; + FFactory := AFactory; + FLock := TSemaphoreObject.Create(FMax); + FList := TObjectList.Create(True); + FCS := TCriticalSection.Create(); + for i := 0 to Pred(AMin) do begin + CreateNew(); + end; +end; + +destructor TIntfPool.Destroy(); +begin + FFactory := nil; + FreeAndNil(FCS); + FreeAndNil(FLock); + FreeAndNil(FList); + inherited Destroy(); +end; + +function TIntfPool.Get(const ATimeOut : Cardinal): IInterface; +var + i : PtrInt; +begin + Result := nil; + if ( FLock.WaitFor(ATimeOut) = wrSignaled ) then begin + for i := 0 to Pred(FList.Count) do begin + if TryGet(i) then begin + Result := TIntfPoolItem(FList[i]).Intf; + Break; + end; + end; + if ( Result = nil ) then begin + Result := CreateNew().Intf; + end; + end else begin + raise EServiceException.Create('Unable to create the object : Timeout expired.'); + end; +end; + +procedure TIntfPool.Release(var AItem: IInterface); +var + i : PtrInt; +begin + for i := 0 to Pred(FList.Count) do begin + if ( TIntfPoolItem(FList[i]).Intf = AItem ) then begin + TIntfPoolItem(FList[i]).Used := False; + AItem := nil; + Break; + end; + end; +end; + initialization TypeRegistryInstance := TTypeRegistry.Create(); SerializeOptionsRegistryInstance := TSerializeOptionsRegistry.Create(); diff --git a/wst/trunk/imp_utils.pas b/wst/trunk/imp_utils.pas index 35f0a8319..610817a2e 100644 --- a/wst/trunk/imp_utils.pas +++ b/wst/trunk/imp_utils.pas @@ -96,6 +96,10 @@ begin If TryStrToInt64(AValue,int64Val) Then SetOrdProp(FParent,AName,int64Val); End; + {$IFDEF FPC} + tkBool : + SetOrdProp(FParent,AName,Ord(StrToBool(AValue))); + {$ENDIF} End; End; end; diff --git a/wst/trunk/metadata_service_binder.pas b/wst/trunk/metadata_service_binder.pas index db0a34e67..a6b27bb49 100644 --- a/wst/trunk/metadata_service_binder.pas +++ b/wst/trunk/metadata_service_binder.pas @@ -15,16 +15,23 @@ type TWSTMetadataService_ServiceBinder=class(TBaseServiceBinder) Protected - procedure GetRepositoryListHandler(AFormatter:IFormatterResponse); - procedure GetRepositoryInfoHandler(AFormatter:IFormatterResponse); + procedure GetRepositoryListHandler(AFormatter:IFormatterResponse; AContext : ICallContext); + procedure GetRepositoryInfoHandler(AFormatter:IFormatterResponse; AContext : ICallContext); Public constructor Create(); End; + { TWSTMetadataService_ServiceBinderFactory } + TWSTMetadataService_ServiceBinderFactory = class(TInterfacedObject,IItemFactory) + private + FInstance : IInterface; protected function CreateInstance():IInterface; - End; + public + constructor Create(); + destructor Destroy();override; + end; procedure Server_service_RegisterWSTMetadataServiceService(); @@ -32,7 +39,7 @@ Implementation uses TypInfo, wst_resources_imp,metadata_repository; { TWSTMetadataService_ServiceBinder implementation } -procedure TWSTMetadataService_ServiceBinder.GetRepositoryListHandler(AFormatter:IFormatterResponse); +procedure TWSTMetadataService_ServiceBinder.GetRepositoryListHandler(AFormatter:IFormatterResponse; AContext : ICallContext); Var cllCntrl : ICallControl; tmpObj : IWSTMetadataService; @@ -41,14 +48,14 @@ Var procName,trgName : string; returnVal : TArrayOfStringRemotable; Begin - callCtx := GetCallContext(); + callCtx := AContext; If ( PTypeInfo(TypeInfo(TArrayOfStringRemotable))^.Kind in [tkClass,tkInterface] ) Then Pointer(returnVal) := Nil; tmpObj := Self.GetFactory().CreateInstance() as IWSTMetadataService; if Supports(tmpObj,ICallControl,cllCntrl) then - cllCntrl.SetCallContext(GetCallContext()); + cllCntrl.SetCallContext(callCtx); returnVal := tmpObj.GetRepositoryList(); If ( PTypeInfo(TypeInfo(TArrayOfStringRemotable))^.Kind = tkClass ) And Assigned(Pointer(returnVal)) Then @@ -64,7 +71,7 @@ Begin callCtx := Nil; End; -procedure TWSTMetadataService_ServiceBinder.GetRepositoryInfoHandler(AFormatter:IFormatterResponse); +procedure TWSTMetadataService_ServiceBinder.GetRepositoryInfoHandler(AFormatter:IFormatterResponse; AContext : ICallContext); Var cllCntrl : ICallControl; tmpObj : IWSTMetadataService; @@ -74,14 +81,14 @@ Var AName : string; returnVal : TWSTMtdRepository; Begin - callCtx := GetCallContext(); + callCtx := AContext; Pointer(returnVal) := Nil; strPrmName := 'AName'; AFormatter.Get(TypeInfo(string),strPrmName,AName); tmpObj := Self.GetFactory().CreateInstance() as IWSTMetadataService; if Supports(tmpObj,ICallControl,cllCntrl) then - cllCntrl.SetCallContext(GetCallContext()); + cllCntrl.SetCallContext(callCtx); returnVal := tmpObj.GetRepositoryInfo(AName); If Assigned(Pointer(returnVal)) Then @@ -109,9 +116,20 @@ End; { TWSTMetadataService_ServiceBinderFactory } function TWSTMetadataService_ServiceBinderFactory.CreateInstance():IInterface; Begin - Result := TWSTMetadataService_ServiceBinder.Create() as IInterface; + Result := FInstance; End; +constructor TWSTMetadataService_ServiceBinderFactory.Create(); +begin + FInstance := TWSTMetadataService_ServiceBinder.Create(); +end; + +destructor TWSTMetadataService_ServiceBinderFactory.Destroy(); +begin + FInstance := nil; + inherited Destroy(); +end; + procedure Server_service_RegisterWSTMetadataServiceService(); Begin diff --git a/wst/trunk/metadata_wsdl.pas b/wst/trunk/metadata_wsdl.pas index 3fc8d011d..45365570f 100644 --- a/wst/trunk/metadata_wsdl.pas +++ b/wst/trunk/metadata_wsdl.pas @@ -577,7 +577,7 @@ procedure TBaseComplexRemotable_TypeHandler.Generate( var typItm, propTypItm : TTypeRegistryItem; s, prop_ns_shortName : string; - defTypesNode, defSchemaNode, cplxNode, sqcNode, propNode, eltNode : TDOMElement; + defTypesNode, defSchemaNode, cplxNode, sqcNode, propNode : TDOMElement; i : Integer; propList : PPropList; propCount, propListLen : Integer; @@ -596,13 +596,10 @@ begin Assert(Assigned(defTypesNode)); defSchemaNode := defTypesNode.FirstChild as TDOMElement; - s := Format('%s:%s',[sXSD,sELEMENT]); - eltNode := CreateElement(s,defSchemaNode,AWsdlDocument); - eltNode.SetAttribute(sNAME, typItm.DeclaredName) ; - s := Format('%s:%s',[sXSD,sCOMPLEX_TYPE]); - cplxNode := CreateElement(s,eltNode,AWsdlDocument); - //cplxNode.SetAttribute(sNAME, typItm.DeclaredName) ; + cplxNode := CreateElement(s,defSchemaNode,AWsdlDocument); + cplxNode.SetAttribute(sNAME, typItm.DeclaredName) ; + s := Format('%s:%s',[sXSD,sSEQUENCE]); sqcNode := CreateElement(s,cplxNode,AWsdlDocument); objTypeData := GetTypeData(typItm.DataType); @@ -623,7 +620,7 @@ begin s := Format('%s:%s',[sXSD,sELEMENT]); propNode := CreateElement(s,sqcNode,AWsdlDocument); end; - propNode.SetAttribute(sNAME,p^.Name); + propNode.SetAttribute(sNAME,typItm.GetExternalPropertyName(p^.Name)); propTypItm := GetTypeRegistry().Find(p^.PropType^.Name); if Assigned(propTypItm) then begin prop_ns_shortName := GetNameSpaceShortName(propTypItm.NameSpace,AWsdlDocument); @@ -775,7 +772,7 @@ procedure TBaseArrayRemotable_TypeHandler.Generate( var typItm, propTypItm : TTypeRegistryItem; s, prop_ns_shortName : string; - defTypesNode, defSchemaNode, cplxNode, sqcNode, propNode, eltNode : TDOMElement; + defTypesNode, defSchemaNode, cplxNode, sqcNode, propNode : TDOMElement; arrayTypeData : PTypeData; arrayTypeClass : TBaseArrayRemotableClass; begin @@ -792,13 +789,10 @@ begin Assert(Assigned(defTypesNode)); defSchemaNode := defTypesNode.FirstChild as TDOMElement; - s := Format('%s:%s',[sXSD,sELEMENT]); - eltNode := CreateElement(s,defSchemaNode,AWsdlDocument); - eltNode.SetAttribute(sNAME, typItm.DeclaredName) ; - s := Format('%s:%s',[sXSD,sCOMPLEX_TYPE]); - cplxNode := CreateElement(s,eltNode,AWsdlDocument); - //cplxNode.SetAttribute(sNAME, typItm.DeclaredName) ; + cplxNode := CreateElement(s,defSchemaNode,AWsdlDocument); + cplxNode.SetAttribute(sNAME, typItm.DeclaredName) ; + s := Format('%s:%s',[sXSD,sSEQUENCE]); sqcNode := CreateElement(s,cplxNode,AWsdlDocument); arrayTypeClass := TBaseArrayRemotableClass(arrayTypeData^.ClassType); diff --git a/wst/trunk/semaphore.pas b/wst/trunk/semaphore.pas new file mode 100644 index 000000000..b60a2d535 --- /dev/null +++ b/wst/trunk/semaphore.pas @@ -0,0 +1,99 @@ +unit semaphore; + +{$mode objfpc}{$H+} +interface + +uses + Classes, SysUtils, syncobjs; + +type + + ESemaphoreException = class(Exception); + + { TSemaphoreObject } + + TSemaphoreObject = class + private + FHandle : PRTLEvent; + FLimit: Integer; + FCurrentState : Integer; + FCriticalSection : TCriticalSection; + public + constructor Create(const ALimit : Integer); + destructor Destroy(); override; + function WaitFor(ATimeout : Cardinal) : TWaitResult; + procedure Release(); + property Limit : Integer read FLimit; + end; + +implementation + +{ TSemaphoreObject } + +constructor TSemaphoreObject.Create(const ALimit: Integer); +begin + Assert(ALimit>0); + FLimit := ALimit; + FHandle := RTLEventCreate(); + FCriticalSection := TCriticalSection.Create(); + FCurrentState := FLimit; + RTLeventSetEvent(FHandle); +end; + +destructor TSemaphoreObject.Destroy(); +begin + RTLeventdestroy(FHandle); + FreeAndNil(FCriticalSection); + inherited Destroy(); +end; + +function TSemaphoreObject.WaitFor(ATimeout: Cardinal): TWaitResult; +var + ok : Boolean; +begin + Result := wrTimeout; + ok := False; + FCriticalSection.Acquire(); + try + if ( FCurrentState > 0 ) then begin + Dec(FCurrentState); + ok := True; + if ( FCurrentState = 0 ) then + RTLeventResetEvent(FHandle); + end; + finally + FCriticalSection.Release(); + end; + if not ok then begin + RTLeventWaitFor(FHandle,ATimeout); + FCriticalSection.Acquire(); + try + if ( FCurrentState > 0 ) then begin + Dec(FCurrentState); + ok := True; + end; + finally + FCriticalSection.Release(); + end; + end; + if ok then + Result := wrSignaled; +end; + +procedure TSemaphoreObject.Release(); +begin + FCriticalSection.Acquire(); + try + if ( FCurrentState < Limit ) then begin + Inc(FCurrentState); + end else begin + raise ESemaphoreException.Create('Invalid semaphore operation.'); + end; + finally + FCriticalSection.Release(); + end; + RTLeventSetEvent(FHandle); +end; + +end. + diff --git a/wst/trunk/server_service_intf.pas b/wst/trunk/server_service_intf.pas index 373c7e55f..7ecfa55f1 100644 --- a/wst/trunk/server_service_intf.pas +++ b/wst/trunk/server_service_intf.pas @@ -33,6 +33,7 @@ Type IServiceExtension = interface; IServiceExtensionRegistry = interface; + IObjectControl = interface; ICallControl = interface ['{7B4B7192-EE96-4B52-92C7-AE855FBC31E7}'] @@ -95,7 +96,7 @@ Type const AExtensionList : array of string ); function GetExtension( - out AExtensionList : string + out AExtensionList : string ) : Boolean; end; @@ -122,15 +123,21 @@ Type procedure EndExceptionList(); End; - TServiceVerbMethod = procedure(AFormatter:IFormatterResponse) of object; + IObjectControl = interface + ['{C422C7CA-4C95-48A4-9A82-2616E619F851}'] + procedure Activate(); + procedure Deactivate(); + function CanBePooled() : Boolean; + end; + + TServiceVerbMethod = procedure(AFormatter:IFormatterResponse; AContext : ICallContext) of object; { TBaseServiceBinder } - TBaseServiceBinder = Class(TInterfacedObject,IServerService) + TBaseServiceBinder = Class(TInterfacedPersistent,IServerService) Private FVerbList : TObjectList; FImplementationFactory : IServiceImplementationFactory; - FCallContext : ICallContext; Protected procedure RegisterVerbHandler( const AVerb : string; @@ -138,9 +145,8 @@ Type ); function FindVerbHandler(const AVerb : string):TServiceVerbMethod; procedure HandleRequest(ARequestBuffer : IRequestBuffer); - function GetFactory():IItemFactory; + function GetFactory():IServiceImplementationFactory; function CreateCallContext():ICallContext;virtual; - function GetCallContext():ICallContext; procedure DoProcessMessage( const AMessageStage : TMessageStage; ACallContext : ICallContext; @@ -163,6 +169,14 @@ Type function GetCallContext():ICallContext; End; + { TActivableServiceImplementation } + + TActivableServiceImplementation = class(TBaseServiceImplementation,IObjectControl) + protected + procedure Activate();virtual; + procedure Deactivate();virtual; + function CanBePooled() : Boolean;virtual; + end; { TImplementationFactory } @@ -178,7 +192,7 @@ Type const AExtensionList : array of string ); function GetExtension( - out AExtensionList : string + out AExtensionList : string ) : Boolean; end; @@ -332,17 +346,17 @@ begin if not Assigned(f) then Error('No formatter for that content type : "%s"',[s]); try - cllCtx := GetCallContext(); + cllCtx := CreateCallContext(); DoProcessMessage(msBeforeDeserialize,cllCtx,ARequestBuffer); strm := ARequestBuffer.GetContent(); f.LoadFromStream(strm); - f.BeginCallRead(GetCallContext()); + f.BeginCallRead(cllCtx); DoProcessMessage(msAfterDeserialize,cllCtx,f); s := f.GetCallProcedureName(); m := FindVerbHandler(s); if not Assigned(m) then Error('No handler for that verb : "%s"',[s]); - m(f); + m(f,cllCtx); for i := 0 to Pred(cllCtx.GetHeaderCount(AllHeaderDirection)) do begin hdr := cllCtx.GetHeader(i); if ( hdr.Direction = hdIn ) and ( hdr.mustUnderstand <> 0 ) and ( not hdr.Understood ) then begin @@ -368,23 +382,14 @@ begin DoProcessMessage(msAfterSerialize,cllCtx,ARequestBuffer); end; -function TBaseServiceBinder.GetFactory(): IItemFactory; +function TBaseServiceBinder.GetFactory(): IServiceImplementationFactory; begin Result := FImplementationFactory; end; function TBaseServiceBinder.CreateCallContext(): ICallContext; begin - if not Assigned(FCallContext) then - FCallContext := TSimpleCallContext.Create() as ICallContext; - Result := FCallContext; -end; - -function TBaseServiceBinder.GetCallContext(): ICallContext; -begin - if not Assigned(FCallContext) then - CreateCallContext(); - Result := FCallContext; + Result := TSimpleCallContext.Create() as ICallContext; end; procedure TBaseServiceBinder.DoProcessMessage( @@ -421,6 +426,7 @@ end; constructor TBaseServiceBinder.Create(AImplementationFactory : IServiceImplementationFactory); begin Assert(Assigned(AImplementationFactory)); + inherited Create(); FImplementationFactory := AImplementationFactory; FVerbList := TObjectList.Create(True); end; @@ -554,6 +560,7 @@ end; { TImplementationFactory } const sSERVICES_EXTENSIONS = 'extensions';sLIST = 'list'; + procedure TImplementationFactory.RegisterExtension( const AExtensionList : array of string ); @@ -621,6 +628,23 @@ begin Result := ServiceExtensionRegistryInst; end; +{ TActivableServiceImplementation } + +procedure TActivableServiceImplementation.Activate(); +begin + +end; + +procedure TActivableServiceImplementation.Deactivate(); +begin + +end; + +function TActivableServiceImplementation.CanBePooled(): Boolean; +begin + Result := False; +end; + Initialization FormatterRegistryInst := TFormatterRegistry.Create() as IFormatterRegistry; ServerServiceRegistryInst := TServerServiceRegistry.Create() as IServerServiceRegistry;