Delphi中Hook技术全接触

看到有的兄弟说Delphi下的Hook不好做,所以在下把每个Hook都在Delphi做了一下,觉得没啥问题,而且处理的方法较新颖,拿来让兄弟们探讨,关于hook问题,有不懂的问我就行,不过有的Hook我只做了个框架,没有具体实用作用,要做的兄弟自已完善就行了,呵呵,代码在下面,自已看啦..........

-------------------------------------------

我的联系方法:

oicq; 10772919

e-mail: njhhack@21cn.com

homepage: hotsky.363.net

--------------------------------------------

----------这是*.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;

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;

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;

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;

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;

procedure DllEntryPoint(fdwReason:DWORD);

begin

case fdwReason of

DLL_PROCESS_DETACH:

Extro;

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;

wm_destroy:

begin

freelibrary(win.hlib);

halt;

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;

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;

begin

run; //开始运行主程序

end.