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