unit Container;
interface
uses
System.SysUtils,
System.Generics.Collections;
type
EContainerException =
class(
Exception );
GlobalContainer =
class
private
class var _ClassDict : TDictionary<
string, TClass>;
protected
class constructor Create;
class destructor Destroy;
public
class procedure RegisterClass<TInterface : IInterface; TRegClass :
class>(
const Name :
string = '
' );
class function GetClass<T : IInterface>(
const Name :
string = '
' ) : T;
end;
implementation
uses
System.TypInfo;
{ GlobalContainer }
class constructor GlobalContainer.Create;
begin
_ClassDict := TDictionary<
string, TClass>.Create;
end;
class destructor GlobalContainer.Destroy;
begin
_ClassDict.Free;
end;
class function GlobalContainer.GetClass<T>(
const Name :
string ) : T;
var
LGUID : TGUID;
LKey :
string;
LClass : TClass;
LObj : TObject;
begin
LGUID := GetTypeData( TypeInfo( T ) ).Guid;
LKey := LGUID.ToString +
Name.ToUpper;
if _ClassDict.ContainsKey( LKey )
then
begin
LClass := _ClassDict.Items[LKey];
LObj := LClass.Create;
Supports( LObj, LGUID, Result );
end
else
raise EContainerException.CreateFmt( '
Keine Klasse zum Interface%s(%s) gefunden', [LGUID.ToString,
Name] );
end;
class procedure GlobalContainer.RegisterClass<TInterface, TRegClass>(
const Name :
string );
var
LGUID : TGUID;
LKey :
string;
begin
LGUID := GetTypeData( TypeInfo( TInterface ) ).Guid;
LKey := LGUID.ToString +
Name.ToUpper;
_ClassDict.AddOrSetValue( LKey, TRegClass );
end;
end.