Советы по Delphi



         

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


/p>

Project1.dpr

program Project1;

uses Forms,Unit1 in '..\..\Work\Temp\4\Unit1.pas' {Form1};
{$R *.RES}

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

Unit1.dfm

object Form1: TForm1
Left = 192Top = 107Width = 435Height = 300Caption = 'Form1'Color = clBtnFaceFont.Charset = DEFAULT_CHARSETFont.Color = clWindowTextFont.Height = -11Font.Name = 'MS Sans Serif'Font.Style = []OldCreateOrder = FalsePixelsPerInch = 96TextHeight = 13object Button1: TButtonLeft = 72Top = 176Width = 273Height = 65Caption = 'Begin'Font.Charset = DEFAULT_CHARSETFont.Color = clWindowTextFont.Height = -24Font.Name = 'MS Sans Serif'Font.Style = []ParentFont = FalseTabOrder = 0OnClick = Button1Clickendobject Button2: TButtonLeft = 304Top = 16Width = 105Height = 49Caption = 'MessageBox'TabOrder = 1OnClick = Button2Clickendend

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.

[000807]




Содержание  Назад  Вперед