Moodsky 发表于 2007-2-8 16:42:05

Delphi中Hook技术全接触

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

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


interface

uses windows,messages,sysutils;

const
HTName:array 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+'----'+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',));
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',));
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 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 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+'----'+str);
closefile(f);
end;


procedure InitHookData;
var k:integer;
begin
with Shared^ do
begin
   for k:=0 to 14 do Hook.HookHand:=0;
   //
   Hook.HookType:=WH_CALLWNDPROC;
   Hook.HookProc:=@CallWndProc;
   //
   Hook.HookType:=WH_CALLWNDPROCRET;
   Hook.HookProc:=@CallWndRetProc;
   //
   Hook.HookType:=WH_CBT;
   Hook.HookProc:=@CBTProc;
   //
   Hook.HookType:=WH_DEBUG;
   Hook.HookProc:=@DebugProc;
   //
   Hook.HookType:=WH_GETMESSAGE;
   Hook.HookProc:=@GetMsgProc;
   //
   Hook.HookType:=WH_JOURNALPLAYBACK;
   Hook.HookProc:=@JournalPlaybackProc;
   //
   Hook.HookType:=WH_JOURNALRECORD;
   Hook.HookProc:=@JournalRecordProc;
   //
   Hook.HookType:=WH_KEYBOARD;
   Hook.HookProc:=@KeyboardProc;
   //
   Hook.HookType:=WH_MOUSE;
   Hook.HookProc:=@MouseProc;
   //
   Hook.HookType:=WH_MSGFILTER;
   Hook.HookProc:=@MessageProc;
   //
   Hook.HookType:=WH_SHELL    ;
   Hook.HookProc:=@ShellProc;
   //
   Hook.HookType:=WH_SYSMSGFILTER;
   Hook.HookProc:=@SysMsgProc;
   //
   Hook.HookType:=WH_FOREGROUNDIDLE;
   Hook.HookProc:=@ForegroundIdleProc;

end;
end;

function SetHook(fSet:boolean;HookId:integer):bool;stdcall;
begin
with shared^ do
if fSet=true then
begin
   if Hook.HookHand=0 then
   begin
   Hook.HookHand:=SetWindowsHookEx(Hook.HookType,Hook.HookProc,hinstance,0);
   if Hook.HookHand<>0 then Result:=true
   else Result:=false;
   end else Result:=true;
end else
begin
   if Hook.HookHand<>0 then
   begin
   if UnhookWindowsHookEx(Hook.HookHand)=true then
   begin
       Hook.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 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 of integer;
   hLib:integer;
   HookStat:array 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) and ((k=6) or (k=7)) then break;
       if lparam=win.hbut then
       begin
         if win.HookStat=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,pchar('stop'));
   win.HookStat:=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:=CreateWindow('BUTTON','Start',WS_VISIBLE or WS_CHILD,10,10+30*(k-1),50,24,win.hmain,0,hInstance,nil);
   win.hlab:=CreateWindow('STATIC',HTName,WS_VISIBLE or WS_CHILD,70,10+30*(k-1)+4,150,24,win.hmain,0,hInstance,nil);
   win.HookStat:=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.
页: [1]
查看完整版本: Delphi中Hook技术全接触