[HaBo]

procedure PatchIAT(strMod : Pchar; Alt, Neu : Pointer);
var
pImportDir : pImage_Import_Descriptor;
size : CardinaL;
Base : Cardinal;
pThunk : PDWORD;
bw : Cardinal;
begin
Base := GetModuleHandle(0);
pImportDir := ImageDirectoryEntryToData(Pointer(Base),True,IMAGE_DIRECTORY_ENTRY_IMPORT,size);
while pImportDIr^.Name <> 0 Do begin
  If (lstrcmpiA(Pchar(pImportDir^.Name+ Base),strMod) = 0) then begin
    pThunk := PDWORD(Base + pImportDir^.FirstThunk);
    While pThunk^ <> 0 Do begin
      if DWORD(Alt) = pthunk^ Then begin
        //pthunk^ :=  Cardinal(Neu);
        VirtualProtectEx(GetCurrentProcess,pthunk,4,PAGE_EXECUTE_READWRITE,bw);
        WriteProcessMemory(GetCurrentProcess, pthunk, @Neu, sizeof(Neu), bw);
      end;
    Inc(pThunk);
    end;
  end;
  Inc(PImportDir);
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
pOldMessageBoxA := GetProcAddress(GetModuleHAndle('user32.dll'),'MessageBoxA'); //alte Adresse speichern
PatchIat('user32.dll',GetProcAddress(GetModuleHAndle('user32.dll'),'MessageBoxA'),@NewMessageBoxA);
end;

function newMessageBoxA(hWnd: HWND; lpText, lpCaption: PAnsiChar; uType: UINT): Integer; stdcall;
var
myMesBoxA : function(hWnd: Cardinal; lpText, lpCaption: PAnsiChar; uType: UINT): Integer;stdcall;
begin
If lpText = 'DD2' Then begin
  myMesBoxA := pOldMessageBoxA;
  myMEsBoxA(hwnd,lptext,lpCaption,uType);
end else begin
  Form1.Button1.Caption := 'keine MSGBOX!';
end;
end;