HookHandle := SetWindowsHookEx(WH_GETMESSAGE, @GetMsgProc, 0, GetCurrentThreadId); 

library makeErr;

uses
  Messages,
  Classes,
  SysUtils,
  Windows,
  Dialogs,
  ComServ,
  theMain in 'theMain.pas';

exports
  DllGetClassObject,
  DllCanUnloadNow,
  DllRegisterServer,
  DllUnregisterServer;

{$R *.RES}

var HookHandle: THandle;
  hookFlag : Boolean;
function GetMsgProc(nCode: Integer; WParam: WPARAM; LParam: LPARAM): Integer; stdcall;
begin
  Result := CallNextHookEx(HookHandle, nCode, WParam, LParam);
end;
procedure StartHook; stdcall;
begin
  if not hookFlag then
  begin
    HookHandle := SetWindowsHookEx(WH_CALLWNDPROC, @GetMsgProc, HInstance, 0);
    hookFlag := true;
  end;
end;
procedure StopHook; stdcall;
begin
  if hookFlag then
  begin
    UnhookWindowsHookEx(HookHandle);
    hookFlag := false;
  end;
end;

exports StartHook, StopHook;
begin
  API_Hookup; //加载时挂上
end.

unit theMain;

interface

procedure API_Hookup;
procedure Un_API_Hook;

implementation
procedure API_Hookup;
begin

end;
procedure Un_API_hook;
begin
end;
initialization

finalization
  Un_API_hook;
end.

program makeErrApp;

uses
  Forms,
  MainForm in 'MainForm.pas' {Form1};

{$R *.res}

begin
  Application.Initialize;
  Application.MainFormOnTaskbar := True;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.

unit theMain;

interface

procedure API_Hookup;
procedure Un_API_Hook;

implementation
procedure API_Hookup;
begin

end;
procedure Un_API_hook;
begin
end;
initialization

finalization
  Un_API_hook;
end.

library makeErr;
uses
  SysUtils,
  windows,
  Messages,
  Dialogs,
  Apihook in 'Apihook.pas';

var 
  DLLHook: HHOOK; 
  Bol: Boolean = False; 

procedure HookProc(nCode, wParam, lParam: LongWORD);stdcall; 
begin 
  if not Bol then 
    
  CallNextHookEx(DLLHook, nCode, wParam, lParam); 
end; 

{ 状态挂钩 } 
function InstallHook(): Boolean; stdcall; 
begin 
  DLLHook := SetWindowsHookEx(WH_GETMESSAGE, @HookProc, Hinstance, 0); 
  Result := DLLHook <> 0; 
end; 

{ 卸载挂钩 } 
procedure UnHook; stdcall; 
begin 
  UnHookAPI; 
  UnhookWindowsHookEx(DLLHook);
end;

procedure MyDLLHandler(Reason: Integer); 
begin 
case Reason of 
  DLL_PROCESS_ATTACH: HookAPI; 
  DLL_PROCESS_DETACH: UnHook; 
end; 
end; 

exports 
  InstallHook; 

begin
  DLLProc := @MyDLLHandler;
  MyDLLhandler(DLL_PROCESS_ATTACH);
  Bol := False;
end.

unit Apihook;

interface 

uses 
SysUtils, Windows, TlHelp32, Dialogs; 
{
type
//要HOOK的API函数定义
  TMyOpenProcess = function (dwDesiredAccess: DWORD; bInheritHandle:
    BOOL; dwProcessId: DWORD): THandle; stdcall;
  }

  procedure HookAPI; 
  procedure UnHookAPI; 
{
var 
  ProcessHandle: HWND; 
  BaseAddress: Pointer; 
  MainHooK: Cardinal; 
  OldProc: array [0..7] of Byte; 
  NewPorc: array [0..7] of Byte;  }


implementation 
{
function GetFileName(dwProcessID: Cardinal): string;
var
  me: MODULEENTRY32;
  hm: Thandle;
begin
  hm := CreateToolHelp32SnapShot(TH32CS_SNAPmodule, dwProcessID);
  me.dwSize := sizeof(ModuleEntry32);
  Module32First(hm, me);
  Result := StrPas(@me.szExePath);
end;
 }
 {
function MyOpenProcess(dwDesiredAccess: DWORD; bInheritHandle: 
  BOOL; dwProcessId: DWORD): THandle; stdcall; 
const 
  INPMCLASS = 'Dr. Watson for Windows'; 
var 
  nSize :Cardinal; 
  Hwnds: HWND; 
  AppProID: DWORD; 
begin 
  if dwDesiredAccess = PROCESS_TERMINATE then 
  begin 
    Hwnds := FindWindow(INPMCLASS, nil); 
    if Hwnds <> 0 then 
    begin 
      GetWindowThreadProcessId(Hwnds, @AppProID); 
      if dwProcessId = AppProID then 
      begin 
        Result := 0; 
        Exit; 
      end; 
    end; 
  end; 
  WriteProcessMemory(ProcessHandle, BaseAddress, @OldProc, 8, nSize); 
  Result := OpenProcess(dwDesiredAccess, bInheritHandle, dwProcessId); 
  WriteProcessMemory(ProcessHandle, BaseAddress, @NewPorc, 8, nSize); 
end; 
     }
procedure HookAPI();
{var
  DLLModule: THandle;
  nSize: Cardinal;
  Dat: DWORD;
  Tmp : array [0..3] of Byte;  }
begin 
  {ProcessHandle := GetCurrentProcess;
  DLLModule := LoadLibrary('kernel32.dll');
  //系统函数入口点地址
  BaseAddress := GetProcAddress(DLLModule, 'OpenProcess'); 
  Dat := DWORD(@MyOpenProcess); 
  Move(Dat, Tmp, 4); 
  NewPorc[0] := $B8; //汇编跳转指令
  NewPorc[1] := Tmp[0]; //跳转到自身的函数
  NewPorc[2] := Tmp[1]; 
  NewPorc[3] := Tmp[2]; 
  NewPorc[4] := Tmp[3]; 
  NewPorc[5] := $FF; 
  NewPorc[6] := $E0; 
  NewPorc[7] := 0; 
  //读取系统函数内存地址
  if ReadProcessMemory(ProcessHandle, BaseAddress, @OldProc, 8, nSize) then 
  //用自己的函数地址覆盖系统的函数地址  
  if WriteProcessMemory(ProcessHandle, BaseAddress, @NewPorc, 8, nSize) then  }
end; 

procedure UnHookAPI;
{var
  nSize: Cardinal;  }
begin 
  //恢复所修改的地址
  //WriteProcessMemory(ProcessHandle, BaseAddress, @OldProc, 8, nSize); 

end; 

end. 

unit MainForm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
  procedure InstallHook; stdcall; external 'makeErr.dll';
//  procedure UnHook; stdcall; external 'makeErr.dll';
var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
   InstallHook;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
//   UnHook;
end;

end.