Your Ad Here
首页 | 编程语言 | 网站建设 | 游戏天堂 | 冲浪宝典 | 网络安全 | 操作系统 | 软件时空 | 硬件指南 | 病毒相关 | IT 认证
软讯网络 > 编程语言 > Delphi > QQ聊天记录器演示程序(一)
【标  题】:QQ聊天记录器演示程序(一)
【关键字】:程序,QQ,聊天,聊天记录,QQ
【来  源】:网络

QQ聊天记录器演示程序(一)

Your Ad Here    注:本篇没有高手需要的内容,因为此文中的技术实在无新意可言,只是些简单的实现(可针对QQ2003和QQ2004版本),各位高手可以就此打住,若浪费宝贵时间,吾将深感不安。   作者网站:http://asp.itdrp.com/hottey

    嘘!好不容易有了一点轻松点的时候.现在才有时间把前几天做的QQ聊天记录器发上来和大家一起分享.做这个程序是看到最近网上有一个叫QQAutoReorder的软件.它所实现的功能就是对QQ聊天记录进行记录.所采用的技术是:对QQ对话框进行挂钩.它并不能对用户没有点击的QQ消息进行记录.(我认为若想对QQ消息进行实时记录,意思就是不等QQ消息框出来就记录下QQ的消息.可能只能去拦截QQ的数据封包了吧.我也花了一天时间在这上面,但最后的结论是’太自不量力了’^_^看来QQ的数据封包可不是那么容易就能得到的L)

   言归正传:本文采用对QQ消息框进行挂钩了方法(一来比较容易实现,二来也是大多数此类程序通用的方法.)为了简化程序:我将此程序分为两部实现(均于QQ2004下实现,到最后在兼容QQ2003的版本):

  一.   捕获别人给自己发来的消息:

  既然是挂钩QQ的消息框,自然得从众多的钩子类型中找出一种最为合理,也最方便的.很容易想到的是无论你用什么方式查看QQ的消息.总会导致一个QQ消息窗体的生成.就是会产生一个CREATE事件.从这一点上看,用一个WH_SHELL钩子是比较明智的.

  帮助上对WH_SHELL的说明是:监控Windows外壳通知消息,例如顶级窗口的创建的释放.我们这里要关心是窗口的创建消息.

  由于有可能一次出现多个QQ消息窗口的情况,我在这里使用全局钩子:并定义以下数据结构:


 HookType.Pas单元

unit HookType;

interface

uses

  Windows, Messages;
const

  WM_USERCMD   = WM_APP + 1;  file://用户自定应用程序级消息

  UC_WINCREATE  = WM_APP + 2;   file://QQ消息窗口创建

  UC_WINDESTROY = WM_APP + 3;  file://发送QQ消息

  BUFFER_SIZE  = 16 * 1024;

  HOOK_MEM_FILENAME = 'MEM_FILE';

type

  TShared = record


   KeyHook : HHook;   file://键盘钩子

    ShellHook: HHook;

    CallHook : HHook;

    MainWnd : THandle;  file://窗体的Handle(非Application.Handle)

    Moudle  : THandle;  file://DLL

  end;

  PShared = ^TShared;

implementation

end.
 


DLL单元代码


 var

  Memfile: THandle;

  Shared: PShared;

function ShellProc(iCode: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;

begin

  case iCode of

    HSHELL_WINDOWCREATED:

file://有顶级窗口创建时向演示程序发送自己定义消息WM_USERCMD. Wparamr参数说明

// wParam specifies the handle of the window being created or destroyed, respectively.

      PostMessage(Shared^.MainWnd,WM_USERCMD ,UC_WINCREATE,wParam);

  end;

  Result := CallNextHookEx(Shared^.ShellHook,iCode,wParam,lParam);

end;

function InstallHook:Boolean;


begin

  Shared^.Moudle:=GetModuleHandle(PChar('qqhook')); file://qqhook是我的DLL文件名.

  Shared^.ShellHook := SetWindowsHookEx(WH_SHELL,

                                      @ShellProc,

                                   Shared^.Moudle,

                                              0);

  if Shared^.ShellHook = 0 then

  begin

    Result := False;

    Exit;

  end;

  Result := true;

end;
 

{撤消钩子过滤函数}


 function UninstallHook: Boolean;

begin

  Freelibrary(Shared^.Moudle);

  Result:=UnHookWindowsHookEx(Shared^.ShellHook);

  UnmapViewOfFile(Shared);

  CloseHandle(memFile);

end;

procedure DllEntry(dwReason : integer);

begin

  case dwReason Of

    DLL_PROCESS_ATTACH:


 

       begin
            Memfile:= OpenFileMapping(FILE_MAP_WRITE,False,HOOK_MEM_FILENAME);

        if MemFile = 0 then

          MemFile := CreateFileMapping($FFFFFFFF,nil,

            PAGE_READWRITE,

            0,

            SizeOf(TShared),

            HOOK_MEM_FILENAME);

        Shared := MapViewOfFile(MemFile,

          File_MAP_WRITE,

          0,

          0,

          0);

      end;

    DLL_PROCESS_DETACH:

      begin

        file://UninstallHook;

      end;

    else;

  end;

end;

exports

  InstallHook;

begin


   DllProc := @DllEntry;
  DllEntry(DLL_PROCESS_ATTACH);

end.

file://上述代码对卸载钩子没有加太多说明,它不属于此范围讨论之内.

演示程序代码


 procedure TForm1.Button1Click(Sender: TObject);

begin

  InstallHook;

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

  Memfile:= OpenFileMapping(FILE_MAP_WRITE,False,HOOK_MEM_FILENAME);

  if MemFile = 0 then

  MemFile := CreateFileMapping($FFFFFFFF,nil,

            PAGE_READWRITE,

            0,

            SizeOf(TShared),

            HOOK_MEM_FILENAME);

  Shared := MapViewOfFile(MemFile,

          File_MAP_WRITE,

          0,

          0,

          0);

  Shared^.MainWnd := Handle;   file://保存窗体句柄

end;

file://窗口消息处理过程

procedure TForm1.WndProc(var Msg: TMessage);

begin

  with Msg do

  begin

    if Msg = WM_USERCMD then    file://DLL发来的自定义消息

      begin

      case wParam of

        UC_WINCREATE :         file://QQ消息框创建

        begin

          GetText(Findhwd(HWND(lParam)));  file://得到QQ消息框里的文本

        end;

      end;

   end;

 end;

 inherited;

end;

file://通过wParam参数找到QQ窗口句柄

function TForm1.Findhwd(parent: HWND):HWND;

var

  hwd,hBtn,hMemo:HWND;

begin

    result := 0;

     hwd:=findwindowex(parent,0,'#32770',nil);  file://QQ次级窗口句柄QQ2003及以前版本没有此项.

    if (hwd<>0) then

    begin

      hBtn := FindwindowEX(hwd,0,nil,'回讯息(&R)');   file://可以以此来证明是收到的QQ消息框.

      if (hBtn<>0) then

        begin

          hMemo := GetDlgItem(hwd,$00000380);        file://RichEdit的句柄,QQ消息就存在于此处.

          if (hMemo<>0) then

            result := hMemo;

        end;

    end;

end;

file://得到指定句柄控件中的文本.

procedure TForm1.GetText(hwd: HWND);

var

  Ret: LongInt;


  QQText: PChar;
  Buf: integer;

begin

  GetMem(QQText,1024);

  if (hwd<>0) then

  begin

  try

    Ret := SendMessage(hwd, WM_GETTEXTLENGTH, 0, 0) + 1;

    Buf := LongInt(QQText);

    SendMessage(hwd, WM_GETTEXT, Min(Ret, 1024), Buf);

    memo1.Lines.Add(QQText);  file://在Memo中显示文本

  finally

    FreeMem(QQText, 1024);

  end;

  end;

end;

以上是我测试时的代码,只是为了分类阐述的方便,才帖出来.也许还有些不合理的地方. 若这里有什么不详尽之处,在下篇将提供完整代码下载.

Delphi单元文件详解:【上一篇】
QQ聊天记录器演示程序(二):【下一篇】
【相关文章】
  • 利用Dephi5编写控制面板程序
  • 用Delphi编写Win2000服务程序
  • Delphi开发WEB应用程序打印组件
  • 用Delphi和Web Services开发短信应用程序
  • 基于MMX指令集的程序设计简介
  • 好玩实用:Delphi模拟QQ窗体伸缩功能
  • 开发基于DCOM的局域网聊天室(二)
  • 开发基于DCOM的局域网聊天室(一)
  • Delphi开发单机瘦小数据库程序要点
  • 用Delphi编写打印程序的窍门
  • 【随机文章】
  • 金融行业解决方案
  • 数据挖掘——CRM技术的助推剂
  • 要停下的mc?个实例名 0磁ブ屑
  • C++习题与解析(友元-01)
  • Javascript对象扩展 - Object
  • 删除索引
  • 备份精灵Ghost问答集锦
  • Pure-ftpd解决匿名登陆问题
  • 取到Sql Server中某数据库中所有用户建的表的字段
  • 关于IT维护团队管理的随笔
  • 【相关评论】
    没有相关评论
    【发表评论】
    姓名:
    邮件:
    随机码*
    评论*
          
    |  首 页  |  版权声明  |  联系我们   |  网站地图  |
    CopyRight © 2004-2007 bbb软讯网络 All Rigths Reserved.