转至繁体中文版     | 网站首页 | 图文教程 | 资源下载 | 站长博客 | 图片素材 | 武汉seo | 武汉网站优化 | 
最新公告:     敏韬网|教学资源学习资料永久免费分享站!  [mintao  2008年9月2日]        
您现在的位置: 学习笔记 >> 图文教程 >> 软件开发 >> Delphi程序 >> 正文
win32下的系统日志钩子示例程序(Delphi 版)         ★★★★

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

作者:闵涛 文章来源:闵涛的学习笔记 点击数:806 更新时间:2009/4/23 18:44:20
{
   win9X,NT,w2k 中的系统日志钩子示例程序(Delphi 版)
   -----------------------------------------------------
   windows下的日志钩子是一种很有用的HOOK类型,他不需要动态链接库*.DLL,就能实现
   系统级的事件监控,它只能监视两种硬件的事件,即鼠标,键盘的操作,而不能监视其它
   消息,被记录的消息可以用日志回放钩子将它还原,下面这个程序用Delphi设计,没有
   用delphi的控件,只用了win32 api,所以通用于Delphi的任何版本,当然你也可以用c
   来实现,有看不懂的可以写信给我,这是第一版,可能有BUG,大家发现了通知我一下,欢
   迎大家和我一起来讨论HOOK技术:
   -----------------------------------------------------
       First Created:njhhack  2001.6.14  (ver1.0)
       电子信箱:njhhack@21cn.com
       主页:hotsky.363.net
}
Program Journal;
//包含如下头文件
uses windows,messages,sysutils;
{$r *.res}  //使用资源文件
//定义一个新的结构类型
type
 TWin = record
   Msg:TMsg;                  
   wClass:TWndClass;
   hMain:integer;
   lr:trect;
   tem:TEVENTMSG;
 end;
var
 Win:TWin;                    //结构变量
 HHJournalRecordProc:integer;  //日志钩子句柄
//将字符串str写到文件c:\key.txt中  
procedure SaveInfo(str:string);stdcall;
var
 f:textfile;
 fname:string;
begin
 fname:=''''c:\key.txt'''';
 assignfile(f,fname);
 if fileexists(fname)=false then rewrite(f)
 else append(f);
 writeln(f,str);
 closefile(f);
end;

//将信息写到屏幕
procedure writestr;
var
 hdc:integer;
 str:string;
begin
 hdc:=getdc(win.hmain);
 RoundRect(hdc,10,10,240,140,12,8);
 with win.tem do
 begin
   str:=format(''''窗口句柄=%x'''',[hwnd]);
   textout(hdc,30,24*1,pchar(str),length(str));
   str:=format(''''鼠标位置=(%d,%d)'''',[paraml,paramh]);
   textout(hdc,30,24*2,pchar(str),length(str));
   str:=format(''''消息类型=%x'''',[message]);
   textout(hdc,30,24*3,pchar(str),length(str));
   str:=format(''''时间=%d'''',[time div 1000]);
   textout(hdc,30,24*4,pchar(str),length(str));
 end;
 releasedc(win.hmain,hdc);
end;
//日志钩子的回调函数
function JournalRecordProc(nCode:integer;wParam:WPARAM;lParam:LPARAM):LRESULT;stdcall;
begin
 win.tem:=TEVENTMSG(PEVENTMSG(lParam)^);
 if nCode>=0 then
 begin
   with win.tem do
   begin
     with win.lr do
     begin
       left:=10;
       top:=10;
       right:=240;
       bottom:=140;
     end;
     InvalidateRect(win.hmain,@win.lr,false);
     if message=wm_lbuttondown then
     begin
       SaveInfo(format(''''窗口句柄=%x,鼠标位置=(%d,%d),消息类型=WM_LBUTTONDOWN,时间=%d'''',[hwnd,paraml,paramh,time div 1000]));
     end;
   end;
 end;
 Result:=CallNextHookEx(HHJournalRecordProc,nCode,wParam,lParam); //调用下一个钩子
end;
//钩子设置和删除函数
procedure SetHook(fSet:boolean);
begin
 if fSet=true then
 begin
   if HHJournalRecordProc=0 then HHJournalRecordProc:=SetWindowsHookEx(WH_JOURNALRECORD,@JournalRecordProc,hinstance,0);
 end else
 begin
   if HHJournalRecordProc<>0 then UnhookWindowsHookEx(HHJournalRecordProc);
 end;
end;
//主程序的回调函数
function WindowProc(hWnd,Msg,wParam,lParam:longint):LRESULT; stdcall;
begin
 Result:=DefWindowProc(hWnd,Msg,wParam,lParam);
 case Msg of
 wm_paint:writestr;
 wm_destroy:begin SetHook(False);halt;end;
 end;
end;
//主程序的执行函数
procedure run;stdcall;
begin
 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:=''''JournalRecordHook'''';
 end;
 RegisterClass(win.wClass);
 win.hmain:=CreateWindow(win.wClass.lpszClassName,''''系统日志钩子演示程序'''',WS_VISIBLE or WS_OVERLAPPEDWINDOW,10,10,260,180,0,0,hInstance,nil);
 SetHook(true);
 while(GetMessage(win.Msg,win.hmain,0,0))do
 begin
   TranslateMessage(win.Msg);
   DispatchMessage(win.Msg);
 end;
end;

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



[系统软件]InstallShield Express for delphi制作安装程序定…  [常用软件]InstallShield Express制作Delphi数据库安装程序
[Delphi程序]为什么选择Delphi.Net ?  [Delphi程序]《关于VisiBroker For Delphi的使用》(4)
[Delphi程序]Delphi 程序员代码编写标准指南  [Delphi程序]转贴:Conversion to Delphi 6: Missing unit Pro…
[Delphi程序]Borland Delphi 9 的新特性  [Delphi程序]Delphi 键盘码表
[Delphi程序]Chuck Jazdzewski的离开意味着Delphi的终结吗?  [Delphi程序]Delphi Access violations 问题的解决之道
教程录入:mintao    责任编辑:mintao 
  • 上一篇教程:

  • 下一篇教程:
  • 【字体: 】【发表评论】【加入收藏】【告诉好友】【打印此文】【关闭窗口
      注:本站部分文章源于互联网,版权归原作者所有!如有侵权,请原作者与本站联系,本站将立即删除! 本站文章除特别注明外均可转载,但需注明出处! [MinTao学以致用网]
      网友评论:(只显示最新10条。评论内容只代表网友观点,与本站立场无关!)

    同类栏目
    · C语言系列  · VB.NET程序
    · JAVA开发  · Delphi程序
    · 脚本语言
    更多内容
    热门推荐 更多内容
  • 没有教程
  • 赞助链接
    更多内容
    闵涛博文 更多关于武汉SEO的内容
    500 - 内部服务器错误。

    500 - 内部服务器错误。

    您查找的资源存在问题,因而无法显示。

    | 设为首页 |加入收藏 | 联系站长 | 友情链接 | 版权申明 | 广告服务
    MinTao学以致用网

    Copyright @ 2007-2012 敏韬网(敏而好学,文韬武略--MinTao.Net)(学习笔记) Inc All Rights Reserved.
    闵涛 投放广告、内容合作请Q我! E_mail:admin@mintao.net(欢迎提供学习资源)

    站长:MinTao ICP备案号:鄂ICP备11006601号-18

    闵涛站盟:医药大全-武穴网A打造BCD……
    咸宁网络警察报警平台