嘘!好不容易有了一点轻松点的时候.现在才有时间把前几天做的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;  //用户自定应用程序级消息 


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


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


  BUFFER_SIZE  = 16 * 1024; 


  HOOK_MEM_FILENAME = 'MEM_FILE'; 


type 


  TShared = record 


    KeyHook : HHook;   //键盘钩子 


    ShellHook: HHook; 


    CallHook : HHook; 


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


    Moudle  : THandle;  //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: 


//有顶级窗口创建时向演示程序发送自己定义消息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')); //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 


        //UninstallHook; 


      end; 


    else; 


  end; 


end; 


  


  


exports 


  InstallHook; 


  


begin 


  DllProc := @DllEntry; 


  DllEntry(DLL_PROCESS_ATTACH); 


end.




 



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



 



演示程序代码



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;   //保存窗体句柄 


end; 


  


//窗口消息处理过程 


procedure TForm1.WndProc(var Msg: TMessage); 


begin 


  with Msg do 


  begin 


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


      begin 


      case wParam of 


        UC_WINCREATE :         //QQ消息框创建 


        begin 


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


        end; 


      end; 


   end; 


 end; 


 inherited; 


end; 


  


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


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


var 


  hwd,hBtn,hMemo:HWND; 


begin 


    result := 0; 


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


    if (hwd<>0) then 


    begin 


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


      if (hBtn<>0) then 


        begin 


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


          if (hMemo<>0) then 


            result := hMemo; 


        end; 


    end; 


end; 


  


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


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);  //在Memo中显示文本 


  finally 


    FreeMem(QQText, 1024); 


  end; 


  end; 


end;




 



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



hottey