Перехват API функций , на примере MessageBoxA и клавиатурного шпиона

DLL:

library Mouse_mes;
 
uses
  sysutils,
  windows,
  messages;
 
type
   TImageImportDescriptor=packed record
    OriginalFirstThunk    : DWORD;
    TimeDateStamp         : DWORD;
    ForwarderChain        : DWORD;
    Name                  : DWORD;
    FirstThunk            : DWORD;
  end;
  PImageImportDescriptor=^TImageImportDescriptor;
 
var filename:array[0..max_path-1] of char;
    hook:HHook=0;
    PEHeader:PImageNtHeaders;
    ImageBase:cardinal;
 
function MyHookProcedure(hWnd: HWND; lpText, lpCaption: PWideChar; uType: UINT): Integer;
stdcall;
begin
  result:=MessageBoxA(0, 'Notepad', 'my hook', 0);
  //Но уже через нашу табл. импорта
end;
 
procedure ProcessImports(PImports:PImageImportDescriptor);
    Var
        PImport:PImageImportDescriptor;
        PRVA_Import:LPDWORD;
        ProcAddress:pointer;
        Temp_Cardinal:cardinal;
    begin{1}
      ProcAddress:=GetProcAddress(GetModuleHandle('USER32.DLL'), 'MessageBoxA');
      PImport:=PImports;
      while PImport.Name<>0 do
        begin{2}
          PRVA_Import:=LPDWORD(pImport.FirstThunk+ImageBase);
          while PRVA_Import^<>0 do
          begin{3}
            if PPointer(PRVA_Import)^=ProcAddress
               then
                 begin{4}
                   VirtualProtect(PPointer(PRVA_Import),4,PAGE_READWRITE,Temp_Cardinal);
                   PPointer(PRVA_Import)^:=@MyHookProcedure; //пишем свою...
                   VirtualProtect(PPointer(PRVA_Import),4,Temp_Cardinal,Temp_Cardinal);
                 end;{1}
            Inc(PRVA_Import);
          end;{2}
       Inc(PImport);
   end;{3}
end;{4}
 
procedure DLLEntryPoint(dwReason: DWORD); //stdcall;  <- вот это как раз не нужно...
begin
 case reson of
  DLL_PROCESS_ATTACH:
     begin
      DisableThreadLibraryCalls(hInstance);
      ZeroMemory(@FileName, SizeOf(FileName));
      GetModuleFileName(GetModuleHandle(nil), @FileName, SizeOf(FileName));
 
         if Pos('NOTEPAD.EXE',AnsiUpper(@FileName))<>0 then //сейчас я хочу попробовать все это дело надо  нотепадом
          begin
           ImageBase:=GetModuleHandle(nil);
           PEHeader:=pointer(int64(ImageBase)+PImageDosHeader(ImageBase)._lfanew);//pe header
           ProcessImports(pointer(PEHeader.OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_IMPORT].VirtualAddress+ImageBase));
          end;
      end;
  end;
end;
 
function nexthook(code:integer;wParam,lParam:longint):longint;stdcall;
begin
  result:=callnexthookex(hook,code,wParam,lParam);
end;
 
procedure sethook(flag:bool);export; stdcall;
begin
 if flag then
    hook:=setwindowshookex(wh_getmessage,@nexthook,hInstance,0)
 else
   begin
    unhookwindowshookex(hook);
    hook:=0;
   end;
end;
 
exports sethook;
 
begin
DLLProc:=@DllEntryPoint;
DllEntryPoint(DLL_PROCESS_ATTACH)
end.

EXE:

program Project2;
uses windows;
 
var
   sethook:procedure(flag:bool)stdcall;
   hDll:hModule;
 
begin
  hDll:=LoadLibrary('Mouse_mes.dll');
 
  @sethook:=GetProcAddress(hDll, 'sethook');
 
  sethook(true);
  messagebox(0,'Не закрывай, пока идет работа','',0);
  sethook(false);
  FreeLibrary(hDll);
 
end.

Автор ответа - © xZero

////////////////////////////////////////////////////////////////////////////////
//
//  Демонстрационная программа перехвата вызова API функций
//  Автор: Джеффри РИХТЕР
//  Адаптация для Delphi: Александр (Rouse_) Багель
//
 
unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;
 
type
 
  TMessageBox = function(hWnd: HWND; lpText, lpCaption:
    PChar; uType: UINT): Integer; stdcall;
 
  PFARPROC = ^FARPROC;
 
  TIIDUnion = record
    case Integer of
      0: (Characteristics: DWORD);
      1: (OriginalFirstThunk: DWORD);
  end;
 
  PImageImportDescriptor = ^TImageImportDescriptor;
  TImageImportDescriptor = record
    Union: TIIDUnion;
    TimeDateStamp: DWORD;
    ForwarderChain: DWORD;
    Name: DWORD;
    FirstThunk: DWORD;
  end;
 
  PImageThunkData = ^TImageThunkData32;
  TImageThunkData32 = packed record
    _function : PDWORD;
  end;
 
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    procedure ReplaceIATEntryInOneMod(const OldProc, NewProc: FARPROC);
    procedure SetAPIHook;
    procedure ResetAPIHook;
  end;
 
  {$EXTERNALSYM ImageDirectoryEntryToData}
  function ImageDirectoryEntryToData(Base: Pointer; MappedAsImage: ByteBool;
    DirectoryEntry: Word; var Size: ULONG): Pointer; stdcall; external 'imagehlp.dll';
 
  {$EXTERNALSYM HookMessageBox}
  function HookMessageBox(hWnd: HWND; lpText, lpCaption: PChar;
    uType: UINT): Integer; stdcall;
 
var
  Form1: TForm1;
 
var
  OldMessageBox: FARPROC = nil;
  CurrentMessageBox: FARPROC;
 
implementation
 
{$R *.dfm}
 
// Перехват API посредством подмены в таблице импорта
procedure TForm1.ReplaceIATEntryInOneMod(const OldProc,
  NewProc: FARPROC);
var
  Size: DWORD;
  ImportEntry: PImageImportDescriptor;
  Thunk: PImageThunkData;
  Protect, newProtect: DWORD;
  DOSHeader: PImageDosHeader;
  NTHeader: PImageNtHeaders;
begin
  if OldProc = nil then Exit;
  if NewProc = nil then Exit;
 
   // Можно искать вот так
  ImportEntry := ImageDirectoryEntryToData(Pointer(hInstance), BOOL(1),
    IMAGE_DIRECTORY_ENTRY_IMPORT, Size);
 
  // Или вот так
  {DOSHeader := PImageDosHeader(hInstance);
  if IsBadReadPtr(Pointer(hInstance), SizeOf(TImageNtHeaders)) then Exit;
  if (DOSHeader^.e_magic <> IMAGE_DOS_SIGNATURE) then Exit;
  NTHeader := PImageNtHeaders(DWORD(DOSHeader) + DWORD(DOSHeader^._lfanew));
  if NTHeader^.Signature <> IMAGE_NT_SIGNATURE then Exit;
  ImportEntry := PImageImportDescriptor(DWORD(hInstance) +
      DWORD(NTHeader^.OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_IMPORT].VirtualAddress));
  if DWORD(ImportEntry) = DWORD(NTHeader) then Exit;  }
 
  if ImportEntry <> nil then
  begin
    while ImportEntry^.Name <> 0 do
    begin
        Thunk := PImageThunkData(DWORD(hInstance) +
          DWORD(ImportEntry^.FirstThunk));
        while Thunk^._function <> nil do
        begin
          if (Thunk^._function = OldProc) then
          begin
            if not IsBadWritePtr(@Thunk^._function, sizeof(DWORD)) then
              Thunk^._function := NewProc
            else
            begin
 
              if VirtualProtect(@Thunk^._function, SizeOf(DWORD),
                PAGE_EXECUTE_READWRITE, Protect) then
              begin
                Thunk^._function := NewProc;
                newProtect := Protect;
                VirtualProtect(@Thunk^._function, SizeOf(DWORD),
                  newProtect, Protect);
              end;
            end;
          end
          else
            Inc(PChar(Thunk), SizeOf(TImageThunkData32));
        end;
      ImportEntry := Pointer(Integer(ImportEntry) + SizeOf(TImageImportDescriptor));
    end;
  end;
end;
 
function HookMessageBox(hWnd: HWND; lpText, lpCaption: PChar; uType: UINT): Integer; stdcall;
begin
  Result := TMessageBox(OldMessageBox)(hWnd,
    PChar(Format('Перехвачен текст: "%s"', [lpText])),
    PChar(Format('Перехвачен текст: "%s"', [lpCaption])), uType);
end;
 
// Снятие хука
procedure TForm1.ResetAPIHook;
begin
  ReplaceIATEntryInOneMod(CurrentMessageBox, OldMessageBox);
end;
 
// Установка хука
procedure TForm1.SetAPIHook;
begin
  OldMessageBox :=
    GetProcAddress(GetModuleHandle('User32.dll'), 'MessageBoxA');
  CurrentMessageBox := @HookMessageBox;
  ReplaceIATEntryInOneMod(OldMessageBox, CurrentMessageBox);
end;
 
////////////////////////////////////////////////////////////////////////////////
 
procedure TForm1.Button1Click(Sender: TObject);
begin
  MessageBox(0, 'Текст сообщения', 'Заголовок', 0);
end;
 
procedure TForm1.Button2Click(Sender: TObject);
begin
  SetAPIHook;
  MessageBox(0, 'Текст сообщения', 'Заголовок', 0);
  ResetAPIHook;
end;
 
end.

Автор: Rouse_

Вот пример библиотеки для клавиатурного шпиона, где показан правильный принцип - общие данные держаться в MMF:

////////////////////////////////////////////////////////////////////////////////
//
//  ****************************************************************************
//  * Unit Name : HookDLL
//  * Purpose   : Демонстрационный пример клавиатурного шпиЁна... :)
//  * Author    : Александр (Rouse_) Багель
//  * Version   : 1.00
//  ****************************************************************************
//
library HookDLL;
 
uses
  Windows,
  Messages,
  SysUtils;
 
const
  GlobMapID = 'Global Keyboard Hook Demo {917C91AA-88D5-4134-BB91-15161728594D}';
 
type
  PShareInf = ^TShareInf;
  TShareInf = record  
    AppWndHandle: HWND;
    OldHookHandle: HHOOK;
    hm:THandle;
  end;
 
var
  MapHandle: THandle = 0;
  ShareInf: PShareInf = nil;
  ptr:PByteArray;
 
procedure DLLEntryPoint(dwReason: DWORD); //stdcall;  <- вот это как раз не нужно...
begin
  case dwReason Of
    DLL_PROCESS_ATTACH:
    begin
      // Все данные во избежании разрыва цепочки хуков храним в отображаемом в память процесса файле,
      // только тогда все экземпляры хука будут владеть достоверной информацией
      MapHandle:=CreateFileMapping(INVALID_HANDLE_VALUE, nil, PAGE_READWRITE, 0, SizeOf(TShareInf), GlobMapID);
      ShareInf:=MapViewOfFile(MapHandle, FILE_MAP_ALL_ACCESS, 0, 0, SizeOf(TShareInf));
    end;
    DLL_PROCESS_DETACH:
    begin
      UnMapViewOfFile(ShareInf);
      CloseHandle(MapHandle);
    end;
  end;
end;
 
function KeyboardHook(Code: Integer; WParam: WPARAM; LParam: LPARAM): LRESULT;stdcall;
begin
  if Code in [HC_ACTION, HC_NOREMOVE] then
    SendMessage(ShareInf^.AppWndHandle, WM_USER, WParam, Code); // нотифицируем наше приложение о нажатии клавиши
  Result := CallNextHookEx(ShareInf^.OldHookHandle, Code, WParam, LParam); // вызываем след. ловушку
end;
 
function SetKeyboardHook(Wnd: HWND): BOOL; stdcall;
begin
  if ShareInf <> nil then
  begin
    ShareInf^.AppWndHandle := Wnd;
    ShareInf^.OldHookHandle := SetWindowsHookEx(WH_KEYBOARD, @KeyboardHook, HInstance, 0); // <- Обратите внимание, не допускаем главной ошибки
    Result:=ShareInf^.OldHookHandle <> 0;
  end
  else
    Result:=False;
end;
 
function RemoveKeyboardHook: BOOL; stdcall;
begin
  Result := UnhookWindowsHookEx(ShareInf^.OldHookHandle);
  CloseHandle(ShareInf^.hm);
end;
 
exports
  SetKeyboardHook, RemoveKeyboardHook;
 
begin
  DLLProc := @DLLEntryPoint;
  DLLEntryPoint(DLL_PROCESS_ATTACH);
end.

Приложение:

////////////////////////////////////////////////////////////////////////////////
//
//  ****************************************************************************
//  * Unit Name : HookDemo
//  * Purpose   : Демонстрационный пример клавиатурного шпиЁна... :)
//  * Author    : Александр (Rouse_) Багель
//  * Version   : 1.00
//  ****************************************************************************
//
unit HookDemo;
 
interface
 
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;
 
type
  TMainForm = class(TForm)
    Memo1: TMemo;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  public
   procedure WMUser(var Message: TMessage); message WM_USER;
  end;
 
  function SetKeyboardHook(Wnd: HWND): BOOL; stdcall;
    external 'HookDLL.dll' name 'SetKeyboardHook';
  function RemoveKeyboardHook: BOOL; stdcall;
    external 'HookDLL.dll' name 'RemoveKeyboardHook';
 
var
  MainForm: TMainForm;
 
implementation
 
{$R *.dfm}
 
procedure TMainForm.WMUser(var Message: TMessage);
begin
  Memo1.Lines.Add('Code: ' + IntToStr(Message.WParam) + ': ' + Chr(Message.WParam));
end;
 
procedure TMainForm.FormCreate(Sender: TObject);
begin
  if not SetKeyboardHook(Handle) Then
    MessageBox(Handle, 'Unable to set hook', PChar(Application.Title), MB_OK OR MB_ICONHAND);
end;
 
procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  if not RemoveKeyboardHook Then
    MessageBox(Handle, 'Unable to remove hook', PChar(Application.Title), MB_OK OR MB_ICONHAND);
end;

Автор: Rouse_