// Способ первый
procedure TForm1.Button1Click(Sender: TObject);
var
  i: Integer;
begin
  i := 1;
  asm
    int 3
  end;
  Inc(i); // Остановка произойдет на этой строке
end;

// Способ второй
procedure TForm1.Button1Click(Sender: TObject);
var
  i: Integer;
begin
  i := 1;
  asm
    db $CC
  end;
  Inc(i); // Остановка произойдет на этой строке
end;

procedure EnumMethods(aClass: TClass; Lines: TStrings);
type
  TMethodtableEntry = packed record
    Len: Word;
    Adr: Pointer;
    Name: ShortString;
  end;
  {Note: name occupies only the size required, so it is not a true shortstring! The actual
  entry size is variable, so the method table is not an array of TMethodTableEntry!}
var
  pp: ^Pointer;
  pMethodTable: Pointer;
  pMethodEntry: ^TMethodTableEntry;
  i, numEntries: Word;
begin
  if aClass = nil then
    Exit;

  pp := Pointer(Integer(aClass) + vmtMethodtable);
  pMethodTable := pp^;
  Lines.Add(Format('Class %s: method table at %p', [aClass.Classname, pMethodTable]));
  if pMethodtable <> nil then
  begin
    {first word of the method table contains the number of entries}
    numEntries := PWord(pMethodTable)^;
    Lines.Add(Format('  %d published methods', [numEntries]));
    {make pointer to first method entry, it starts at the second word of the table}
    pMethodEntry := Pointer(Integer(pMethodTable) + 2);
    for i := 1 to numEntries do
    begin
      with pMethodEntry^ do
        Lines.Add(Format('  %d: len: %d, adr: %p, name: %s', [i, Len, Adr, Name]));
      {make pointer to next method entry}
      pMethodEntry := Pointer(Integer(pMethodEntry) + pMethodEntry^.Len);
    end;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  sl: TStringList;
begin
  sl := TStringList.Create;
  try
    EnumMethods(TMyClass, sl);
    ShowMessage(sl.Text);
  finally
    sl.Free;
  end;
end;

unit Test;

interface

uses
  SysUtils, Classes, TypInfo;

procedure GetComponentProperties(Instance: TPersistent; AList: TStrings);
procedure SetComponentProperties(Instance: TPersistent; AList: TStrings);

implementation

/// 

/// Получение имен и значений published свойств
/// 
/// Объект, свойства которого нужно сохранить
/// Результатирующий список пар "имя свойства"="значение"
procedure GetComponentProperties(Instance: TPersistent; AList: TStrings);
var
  i, Count: Integer;
  PropInfo: PPropInfo;
  PropList: PPropList;
begin
  if not Assigned(AList) then
    Exit;

  Count := GetTypeData(Instance.ClassInfo)^.PropCount;
  if Count > 0 then
  begin
    GetMem(PropList, Count * SizeOf(Pointer));
    try
      GetPropInfos(Instance.ClassInfo, PropList);
      for i := 0 to Count-1 do
      begin
        PropInfo := PropList^[i];
        if PropInfo = nil then
          Break;
        if IsStoredProp(Instance, PropInfo) then
          case PropInfo^.PropType^.Kind of
            tkInteger, tkInt64:
              AList.Add(PropInfo^.Name + '=' + IntToStr(GetOrdProp(Instance, propInfo)));
            tkString, tkLString, tkWString, tkUString:
              AList.Add(PropInfo^.Name + '=' + GetStrProp(Instance, propInfo));
            tkEnumeration:
              AList.Add(PropInfo^.Name + '=' + GetEnumProp(Instance, propInfo));
            tkSet:
              AList.Add(PropInfo^.Name + '=' + GetSetProp(Instance, propInfo));
          end;
      end;
    finally
      FreeMem(PropList, Count * SizeOf(Pointer));
    end;
  end;
end;

/// 

/// Установка значений published свойств по их именам
/// 
/// Объект, свойства которого нужно сохранить
/// Результатирующий список пар "имя свойства"="значение"
procedure SetComponentProperties( Instance: TPersistent; AList: TStrings );
var
  i, j, Count: Integer;
  PropInfo: PPropInfo;
  PropList: PPropList;
begin
  if not Assigned(AList) then
    Exit;

  Count := GetTypeData(Instance.ClassInfo)^.PropCount;
  if Count > 0 then
  begin
    GetMem(PropList, Count * SizeOf(Pointer));
    try
      GetPropInfos(Instance.ClassInfo, PropList);
      for i := 0 to AList.Count-1 do
        for j := 0 to Count-1 do
        begin
          PropInfo := PropList^[j];
          if PropInfo = nil then
            Break;
          if IsStoredProp(Instance, PropInfo) then
            if PropInfo^.Name = AList.Names[i] then
              case PropInfo^.PropType^.Kind of
                tkInteger, tkInt64:
                  SetOrdProp(Instance, AList.Names[i], StrToInt(AList.Values[AList.Names[i]]));
                tkString, tkLString, tkWString, tkUString:
                  SetStrProp(Instance, AList.Names[i], AList.Values[AList.Names[i]]);
                tkEnumeration:
                  SetEnumProp(Instance, AList.Names[i], AList.Values[AList.Names[i]]);
                tkSet:
                  SetSetProp(Instance, AList.Names[i], AList.Values[AList.Names[i]]);
              end;
        end;
    finally
      FreeMem(PropList, Count * SizeOf(Pointer));
    end;
  end;
end;

end.

// Использование

unit Unit1;

interface

type
  TEnum = (a1, a2, a3);
  TSet = set of TEnum;

  TTestClass = class(TPersistent)
  private
    FPropA: string;
    FPropB: Word;
    FPropC: TEnum;
    FPropD: TSet;
  published
    property PropA: string read FPropA write FPropA;
    property PropB: Word read FPropB write FPropB;
    property PropC: TEnum read FPropC write FPropC;
    property PropD: TSet read FPropD write FPropD;
  end;

{...}

implementation

uses
  Test, TypInfo;

var
  TestClass: TTestClass;

procedure TForm1.FormCreate(Sender: TObject);
begin
  TestClass := TTestClass.Create;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  TestClass.Free;
end;

///

/// Сохранение
///
procedure TForm1.Button1Click(Sender: TObject);
var
  sl: TStrings;
begin
  TestClass.PropA := 'abc...';
  TestClass.PropB := Length(TestClass.PropA);
  TestClass.PropC := a2;
  TestClass.PropD := [a1, a3];

  sl := TStringList.Create;
  GetComponentProperties(TestClass, sl);
  sl.SaveToFile('c:\SaveProps.txt');
  sl.Free;
end;

///

/// Восстановление
///
procedure TForm1.Button2Click(Sender: TObject);
var
  sl: TStrings;
begin
  if not FileExists('c:\SaveProps.txt') then
    raise Exception.Create('Не найден файл с сохранеными свойствами класса.');

  sl := TStringList.Create;
  sl.LoadFromFile('c:\SaveProps.txt');
  SetComponentProperties(TestClass, sl);
  sl.Free;
end;

///

/// Проверка значения свойств экземпляра класса
///
procedure TForm1.Button3Click(Sender: TObject);
var
  i: TEnum;
  Element: string;
begin
  Element := '[';
  for i := Low(TEnum) to High(TEnum) do
    if i in TestClass.PropD then
    begin
      Element := Element + GetSetElementName(TypeInfo(TEnum), Ord(i));
      if i <> High(TEnum) then
        Element := Element + ', ';
   end;
 Element := Element + ']';

 ShowMessage('TestClass:'#13 +
             '  PropA = ' + QuotedStr(TestClass.PropA) + #13 +
             '  PropB = ' + IntToStr(TestClass.PropB) + #13 +
             '  PropC = ' + GetEnumName(TypeInfo(TEnum), Ord(TestClass.PropC)) + #13 +
             '  PropD = ' + Element);
end;

end.

uses
  TypInfo;

function ObjectsUnit(Obj: TClass): string;
begin
  Result := GetTypeData(PTypeInfo(Obj.ClassInfo))^.UnitName;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ShowMessage(ObjectsUnit(TForm1));
end;

uses
  TypInfo;

procedure BrushStylesAsStrings(AList: TStrings);
var
  i: Integer;
  pInfo: PTypeInfo;
  pEnum: PTypeData;
begin
  AList.Clear;
  pInfo := PTypeInfo(TypeInfo(TBrushStyle));
  pEnum := GetTypeData(pInfo);
  with pEnum^ do
  begin
    for i := MinValue to MaxValue do
      AList.Add(GetEnumName(pInfo, i));
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  sl: TStrings;
begin
  sl := TStringList.Create;
  BrushStylesAsStrings(sl);
  ShowMessage(sl.Text);
  sl.Free;
end;

// Способ первый
uses
  TypInfo;

function GetProperty(AControl: TPersistent; AProperty: string): PPropInfo;
var
  i: Integer;
  Props: PPropList;
  TypeData: PTypeData;
begin
  Result := nil;
  if (AControl = nil) or (AControl.ClassInfo = nil) then
    Exit;
  TypeData := GetTypeData(AControl.ClassInfo);
  if (TypeData = nil) or (TypeData^.PropCount = 0) then
    Exit;
  GetMem(Props, TypeData^.PropCount * SizeOf(Pointer));
  try
    GetPropInfos(AControl.ClassInfo, Props);
    for i := 0 to TypeData^.PropCount-1 do
    begin
      with Props^[i]^ do
        if Name = AProperty then
          Result := Props^[i];
    end;
  finally
    FreeMem(Props);
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  PropInfo: PPropInfo;
begin
  PropInfo := GetProperty(Button1.Font, 'Name');
  if PropInfo <> nil then
    SetStrProp(Button1.Font, PropInfo, 'Arial');
end;

// Способ второй
uses
  TypInfo;

procedure TForm1.Button1Click(Sender: TObject);
var
  PInfo: PPropInfo;
  Font: TFont;
begin
  Font := TFont.Create;

  // Настройка шрифта
  Font.Name := 'Arial';
  PInfo := GetPropInfo(Sender.ClassInfo, 'Font');
  if Assigned(PInfo) then
    SetOrdProp(Sender, PInfo, Integer(Font));

  Font.Free;
end;

// Способ третий
uses
  TypInfo;

procedure SetStringPropertyIfExists(AComp: TPersistent; APropName: string;
  AValue: string);
var
  PropInfo: PPropInfo;
  TK: TTypeKind;
begin
  PropInfo := GetPropInfo(AComp.ClassInfo, APropName);
  if PropInfo <> nil then
  begin
    TK := PropInfo^.PropType^.Kind;
    if (TK = tkString) or (TK = tkLString) or (TK = tkWString) or (TK = tkUString) then
      SetStrProp(AComp, PropInfo, AValue);
  end;
end;

procedure SetIntegerPropertyIfExists(AComp: TPersistent; APropName: string;
  AValue: Integer);
var
  PropInfo: PPropInfo;
begin
  PropInfo := GetPropInfo(AComp.ClassInfo, APropName);
  if PropInfo <> nil then
  begin
    if PropInfo^.PropType^.Kind = tkInteger then
      SetOrdProp(AComp, PropInfo, AValue);
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  SetStringPropertyIfExists(Button1.Font, 'Name', 'Arial');
  SetIntegerPropertyIfExists(Button1.Font, 'Size', 18);
end;

uses
  StrUtils, TypInfo;

///

/// Копирование всех одинаковых по названию свойств/методов одного компонента в
/// другой за исключение "Name", "Left", "Top", "" и тех которые заданы в aExcept
/// Примеры использования:
/// CopyComponentProp(N11, N21, []);
/// CopyComponentProp(ListBox2, ListBox3, []);
/// CopyComponentProp(ListView1, ListView2, ['Items', 'Color']);
///
procedure AssignComponentProp(Source, Target: TObject; aExcept: array of string);
var
  i, Index: Integer;
  PropName: string;
  Source_PropList, Target_PropList: PPropList;
  Source_NumProps, Target_NumProps: Word;
  Source_PropObject, Target_PropObject: TObject;

  // Поиск в списке свойства с заданным именем
  function FindProperty(const PropName: string; PropList: PPropList; NumProps: Word): Integer;
  var
    i: Integer;
  begin
    Result := -1;
    for i := 0 to NumProps-1 do
      if CompareStr(PropList^[i]^.Name, PropName) = 0 then
      begin
        Result := i;
        Break;
      end;
  end;

begin
  if not Assigned(Source) or not Assigned(Target) then
    Exit;

  Source_NumProps:= GetTypeData(Source.ClassInfo)^.PropCount;
  Target_NumProps:= GetTypeData(Target.ClassInfo)^.PropCount;
  GetMem(Source_PropList, Source_NumProps * SizeOf(Pointer));
  GetMem(Target_PropList, Target_NumProps * SizeOf(Pointer));
  try
    // Получаем список свойств
    GetPropInfos(Source.ClassInfo, Source_PropList);
    GetPropInfos(Target.ClassInfo, Target_PropList);
    for i := 0 to Source_NumProps-1 do
    begin
      PropName := Source_PropList^[i]^.Name;
      if (AnsiIndexText('None' , aExcept ) = -1) and
         ((AnsiIndexText(PropName, ['Name', 'Left', 'Top', '']) <> -1) or
          (AnsiIndexText(PropName, aExcept ) <> -1)) then
        Continue;

      Index:= FindProperty(PropName, Target_PropList, Target_NumProps);
      if Index = -1 then
        Continue; // не нашли
      // Проверить совпадение типов
      if Source_PropList^[i]^.PropType^.Kind <> Target_PropList^[Index]^.PropType^.Kind then
        Continue;
      case Source_PropList^[i]^.PropType^^.Kind of
        tkClass: begin
          Source_PropObject := GetObjectProp(Source, Source_PropList^[i]);
          Target_PropObject := GetObjectProp(Target, Target_PropList^[Index]);
          AssignComponentProp(Source_PropObject, Target_PropObject, ['None']);
        end;
        tkMethod:
          SetMethodProp(Target, PropName, GetMethodProp(Source, PropName));
        else
          SetPropValue(Target, PropName, GetPropValue(Source, PropName));
      end;
    end;
  finally
    FreeMem(Source_PropList);
    FreeMem(Target_PropList);
  end;
end;

type
  TForm1 = class(TForm)
    {...}
  private
    procedure ExecMethodByName(AName: string);
  published
    procedure SomeMethod(S: string);
  end;

var
  Form1: TForm1;

implementation

type
  PYourMethod = ^TYourMethod;
  TYourMethod = procedure(S: string) of Object;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ExecMethodByName('SomeMethod');
end;

procedure TForm1.ExecMethodByName(AName: string);
var
  PAddr: PYourMethod;
  M: TMethod;
begin
  PAddr := MethodAddress(AName);
  if PAddr <> nil then
  begin
    M.Code := PAddr;
    M.Data := Self;
    TYourMethod(M)('hello');
  end;
end;

procedure TForm1.SomeMethod(S: string);
begin
  ShowMessage(S);
end;

uses
  TypInfo;

function GetFontProp(anObj: TObject; anClass: TClass): TFont;
var
 PInfo: PPropInfo;

 function PrepareClassName(const Name: string): string;
 begin
   if Name[1] = 'T' then
     Result := Copy(Name, 2, Length(Name)-1)
   else
     Result := Name;
 end;

begin
  // Пытаемся получить указатель на информацию о свойстве anClass
  // TObject.ClassInfo возвращает указатель на RTTI table с нужным свойством
  PInfo := GetPropInfo(anObj.ClassInfo, PrepareClassName(anClass.ClassName));
  Result := nil;
  if PInfo <> nil then
    if (PInfo^.Proptype^.Kind = tkClass) and
      GetTypeData(PInfo^.Proptype^)^.ClassType.InheritsFrom(anClass) then
      Result := TFont(GetOrdProp(anObj, PInfo));
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  if Assigned(GetFontProp(Self, TFont)) then
    ShowMessage('Имеется');
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  // Работает только с зарегистрированными классами
  RegisterClasses([TButton, TForm]);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  CRef: TPersistentClass;
  AControl: TControl;
begin
  CRef := GetClass('TButton');
  if CRef <> nil then
  begin
    AControl := TControl(TControlClass(CRef).Create(Self));
    with AControl do
    begin
      Parent := Self;
      Width := 50;
      Height := 30;
    end;
  end
  else
    MessageDlg('No such class', mtWarning, [mbOk], 0);
end;