Auto register classes

This is something I wrote back when Attributes was sort of new to Delphi, but it’s a neat example of how custom attributes can simplify your code. It would actually be a nice candidate for addition to the VCL.

In short: If you are serializing objects to JSon, you probably know that Delphi can only re-create those objects if it knows the class type (or if you manually provide the class during parsing). This means that you end up writing an implementation section where you manually call RegisterClass() for each of the class types you use.

RegisterClass is just perfect for turning into an Attribute

While this is not problematic or difficult, it’s one of those chores that is perfect for attributes. So instead of having to write an initialization section on unit level, you can just attach a [ClassRegister] attribute, and it’s automatically registered for you when the unit is loaded into memory.

Here is the unit, feel free to use it and rename it to whatever you like:

unit quartex.util.register;
 
interface

type
  ///<summary>
  ///<para>The [ClassRegister] attribute registers the attached class
  /// into Delphi's internal class registry. This is the same as calling
  /// RegisterClass manually during unit initialization, except it's
  /// simpler and more elegant.</para>
  ///<code>
  ///type 
  ///   [ClassRegister]
  ///   TSomeClass = class(TPersistent)
  ///   end;
  ///</code>
  ///</summary>
  ClassRegister = class(TCustomAttribute)
  end;

implementation

uses
  System.Rtti, System.TypInfo, System.Classes;

// This procedure walks through all classtypes and isolates
// those with our TAutoRegister attribute.
// It then locates the actual classtype and registeres it
// with Delphi's internal persistence layer
procedure ProcessAutoRegisterAttributes;
var
  ctx : TRttiContext;
  typ : TRttiType;
  attr : TCustomAttribute;
  lRealType: TClass;
  lAccess: PTypeData;
begin
  ctx := TRttiContext.Create();
  try
    for typ in ctx.GetTypes() do
    begin
      if typ.TypeKind = tkClass then
      begin
        for attr in typ.GetAttributes() do
        begin
          if attr is ClassRegister then
          begin
            lAccess := GetTypeData(typ.Handle);
            if lAccess <> nil then
            begin
              lRealType := lAccess^.ClassType;
              if lRealType <> nil then
              begin
                if lRealType.InheritsFrom(TPersistent)
                or lRealType.InheritsFrom(TInterfacedPersistent) then
                  RegisterClass( TPersistentClass(lRealType) );
              end;
              break;
            end;
          end;
        end;
      end;
    end;
  finally
    ctx.Free();
  end;
end;
 
// We want to register all the classes decorated with our
// attribute when this unit is loaded into memory. This process is
// ultimately very quick since it's all pointer material.
Initialization
begin
  ProcessAutoRegisterAttributes;
end;
 
end.