В дополнение к
http://www.rsdn.ru/Forum/Message.aspx?mid=548308&only=1Автор: Serginio1
Дата: 24.02.04
Function GetClassStaticName(v:Tobject):String;
begin
result:= TVclass(v.ClassType).StaticVirt
end;
Преобразуется в
class function Unit.GetClassStaticName(v: TObject): String;
var text1: String;
begin text1:= (TObjectHelper.ClassType(v) as @MetaTVirtClass).StaticVirt;
result:= text1
end;
Но вот TObjectHelper.ClassType
class function TObjectHelper.ClassType(Self: TObject): @TClass;
var class1: @TClass;
begin class1:= Unit.@GetMetaFromHandle(TObjectHelper.ClassInfo(Unit.@GetMetaFromObject(Self)).TypeHandle);
result:= class1
end;
class function TObjectHelper.ClassInfo(Self: @TClass): Type;
var type1: Type;
begin type1:= (Self as @TClass).InstanceType;
result:= type1
end;
Безобидный на первый взгляд, вместо старго получения адреса VMT
трансформируется
{ _TClass }
var
MetaTypeMap: Hashtable;
procedure InitMetaTypeMap;
begin
if not Assigned(MetaTypeMap) then
MetaTypeMap := Hashtable.Create;
end;
function _GetMetaFromHandle(ATypeHandle: System.RuntimeTypeHandle): _TClass;
var
t, save: System.Type;
ancestor: _TClass;
ctorInfo: System.Reflection.ConstructorInfo;
begin
InitMetaTypeMap;
Result := _TClass(MetaTypeMap[ATypeHandle]);
if not Assigned(Result) then
begin
save := System.Type.GetTypeFromHandle(ATypeHandle);
t := save;
if not t.IsSubClassOf(TypeOf(_TClass)) then
begin
t := t.GetNestedType('@Meta' + t.name,
BindingFlags.Public or BindingFlags.NonPublic);
end;
if Assigned(t) then
Result := _TClass(t.GetField('@Instance').GetValue(nil))
else
begin // Requested type is not a Delphi class
t := save.BaseType;
if Assigned(t) then
begin // Is it a descendent of a Delphi class?
ancestor := _GetMetaFromHandle(t.TypeHandle);
t := System.Object(ancestor).GetType;
if t.IsSubClassOf(TypeOf(_TClass)) then
begin // yes! descendent of a Delphi class
ctorInfo := t.GetConstructor(System.Type.EmptyTypes);
if Assigned(ctorInfo) then
begin // construct an instance of the Delphi classref
// but set its instancetypehandle to this non-Delphi type
Result := _TClass(ctorInfo.Invoke(nil));
Result.SetInstanceType(ATypeHandle);
end;
end;
end;
if not Assigned(Result) then
Result := _TClass.Create(ATypeHandle);
end;
MetaTypeMap.Add(ATypeHandle, Result);
end;
end;
function _GetMetaFromObject(Obj: TObject): _TClass;
begin
if Obj = nil then
Result := nil
else if Obj is _TClass then
Result := _TClass(Obj)
else
Result := _GetMetaFromHandle(System.Type.GetTypeHandle(Obj));
end;
Хотя доступ к Хэш таблице достаточно быстр, это всетаки не получение адреса VMT из первого поля объекта.