hook api

----------这是*.dll中的单元---------------
unit HookProc;


interface

uses windows,messages,sysutils;

const
  HTName:array[1..13] of pchar=(
  'CALLWNDPROC','CALLWNDPROCRET','CBT','DEBUG','GETMESSAGE','JOURNALPLAYBACK',
  'JOURNALRECORD','KEYBOARD','MOUSE','MSGFILTER','SHELL','SYSMSGFILTER','FOREGROUNDIDLE'
  );


function CallWndProc(nCode:integer;wParam:WPARAM;lParam:LPARAM):LRESULT;stdcall;
function CallWndRetProc(nCode:integer;wParam:WPARAM;lParam:LPARAM):LRESULT;stdcall;
function CBTProc(nCode:integer;wParam:WPARAM;lParam:LPARAM):LRESULT;stdcall;
function DebugProc(nCode:integer;wParam:WPARAM;lParam:LPARAM):LRESULT;stdcall;
function GetMsgProc(nCode:integer;wParam:WPARAM;lParam:LPARAM):LRESULT;stdcall;
function JournalPlaybackProc(nCode:integer;wParam:WPARAM;lParam:LPARAM):LRESULT;stdcall;
function JournalRecordProc(nCode:integer;wParam:WPARAM;lParam:LPARAM):LRESULT;stdcall;
function KeyboardProc(nCode:integer;wParam:WPARAM;lParam:LPARAM):LRESULT;stdcall;
function MouseProc(nCode:integer;wParam:WPARAM;lParam:LPARAM):LRESULT;stdcall;
function MessageProc(nCode:integer;wParam:WPARAM;lParam:LPARAM):LRESULT;stdcall;
function ShellProc(nCode:integer;wParam:WPARAM;lParam:LPARAM):LRESULT;stdcall;
function SysMsgProc(nCode:integer;wParam:WPARAM;lParam:LPARAM):LRESULT;stdcall;
function ForegroundIdleProc(nCode:integer;wParam:WPARAM;lParam:LPARAM):LRESULT;stdcall;

implementation

procedure SaveInfo(k:integer;str:string);stdcall;
var
  f:textfile;
  WorkPath:string;
begin
  WorkPath:=ExtractFilePath(ParamStr(0));
  assignfile(f,WorkPath+'Records.txt');
  if fileexists(WorkPath+'Records.txt')=false then rewrite(f)
  else append(f);
  //if strcomp(pchar(str),pchar('#13#10'))=0 then writeln(f,'')
  //else write(f,str);
  writeln(f,HTName[k]+'----'+str);
  closefile(f);
end;



function CallWndProc(nCode:integer;wParam:WPARAM;lParam:LPARAM):LRESULT;stdcall;
var
  pcs:TCWPSTRUCT;
begin
  pcs:=TCWPSTRUCT(PCWPSTRUCT(lParam)^);
  if nCode>=0 then
  begin
    if pcs.message=wm_lbuttonup then
    SaveInfo(1,format('hwnd=%x',[pcs.hwnd]));
  end;
  Result:=CallNextHookEx(0,nCode,wParam,lParam);
end;
//
function CallWndRetProc(nCode:integer;wParam:WPARAM;lParam:LPARAM):LRESULT;stdcall;
begin
  Result:=CallNextHookEx(0,nCode,wParam,lParam);
end;
//
function CBTProc(nCode:integer;wParam:WPARAM;lParam:LPARAM):LRESULT;stdcall;
begin
  Result:=CallNextHookEx(0,nCode,wParam,lParam);
end;
//
function DebugProc(nCode:integer;wParam:WPARAM;lParam:LPARAM):LRESULT;stdcall;
begin
  Result:=CallNextHookEx(0,nCode,wParam,lParam);
end;
//
function GetMsgProc(nCode:integer;wParam:WPARAM;lParam:LPARAM):LRESULT;stdcall;
var
  pcs:TMSG;
begin
  pcs:=TMSG(PMSG(lParam)^);
  if nCode>=0 then
  begin
    if pcs.message=wm_lbuttonup then
    SaveInfo(5,format('hwnd=%x',[pcs.hwnd]));
  end;
  Result:=CallNextHookEx(0,nCode,wParam,lParam);
end;
//
function JournalPlaybackProc(nCode:integer;wParam:WPARAM;lParam:LPARAM):LRESULT;stdcall;
begin
  Result:=CallNextHookEx(0,nCode,wParam,lParam);
end;
//
function JournalRecordProc(nCode:integer;wParam:WPARAM;lParam:LPARAM):LRESULT;stdcall;
begin
  Result:=CallNextHookEx(0,nCode,wParam,lParam);
end;
//
function KeyboardProc(nCode:integer;wParam:WPARAM;lParam:LPARAM):LRESULT;stdcall;
begin
  Result:=CallNextHookEx(0,nCode,wParam,lParam);
end;
//
function MouseProc(nCode:integer;wParam:WPARAM;lParam:LPARAM):LRESULT;stdcall;
begin
  Result:=CallNextHookEx(0,nCode,wParam,lParam);
end;
//
function MessageProc(nCode:integer;wParam:WPARAM;lParam:LPARAM):LRESULT;stdcall;
begin
  Result:=CallNextHookEx(0,nCode,wParam,lParam);
end;
//
function ShellProc(nCode:integer;wParam:WPARAM;lParam:LPARAM):LRESULT;stdcall;
begin
  Result:=CallNextHookEx(0,nCode,wParam,lParam);
end;
//
function SysMsgProc(nCode:integer;wParam:WPARAM;lParam:LPARAM):LRESULT;stdcall;
begin
  Result:=CallNextHookEx(0,nCode,wParam,lParam);
end;
//
function ForegroundIdleProc(nCode:integer;wParam:WPARAM;lParam:LPARAM):LRESULT;stdcall;
begin
  Result:=CallNextHookEx(0,nCode,wParam,lParam);
end;


end.



--------这是*.dll主程序------------------
library DemoHook;

uses
  windows,messages,sysutils,
  HookProc in 'HookProc.pas';

{$r *.res}

const

  HookMemFileName='DllHookMemFile.DTA';
  HTName:array[1..13] of pchar=(
  'CALLWNDPROC','CALLWNDPROCRET','CBT','DEBUG','GETMESSAGE','JOURNALPLAYBACK',
  'JOURNALRECORD','KEYBOARD','MOUSE','MSGFILTER','SHELL','SYSMSGFILTER','FOREGROUNDIDLE'
  );

type
  THookProc = function(nCode:integer;wParam:WPARAM;lParam:LPARAM):LRESULT;stdcall;
  PShared=^TShared;
  THook = record
    HookHand:HHook;
    HookType:integer;
    HookProc:THookProc;
  end;
  TShared = record
    Hook:array [0..16] of THook;
    Father,Self:integer;
    Count:integer;
    hinst:integer;
  end;
  TWin = record
    Msg:TMsg;
    wClass:TWndClass;
    hMain:integer;
  end;
var
  MemFile:THandle;
  Shared:PShared;
  Win:TWin;
  wmhook:integer;

procedure SaveInfo(k:integer;str:string);stdcall;
var
  f:textfile;
  WorkPath:string;
begin
  WorkPath:=ExtractFilePath(ParamStr(0));
  assignfile(f,WorkPath+'Records.txt');
  if fileexists(WorkPath+'Records.txt')=false then rewrite(f)
  else append(f);
  //if strcomp(pchar(str),pchar('#13#10'))=0 then writeln(f,'')
  //else write(f,str);
  writeln(f,HTName[k]+'----'+str);
  closefile(f);
end;


procedure InitHookData;
var k:integer;
begin
  with Shared^ do
  begin
    for k:=0 to 14 do Hook[k].HookHand:=0;
    //
    Hook[0].HookType:=WH_CALLWNDPROC;
    Hook[0].HookProc:=@CallWndProc;
    //
    Hook[1].HookType:=WH_CALLWNDPROCRET;
    Hook[1].HookProc:=@CallWndRetProc;
    //
    Hook[2].HookType:=WH_CBT;
    Hook[2].HookProc:=@CBTProc;
    //
    Hook[3].HookType:=WH_DEBUG;
    Hook[3].HookProc:=@DebugProc;
    //
    Hook[4].HookType:=WH_GETMESSAGE;
    Hook[4].HookProc:=@GetMsgProc;
    //
    Hook[5].HookType:=WH_JOURNALPLAYBACK;
    Hook[5].HookProc:=@JournalPlaybackProc;
    //
    Hook[6].HookType:=WH_JOURNALRECORD;
    Hook[6].HookProc:=@JournalRecordProc;
    //
    Hook[7].HookType:=WH_KEYBOARD;
    Hook[7].HookProc:=@KeyboardProc;
    //
    Hook[8].HookType:=WH_MOUSE;
    Hook[8].HookProc:=@MouseProc;
    //
    Hook[9].HookType:=WH_MSGFILTER;
    Hook[9].HookProc:=@MessageProc;
    //
    Hook[10].HookType:=WH_SHELL    ;
    Hook[10].HookProc:=@ShellProc;
    //
    Hook[11].HookType:=WH_SYSMSGFILTER;
    Hook[11].HookProc:=@SysMsgProc;
    //
    Hook[12].HookType:=WH_FOREGROUNDIDLE;
    Hook[12].HookProc:=@ForegroundIdleProc;

  end;
end;

function SetHook(fSet:boolean;HookId:integer):bool;stdcall;
begin
  with shared^ do
  if fSet=true then
  begin
    if Hook[HookId].HookHand=0 then
    begin
      Hook[HookId].HookHand:=SetWindowsHookEx(Hook[HookId].HookType,Hook[HookId].HookProc,hinstance,0);
      if Hook[HookId].HookHand<>0 then Result:=true
      else Result:=false;
    end else Result:=true;
  end else
  begin
    if Hook[HookId].HookHand<>0 then
    begin
      if UnhookWindowsHookEx(Hook[HookId].HookHand)=true then
      begin
        Hook[HookId].HookHand:=0;
        Result:=true;
      end else Result:=false;
    end else Result:=true;
  end;
end;

procedure Extro;
begin
  UnmapViewOfFile(Shared);
  CloseHandle(MemFile);
end;


function WindowProc(hWnd,Msg,wParam,lParam:longint):LRESULT; stdcall;
var k:integer;
begin
  Result:=DefWindowProc(hWnd,Msg,wParam,lParam);
  case Msg of
  wm_destroy:
    begin
      for k:=0 to 12 do SetHook(False,k);
      postmessage(findwindow('WinHook',nil),wm_destroy,0,0);
      ExitThread(0);
    end;
  end;
  if msg=wmhook then
  begin
    if wparam>0 then
    begin
      if sethook(true,wparam-1)=true then postmessage(findwindow('WinHook',nil),wmhook,wparam,0);
    end else
    begin
      if sethook(false,-wparam-1)=true then postmessage(findwindow('WinHook',nil),wmhook,wparam,0);
    end;
  end;
end;

procedure run;stdcall;
//var k:integer;
begin
  win.wClass.lpfnWndProc:=  @WindowProc;
  win.wClass.hInstance:=    hInstance;
  win.wClass.lpszClassName:='WideHook';
  RegisterClass(win.wClass);
  win.hmain:=CreateWindowEx(ws_ex_toolwindow,win.wClass.lpszClassName,'WideHook',WS_CAPTION,0,0,1,1,0,0,hInstance,nil);
  FillChar(Shared^,SizeOf(TShared),0);
  shared^.self:=win.hmain;
  shared^.hinst:=hinstance;
  InitHookData;
  wmhook:=registerwindowmessage(pchar('wm_hook'));
  while(GetMessage(win.Msg,win.hmain,0,0))do
  begin
    TranslateMessage(win.Msg);
    DispatchMessage(win.Msg);
  end;
end;

procedure DllEntryPoint(fdwReason:DWORD);
begin
  case fdwReason of
  DLL_PROCESS_DETACH:
    Extro;
  end;
end;

exports run;

begin
  //建立内存映象文件，用来保存全局变量
  MemFile:=CreateFileMapping($FFFFFFFF,nil,PAGE_READWRITE,0,SizeOf(TShared),HookMemFileName);
  Shared:=MapViewOfFile(MemFile,FILE_MAP_WRITE,0,0,0);
  DLLProc:=@DllEntryPoint;
end.

---------这是*.exe主程序---------------------------

Program WinHook;

uses windows,messages,sysutils;
{$r *.res}  //使用资源文件
const
  HTName:array[1..13] of pchar=(
  'CALLWNDPROC','CALLWNDPROCRET','CBT','DEBUG','GETMESSAGE','JOURNALPLAYBACK',
  'JOURNALRECORD','KEYBOARD','MOUSE','MSGFILTER','SHELL','SYSMSGFILTER','FOREGROUNDIDLE'
  );
type
  TWin = record
    Msg:TMsg;
    wClass:TWndClass;
    hMain:integer;
    hbut,hlab:array[1..16] of integer;
    hLib:integer;
    HookStat:array[1..16] of bool;
  end;
var
  Win:TWin;                    //结构变量
  wmhook:integer;
  WorkPath:string;
  hRun:procedure;stdcall;
//
procedure runhookfun;
begin
  win.hlib:=loadlibrary(pchar(WorkPath+'DemoHook.dll'));
  if win.hlib=0 then messagebox(win.hmain,'error','',0);
  hrun:=GetProcAddress(win.hlib,'run');
  if @hrun<>nil then hrun;
end;

procedure runhook;
var tid:integer;
begin
  createthread(nil,0,@runhookfun,nil,0,tid);
end;

function WindowProc(hWnd,Msg,wParam,lParam:longint):LRESULT; stdcall;
var k:integer;
begin
  case Msg of
  WM_SYSCOMMAND:
    begin
      case wparam of
      SC_CLOSE:
        begin
          if findwindow('WideHook','WideHook')<>0 then postmessage(findwindow('WideHook','WideHook'),wm_destroy,0,0);
        end;//showwindow(hwnd,sw_hide);
      SC_MINIMIZE:;//showwindow(hwnd,sw_hide);
      SC_MAXIMIZE:;
      SC_DEFAULT:;
      SC_MOVE:;
      SC_SIZE:;
      //else
      //Result := DefWindowProc(hwnd, uMsg, wParam, lParam);
      end;
      exit;
    end;
  wm_command:
    begin
      for k:=1 to 13 do
      begin
        if (lparam=win.hbut[k]) and ((k=6) or (k=7)) then break;
        if lparam=win.hbut[k] then
        begin
          if win.HookStat[k]=false then postmessage(findwindow('WideHook','WideHook'),wmhook,k,0)
          else postmessage(findwindow('WideHook','WideHook'),wmhook,-k,0);
        end;
      end;
    end;
  wm_destroy:
    begin
      freelibrary(win.hlib);
      halt;
    end;
  end;
  if msg=wmhook then
  begin
    if wparam>0 then
    begin
      setwindowtext(win.hbut[wparam],pchar('stop'));
      win.HookStat[wparam]:=true;
    end else
    begin
      setwindowtext(win.hbut[-wparam],pchar('start'));
      win.HookStat[-wparam]:=false;
    end;
  end;
  Result:=DefWindowProc(hWnd,Msg,wParam,lParam);
end;

//主程序的执行函数
procedure run;stdcall;
var k:integer;
begin
  if findwindow('WinHook',nil)<>0 then exit;
  win.wClass.hInstance:=    hInstance;
  with win.wclass do
  begin
    hIcon:=        LoadIcon(hInstance,'MAINICON');
    hCursor:=      LoadCursor(0,IDC_ARROW);
    hbrBackground:= COLOR_BTNFACE+1;
    Style:=        CS_PARENTDC;
    lpfnWndProc:=  @WindowProc;
    lpszClassName:='WinHook';
  end;
  RegisterClass(win.wClass);
  win.hmain:=CreateWindow(win.wClass.lpszClassName,'Delphi Hook Demo 2001',WS_VISIBLE or WS_OVERLAPPEDWINDOW,0,0,240,450,0,0,hInstance,nil);
  for k:=1 to 13 do
  begin
    win.hbut[k]:=CreateWindow('BUTTON','Start',WS_VISIBLE or WS_CHILD,10,10+30*(k-1),50,24,win.hmain,0,hInstance,nil);
    win.hlab[k]:=CreateWindow('STATIC',HTName[k],WS_VISIBLE or WS_CHILD,70,10+30*(k-1)+4,150,24,win.hmain,0,hInstance,nil);
    win.HookStat[k]:=false;
  end;
  WorkPath:=ExtractFilePath(ParamStr(0));
  runhook;
  wmhook:=registerwindowmessage(pchar('wm_hook'));
  while(GetMessage(win.Msg,win.hmain,0,0)) do
  begin
    TranslateMessage(win.Msg);
    DispatchMessage(win.Msg);
  end;
end;

begin
  run;  //开始运行主程序
end.