25.02.2010

Вмешательства в работу компонентов

Общие сведения

В данном документе под вмешательством в работу компонентов подразумевается изменение логики работы компонентов VCL, на уровне уже существующих классов. Те мы вмешиваемся в работу всех компонентов определенного класса и их потомков.

Цели

У каждого вмешательства в работу компонентов должна быть какая-то цель. В данном случае подобные вмешательства потребовались для устранения некоторых ошибок с поддержкой тем Windows.

Средства

Компонент состоит из данных и кода. Данные компонента (те поля) не сложно изменить, даже если они находятся в private секции. Для этого нужно рассчитать корректное смещение (как правило, это завязано на версию vcl). В случае, когда read-only свойство не имеет getter функции, адрес поля можно легко получить как @Prop. Такие свойства можно использовать и как базовый адрес для получения других приватных полей, чтобы не рассчитывать смещение с самого начала. Помните о выравнивании полей.

Код компонента - общий на все экземпляры, поэтому его изменения повлияют сразу на всех, использующих данный класс или его потомков. Единственным исключением являются приложения с динамическими или ActiveX библиотеками, в случае, если эти библиотеки не используют компоненты из общих bpl (те если динамическая библиотека включает в себя реализацию компонента).

Наиболее простым является замена виртуальных и динамических методов.

Замена VMT

Таблица виртуальных методов VMT относится к коду, поэту для ее изменения нам придется получить права на изменение кода при помощи функции VirtualProtect с флагами PAGE_EXECUTE_READWRITE. Получив права, мы можем заменить указатель VMT на нужный нам. При этом часто необходимо запомнить указатель старой VMT и вернуть обратно права. Старый указатель из VMT понадобится для организации вызовов по типу "inherited" и восстановления VMT в оригинальное состояние.

Следует помнить, что виртуальность метода не гарантия от наличия статических ссылок на метод из различных мест. Например, в таблице импорта из bpl, которую в любом случае надо учитывать при компиляции с библиотеками. Так же при манипуляции одной VMT из различных мест следует задуматься о возможности многократного изменения VMT. Препятствовать этому можно введя специальную сигнатуру в "новый" метод и проверять ее наличие перед установкой. Например, легко начать код нового метода с $90909090 (4 оператора NOP).

function ReplaceCodePtr(pp: PPointer; pNew: Pointer): Pointer;
const
  PageSize = SizeOf(Pointer);
var
  SaveFlag: DWORD;
begin
  Result := nil;
  if pp = nil then Exit;
  Result := pp^;
  if VirtualProtect(pp, PageSize, PAGE_EXECUTE_READWRITE, @SaveFlag) then
  try
    pp^ := pNew;
  finally
    VirtualProtect(pp, PageSize, SaveFlag, @SaveFlag);
  end;
end;

// Returns the address of virtual method of AClass with index AIndex
function GetVMTAddress(AClass: TClass; AIndex: Integer): Pointer;
var
  Table: PPointer absolute AClass;
begin
  Inc(Table, AIndex - 1);
  Result := Table^;
end;

// Updates VMT of AClass and sets the new method address of method with index AIndex
function SetVMTAddress(AClass: TClass; AIndex: Integer; NewAddress: Pointer): Pointer;
var
  Table: PPointer absolute AClass;
begin
  Inc(Table, AIndex - 1);
  Result := ReplaceCodePtr(Table, NewAddress);
end;

// Iterates through VMT of AClass and seeks for method MethodAddr
function FindVMTIndex(AClass: TClass; MethodAddr: Pointer): Integer;
begin
  Result := 0;
  repeat
    Inc(Result);
  until (GetVMTAddress(AClass, Result) = MethodAddr);
end;

// Замена метода в VMT на другой, с учетом BPL. Op: флаги vmr*
function VMTReplace(AClass: TClass; Old, New: Pointer; Op: Byte = 0): Pointer;
var
  i: Integer;
begin
  Result := nil;
  if (Old = nil) or (New = nil) then Exit;
  // обработка таблицы импорта bpl (JMP [vmt_item])
  if Word(Old^) = $25FF then begin
    Inc(Integer(Old), 2);
    Result := VMTReplace(AClass, PPointer(Old^)^, New);  // vmt
    if (Result <> nil) and (Op and vmrImport <> 0) then
      ReplaceCodePtr(PPointer(Old^), New);                // import
  end else begin
    if (Op and vmrSign <> 0) and (Integer(Old^) = Integer(New^)) then Exit;
    i := FindVMTIndex(AClass, Old);
    if i <= 0 then Exit;
    Result := Old;
    SetVMTAddress(AClass, i, New)
  end;
end;
 

Замена динамических методов

Динамические методы используются для обработки событий Windows. Поскольку идентификация идет по индексу, то меньше проблем с учетом bpl (хотя статические ссылки всеравно могут быть). Поиск осуществляется практически стандартным методом (далее слегка модифицированный код из System). Замена - так же как и для VMT.

function GetDynaPMethod(vmt: TClass; AIndex: SmallInt): PPointer;
asm
  { ->    EAX    vmt of class            }
  {      DX      dynamic method index    }
  { <-    EAX pointer to routine  }
  {      ZF = 0 if found        }

        PUSH    EDI
        PUSH    EBX
        MOV    EBX,EDX
        XCHG    EAX,EBX
        JMP    @@haveVMT
@@outerLoop:
        MOV    EBX,[EBX]
@@haveVMT:
        MOV    EDI,[EBX].vmtDynamicTable
        TEST    EDI,EDI
        JE      @@parent
        MOVZX  ECX,word ptr [EDI]
        PUSH    ECX
        ADD    EDI,2
        REPNE  SCASW
        JE      @@found
        POP    ECX
@@parent:
        MOV    EBX,[EBX].vmtParent
        TEST    EBX,EBX
        JNE    @@outerLoop
        XOR    EAX, EAX
        JMP    @@exit

@@found:
        POP    EAX            {dyna method count}
        ADD    EAX,EAX        {* 2}
        SUB    EAX,ECX        { this will always clear the Z-flag ! }
        //MOV    EAX,[EDI+EAX*2-4]
        ADD    EAX, EAX
        SUB    EAX, 4
        ADD    EAX, EDI

@@exit:
        POP    EBX
        POP    EDI
end;

function GetDynaMethod(vmt: TClass; AIndex: SmallInt): Pointer;
begin
  Result := GetDynaPMethod(vmt, AIndex);
  if Result <> nil then Result := PPointer(Result)^;
end;

function SetDynaMethod(AClass: TClass; AIndex: SmallInt;
  NewAddress: Pointer): Pointer;
var
  pp: PPointer;
begin
  pp := GetDynaPMethod(AClass, AIndex);
  Result := ReplaceCodePtr(pp, NewAddress);
end;
 

Пример

var
  OldLVWMNotify: Pointer;

procedure LVWMNotify(Obj: TCustomListView; var Message: TMessage);
var
  Old: TWndMethod;
  NMHDispInfo: PNMHDispInfoW;
begin
  if TWMNotify(Message).NMHdr^.code = HDN_GETDISPINFOW then
  begin
    NMHDispInfo := Pointer(Message.LParam);
    // чтобы вернулась нормальная ссылка, а не мусор
    NMHDispInfo.pszText := nil;
  end;
  TMethod(Old).Code := OldLVWMNotify;
  TMethod(Old).Data := Obj;
  Old(Message);
end;

procedure LVWMNotifyFix;
asm
  DD $90909090
  JMP LVWMNotify
end;

initialization
  OldLVWMNotify := GetDynaMethod(TCustomListView, SmallInt(WM_NOTIFY));
  if (OldLVWMNotify <> nil) and (Cardinal(OldLVWMNotify^) <> $90909090) then
    SetDynaMethod(TCustomListView, SmallInt(WM_NOTIFY), @LVWMNotifyFix)
  else
    OldLVWMNotify := nil;
finalization
  if OldLVWMNotify <> nil then
    SetDynaMethod(TCustomListView, SmallInt(WM_NOTIFY), OldLVWMNotify);
end.