unit mybean.core.beanFactory; interface uses Classes, SysUtils, SyncObjs, Windows, {$IFDEF CONSOLE} {$ELSE} {$if CompilerVersion < 23} Forms, {$else} vcl.Forms, {$ifend} {$ENDIF} mybean.core.intf, mybean.core.utils, mybean.core.objects, superobject; type {$if CompilerVersion > 23} /// /// 创建插件方法<匿名方法> /// TCreatePluginMethod = reference to function():TObject; {$ELSE} /// /// 创建插件方法 /// TCreatePluginMethod = function():TObject; {$ifend} TPluginInfo = class(TObject) private FInstance: IInterface; FID: string; FIsMainForm: Boolean; FPluginClass: TClass; FSingleton: Boolean; FCreateMethod: TCreatePluginMethod; procedure checkFreeInstance; public destructor Destroy; override; property ID: string read FID write FID; property IsMainForm: Boolean read FIsMainForm write FIsMainForm; property PluginClass: TClass read FPluginClass write FPluginClass; property Singleton: Boolean read FSingleton write FSingleton; end; TBeanInfo = class(TObject) private FbeanID: string; FInstance: IInterface; procedure checkFreeInstance; public destructor Destroy; override; property beanID: string read FbeanID write FbeanID; /// /// 单实例时 保存的对象 /// property Instance: IInterface read FInstance write FInstance; end; TOnInitializeProc = procedure;stdcall; TPluginInfoProc = procedure(pvObject: TPluginInfo); stdcall; TOnCreateInstanceProc = function(pvObject: TPluginInfo): TObject; stdcall; TOnCreateInstanceProcEX = function(pvObject: TPluginInfo; var vBreak: Boolean): TObject; stdcall; TBeanFactory = class(TInterfacedObject, IBeanFactory, IErrorInfo) private FVclOwners:TComponent; FBeforeGetBean: TPluginInfoProc; /// /// bean的配置 /// FConfig:ISuperObject; FCS: TCriticalSection; FInitializeProcInvoked:Boolean; FLastErr:String; FLastErrCode:Integer; FOnCreateInstanceProc: TOnCreateInstanceProc; FOnCreateInstanceProcEX: TOnCreateInstanceProcEX; FOnInitializeProc: TOnInitializeProc; FPlugins: TStrings; FBeanList:TStrings; function createInstance(pvObject: TPluginInfo): IInterface; procedure lock; procedure unLock; /// /// 根据beanID获取配置,如果没有返回nil值 /// function findBeanConfig(pvBeanID:PAnsiChar):ISuperObject; /// /// 根据beanID获取插件ID /// function getPluginID(pvBeanID:PAnsiChar):String; /// /// 在创建的时候传入设置配置 /// function checkBeanConfigSetter(const pvInterface: IInterface; const pvBeanID: PAnsiChar): Boolean; /// function checkGetBeanAccordingBeanConfig(pvBeanID: PAnsiChar; pvPluginInfo: TPluginInfo): IInterface; protected procedure resetErrorINfo; /// /// 获取错误代码,没有错误返回 0 /// function getErrorCode: Integer; stdcall; /// /// 获取错误信息数据,返回读取到的错误信息长度, /// 如果传入的pvErrorDesc为nil指针,返回错误信息的长度 /// function getErrorDesc(pvErrorDesc: PAnsiChar; pvLength: Integer): Integer; stdcall; protected procedure clear; function _Release: Integer; stdcall; public /// /// 注册插件 /// /// /// /// /// ID /// 类 /// 是否单实例 function RegisterBean(pvPluginID: String; pvClass: TClass; pvSingleton: Boolean = false): TPluginInfo; overload; /// /// 注册插件 /// /// 创建插件的方法 /// 是否单实例 function RegisterBean(pvPluginID: String; pvCreateMethod: TCreatePluginMethod; pvSingleton: Boolean = false): TPluginInfo; overload; procedure RegisterMainFormBean(pvPluginID:string; pvClass: TClass); constructor Create; virtual; destructor Destroy; override; protected function getBeanMapKey(pvBeanID:PAnsiChar): String; function checkGetBeanConfig(pvBeanID:PAnsiChar): ISuperObject; /// 获取所有的插件ID function getBeanList(pvIDs:PAnsiChar; pvLength:Integer): Integer; stdcall; /// 创建一个插件 function getBean(pvBeanID: PAnsiChar): IInterface; stdcall; public /// /// 初始化,加载DLL后执行 /// procedure checkInitalize;stdcall; /// /// 卸载DLL之前执行 /// procedure checkFinalize;stdcall; /// /// 配置所有bean的相关的配置,会覆盖之前的Bean配置 /// pvConfig是Json格式 /// beanID(mapKey) /// { /// id:xxxx, /// ..... /// } /// function configBeans(pvConfig:PAnsiChar):Integer; stdcall; /// /// 配置bean的相关信息 /// pvConfig是Json格式的参数 /// 会覆盖之前的bean配置 /// { /// id:xxxx, /// ..... /// } /// function configBean(pvBeanID, pvConfig: PAnsiChar): Integer; stdcall; /// /// 配置bean配置 /// pluginID,内部的插件ID /// function configBeanPluginID(pvBeanID, pvPluginID: PAnsiChar): Integer; stdcall; /// /// 配置bean配置 /// singleton,单实例 /// function configBeanSingleton(pvBeanID: PAnsiChar; pvSingleton:Boolean): Integer; stdcall; public property BeforeGetBean: TPluginInfoProc read FBeforeGetBean write FBeforeGetBean; property VclOwners: TComponent read FVclOwners; property OnInitializeProc: TOnInitializeProc read FOnInitializeProc write FOnInitializeProc; property OnCreateInstanceProc: TOnCreateInstanceProc read FOnCreateInstanceProc write FOnCreateInstanceProc; /// /// 自定义创建插件实例的函数 /// property OnCreateInstanceProcEX: TOnCreateInstanceProcEX read FOnCreateInstanceProcEX write FOnCreateInstanceProcEX; end; var // 初始化 库文件 OnIntializeLibFactory:TProcedure; // 反初始化 库文件 OnFinalizeLibFactory:TProcedure; /// /// 导出Bean工厂实例给ApplictionContext进行管理 /// function getBeanFactory: IBeanFactory; stdcall; /// /// DLL加载,传入ApplictionContext和appKeyMap服务实例 /// procedure initializeBeanFactory(appContext: IApplicationContext; appKeyMap: IKeyMap); stdcall; function beanFactory: TBeanFactory; function CreateNewName(const pvRoot: TComponent; const pvBaseName: string): string; implementation uses uSOTools; var __instanceObject:TBeanFactory; __Instance:IBeanFactory; exports getBeanFactory, initializeBeanFactory; function CreateNewName(const pvRoot: TComponent; const pvBaseName: string): string; var i: integer; begin Result := pvBaseName; if (Length(Result) > 1) and (Result[1] = 'T') then Delete(Result, 1, 1); i := 1; if pvRoot <> nil then with pvRoot do while FindComponent(Result + IntToStr(i)) <> nil do inc(i); Result := Result + IntToStr(i); end; function getBeanFactory: IBeanFactory; stdcall; begin Result := __Instance; end; function beanFactory: TBeanFactory; begin Result := __instanceObject; end; procedure initializeBeanFactory(appContext: IApplicationContext; appKeyMap: IKeyMap); begin mybean.core.intf.appPluginContext := appContext; mybean.core.intf.applicationKeyMap := appKeyMap; if Assigned(OnIntializeLibFactory) then begin OnIntializeLibFactory(); end; end; procedure TBeanFactory.checkFinalize; begin FVclOwners.DestroyComponents; clear; if Assigned(OnFinalizeLibFactory) then begin OnFinalizeLibFactory(); end; end; function TBeanFactory.checkGetBeanAccordingBeanConfig(pvBeanID: PAnsiChar; pvPluginInfo: TPluginInfo): IInterface; var i:Integer; lvBeanINfo:TBeanInfo; lvConfig:ISuperObject; lvIsSingleton:Boolean; begin lvIsSingleton := False; lvConfig := findBeanConfig(pvBeanID); if lvConfig <> nil then begin lvIsSingleton := lvConfig.B['singleton']; end; if lvIsSingleton then begin lock(); try i := FBeanList.IndexOf(string(AnsiString(pvBeanID))); if i = -1 then begin lvBeanINfo := TBeanInfo.Create; try lvBeanINfo.FbeanID := string(AnsiString(pvBeanID)); lvBeanINfo.FInstance := createInstance(pvPluginInfo); checkBeanConfigSetter(lvBeanINfo.FInstance, pvBeanID); except lvBeanINfo.Free; raise; end; Result := lvBeanINfo.FInstance; FBeanList.AddObject(string(AnsiString(pvBeanID)), lvBeanINfo); end else begin lvBeanINfo := TBeanInfo(FBeanList.Objects[i]); Result := lvBeanINfo.FInstance; end; finally unLock; end; end else begin Result := createInstance(pvPluginInfo); checkBeanConfigSetter(Result, pvBeanID); end; end; function TBeanFactory.checkGetBeanConfig(pvBeanID: PAnsiChar): ISuperObject; var lvMapKey:String; begin lvMapKey := getBeanMapKey(pvBeanID); Result := FConfig.O[lvMapKey]; if Result = nil then begin Result := SO(); FConfig.O[lvMapKey] := Result; end; end; procedure TBeanFactory.checkInitalize; begin try if Assigned(FOnInitializeProc) and (not FInitializeProcInvoked) then begin if not FInitializeProcInvoked then begin FOnInitializeProc(); FInitializeProcInvoked := true; end; end; except on E:Exception do begin __beanLogger.logMessage('执行初始化时出现了异常' + sLineBreak + e.Message); end; end; end; procedure TBeanFactory.clear; var i: Integer; begin for i := 0 to FBeanList.Count -1 do begin FBeanList.Objects[i].Free; end; FBeanList.Clear; for i := 0 to FPlugins.Count -1 do begin FPlugins.Objects[i].Free; end; FPlugins.Clear; end; function TBeanFactory.configBean(pvBeanID, pvConfig: PAnsiChar): Integer; var lvNewConfig, lvConfig:ISuperObject; begin lvNewConfig := SO(String(AnsiString(pvConfig))); if (lvNewConfig = nil) or (not lvNewConfig.IsType(stObject)) then begin Result := -1; FLastErr := 'configBean执行失败, 非法的配置' + sLineBreak + String(AnsiString(pvConfig)); end else begin Result := 0; lvConfig := checkGetBeanConfig(pvBeanID); lvConfig.Merge(lvNewConfig); end; end; function TBeanFactory.configBeanPluginID(pvBeanID, pvPluginID: PAnsiChar): Integer; var lvConfig:ISuperObject; begin lvConfig := checkGetBeanConfig(pvBeanID); lvConfig.S['pluginID'] := String(AnsiString(pvPluginID)); Result := 0; end; function TBeanFactory.configBeans(pvConfig: PAnsiChar): Integer; var lvConfig:ISuperObject; lvStr:string; begin resetErrorINfo; lvStr := string(AnsiString(pvConfig)); lvConfig := SO(lvStr); if lvConfig = nil then begin Result := -1; FLastErr := 'configBeans执行失败, 非法的配置' + sLineBreak + lvStr; end else begin FConfig.Merge(lvConfig); Result := 0; end; end; function TBeanFactory.configBeanSingleton(pvBeanID: PAnsiChar; pvSingleton: Boolean): Integer; var lvConfig:ISuperObject; begin lvConfig := checkGetBeanConfig(pvBeanID); lvConfig.B['singleton'] := pvSingleton; Result := 0; end; constructor TBeanFactory.Create; begin inherited Create; FVclOwners := TComponent.Create(nil); FConfig := SO(); FPlugins := TStringList.Create; FBeanList := TStringList.Create; FCS := TCriticalSection.Create(); end; function TBeanFactory.createInstance(pvObject: TPluginInfo): IInterface; var lvResultObject:TObject; lvClass: TClass; lvBreak:Boolean; begin lvResultObject := nil; ///使用事件创建接口 if Assigned(FOnCreateInstanceProcEX) then begin lvBreak := false; lvResultObject := FOnCreateInstanceProcEX(pvObject, lvBreak); if lvResultObject <> nil then try lvResultObject.GetInterface(IInterface, Result); if Result = nil then raise Exception.CreateFmt('[%s]未实现IInterface接口,不能进行创建bean', [pvObject.FPluginClass.ClassName]); Exit; except lvResultObject.Free; lvResultObject := nil; raise; end; if lvBreak then exit; end; ///使用事件2创建 if Assigned(FOnCreateInstanceProc) then begin lvResultObject := FOnCreateInstanceProc(pvObject); if lvResultObject <> nil then try lvResultObject.GetInterface(IInterface, Result); if Result = nil then raise Exception.CreateFmt('[%s]未实现IInterface接口,不能进行创建bean', [pvObject.FPluginClass.ClassName]); Exit; except lvResultObject.Free; lvResultObject := nil; raise; end; end; /// 使用提供的方法进行创建 if Assigned(pvObject.FCreateMethod) then begin lvResultObject := pvObject.FCreateMethod(); try lvResultObject.GetInterface(IInterface, Result); if Result = nil then raise Exception.CreateFmt('[%s]提供的创建方法返回的实例, 未实现IInterface接口,不能进行创建bean', [pvObject.FID]); except lvResultObject.Free; lvResultObject := nil; raise; end; end else begin ///默认方式创建 lvClass := pvObject.PluginClass; {$IFNDEF CONSOLE} if (pvObject.IsMainForm) then begin Application.CreateForm(TCustomFormClass(lvClass), lvResultObject); try lvResultObject.GetInterface(IInterface, Result); if Result = nil then raise Exception.CreateFmt('[%s]未实现IInterface接口,不能进行创建bean', [pvObject.FPluginClass.ClassName]); except lvResultObject.Free; lvResultObject := nil; raise; end; end else {$ENDIF} if lvClass.InheritsFrom(TComponent) then begin lvResultObject := TComponentClass(lvClass).Create(FVclOwners); try if TComponent(lvResultObject).Name <> '' then begin TComponent(lvResultObject).Name := CreateNewName(FVclOwners, TComponent(lvResultObject).Name); end else begin TComponent(lvResultObject).Name := CreateNewName(FVclOwners, 'BeanVcl_'); end; lvResultObject.GetInterface(IInterface, Result); if Result = nil then raise Exception.CreateFmt('[%s]未实现IInterface接口,不能进行创建bean', [pvObject.FPluginClass.ClassName]); except lvResultObject.Free; lvResultObject := nil; raise; end; end else if lvClass.InheritsFrom(TMyBeanInterfacedObject) then begin lvResultObject := TMyBeanInterfacedObjectClass(lvClass).Create(); try lvResultObject.GetInterface(IInterface, Result); if Result = nil then raise Exception.CreateFmt('[%s]未实现IInterface接口,不能进行创建bean', [pvObject.FPluginClass.ClassName]); except lvResultObject.Free; lvResultObject := nil; raise; end; end else begin lvResultObject := lvClass.Create; try lvResultObject.GetInterface(IInterface, Result); if Result = nil then raise Exception.CreateFmt('[%s]未实现IInterface接口,不能进行创建bean', [pvObject.FPluginClass.ClassName]); except lvResultObject.Free; lvResultObject := nil; raise; end; end; end; end; destructor TBeanFactory.Destroy; begin FVclOwners.Free; clear; FreeAndNil(FCS); FConfig := nil; FPlugins.Free; FBeanList.Free; inherited Destroy; end; function TBeanFactory.checkBeanConfigSetter(const pvInterface: IInterface; const pvBeanID: PAnsiChar): Boolean; var lvSetter:IBeanConfigSetter; lvConfig:ISuperObject; lvConfigStr:string; begin Result := false; if pvInterface = nil then exit; if pvInterface.QueryInterface(IBeanConfigSetter, lvSetter) = S_OK then begin lvConfig := findBeanConfig(pvBeanID); if lvConfig <> nil then begin lvConfigStr := lvConfig.AsJSon(True, False); lvSetter.setBeanConfig(PAnsiChar(AnsiString(lvConfigStr))); Result := true; lvConfigStr := ''; end; end; end; function TBeanFactory.findBeanConfig(pvBeanID: PAnsiChar): ISuperObject; var lvMapKey:String; begin Result := nil; lvMapKey := getBeanMapKey(pvBeanID); Result := FConfig.O[lvMapKey]; end; { TBeanFactory } function TBeanFactory.getBean(pvBeanID: PAnsiChar): IInterface; var i:Integer; lvPluginINfo:TPluginInfo; lvPluginID:String; begin resetErrorINfo; lvPluginID := getPluginID(pvBeanID); Result := nil; try i := FPlugins.IndexOf(lvPluginID); if i = -1 then begin FLastErrCode := -1; FLastErr := '找不到对应的插件[' + pvBeanID + ']'; exit; end; lvPluginINfo :=TPluginInfo(FPlugins.Objects[i]); /// 触发事件 if Assigned(FBeforeGetBean) then begin FBeforeGetBean(lvPluginINfo); end; if lvPluginINfo.Singleton then begin lock; try if lvPluginINfo.FInstance <> nil then begin Result := lvPluginINfo.FInstance; exit; end else begin Result := createInstance(lvPluginINfo); checkBeanConfigSetter(Result, pvBeanID); lvPluginINfo.FInstance := Result; end; finally unLock; end; end else begin Result := checkGetBeanAccordingBeanConfig(pvBeanID, lvPluginINfo); end; except on E:Exception do begin if FLastErrCode = 0 then FLastErrCode := -1; FLastErr := E.Message; __beanLogger.logMessage(string(FLastErr), 'DEBUG_'); end; end; end; function TBeanFactory.getBeanList(pvIDs:PAnsiChar; pvLength:Integer): Integer; var lvLen:Integer; lvStr:AnsiString; begin lvStr := AnsiString(FPlugins.Text); lvLen := Length(lvStr); if lvLen > pvLength then lvLen := pvLength; CopyMemory(pvIDs, PAnsiChar(lvStr), lvLen); Result := lvLen; end; function TBeanFactory.getBeanMapKey(pvBeanID:PAnsiChar): String; begin Result := TSOTools.makeMapKey(String(AnsiString(pvBeanID))); end; function TBeanFactory.getErrorCode: Integer; begin Result := FLastErrCode; end; function TBeanFactory.getErrorDesc(pvErrorDesc: PAnsiChar; pvLength: Integer): Integer; var j:Integer; lvStr:AnsiString; begin lvStr := AnsiString(FLastErr); j := Length(lvStr); if pvErrorDesc <> nil then begin if j > pvLength then j := pvLength; CopyMemory(pvErrorDesc, PAnsiChar(lvStr), j); end; Result := j; lvStr := ''; end; function TBeanFactory.getPluginID(pvBeanID: PAnsiChar): String; var lvConfig:ISuperObject; begin Result := ''; lvConfig := findBeanConfig(pvBeanID); if lvConfig <> nil then begin Result := Trim(lvConfig.S['pluginID']); if Result = '' then begin Result :=Trim(lvConfig.S['id']); end; end; if Result = '' then begin Result := string(AnsiString(pvBeanID)); end; end; procedure TBeanFactory.lock; begin FCS.Enter; end; function TBeanFactory.RegisterBean(pvPluginID: String; pvCreateMethod: TCreatePluginMethod; pvSingleton: Boolean = false): TPluginInfo; var lvObject:TPluginInfo; begin Result := nil; if FPlugins.IndexOf(pvPluginID) <> -1 then Exit; lvObject := TPluginInfo.Create; lvObject.FID := pvPluginID; lvObject.IsMainForm := false; lvObject.FSingleton := pvSingleton; lvObject.FCreateMethod := pvCreateMethod; lvObject.FInstance := nil; FPlugins.AddObject(pvPluginID, lvObject); Result := lvObject; end; procedure TBeanFactory.RegisterMainFormBean(pvPluginID:string; pvClass: TClass); var lvObject:TPluginInfo; begin //已经注册不再进行注册 if FPlugins.IndexOf(pvPluginID) <> -1 then Exit; lvObject := TPluginInfo.Create; lvObject.FID := pvPluginID; lvObject.FPluginClass := pvClass; lvObject.FIsMainForm := true; lvObject.FInstance := nil; FPlugins.AddObject(pvPluginID, lvObject); end; procedure TBeanFactory.resetErrorINfo; begin FLastErr := ''; FLastErrCode := 0; end; procedure TBeanFactory.unLock; begin FCS.Leave; end; function TBeanFactory._Release: Integer; begin Result := inherited _Release; end; function TBeanFactory.RegisterBean(pvPluginID: String; pvClass: TClass; pvSingleton: Boolean = false): TPluginInfo; var lvObject:TPluginInfo; begin Result := nil; if FPlugins.IndexOf(pvPluginID) <> -1 then Exit; lvObject := TPluginInfo.Create; lvObject.FID := pvPluginID; lvObject.FPluginClass := pvClass; lvObject.IsMainForm := false; lvObject.FSingleton := pvSingleton; lvObject.FInstance := nil; FPlugins.AddObject(pvPluginID, lvObject); Result := lvObject; end; destructor TPluginInfo.Destroy; begin try checkFreeInstance; except end; inherited Destroy; end; procedure TPluginInfo.checkFreeInstance; //var // lvFree:IFreeObject; begin // if FInstance <> nil then // begin // if FInstance.QueryInterface(IFreeObject, lvFree)=S_OK then // begin // FInstance := nil; // lvFree.FreeObject; // lvFree := nil; // end; // FInstance := nil; // end; FInstance := nil; end; procedure TBeanInfo.checkFreeInstance; //var // lvFree:IFreeObject; begin // if FInstance <> nil then // begin // if FInstance.QueryInterface(IFreeObject, lvFree)=S_OK then // begin // FInstance := nil; // lvFree.FreeObject; // lvFree := nil; // end; // end; FInstance := nil; end; destructor TBeanInfo.Destroy; begin try checkFreeInstance; except end; inherited Destroy; end; initialization __instanceObject := TBeanFactory.Create; __Instance := __instanceObject; {$IFDEF CONSOLE} // writeLn('逻辑Bean'); {$ENDIF} finalization __instance.checkFinalize; __instance := nil; end.