此篇代码是在读完【Delphi高手突破】中关于消息处理一章之后尝试的代码,保留下来了

自定义消息拦截

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;

  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.

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

优化代码如下

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);