Перехват вызовов функций из динамических библиотек

// проверено и работает для WIN 9x и WinNT // в юните на первый взгляд, есть структуры , описание которых уже есть в Дельфи , но к сожалению не
// всех и не во всех версиях Дельфи эти структуры присутствуют. Да уж, это не С

Проблема скорее для хакера, а не для программиста. Но существуют ситуации, когда это необходимо. Сложно предположить ситуацию, в которой это может понадобится, но например: можете перехватывать надоевшее окошко о необходимости купить компонент :) . Разумеется этот код предназначен для более широких целей и в более широком варианте позволяет контролировать работу внешней программы, производя "мягкий" взлом - изменения присходят только в памяти и не касаются исполняемого файла на диске. Разумеется можно использовать и для более светлых целей. При использовании данного исходника будьте осторожны: при компилировании пректа с динамическими пакетами перехватываемая функция может находится в пакете, а не в файле программы. Перед перехватом функции необходимо заменить её функцией-ловушкой. Например для MessageBox

type


TMyProc= function
 (hWnd: HWND; lpText, lpCaption: 
  PAnsiChar; uType: UINT): Integer; stdcall
;
PTMyProc=^TMyProc;

function
 MyMessageBox(hWnd: HWND; lpText, lpCaption: 
  PAnsiChar; uType: UINT): Integer; stdcall
;
begin

  ShowMessage('Message intercepted');
  result:=IDOK;
end
;

и сам перехват происходит так

InterceptDllCall(hInstance,'user32.dll','MessageBoxA',
Pointer(@MyMessageBox),PPointer(@myProc),nil
); 

теперь все вызовы MessageBox будут ссылаться на нашу функцию :) Надеюсь вы помните, что функции MessageBox в user32.dll нет - это только оболочка для MessageBoxА

и обратная операция - восстановление работоспособности старой функции

InterceptDllCall(hInstance,'user32.dll','MessageBoxA',
Pointer(myProc),nil
,Pointer(@MyMessageBox)); 

Привожу полностью все файлы проекта:

// Intercep.pas

unit
 intercep;

interface

uses
 windows, dialogs, SysUtils;
type


  PImageDosHeader = ^TImageDosHeader;
  {EXTERNALSYM _IMAGE_DOS_HEADER}
  _IMAGE_DOS_HEADER = packed
 record
 { DOS .EXE header                  }
    e_magic: Word; { Magic number                     }
    e_cblp: Word; { Bytes on last page of file       }
    e_cp: Word; { Pages in file                    }
    e_crlc: Word; { Relocations                      }
    e_cparhdr: Word; { Size of header in paragraphs     }
    e_minalloc: Word; { Minimum extra paragraphs needed  }
    e_maxalloc: Word; { Maximum extra paragraphs needed  }
    e_ss: Word; { Initial (relative) SS value      }
    e_sp: Word; { Initial SP value                 }
    e_csum: Word; { Checksum                         }
    e_ip: Word; { Initial IP value                 }
    e_cs: Word; { Initial (relative) CS value      }
    e_lfarlc: Word; { File address of relocation table }
    e_ovno: Word; { Overlay number                   }
    e_res: array
[0..3] of
 Word; { Reserved words                   }
    e_oemid: Word; { OEM identifier (for e_oeminfo)   }
    e_oeminfo: Word; { OEM information; e_oemid specific}
    e_res2: array
[0..9] of
 Word; { Reserved words                   }
    e_lfanew: LongInt; { File address of new exe header   }
  end
;
  TImageDosHeader = _IMAGE_DOS_HEADER;
  //  {$EXTERNALSYM IMAGE_DOS_HEADER}

  IMAGE_DOS_HEADER = _IMAGE_DOS_HEADER;

  //***************************************
  PImageDataDirectory = ^TImageDataDirectory;
  _IMAGE_DATA_DIRECTORY = record

    VirtualAddress: DWORD;
    Size: DWORD;
  end
;
  //  {$EXTERNALSYM _IMAGE_DATA_DIRECTORY}
  TImageDataDirectory = _IMAGE_DATA_DIRECTORY;
  IMAGE_DATA_DIRECTORY = _IMAGE_DATA_DIRECTORY;
  //  {$EXTERNALSYM IMAGE_DATA_DIRECTORY}

  //*************
  PImageOptionalHeader = ^TImageOptionalHeader;
  _IMAGE_OPTIONAL_HEADER = packed
 record

    { Standard fields. }
    Magic: Word;
    MajorLinkerVersion: Byte;
    MinorLinkerVersion: Byte;
    SizeOfCode: DWORD;
    SizeOfInitializedData: DWORD;
    SizeOfUninitializedData: DWORD;
    AddressOfEntryPoint: DWORD;
    BaseOfCode: DWORD;
    BaseOfData: DWORD;
    { NT additional fields. }
    ImageBase: DWORD;
    SectionAlignment: DWORD;
    FileAlignment: DWORD;
    MajorOperatingSystemVersion: Word;
    MinorOperatingSystemVersion: Word;
    MajorImageVersion: Word;
    MinorImageVersion: Word;
    MajorSubsystemVersion: Word;
    MinorSubsystemVersion: Word;
    Win32VersionValue: DWORD;
    SizeOfImage: DWORD;
    SizeOfHeaders: DWORD;
    CheckSum: DWORD;
    Subsystem: Word;
    DllCharacteristics: Word;
    SizeOfStackReserve: DWORD;
    SizeOfStackCommit: DWORD;
    SizeOfHeapReserve: DWORD;
    SizeOfHeapCommit: DWORD;
    LoaderFlags: DWORD;
    NumberOfRvaAndSizes: DWORD;
    DataDirectory: packed
 array
[0..IMAGE_NUMBEROF_DIRECTORY_ENTRIES - 1] of

      TImageDataDirectory;
  end
;
  // {$EXTERNALSYM _IMAGE_OPTIONAL_HEADER}
  TImageOptionalHeader = _IMAGE_OPTIONAL_HEADER;
  IMAGE_OPTIONAL_HEADER = _IMAGE_OPTIONAL_HEADER;
  // {$EXTERNALSYM IMAGE_OPTIONAL_HEADER}

  PImageNtHeaders = ^TImageNtHeaders;
  _IMAGE_NT_HEADERS = packed
 record

    Signature: DWORD;
    FileHeader: TImageFileHeader;
    OptionalHeader: TImageOptionalHeader;
  end
;
  // {$EXTERNALSYM _IMAGE_NT_HEADERS}
  TImageNtHeaders = _IMAGE_NT_HEADERS;
  IMAGE_NT_HEADERS = _IMAGE_NT_HEADERS;
  // {$EXTERNALSYM IMAGE_NT_HEADERS}

  PImage_import_by_name = ^TImage_import_by_mame;
  _IMAGE_IMPORT_BY_NAME = packed
 record


    Hint: Word;
    Name: Byte;
  end
;
  TImage_import_by_mame = _IMAGE_IMPORT_BY_NAME;

  _u1 = packed
 record

    case
 Integer of


      0: (ForwarderString: PByte);
      1: (Functionn: PDWORD);
      2: (Ordinal: DWORD);
      3: (AddressOfData: PImage_import_by_name);
  end
;
  PImageThunkData = ^TImageThunkData;
  _IMAGE_THUNK_DATA = packed
 record


    u1: _u1;
  end
;
  TImageThunkData = _IMAGE_THUNK_DATA;
  IMAGE_THUNK_DATA = _IMAGE_THUNK_DATA;

  _temp_charcteristics = record

    case
 Integer of

      0: (Characteristics: DWORD); // 0 for terminating null import descriptor
      1: (OriginalFirstThunk: PImageThunkData); // RVA to original unbound IAT
  end
;

  PImageImportDescriptor = ^TImageImportDescriptor;
  _IMAGE_IMPORT_DESCRIPTOR = packed
 record


    t: _temp_charcteristics;
    TimeDateStamp: DWord; // 0 if not bound,
    // -1 if bound, and real date	ime stamp
    //     in IMAGE_DIRECTORY_ENTRY_BOUND_IMPORT (new BIND)
    // O.W. date/time stamp of DLL bound to (Old BIND)

    ForwarderChain: DWORD; // -1 if no forwarders
    Name: DWORD;
    FirstThunk: PImageThunkData;
      // RVA to IAT (if bound this IAT has actual addresses)
  end
;
  TImageImportDescriptor = _IMAGE_IMPORT_DESCRIPTOR;
  IMAGE_IMPORT_DESCRIPTOR = _IMAGE_IMPORT_DESCRIPTOR;
  PPointer = ^Pointer;
function
 InterceptDllCall(

  hLocalModule: HModule;
  c_szDllName: Pchar;
  c_szApiName: PChar;
  pApiNew: Pointer;
  p_pApiOrg: PPointer;
  pApiToChange: Pointer): Boolean;
implementation


function
 MakePtr(base: Dword; Offset: DWORD): Pointer;
begin

  Result := Pointer(Base + Offset);
end
;

function
 InterceptDllCall(

  hLocalModule: HModule;
  c_szDllName: Pchar;
  c_szApiName: PChar;
  pApiNew: Pointer;
  p_pApiOrg: PPointer;
  pApiToChange: Pointer): Boolean;

var

  pDosHeader: PImageDosHeader;

  pNtHeader: PImageNtHeaders;
  PImportDesc: PImageImportDescriptor;
  dwProtect: DWORD;
  dwNewProtect: DWORD;
  dwAddressToInterCept: DWORD;
  pThunk: PImageThunkData;
begin

  pDosHeader := PImageDosHeader(hLocalModule);
  Result := False
;
  if
 (pApiToChange <> nil
) then

    dwAddressToIntercept := DWORD(pApiToChange)
  else

    dwAddressToIntercept := Dword(GetProcAddress(GetModuleHandle(c_szDllName),
      c_szApiName));

  if
 IsBadReadPtr(Pointer(hLocalModule), sizeof(PImageNtHeaders)) then

    Exit;

  if
 pDosHeader.e_magic <> IMAGE_DOS_SIGNATURE then

    exit;
  pNtHeader := PImageNtHeaders(MakePtr(DWord(pDOSHeader),
    DWord(pDOSHeader.e_lfanew)));
  if
 pNTHeader.signature <> IMAGE_NT_SIGNATURE then

    exit;
  pImportDesc := PImageImportDescriptor(

    MakePtr(hLocalModule,
    pNtHeader.OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_IMPORT].VirtualAddress));

  if
 (PImportDesc = PImageImportDescriptor(pNtHeader)) then

    exit;

  while
 (pImportDesc.Name > 0) do

  begin


    pThunk := PImageThunkData(MakePtr(DWord(hLocalModule),
      Dword(pImportDesc.FirstThunk)));
    while
 (pThunk.u1.Functionn <> nil
) do

    begin

      if
 DWord(pThunk.u1.Functionn) = dwAddressToIntercept then

      begin

        if
 not
 IsBadWritePtr(Pointer(@pThunk.u1.Functionn), sizeof(DWORD)) then

        begin

          if
 (p_pApiOrg <> nil
) then

            p_pApiOrg^ := Pointer(pThunk.u1.Functionn);
          pThunk.u1.Functionn := pApiNew;
          Result := True
;
        end

        else

        begin

          if
 VirtualProtect(Pointer(@pThunk.u1.Functionn), sizeof(DWORD),
            PAGE_EXECUTE_READWRITE, @dwProtect) then

          begin

            if
 (p_pApiOrg <> nil
) then

              p_pApiOrg^ := Pointer(pThunk.u1.Functionn);
            pThunk.u1.Functionn := PDWORD(pApiNew);
            Result := True
;
            dwNewProtect := dwProtect;
            VirtualProtect(Pointer(@pThunk.u1.Functionn), sizeof(DWORD),
              dwNewProtect, @dwProtect);
          end
;
        end
;
      end
;
      Inc(PThunk);
    end
;
    Inc(pImportDEsc);
  end
;
end
;

end
.

// Project1.dpr

program
 Project1;

uses

  Forms,
  Unit1 in
 '....WorkTemp4Unit1.pas' {Form1};

{$R *.RES}

begin


  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end
.

// Unit1.dfm

object
 Form1: TForm1

  Left = 192
    Top = 107
    Width = 435
    Height = 300
    Caption = 'Form1'
    Color = clBtnFace
    Font.Charset = DEFAULT_CHARSET
    Font.Color = clWindowText
    Font.Height = -11
    Font.Name = 'MS Sans Serif'
    Font.Style = []
    OldCreateOrder = False

    PixelsPerInch = 96
    TextHeight = 13
    object
 Button1: TButton
    Left = 72
      Top = 176
      Width = 273
      Height = 65
      Caption = 'Begin'
      Font.Charset = DEFAULT_CHARSET
      Font.Color = clWindowText
      Font.Height = -24
      Font.Name = 'MS Sans Serif'
      Font.Style = []
      ParentFont = False

      TabOrder = 0
      OnClick = Button1Click
  end

  object
 Button2: TButton
    Left = 304
      Top = 16
      Width = 105
      Height = 49
      Caption = 'MessageBox'
      TabOrder = 1
      OnClick = Button2Click
  end

end


// Unit1.pas

unit
 Unit1;

interface


uses


  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, intercep;

type


  TMyProc = function
(hWnd: HWND; lpText, lpCaption: PAnsiChar; uType: UINT):
    Integer; stdcall
;
  PTMyProc = ^TMyProc;

  TForm1 = class
(TForm)
    Button1: TButton;
    Button2: TButton;
    procedure
 Button1Click(Sender: TObject);
    procedure
 Button2Click(Sender: TObject);
  private

    { Private declarations }
  public

    { Public declarations }
  end
;

var


  Form1: TForm1;
  myProc: PTMyProc;
implementation


function
 MyMessageBox(hWnd: HWND; lpText, lpCaption: PAnsiChar; uType: UINT):
  Integer; stdcall
;
begin

  ShowMessage('Message intercepted');

  result := IDOK;
end
;
{$R *.DFM}

procedure
 TForm1.Button1Click(Sender: TObject);

begin

  myProc := nil
;
  MessageBox(0, 'Hello', 'Message 1', MB_OK);
  InterceptDllCall(hInstance, 'user32.dll', 'MessageBoxA',
    Pointer(@MyMessageBox), PPointer(@myProc), nil
); //then ShowMessage('Ok');
  MessageBox(0, 'Hello', 'Message 2', MB_OK);
  InterceptDllCall(hInstance, 'user32.dll', 'MessageBoxA',
    Pointer(myProc), nil
, Pointer(@MyMessageBox));
  MessageBox(0, 'Hello', 'Message 3 ', MB_OK);
end
;

procedure
 TForm1.Button2Click(Sender: TObject);
begin

  MessageBox(0, 'Hello', 'Message 4 ', MB_OK);
end
;

end
.