Переменные "экземпляра мета-класса в Delphi"

Мне давно не хватает такой конструкции:

TA = class
 class static Count : Integer
end;
 
TB = class(TA)
end;
 
TA.Count := 20;
TB.Count := 45;
 
WriteLen(TA.Count);
WriteLn(TB.Count);

Получаем вывод:
20
45

Клёво не правда ли?

Т.е. чтобы у мета-класса TA была СВОЯ переменная Count, а у мета-класса TB - СВОЯ.

Но язык к сожалению не позволяет устроить такое "безобразие". Или я что-то опять пропустил?

Обращаю внимание на тот факт, что не у ЭКЗЕМПЛЯРОВ КЛАССОВ, а у экземпляров МЕТА-классов.

Опять же для знатоков БД (я к ним - не отношусь, так что - не бейте больно ногами) - привожу пример - "данные" и "мета-данные". Может быть - так понятнее...

Теперь о том - как это устроить.

На помощь придёт "копание в VMT".

Итак:

TA = class
protected
 procedure MetaClassVarPlacement;
  virtual;
public
 class function GetClassVar: Integer;
  class procedure SetClassVar(aValue: Integer);
end;
 
TB = class(TA)
end;
 
procedure TA.MetaClassVarPlacement;
  //virtual;
begin
end;
 
class function TA.GetClassVar: Integer;
  {-}
var
 l_Head : PPointer;
begin
 asm
  mov edx, VMTOffset TA.MetaClassVarPlacement
  add edx, eax
  mov l_Head, edx
 end;//asm
 if ( l_Head^= @TA.MetaClassVarPlacement) then
  Result := 0
 else
  Result := PInteger(l_Head)^;
end;
 
class procedure TA.SetClassVar(aValue: Integer);
  {-}
var
 l_Head : PPointer;
 l_Old  : DWORD;
begin
 assert(aValue <> Int64(@MetaClassVarPlacement), 'Предполагеаем, что это никогда не всплывёт');
 // - если предыдущая строчка не компилируется - закомментируйте её
 asm
  mov edx, VMTOffset TA.MetaClassVarPlacement
  add edx, eax
  mov l_Head, edx
 end;//asm
 if (l_Head^ = @TA.MetaClassVarPlacement) then
 begin
  VirtualProtect(l_Head, 4, PAGE_EXECUTE_READWRITE, @l_Old);
 end;
 PInteger(l_Head)^ := aValue;
end;
...
TA.SetClassVar(20);
TB.SetSlassVar(45);
 
WriteLn(TA.GetClassVar);
WriteLn(TB.GetClassVar);

Disclaimer. Этот код писался "с листа" посему - может и не заработать. Пишите. Тогда приведу рабочую версию.

Для Чего это может быть нужно?

Например для кешей объектов и фабрик. Или подсчёта количества объектов "именно этого класса":

TA.NewInstance:
begin
 Result := inherited NewInstance;
 SetClassVar(GetClassVar+1);
end;

Идея понятна?

Вы скажете - "ассоциативные массивы". Мапа ключ-значение. И вы будете правы. Только мой способ эффективнее по скорости. Для таких "системных" вещей как фабрики, кеш объектов или подсчёт экземпляров класса. Для "прикладных" вещей - КОНЕЧНО мапа или её аналоги.

Попробуйте. Может быть вам понравится.

И ещё - подобны "хоккей" я предпочитаю убирать под директиву NoHack. Т.е. пишу - ДВЕ версии кода. С "выкрутасами" или без. Чтобы легко переключиться можно было на версию "без выкрутасов".

P.S. гораздо более глубоко про VMT написано тут - http://www.transl-gunsmoker.ru/2011/08/hack15-overriding-message-and-dynamic.html

P.P.S. Ссылки из комментариев:

http://hallvards.blogspot.ru/2007/05/hack17-virtual-class-variables-part-i.html
http://hallvards.blogspot.ru/2007/05/hack17-virtual-class-variables-part-ii.html