Delphi中Hook技术全接触(2)

2008-04-09 04:30:39来源:互联网 阅读 ()

新老客户大回馈,云服务器低至5折


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

标签:

版权申明:本站文章部分自网络,如有侵权,请联系:west999com@outlook.com
特别注意:本站所有转载文章言论不代表本站观点,本站所提供的摄影照片,插画,设计作品,如需使用,请与原作者联系,版权归原作者所有

上一篇:win32下的系统日志钩子示例程序(Delphi 版)

下一篇:*****查看技术