delphi 自定义消息拦截

1. 自定义消息拦截

unit UnitMessageHook;

interface

uses

Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,

Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;

const

{定义用于HOOK的消息，也可以是Windows的标准消息}

WM_TestMessage = WM_USER + 2000;

type

TForm1 = class(TForm)

btn1: TButton;

procedure FormCreate(Sender: TObject);

procedure btn1Click(Sender: TObject);

procedure FormDestroy(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.dfm}

var

HookHandle: HHOOK;

{Hook处理函数}

function MyFunctionHookPro(Code: Integer; WParam: LongInt; Msg: LongInt): LongInt; stdcall;

begin

if (Code = HC_ACTION) then

begin

if PMsg(Msg)^.message = WM_TestMessage then

begin

ShowMessage('已经截获该消息' + PChar(PMsg(Msg)^.WParam));

end;

Result := CallNextHookEx(HookHandle, Code, WParam, LongInt(@Msg));

end;

procedure TForm1.btn1Click(Sender: TObject);

var

msg: string;

begin

msg := 'Hello World!';

{发送特定消息}

PostMessage(Self.Handle, WM_TestMessage, Integer(PChar(mess)), 0);

end;

{挂钩}

procedure TForm1.FormCreate(Sender: TObject);

begin

HookHandle := SetWindowsHookEx(WH_GETMESSAGE, @MyFunctionHookPro, HInstance, GetCurrentThreadId);

end;

{摘钩}

procedure TForm1.FormDestroy(Sender: TObject);

begin

UnhookWindowsHookEx(HookHandle);

end;

end.

Copied!

以上代码会造成由于内存空间释放而产生乱码

优化代码如下

procedure Send();

var

mess: string;

ps: PString;

begin

New(ps);

mess := 'Hello World!';

ps^ := mess;

{发送特定消息}

PostMessage(Self.Handle, WM_TestMessage, Integer(PChar(ps)), 0

end;

//接收端

PS := PString(PMsg(Msg)^.WParam);

mess := PS^;

//Do Something

ShowMessage('已经截获该消息' + mess);

//加这一句会导致程序崩溃

Dispose(PS);

来源：http://www.coder163.com/language/delphi/console/钩子原理.html

推荐分享