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.