Re: Метаклассы в Delphi 8
От: Serginio1 СССР https://habrahabr.ru/users/serginio1/topics/
Дата: 03.03.04 12:23
Оценка:
В дополнение к 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 из первого поля объекта.
и солнце б утром не вставало, когда бы не было меня
 
Подождите ...
Wait...
Пока на собственное сообщение не было ответов, его можно удалить.