Sources
Delphi Russian Knowledge Base
DRKB - это самая большая и удобная в использовании база знаний по Дельфи в рунете, составленная Виталием Невзоровым

Перехват API функций на примере MessageBoxA

01.01.2007

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(reson:longint);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.

Автор: Song

Взято из https://forum.sources.ru