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

注:本篇没有高手需要的内容(因为此文中的技术实在无新意可言,只是些简单的实现),各位高手可以就此打住,若浪费宝贵时间,吾将深感不安.
　　 作者网站:http://asp.itdrp.com/hottey ----------------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; //用户自定应用程序级消息
　　 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;
　　
　　以上是我测试时的代码,只是为了分类阐述的方便,才帖出来.也许还有些不合理的地方. 若这里有什么不详尽之处,在下篇将提供完整代码下载.