Перегрузка TCustomForm.Loaded

    Надобность в перегрузке TCustomForm.Loaded возникла в момент, когда начали делать многоязыковую поддержку. Переключение на другой язык планировалось изначально после перезагрузки и, поэтому, способ многоязычности был прост: весь интерфейс пишется на русском языке, а далее создается словарь соответствий русских фраз и фраз другого языка. Т.е. на вход функции дается русский текст и она, найдя текст в словаре, возвращает фразу на другом языке. И, следовательно, основной механизм для реализации идеи - пройтись по всем компонентам после загрузки формы и, делая проверку с помощью is, производить подмену строковых свойств. Почему нельзя создать наследника с переопределенным Loaded и от него наследовать все формы? Да хотя бы потому, что проект имеет огромное количество форм и все их переделать уйдет много времени. К тому же, описанный способ, более универсальный (в плане прихода в другие проекты).
    Сразу оговорюсь, что метод был проработан под Delphi 5 и на других версиях не тестировался.

    Замена метода Loaded, просто подменой соответствующего адреса в таблице виртуальных методов, некорректна. Ключевое слово inherited всегда знает, какой именно родитель содержит предыдущую реализацию метода. Поэтому inherited таблицу виртуальных методов не использует, а непосредственно вызывает функцию, зная ее точный адрес.
    Вот код рассматриваемого метода:

procedure TCustomForm.Loaded;
var
Control: TWinControl;
begin
inherited Loaded;
if ActiveControl <> nil then
begin
Control := ActiveControl;
FActiveControl := nil;
if Control.CanFocus then SetActiveControl(Control);
end;
end;

Идея перегрузки заключается в следующем. Находим адрес инструкции inherited Loaded (инструкция call с 32-х битным относительным смещением) и запоминаем адрес метода Loaded у родителя TCustomForm (им будет TControl). Далее в данную инструкцию (call) ставим адрес нашей процедуры, которая будет пробегать по компонентам и производить нужную обработку. Сама же процедура должна вызвать метод TControl.Loaded (до основной работы). Таким образом мы добавляем свой код между строчками inherited Loaded и if ActiveControl<>nil then ....
Для начала создадим класс, в котором будет наш метод.

TLangUpdateForm = class(TCustomForm)
protected
procedure Loaded; override;
procedure Translate;
end;

Объявленный метод Loaded мы разберем на байтики, чтобы узнать адрес метода TCustomForm.Loaded (от нас он скрыт в секции protected). Подводным камнем в получении адреса является галочка Optimization в настройках Delphi. Реализация метода Loaded такова:

procedure TLangUpdateForm.Loaded;
begin
Inherited;
end;

Если оптимизация включена, то весь метод состоит из двух машинных команд:

0000: call TCustomForm.Loaded
0005: ret

Если оптимизация отключена, то код немного больше:

;begin
0000: push ebp
0001: mov   ebp,esp
0003: push ecx
0004: mov   [ebp-$04],eax
;Inherited
0007: mov   ax,[ebp-$04]
000A: call TCustomForm.Loaded
;end;
000F: pop   ecx
0010: pop   ebp
0011: ret

Чтобы узнать, есть оптимизация и нет, считываем первый байт о начала метода. Если этот байт равен 0EBh (call), то начиная со следующего байта идет 32-х битный относительный адрес TCustomForm.Loaded. В противном случае тот же адрес будет лежать со смещением 11 байт относительно начала TLangUpdateForm.Loaded.
Теперь начало машинного кода TCustomForm.Loaded.

0000: push ebx
0001: push esi
0002: push edi
0003: mov esi,eax
0005: mov eax,esi
0007: call TControl.Loaded
...

Здесь по смещению 0007 лежит вызов (inherited) метода TControl.Loaded. Мы запомним адрес вызова и на его место поставил адрес своего метода. Так как прямого обращения к памяти у нас изначально нет, то мы воспользуемся процедурой VirtualProtect для разрешения считывать и записывать данных.

var
pLoaded_Addr: ^Integer;
dwProtect: DWORD;
P : Pointer;
InhJmpPos,pTControlLoaded : Integer;
....
initialization
pLoaded_Addr := @TLangUpdateForm.Loaded;
P := @TLangUpdateForm.Loaded; //для VirtualProtect
//разрешаем доступ
VirtualProtect(P, SizeOf(Pointer)+11, PAGE_READWRITE, @dwProtect);
asm
push eax
push ebx
mov eax,pLoaded_Addr
cmp byte ptr [eax],$E8 //проверяем наличие call в первом байте
je   @@1
add eax,10
@@1:
inc eax    //пропускаем call
mov ebx,[eax] //теперь в ebx отн. смещение TCustomForm.Loaded
add eax,ebx
add eax,4+7+1 //ebx+eax+4 абсолютное смещение
   //+7 смещение call; +1 - смещение адреса TControl.Loaded
mov pLoaded_Addr,eax //запоминаем адрес адреса
add eax,4
mov InhJmpPos,eax //адрес ячейки, следующей за call
pop ebx
pop eax
end;
//снимаем разрешение на доступ
VirtualProtect(P, SizeOf(Pointer)+11, dwProtect, @dwProtect);

Теперь в pLoaded_Addr адрес перехода на TControl.Loaded. Запоминаем его и ставим адрес на свой метод.

VirtualProtect(pLoaded_Addr, SizeOf(Pointer), PAGE_READWRITE, @dwProtect);
//здесь добавили InhJmpPos, чтобы запомнить абсолютный адрес, а не относительный
pTControlLoaded := pLoaded_Addr^ + InhJmpPos;
//а записали относительный
pLoaded_Addr^ := Integer(@TLangUpdateForm.Translate~~) -~~ InhJmpPos;
VirtualProtect(pLoaded_Addr, SizeOf(Pointer), dwProtect, @dwProtect);

Осталось реализовать наш метод.

procedure TLangUpdateForm.Translate;
begin
asm
call dword ptr [pTControlLoaded]
end;
....
end;

Здесь есть один нюанс. Delphi в нашем ассеблерном коде не может предположить, что именно мы вызываем. Если после асм. вставки идет код вызова, например, статического метода не обращающегося к полям объекта, то при включенной оптимизации в тот метод может не быть передан параметр Self. А так как TControl.Loaded нуждается в Self и, в общем то, ждет его от нас, требуется его получить. Если код Translate обращается к полям объекта, то проблем нет. В противном случае, можно просто упомянуть Self в исходнике, тогда компилятор сам добавит нужный нам код. Например, так:

asm
mov eax,Self
call dword ptr [pTControlLoaded]
end;