Патч рутинного вызова в Delphi

Question

Я хочу исправить обычный вызов, чтобы иметь возможность обрабатывать его самостоятельно с некоторыми изменениями. Я пишу загрузчик ресурсов. Я хочу исправить патчи Delphi LoadResourceModule и InitInheritedComponent с моими. Я проверил вызов PatchAPI в модуле MadExcept.pas, но не смог выяснить, смогу ли я использовать его для своего проекта.

Я хочу что-то вроде

мой exe во время выполнения звонков -> LoadResourceModule -> перейти к -> MyCustomResourceModule...

Любые указатели на это были бы очень полезны.

Answer 1

Я использую следующий код:

procedure PatchCode(Address: Pointer; const NewCode; Size: Integer);
var
  OldProtect: DWORD;
begin
  if VirtualProtect(Address, Size, PAGE_EXECUTE_READWRITE, OldProtect) then 
  begin
    Move(NewCode, Address^, Size);
    FlushInstructionCache(GetCurrentProcess, Address, Size);
    VirtualProtect(Address, Size, OldProtect, @OldProtect);
  end;
end;

type
  PInstruction = ^TInstruction;
  TInstruction = packed record
    Opcode: Byte;
    Offset: Integer;
  end;

procedure RedirectProcedure(OldAddress, NewAddress: Pointer);
var
  NewCode: TInstruction;
begin
  NewCode.Opcode := $E9;//jump relative
  NewCode.Offset := NativeInt(NewAddress)-NativeInt(OldAddress)-SizeOf(NewCode);
  PatchCode(OldAddress, NewCode, SizeOf(NewCode));
end;

Вы могли бы реализовать свой крюк / патч / объезд, позвонив RedirectProcedure:

RedirectProcedure(@LoadResourceModule, @MyLoadResourceModule);

Это будет работать для 32-битного кода. Он также будет работать для 64-битного кода при условии, что и старая, и новая функции находятся в одном исполняемом модуле. В противном случае расстояние перехода может превысить диапазон 32-разрядного целого числа.

Мне было бы очень интересно, если бы кто-нибудь мог предоставить альтернативу, которая работала бы для 64-битного адресного пространства, независимо от того, насколько далеко друг от друга были адреса.

Answer 2

Для этого уже есть обходная библиотека Delphi.

Delphi Detours Library - это библиотека, позволяющая перехватывать функции API-интерфейсов Delphi и Windows. Она обеспечивает простой способ вставки и удаления перехватчиков.

Особенности:

• Поддержка архитектуры x86 и x64.
• Разрешить вызов оригинальной функции через функцию батута.
• Поддержка Multi Hook.
• Поддержка COM/ интерфейсов /win32api.
• Поддержка COM Vtable исправлений.
• Полностью поточно-ориентированный перехват и отсоединение кода.
• Поддержка метода подключения объекта.
• Поддерживается Delphi 7/2005-2010/XE-XE7 .
• Поддержка Lazarus / FPC.
• 64-битный адрес поддерживается.
• Библиотека не использует внешнюю библиотеку.
• Библиотека может вставлять и удалять крючки в любое время.
• Библиотека содержит библиотеку InstDecode, которая позволяет вам декодировать инструкции asm (x86 и x64).

Answer 3

Я изменил код Дэвида Хеффернана для 64-битной поддержки и косвенного перехода к методам в BPL. С некоторой помощью: http://chee-yang.blogspot.com.tr/2008/11/hack-into-delphi-class.html

type
  PAbsoluteIndirectJmp = ^TAbsoluteIndirectJmp;
  TAbsoluteIndirectJmp = packed record
    OpCode: Word;  // $FF25(Jmp, FF /4) 
    Addr: DWORD;  // 32-bit address
                  // in 32-bit mode: it is a direct jmp address to target method
                  // in 64-bit mode: it is a relative pointer to a 64-bit address used to jmp to target method
  end;

  PInstruction = ^TInstruction;
  TInstruction = packed record
    Opcode: Byte;
    Offset: Integer;
  end;


function GetActualAddr(Proc: Pointer): Pointer;
begin
  Result := Proc;
  if Result <> nil then
    if PAbsoluteIndirectJmp(Result)^.OpCode = $25FF then  // we need to understand if it is proc entry or a jmp following an address
{$ifdef CPUX64}
      Result := PPointer( NativeInt(Result) + PAbsoluteIndirectJmp(Result)^.Addr + SizeOf(TAbsoluteIndirectJmp))^;
      // in 64-bit mode target address is a 64-bit address (jmp qword ptr [32-bit relative address] FF 25 XX XX XX XX)
      // The address is in a loaction pointed by ( Addr + Current EIP = XX XX XX XX + EIP)
      // We also need to add (instruction + operand) size (SizeOf(TAbsoluteIndirectJmp)) to calculate relative address
      // XX XX XX XX + Current EIP + SizeOf(TAbsoluteIndirectJmp)
{$else}
      Result := PPointer(PAbsoluteIndirectJmp(Result)^.Addr)^;
      // in 32-bit it is a direct address to method
{$endif}
end;

procedure PatchCode(Address: Pointer; const NewCode; Size: Integer);
var
  OldProtect: DWORD;
begin
  if VirtualProtect(Address, Size, PAGE_EXECUTE_READWRITE, OldProtect) then //FM: remove the write protect on Code Segment
  begin
    Move(NewCode, Address^, Size);
    FlushInstructionCache(GetCurrentProcess, Address, Size);
    VirtualProtect(Address, Size, OldProtect, @OldProtect); // restore write protection
  end;
end;

procedure RedirectProcedure(OldAddress, NewAddress: Pointer);
var
  NewCode: TInstruction;
begin
  OldAddress := GetActualAddr(OldAddress); 

  NewCode.Opcode := $E9;//jump relative
  NewCode.Offset := NativeInt(NewAddress) - NativeInt(OldAddress) - SizeOf(NewCode);

  PatchCode(OldAddress, NewCode, SizeOf(NewCode));
end;