Delphi World - Перехват функции в собственном приложении
Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей  по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
Перехват функции в собственном приложении

Оформил: DeeCo
Автор: http://www.swissdelphicenter.ch

type
   TSaveRedir = packed record
     Addr: Pointer;
     Bytes: array[0..4] of Byte;
   end;
   PSaveRedir = ^TSaveRedir;

 procedure RedirectCall(FromAddr, ToAddr: Pointer; SaveRedir: PSaveRedir);
 var
   OldProtect: Cardinal;
   NewCode: packed record
     JMP: Byte;
     Distance: Integer;
   end;
 begin
   if not VirtualProtect(FromAddr, 5, PAGE_EXECUTE_READWRITE, OldProtect) then
     RaiseLastWin32Error;
   if Assigned(SaveRedir) then
   begin
     SaveRedir^.Addr := FromAddr;
     Move(FromAddr^, SaveRedir^.Bytes, 5);
   end;
   NewCode.JMP := $E9;
   NewCode.Distance := PChar(ToAddr) - PChar(FromAddr) - 5;
   Move(NewCode, FromAddr^, 5);
   if not VirtualProtect(FromAddr, 5, OldProtect, OldProtect) then
     RaiseLastWin32Error;
 end;

 procedure UndoRedirectCall(const SaveRedir: TSaveRedir);
 var
   OldProtect: Cardinal;
 begin
   if not VirtualProtect(SaveRedir.Addr, 5, PAGE_EXECUTE_READWRITE, OldProtect) then
     RaiseLastWin32Error;
   Move(SaveRedir.Bytes, SaveRedir.Addr^, 5);
   if not VirtualProtect(SaveRedir.Addr, 5, OldProtect, OldProtect) then
     RaiseLastWin32Error;
 end;


 // Example: Replace Application.MessageBox with your own. 

function MyNewMessageBox(Self: TApplication; const Text, Caption: PChar;
   Flags: Longint): Integer;
 begin
   ShowMessage('New Messagebox');
   //.... 
end;

 procedure TForm1.Button1Click(Sender: TObject);
 begin
   Application.MessageBox('You'll never see this Text /
     Diesen Text wirst du nie sehen'', '...', MB_OK);
 end;

 var
   S: TSaveRedir;

 initialization
   RedirectCall(@TApplication.MessageBox, @MyNewMessageBox, @S);

 finalization
   UndoRedirectCall(S);
Проект Delphi World © Выпуск 2002 - 2017
Автор проекта: Эксклюзивные курсы программирования